/*                                                                            *
 *   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-15 06:43:42 $
 * $Revision: 1.238 $
 * $Name: not supported by cvs2svn $
 */

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

/*----------------------------------------------------------------------------
                                 Includes
 ----------------------------------------------------------------------------*/
#include <assert.h>
#include <stdarg.h>
#include <time.h>
#include <math.h>
#include <stdlib.h>
#include <fcntl.h> /* used for fileutils_copy/move */
#include <sys/stat.h>/* used for fileutils_copy/move */

#include "xsh_utils.h"
#include <xsh_utils_wrappers.h>
#include <xsh_dfs.h>
#include <xsh_data_pre.h>
#include <xsh_dump.h>
#include <xsh_error.h>
#include <xsh_msg.h>
#include <xsh_parameters.h>
#include <xsh_data_spectrum.h>
#include <xsh_data_atmos_ext.h>
#include <xsh_pfits.h>
#include <xsh_pfits_qc.h>

#include <cpl.h>
#include <ctype.h>
#include <stdbool.h>

#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_multifit_nlin.h>
#include <gsl/gsl_version.h>

/*----------------------------------------------------------------------------
                                 Variables
 ----------------------------------------------------------------------------*/
static int XshDebugLevel = XSH_DEBUG_LEVEL_NONE ;
static int XshTimeStamp = FALSE ;

/*----------------------------------------------------------------------------
                                 Defines
 ----------------------------------------------------------------------------*/
#define MAXIMUM(x, y) ((x) > (y)) ? (x) : (y)
/* Caveat: multiple evalutation of arguments */

#define DEV_BLOCKSIZE   4096  /* used for fileutils_copy/move */
#define XSH_ATM_EXT_UVB_WAV_MIN 310.
/*---------------------------------------------------------------------------*/
/**
 * @defgroup xsh_utils     Tools: Miscellaneous Utilities
 *
 * This module is for the stuff that don't fit anywhere else. It should be
 * kept as small as possible.
 *
 */
/*---------------------------------------------------------------------------*/

/**@{*/
/*
#define CPL_TYPE double
#define CPL_TYPE_T CPL_TYPE_DOUBLE
#define CPL_IMAGE_GET_DATA cpl_image_get_data_double
#define CPL_IMAGE_GET_DATA_CONST cpl_image_get_data_double_const
#define CPL_IMAGE_GET_MEDIAN cpl_tools_get_median_double
*/

#define CPL_TYPE float
#define CPL_TYPE_T CPL_TYPE_FLOAT
#define CPL_IMAGE_GET_DATA cpl_image_get_data_float
#define CPL_IMAGE_GET_DATA_CONST cpl_image_get_data_float_const
#define CPL_IMAGE_GET_MEDIAN cpl_tools_get_median_float




void
xsh_random_init(void)
{
   time_t t;

   /* Intializes random number generator */
   srand((unsigned) time(&t));

   return;
}
/*----------------------------------------------------------------------------*/
/**
 *
  @brief    generates random integer values  in range [v1,v2]
  @param    v1 min value
  @param    v2 max value
  @return   random integer value
 */
/*----------------------------------------------------------------------------*/
int
xsh_get_random_int_window(const int v1, const int v2) {

    long double a=(double)v1,b=(double)v2;
    long double x1;
    //srand((unsigned)time(NULL));

    // x1 will be an element of [a,b]
    x1=( (long double) rand() / RAND_MAX ) * (b-a) + a;

    return (int)x1;
}

/*----------------------------------------------------------------------------*/
/**
 *
  @brief    generates random integer values  in range [v1,v2]
  @param    v1 min value
  @param    v2 max value
  @return   random integer value
 */
/*----------------------------------------------------------------------------*/
double
xsh_get_random_double_window(const double v1, const double v2) {

    long double a=v1,b=v2;
    long double x1;

    srand((unsigned)time(NULL));

    /* x1 will be an element of [a,b] */
    x1=((long double)rand()/RAND_MAX)*(b-a) + a;

    return x1;
}


/**
  @brief    Average with sigma-clipping rejection an imagelist to a single image
  @param    imlist  the input images list
  @param    sigma_low   the sigma value to clip low signal pixels
  @param    sigma_upp   the sigma value to clip high signal pixels
  @param    niter       the number of clipping iterations
  @return   the average image or NULL on error case.

  The returned image has to be deallocated with cpl_image_delete().

  The bad pixel maps of the input frames are not taken into account, and 
  the one of the created image is empty.

  For each pixel position the pixels whose value is higher than
  mean+sigma_upp*stdev or lower than mean-sigma_low*stdev are discarded for the 
  average computation. If all pixels are discarde, the reslting pixel is 0.
  Where mean is the average of the pixels at that position, and stdev is
  the standard deviation of the pixels at that position.

  The input image list can be of type CPL_TYPE_INT, CPL_TYPE_FLOAT and
  CPL_TYPE_DOUBLE.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT if (one of) the input pointer(s) is NULL
  - CPL_ERROR_ILLEGAL_INPUT if the input image list is not valid or if
  sigma is negative
  - CPL_ERROR_TYPE_MISMATCH if the passed image list type is not supported
 */
/*----------------------------------------------------------------------------*/
cpl_image * xsh_imagelist_collapse_sigclip_iter_create(
        const cpl_imagelist *   imlist,
        double                  sigma_low,
        double                  sigma_upp,
        const int               niter)

{
    const cpl_image *   cur_ima=NULL ;
    int                 ni, nx, ny ;
    cpl_table       *   time_line=NULL ;
    cpl_image       *   out_ima=NULL ;
    double              out_val ;
    //int                 nb_val ;
    double              mean, stdev ;
    double              low_thresh, high_thresh ;
    int                 i, j, k ; 
 
    /* Check inputs */
    cpl_ensure(imlist != NULL, CPL_ERROR_NULL_INPUT, NULL);
    cpl_ensure(cpl_imagelist_is_uniform(imlist)==0, CPL_ERROR_ILLEGAL_INPUT,
               NULL);
    cpl_ensure(sigma_low>1., CPL_ERROR_ILLEGAL_INPUT, NULL);
    cpl_ensure(sigma_upp>1., CPL_ERROR_ILLEGAL_INPUT, NULL);
    cpl_ensure(niter > 0, CPL_ERROR_NULL_INPUT, NULL);
 
    ni = cpl_imagelist_get_size(imlist) ;

    cur_ima = cpl_imagelist_get_const(imlist, 0) ;
    nx = cpl_image_get_size_x(cur_ima) ;
    ny = cpl_image_get_size_y(cur_ima) ;
 

    /* Create the table to hold pixel points */
    time_line = cpl_table_new(ni) ;
 

    /* Switch on the data type */


    //case CPL_TYPE_T:
    {
 
        CPL_TYPE       * pout_ima ;
         const CPL_TYPE * pcur_ima ;
         int n=0;   
        int nbad=0;
        CPL_TYPE       * ptime_line ;
      
         cpl_table_new_column(time_line,"VAL",CPL_TYPE_T);
         cpl_table_fill_column_window(time_line,"VAL",0,ni,0);
        if (CPL_TYPE_T == CPL_TYPE_DOUBLE) {
           ptime_line = (CPL_TYPE*) cpl_table_get_data_double(time_line,"VAL") ;
        } else if (CPL_TYPE_T == CPL_TYPE_FLOAT) {
           ptime_line = (CPL_TYPE*) cpl_table_get_data_float(time_line,"VAL") ;
        } else {
           ptime_line = (CPL_TYPE*) cpl_table_get_data_int(time_line,"VAL") ;
        }
        out_ima = cpl_image_new(nx, ny, CPL_TYPE_T) ;
        pout_ima = CPL_IMAGE_GET_DATA(out_ima) ;
        /* Loop on the pixels */
        for (j=0 ; j<ny ; j++) {
            for (i=0 ; i<nx ; i++) {
                /* Fill the vector */

                for (k=0 ; k<ni ; k++) {
                    cur_ima = cpl_imagelist_get_const(imlist, k) ;
                    pcur_ima = CPL_IMAGE_GET_DATA_CONST(cur_ima) ;
                    ptime_line[k] = (CPL_TYPE)pcur_ima[i+j*nx] ;
                }

                /* do kappa-sigma clip */
                
                for(n=0, nbad=0;(n<niter) && (nbad<ni-1);n++) {
                /* Get the mean and stdev */
                   check(mean  = cpl_table_get_column_mean(time_line,"VAL")) ;
                   check(stdev = cpl_table_get_column_stdev(time_line,"VAL")) ;
                   low_thresh = mean - sigma_low * stdev ;
                   high_thresh = mean + sigma_upp * stdev ;

                   /* Compute the final value */
                   out_val = 0.0 ;
                   //nb_val = 0 ;
                   for (k=0 ; k<ni ; k++) {
                      if (ptime_line[k]<=high_thresh && 
                          ptime_line[k]>=low_thresh) {
                         /* good pixel */
                      } else {
                         cpl_table_set_invalid(time_line,"VAL",k);
                         nbad++;
                      }
                   }
                }
                /* set out value equal to now clean mean of inputs */
                out_val  = cpl_table_get_column_mean(time_line,"VAL") ;
                /* Set the output image pixel value */
                pout_ima[i+j*nx] = (CPL_TYPE)out_val ;
            }
        }
        //break ;
    }

  cleanup:
    cpl_table_delete(time_line) ;


    /* Return */
    return out_ima ;
}




/**
  @brief    Convert a double from hours minute seconds to deg:
  @param    hms   angle in hours minute second units 
  @return 0 if suggess, else -1;
*/

double
xsh_hms2deg(const double hms)
{
  int hrs=0;
  int min=0;
  double sec=0;
  double deg=0;
  double rest=hms;
  int sign=1;
 
  if(hms<0) {
    sign=-1;
    rest=-hms;
  }
 
  hrs=(int)(rest/10000.);
  rest=rest-(double)(hrs*10000.);
  min=(int)(rest/100.);
  sec=rest-(double)(min*100.);
  deg=hrs*15+(double)(min/4.)+(double)(sec/240.);
  deg=sign*deg;

  return deg;

}


/**
  @brief    Convert a double from ssessagesimal to deg:
            203049.197= 20:30:49.197 = 20.5136658333
  @param    sess   angle in seesagesimal units (see above)
  @return 0 if suggess, else -1;
*/
double
xsh_sess2deg(const double sess)
{
  int grad=0;
  int min=0;
  double sec=0;
  double deg=0;
  double rest=sess;
  int sign=1;
 
  if(sess<0) {
    sign=-1;
    rest=-sess;
  }
  grad=(int)(rest/10000.);
  rest=rest-(double)(grad*10000.);
  min=(int)(rest/100.);
  sec=rest-(double)(min*100.);
  deg=grad+(double)(min/60.)+(double)(sec/3600.);
  deg=sign*deg;

  return deg;

}

/**
  @brief    Check if an input frame is not binned
  @param    in   input frame
  @return   cpl error code
*/
cpl_error_code
xsh_check_input_is_unbinned(cpl_frame* in)
{

  cpl_propertylist* plist=NULL;
  const char* name=NULL;
  int binx=0;
  int biny=0;

  if(in==NULL) {
    cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT); 
    return cpl_error_get_code();
  }
  name=cpl_frame_get_filename(in);
  plist=cpl_propertylist_load(name,0);
  
  binx=xsh_pfits_get_binx(plist);
  biny=xsh_pfits_get_biny(plist);

  xsh_free_propertylist(&plist);
  if(binx*biny > 1) {
    xsh_msg_error("This recipe expects unbinned input raw frames. Exit");
    cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
  } 
  return cpl_error_get_code();

}


/*
^L
*/

/*
 * @brief
 *   Copy a file.
 *
 * @param srcpath  Source file name.
 * @param dstpath  Destination file name.
 *
 * @return The function returns 0 if no error occurred, otherwise -1 is
 *    returned and errno is set appropriately.
 *
 * The function provides a very basic way to copy the source file
 * @em srcpath to a destination file @em dstpath.
 *
 * The implementation just uses @b read() and @b write() to do the job.
 * It is by far not comparable with the @b cp shell command. Actually it
 * just writes the source file contents into a new file with the
 * appropriate output name.
 *
 * If an error occurs the destination file is removed before the function
 * returns.
 */

int xsh_fileutils_copy (const char * srcpath, const char * dstpath)

{
char *buf;

int src, dst;
int rbytes = 0;
int wbytes = 0;
int blksize = DEV_BLOCKSIZE;

struct stat sb, db;




if ((stat(srcpath,&sb) == 0) && (stat(dstpath,&db) == 0)) 
   {
   if (sb.st_ino == db.st_ino) 
      return 99;	/* if inodes are the same we are done already... */
   }

if ((src = open (srcpath, O_RDONLY)) == -1) return (-1);
    
if ((fstat (src, &sb) == -1) || (!S_ISREG (sb.st_mode)))
   {
   (void) close (src);
   return -2;
   }

if ((dst = open (dstpath, O_CREAT | O_WRONLY | O_TRUNC, sb.st_mode)) == -1)
   {
   (void) close (src);
   return -3;
   }
 
if ((fstat (dst, &db) == -1) || (!S_ISREG (db.st_mode)))
   {
   (void) close (src);
   (void) close (dst);
   (void) unlink (dstpath);
   return -4;
   }

#ifdef HAVE_ST_BLKSIZE
blksize = db.st_blksize;
#else
#   ifdef DEV_BSIZE
blksize = DEV_BSIZE;
#   endif
#endif

if ((buf = (char *) cpl_malloc ((size_t)blksize)) == NULL)
   {
   (void) close (src);
   (void) close (dst);
   (void) unlink (dstpath);
   return -5;
   }

while ((rbytes = (int) read (src, buf, (size_t)blksize)) > 0)
   {
   if ((wbytes = (int) write (dst, buf, (size_t)rbytes)) != rbytes)
      {
      wbytes = -1;
      break;
      }
   }

(void) close (src);
(void) close (dst);
cpl_free (buf);


if ((rbytes == -1) || (wbytes == -1))
   {
   (void) unlink (dstpath);
   return -6;
   }

return 0;

}


/*
^L
*/

/*
 * @brief
 *   Move a file.
 *
 * @param srcpath  Source file name.
 * @param dstpath  Destination file name.
 *
 * @return The function returns 0 if no error occurred, otherwise -1 is
 *    returned and errno is set appropriately.
 *
 * The function moves the source file @em srcpath to the given
 * destination path @em dstpath.
 *
 * If an error occurs the destination file is removed before the function
 * returns and the source file is left untouched.
 */

int xsh_fileutils_move (const char *srcpath, const char *dstpath)

{
int  ii;

struct stat sb;



if ((ii = xsh_fileutils_copy (srcpath, dstpath)) != 0) 
   {
   if (ii == 99)		/* different path name, but same inode */
      return 99;		/* => it's the same file - do nothing */
   else
      return (-2);
   }


/*
Remove the source, but if the source file cannot be checked or is not
writable revert to the original state, i.e. remove the file copy.
*/

if (stat (srcpath, &sb) == -1 || !(sb.st_mode & S_IWUSR))
   {
   (void) unlink (dstpath);
   return -1;
   }

   (void) unlink (srcpath);
return 0;

}

/*---------------------------------------------------------------------------*/
/** 
 * @brief  Set recipe sky frames prefix
 * @param  rec_prefix input recipe name 
 * @return recipe products prefix
 */
/*---------------------------------------------------------------------------*/
const char* 
xsh_set_recipe_sky_file_prefix(char* rec_prefix)
{
  const char* sky_prefix=NULL;
   if(strstr(rec_prefix,"SCI") != NULL) {
     sky_prefix="SKY_SLIT";
   } else if(strstr(rec_prefix,"TELL") != NULL) {
     sky_prefix="SKY_SLIT";
   } else if(strstr(rec_prefix,"FLUX") != NULL) {
     sky_prefix="SKY_SLIT";
   } else {
     sky_prefix="CAL_SLIT_SKY";
   }

   return sky_prefix;

}
/*---------------------------------------------------------------------------*/
/** 
 * @brief  Set recipe frames prefix
 * @param  raw input frameset
 * @param  recipe input recipe name 
 * @return recipe products prefix
 */
/*---------------------------------------------------------------------------*/
char* 
xsh_set_recipe_file_prefix(cpl_frameset* raw,const char* recipe)
{

  cpl_frame* frm=NULL;
  cpl_propertylist* plist=NULL;
  const char* obj=NULL;
  char* prefix=NULL;

  const char* dpr_catg=NULL;
  //const char* dpr_tech=NULL;
  const char* dpr_type=NULL;
  const char* filename=NULL;

  check(frm=cpl_frameset_get_frame(raw,0));
  filename=cpl_frame_get_filename(frm);
  plist=cpl_propertylist_load(filename,0);
  dpr_catg=xsh_pfits_get_dpr_catg(plist);
  //dpr_tech=xsh_pfits_get_dpr_tech(plist);
  dpr_type=xsh_pfits_get_dpr_type(plist);

  if(strstr(dpr_catg,"SCIENCE")!=NULL) {
     if(strstr(dpr_type,"SKY")!=NULL) {
        obj="SKY";
     } else {
        obj="SCI";
     }
  } else if(strstr(dpr_catg,"CALIB")!=NULL) {
    if(strstr(dpr_type,"FLUX")!=NULL) {
      obj="FLUX";
    } else if(strstr(dpr_type,"TELLURIC")!=NULL) {
      obj="TELL";
    } else {
      obj="CAL";
    }
  } else {
      obj="OBJ";
  }

  if(strstr(recipe,"respon_slit_stare")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_SLIT",(void*)NULL);
  } else if(strstr(recipe,"respon_slit_offset")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_SLIT",(void*)NULL);
  } else if(strstr(recipe,"respon_slit_nod")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_SLIT",(void*)NULL);
  } else if(strstr(recipe,"scired_slit_stare")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_SLIT",(void*)NULL);
  } else if(strstr(recipe,"scired_slit_offset")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_SLIT",(void*)NULL);
  } else if(strstr(recipe,"scired_slit_nod")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_SLIT",(void*)NULL);
  } else if(strstr(recipe,"scired_ifu_stare")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_IFU",(void*)NULL);
  } else if(strstr(recipe,"scired_ifu_offset")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_IFU",(void*)NULL);
  } else if(strstr(recipe,"geom_ifu")!=NULL) {
    prefix=xsh_stringcat_any(obj,"_IFU",(void*)NULL);
  } else {
    xsh_msg_warning("recipe %s not supported",recipe);
    prefix=xsh_stringcat_any(obj,"",(void*)NULL);
  }
 

 cleanup:
  xsh_free_propertylist(&plist);

  return prefix;
}

/*---------------------------------------------------------------------------*/
/** 
 * @brief  Set CD matrix
 * @param  plist input propertylist 
 * @return updated propertylist
 */
/*---------------------------------------------------------------------------*/
cpl_error_code xsh_set_cd_matrix(cpl_propertylist* plist)
{

   int naxis=0;
   naxis=xsh_pfits_get_naxis(plist);
   switch (naxis) {

   case 1: xsh_set_cd_matrix1d(plist);break;

   case 2: xsh_set_cd_matrix2d(plist);break;

   case 3: xsh_set_cd_matrix3d(plist);break;

   default: xsh_msg_error("Naxis: %d unsupported",naxis);
   }

   return cpl_error_get_code();
}
/*---------------------------------------------------------------------------*/
/** 
 * @brief  Set CD matrix
 * @param  plist input propertylist 
 * @return updated propertylist
 */
/*---------------------------------------------------------------------------*/
cpl_error_code xsh_set_cd_matrix1d(cpl_propertylist* plist)
{
   double cdelt1=xsh_pfits_get_cdelt1(plist);
   xsh_pfits_set_cd1(plist,cdelt1);

   return cpl_error_get_code();

}


/*---------------------------------------------------------------------------*/
/** 
 * @brief  Set CD matrix
 * @param  plist input propertylist 
 * @return updated propertylist
 */
/*---------------------------------------------------------------------------*/
cpl_error_code xsh_set_cd_matrix2d(cpl_propertylist* plist)
{
   double cdelt1=0;
   double cdelt2=0;

   /* dummy values */
   check(cdelt1=xsh_pfits_get_cdelt1(plist));
   check(cdelt2=xsh_pfits_get_cdelt2(plist));
   check(xsh_pfits_set_cd11(plist,cdelt1));
   check(xsh_pfits_set_cd12(plist,0.));
   check(xsh_pfits_set_cd21(plist,0.));
   check(xsh_pfits_set_cd22(plist,cdelt2));

  cleanup:

   return cpl_error_get_code();

}

/*---------------------------------------------------------------------------*/
/** 
 * @brief  Set CD matrix
 * @param  plist input propertylist 
 * @return updated propertylist
 */
/*---------------------------------------------------------------------------*/
cpl_error_code xsh_set_cd_matrix3d(cpl_propertylist* plist)
{

   double cdelt3=0;
   check(cdelt3=xsh_pfits_get_cdelt3(plist));

   check(xsh_pfits_set_cd31(plist,0.));
   check(xsh_pfits_set_cd13(plist,0.));
   check(xsh_pfits_set_cd32(plist,0.));
   check(xsh_pfits_set_cd23(plist,0.));
   check(xsh_pfits_set_cd33(plist,cdelt3));

  cleanup:

   return cpl_error_get_code();

}

/*---------------------------------------------------------------------------*/
/** 
 * @brief  Extract frames with given tag from frameset
 * @param  pin input parameterlist 
 * @return newly allocated parametrlist or NULL on error
 */
/*---------------------------------------------------------------------------*/

cpl_parameterlist* 
xsh_parameterlist_duplicate(const cpl_parameterlist* pin){

   cpl_parameter* p=NULL;
   cpl_parameterlist* pout=NULL;

   pout=cpl_parameterlist_new();
   p=cpl_parameterlist_get_first((cpl_parameterlist*)pin);
   while (p != NULL)
   {
      cpl_parameterlist_append(pout,p);
      p=cpl_parameterlist_get_next((cpl_parameterlist*)pin);
   }
   return pout;

}


/*---------------------------------------------------------------------------*/
/**
  @brief    Dump property
  @param property property to be dumped
  @return void

 */
/*---------------------------------------------------------------------------*/
static void
xsh_property_dump(cpl_property *property)
{

    const char *name = cpl_property_get_name(property);
    const char *comment = cpl_property_get_comment(property);

    char c;

    long size = cpl_property_get_size(property);

    cpl_type type = cpl_property_get_type(property);


    fprintf(stderr, "Property at address %p\n", property);
    fprintf(stderr, "\tname   : %p '%s'\n", name, name);
    fprintf(stderr, "\tcomment: %p '%s'\n", comment, comment);
    fprintf(stderr, "\ttype   : %#09x\n", type);
    fprintf(stderr, "\tsize   : %ld\n", size);
    fprintf(stderr, "\tvalue  : ");


    switch (type) {
    case CPL_TYPE_CHAR:
        c = cpl_property_get_char(property);
        if (!c)
            fprintf(stderr, "''");
        else
            fprintf(stderr, "'%c'", c);
        break;

    case CPL_TYPE_BOOL:
        fprintf(stderr, "%d", cpl_property_get_bool(property));
        break;

    case CPL_TYPE_INT:
        fprintf(stderr, "%d", cpl_property_get_int(property));
        break;

    case CPL_TYPE_LONG:
        fprintf(stderr, "%ld", cpl_property_get_long(property));
        break;

    case CPL_TYPE_FLOAT:
        fprintf(stderr, "%.7g", cpl_property_get_float(property));
        break;

    case CPL_TYPE_DOUBLE:
        fprintf(stderr, "%.15g", cpl_property_get_double(property));
        break;

    case CPL_TYPE_STRING:
        fprintf(stderr, "'%s'", cpl_property_get_string(property));
        break;

    default:
        fprintf(stderr, "unknown.");
        break;

    }

    fprintf(stderr, "\n");

    return;

}

/*---------------------------------------------------------------------------*/
/**
  @brief    Dump propertylist
  @param set the input frameset
  @param tag the output frame tag

  @return the frame product

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

cpl_frame* 
xsh_frameset_average(cpl_frameset *set, const char* tag)
{
   cpl_frame* result=NULL;
   cpl_frame* frame=NULL;
   cpl_image* image=NULL;
   cpl_imagelist* iml=NULL;
   cpl_propertylist* plist=NULL;
   char name_o[256];
   const char* name=NULL;
   int i=0;
   int size=0;

   check(size=cpl_frameset_get_size(set));
   iml=cpl_imagelist_new();
   for(i=0;i<size;i++) {
      frame=cpl_frameset_get_frame(set,i);
      name=cpl_frame_get_filename(frame);
      image=cpl_image_load(name,CPL_TYPE_FLOAT,0,0);
      cpl_imagelist_set(iml,cpl_image_duplicate(image),i);
      xsh_free_image(&image);
   }
   image=cpl_imagelist_collapse_create(iml);
   frame=cpl_frameset_get_frame(set,0);
   name=cpl_frame_get_filename(frame);
   plist=cpl_propertylist_load(name,0);

   sprintf(name_o,"%s.fits",tag);
   cpl_image_save(image,name_o,CPL_BPP_IEEE_FLOAT,plist,CPL_IO_DEFAULT);
   result=xsh_frame_product(name_o,tag,CPL_FRAME_TYPE_IMAGE, 
                            CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

  cleanup:
   xsh_free_image(&image);
   xsh_free_imagelist(&iml);
   xsh_free_propertylist(&plist);

   return result;
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
/**
@brief coadd frames in a frameset
@param set input frameset
@param instr instrument arm setting
@return coadded frame (with error and qualifier propagation)
 */
cpl_frame* xsh_frameset_add( cpl_frameset *set, xsh_instrument* instr,const int decode_bp)
{
  int iset, i, j, set_size = 0;
  cpl_frame *result = NULL;
  xsh_pre **pre_list = NULL; 
  xsh_pre *pre_res = NULL;
  float *res_flux = NULL;
  float *res_errs = NULL;
  int *res_qual = NULL;
  int nx, ny;

  XSH_ASSURE_NOT_NULL( set);

  check( set_size = cpl_frameset_get_size( set));

  if (set_size > 0){
    XSH_CALLOC( pre_list, xsh_pre*, set_size);

    for( iset=0; iset< set_size; iset++){
      xsh_pre* pre = NULL;
      cpl_frame *frame = NULL;
    
      check( frame = cpl_frameset_get_frame( set, iset));
      check( pre = xsh_pre_load( frame, instr));

      pre_list[iset] = pre;
    }

    pre_res = xsh_pre_duplicate( pre_list[0]);
    nx = pre_res->nx;
    ny = pre_res->ny;
    check( res_flux = cpl_image_get_data_float( xsh_pre_get_data( pre_res)));
    check( res_errs = cpl_image_get_data_float( xsh_pre_get_errs( pre_res)));
    check( res_qual = cpl_image_get_data_int( xsh_pre_get_qual( pre_res)));

    for( j=0; j< ny; j++){
      for( i=0; i< nx; i++){
        int good =0;
        float good_flux=0, bad_flux=0;
        float good_errs=0, bad_errs=0;
        int good_qual=QFLAG_GOOD_PIXEL, bad_qual=QFLAG_GOOD_PIXEL;
        int idx;
        
        idx = i+j*nx;

        for(iset = 0; iset < set_size; iset++){
          float *img_flux = NULL;
          float *img_errs = NULL;
          int *img_qual = NULL;

          check( img_flux = cpl_image_get_data_float( xsh_pre_get_data( pre_list[iset])));
          check( img_errs = cpl_image_get_data_float( xsh_pre_get_errs( pre_list[iset])));
          check( img_qual = cpl_image_get_data_int( xsh_pre_get_qual( pre_list[iset])));

          if ( (img_qual[idx] & decode_bp) == 0 ){
            /* good pix */
            good++;
            good_qual|=img_qual[idx];
            good_flux += img_flux[idx];
            good_errs += img_errs[idx]*img_errs[idx];
          }
          else{
            bad_qual |= img_qual[idx];
            bad_flux += img_flux[idx];
            bad_errs +=  img_errs[idx]*img_errs[idx];
          }
        }

        if ( good == 0){
          res_flux[idx] = bad_flux;
          res_errs[idx] = sqrt( bad_errs);
          res_qual[idx] |= bad_qual;
        }
        else{
          res_flux[idx] = good_flux*set_size/good;
          res_errs[idx] = sqrt( good_errs)*set_size/good;
          res_qual[idx] |= good_qual;
        }
      }
    }
    check( result = xsh_pre_save( pre_res, "COADD.fits", "COADD", 1));

  }
  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frame( &result);
    }
    xsh_pre_free( &pre_res);
    for( i=0; i< set_size; i++){
      xsh_pre_free( &(pre_list[i]));
    }
    XSH_FREE( pre_list);
    return result;
}
/*---------------------------------------------------------------------------*/

/*---------------------------------------------------------------------------*/
/**
  @brief    Dump propertylist
  @param plist the input propertylist
  @return void

 */
/*---------------------------------------------------------------------------*/
void
xsh_plist_dump(cpl_propertylist *plist)
{

    long i=0;
    long sz = cpl_propertylist_get_size(plist);


    fprintf(stderr, "Property list at address %p:\n", plist);

    for (i = 0; i < sz; i++) {
        cpl_property *p = cpl_propertylist_get(plist, i);
        xsh_property_dump(p);
    }

    return;

}


/*---------------------------------------------------------------------------*/
/**
  @brief    Dump frameset
  @param set the input frameset
  @return cpl_error_code

 */
/*---------------------------------------------------------------------------*/
cpl_error_code 
xsh_frameset_dump(cpl_frameset* set)
{

  const cpl_frame* f=NULL;
  int n=0;
  int i=0;
  const char* name=NULL;
  const char* tag=NULL;
  int group=0;
  n=cpl_frameset_get_size(set);
  xsh_msg("files present in set");
  for(i=0;i<n;i++) {

    f=cpl_frameset_get_frame(set,i);
    name=cpl_frame_get_filename(f);
    tag=cpl_frame_get_tag(f);
    group=cpl_frame_get_group(f);
    xsh_msg("filename=%s tag=%s group=%d",name,tag,group);

  }

  return cpl_error_get_code();

}

/*---------------------------------------------------------------------------*/
/**
  @brief    Dump frameset nod info
  @param set the input frameset
  @return cpl_error_code

 */
/*---------------------------------------------------------------------------*/
cpl_error_code 
xsh_frameset_dump_nod_info(cpl_frameset* set)
{

  const cpl_frame* f=NULL;
  int n=0;
  int i=0;
  const char* name=NULL;
  const char* tag=NULL;
  cpl_propertylist* plist=NULL;

  double cum_off_y=0;
  double nod_throw=0;
  double jitter_width=0;


  n=cpl_frameset_get_size(set);
  xsh_msg("files present in set");
  for(i=0;i<n;i++) {

    f=cpl_frameset_get_frame(set,i);
    name=cpl_frame_get_filename(f);
    tag=cpl_frame_get_tag(f);


    plist=cpl_propertylist_load(name,0);
    if(cpl_propertylist_has(plist,XSH_NOD_CUMULATIVE_OFFSETY)) {
       cum_off_y=xsh_pfits_get_cumoffsety(plist);
    } else {

       xsh_msg_warning("missing %s",XSH_NOD_CUMULATIVE_OFFSETY);
    }

    if(cpl_propertylist_has(plist,XSH_NOD_THROW)) {
       nod_throw=xsh_pfits_get_nodthrow(plist);
    } else {
       xsh_msg_warning("missing %s",XSH_NOD_CUMULATIVE_OFFSETY);
    }


    if(cpl_propertylist_has(plist,XSH_NOD_JITTER_BOX)) {
       jitter_width= xsh_pfits_get_nod_jitterwidth(plist);
    } else {
       xsh_msg_warning("missing %s",XSH_NOD_JITTER_BOX);
    }


 

    xsh_msg("filename=%s tag=%s cum_off_y=%f nod_throw=%f jitter_width=%f",
            name,tag,cum_off_y,nod_throw,jitter_width);
    xsh_free_propertylist(&plist);
  }

  return cpl_error_get_code();

}



/*---------------------------------------------------------------------------*/
/**
  @brief    Reset library state

  This function must be called from the recipe initializer function
  to make sure that the recipe is re-entrant (i.e. behaves identical on
  successive invocations)

  Successive plugin invocations share their memory, so it is important
  that all static memory is reset to a well defined state.
 */
/*---------------------------------------------------------------------------*/
void
xsh_init (void)
{
  xsh_error_reset ();
  xsh_msg_init ();
}


/**
  @brief    Return base filename
  @param filename input filename
  @return basename (See unix basename)

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

char * xsh_get_basename(const char *filename)
{
  char *p ;
  p = strrchr (filename, '/');
  return p ? p + 1 : (char *) filename;
}


/*---------------------------------------------------------------------------*/
/**
  @brief	Get the pipeline copyright and license
  @return   The copyright and license string

  The function returns a pointer to the statically allocated license string.
  This string should not be modified using the returned pointer.
 */
/*---------------------------------------------------------------------------*/
const char *
xsh_get_license (void)
{
  const char *xsh_license =
    "This file is part of the X-shooter Instrument Pipeline\n"
    "Copyright (C) 2006 European Southern Observatory\n"
    "\n"
    "This program is free software; you can redistribute it and/or modify\n"
    "it under the terms of the GNU General Public License as published by\n"
    "the Free Software Foundation; either version 2 of the License, or\n"
    "(at your option) any later version.\n"
    "\n"
    "This program is distributed in the hope that it will be useful,\n"
    "but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
    "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n"
    "GNU General Public License for more details.\n"
    "\n"
    "You should have received a copy of the GNU General Public License\n"
    "along with this program; if not, write to the Free Software\n"
    "Foundation, Inc., 59 Temple Place, Suite 330, Boston, \n"
    "MA  02111-1307  USA";
  return xsh_license;
}

/*---------------------------------------------------------------------------*/
/**
   @brief   Recipe initialization
   @param  frames         The input frame set
   @param  parameters     The input parameter list
   @param  instrument     Pointer to the instrument structure pointer
   @param  raws           Pointer to RAW Frameset
   @param  calib          Pointer to CALIB Frameset
   @param  tag_list       List of valid tags for the recipe
   @param  tag_list_size  size of List of valid tags for the recipe
   @param  recipe_id      Name of the recipe, e.g. @em xsh_mbias
   @param  binary_version Recipe version (possibly different from
                          pipeline version)
   @param  short_descr    A short description of what the recipe does
   @return  CPL_ERROR_NONE iff OK

   This function should be called at the beginning of every recipe.
   It takes care of the mandatory tasks that are common for all recipes
   before the beginning of the data reduction.
   - makes sure that the CPL library are up to date,
     and prints a warning message if not,
   - defines the group of all input frames (see @c xsh_dfs_set_groups()), and
   - prints the input frame set.

   See also @c xsh_end().
*/
/*---------------------------------------------------------------------------*/
cpl_error_code
xsh_begin (cpl_frameset * frames, 
           const cpl_parameterlist * parameters,
	   xsh_instrument ** instrument, 
           cpl_frameset ** raws,
	   cpl_frameset ** calib, 
           const char * tag_list[], 
           int tag_list_size,
	   const char *recipe_id, 
           unsigned int binary_version,
	   const char *short_descr)
{
  char *recipe_string = NULL;
  char *recipe_version = NULL;
  char *stars = NULL;		/* A string of stars */
  char *spaces1 = NULL;
  char *spaces2 = NULL;
  char *spaces3 = NULL;
  char *spaces4 = NULL;
  int decode_bp=0;
  cpl_parameter* p=NULL;
  int nraws=0;
/*    CPL 3.0 and later incarnations have a cpl_get_version().
      If the pipeline needs a certain version of CPL in order to function
      properly (say 3.1.2 but not 3.0), then validate the version
      number here. A compile time check on the version number
      is not a guarantee for correct linking, because linktime = runtime.

      const char *version_cpl;
      check( version_cpl = cpl_get_version() );
      if (version_cpl < required_version)
      {
               xsh_warning("Detected version: %s ; Required version: %s",
	                    version_cpl, required_version);
      }
*/

  {
    int lvl;
    //int ts ;

    lvl = xsh_parameters_get_temporary( recipe_id, parameters ) ;
    if ( lvl == 0 )
      xsh_msg( "Keep Temporary File = no" ) ;
    else 
      xsh_msg( "Keep Temporary File = yes" ) ;

    lvl = xsh_parameters_debug_level_get( recipe_id, parameters ) ;
    xsh_msg( "Xsh Debug Level = %s", xsh_debug_level_tostring() ) ;

    //ts = xsh_parameters_time_stamp_get( recipe_id, parameters ) ;
  }

  /* Print welcome message

   *********************************
   ***      PACKAGE_STRING       ***
   *** Recipe: recipe_id version ***
   *********************************
   Short description of recipe

   */

  /* Calculate recipe string */
  {
    int version_string_length;
    int major_version, minor_version, micro_version;

    major_version = binary_version / 10000;
    minor_version = (binary_version % 10000) / 100;
    micro_version = binary_version % 100;

    /* Allocate space for version numbers up to 99.99.99 */
    assure (major_version < 100, CPL_ERROR_UNSUPPORTED_MODE,
	    "Major version: %d", major_version);

    version_string_length = strlen ("XX.YY.ZZ");
    recipe_version = cpl_calloc (sizeof (char), version_string_length + 1);

    snprintf (recipe_version, version_string_length + 1,
	      "%d.%d.%d", major_version, minor_version, micro_version);

    recipe_string =
      xsh_stringcat_4 ("Recipe: ", recipe_id, " ", recipe_version);
  }

  {
    int field = MAXIMUM (strlen (PACKAGE_STRING), strlen (recipe_string));
    int nstars = 3 + 1 + field + 1 + 3;
    int nspaces1, nspaces2, nspaces3, nspaces4;
    int i;

    /* ' ' padding */
    nspaces1 = (field - strlen (PACKAGE_STRING)) / 2;
    nspaces2 = field - strlen (PACKAGE_STRING) - nspaces1;

    nspaces3 = (field - strlen (recipe_string)) / 2;
    nspaces4 = field - strlen (recipe_string) - nspaces3;

    spaces1 = cpl_calloc (sizeof (char), nspaces1 + 1);
    for (i = 0; i < nspaces1; i++)
      spaces1[i] = ' ';
    spaces2 = cpl_calloc (sizeof (char), nspaces2 + 1);
    for (i = 0; i < nspaces2; i++)
      spaces2[i] = ' ';
    spaces3 = cpl_calloc (sizeof (char), nspaces3 + 1);
    for (i = 0; i < nspaces3; i++)
      spaces3[i] = ' ';
    spaces4 = cpl_calloc (sizeof (char), nspaces4 + 1);
    for (i = 0; i < nspaces4; i++)
      spaces4[i] = ' ';

    stars = cpl_calloc (sizeof (char), nstars + 1);
    for (i = 0; i < nstars; i++)
      stars[i] = '*';

    xsh_msg ("%s", stars);
    xsh_msg ("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
    xsh_msg ("*** %s%s%s ***", spaces3, recipe_string, spaces4);
    xsh_msg ("%s", stars);
  }

  xsh_msg ("  %s", short_descr);

  check( *instrument = xsh_dfs_set_groups( frames));
  check( xsh_instrument_set_recipe_id( *instrument, recipe_id));
  p=xsh_parameters_find((cpl_parameterlist *)parameters,recipe_id,"decode-bp");
  decode_bp=cpl_parameter_get_int(p);
  check( xsh_instrument_set_decode_bp( *instrument, decode_bp));
  XSH_NEW_FRAMESET( *raws);
  XSH_NEW_FRAMESET( *calib);
  check( xsh_dfs_split_in_group( frames, *raws, *calib));
  check( xsh_dfs_filter( *raws, tag_list, tag_list_size));
  XSH_ASSURE_NOT_NULL( *raws);
  XSH_ASSURE_NOT_NULL( *instrument);
  xsh_dfs_files_dont_exist(frames);
  nraws=cpl_frameset_get_size(*raws);
 

  /* Print input frames */
  xsh_msg("RAW files");
  check( xsh_print_cpl_frameset( *raws));
  xsh_msg("CALIB files"); 
  check( xsh_print_cpl_frameset( *calib));

  if ((strcmp(recipe_id, "xsh_util_physmod") != 0)
      && (strcmp(recipe_id, "xsh_util_compute_response") != 0)) {

    XSH_ASSURE_NOT_ILLEGAL_MSG(nraws>0,
        "Provide at least a valid input raw frame");

    /* special case: in NIR-JH wwe need to correct input tables */
    if (xsh_instrument_get_arm(*instrument) == XSH_ARM_NIR) {
      xsh_instrument_nir_corr_if_JH(*raws, *instrument);
      if ((strcmp(recipe_id, "xsh_lingain") != 0)
          && (strcmp(recipe_id, "xsh_mdark") != 0)) {
        check(
            xsh_instrument_nir_corr_if_spectral_format_is_JH(*calib,*instrument));
      }
      xsh_calib_nir_corr_if_JH(*calib, *instrument, recipe_id);
    }

  }
  cleanup:
    cpl_free (recipe_string);
    cpl_free (recipe_version);
    cpl_free (stars);
    cpl_free (spaces1);
    cpl_free (spaces2);
    cpl_free (spaces3);
    cpl_free (spaces4);
    return cpl_error_get_code ();
}



static char **TempFiles = NULL ;
static int NbTemp = 0 ;
static char **ProdFiles = NULL ;
static int NbProducts = 0 ;

/*---------------------------------------------------------------------------*/
/**
  @brief
    Add temporary file to temprary files list
  @param[in] name
    The name of the file
*/
/*---------------------------------------------------------------------------*/
void xsh_add_temporary_file( const char *name)
{
  if ( TempFiles == NULL ){
    TempFiles = cpl_malloc( sizeof( char*));
  }
  else {
    TempFiles = cpl_realloc( TempFiles, (NbTemp + 1)*sizeof( char *));
  }
  TempFiles[NbTemp] = cpl_malloc( strlen( name) + 1);
  strcpy( TempFiles[NbTemp], name);
  NbTemp++;
}

/*---------------------------------------------------------------------------*/
/**
  @brief
    Free temprary files list
*/
/*---------------------------------------------------------------------------*/
void xsh_free_temporary_files( void)
{
  int i;
  //xsh_msg("free temporary files");
  for( i = 0 ; i<NbTemp ; i++){
    //xsh_msg("free file %s",TempFiles[i]);
    cpl_free( TempFiles[i]);
  }
  cpl_free( TempFiles);
  TempFiles = NULL; 
  NbTemp=0; 
}

/*---------------------------------------------------------------------------*/
/**
  @brief
    Add temporary file to temprary files list
  @param[in] name
    The name of the file
*/
/*---------------------------------------------------------------------------*/
void xsh_add_product_file( const char *name)
{
  if ( ProdFiles == NULL ){
    ProdFiles = cpl_malloc( sizeof( char*));
  }
  else {
    ProdFiles = cpl_realloc( ProdFiles, (NbProducts + 1)*sizeof( char *));
  }
  ProdFiles[NbProducts] = cpl_malloc( strlen( name) + 1);
  strcpy( ProdFiles[NbProducts], name);
  NbProducts++;
}

/*---------------------------------------------------------------------------*/
/**
  @brief
    Free temprary files list
*/
/*---------------------------------------------------------------------------*/
void xsh_free_product_files( void)
{
  int i;

  for( i = 0 ; i<NbProducts ; i++){
    cpl_free( ProdFiles[i]);
  }
  cpl_free( ProdFiles);
  ProdFiles=NULL;
  NbProducts=0;
}


/*---------------------------------------------------------------------------*/
/**
   @brief	Recipe termination
   @param       recipe_id      Name of calling recipe
   @param       frames         The output frame set
   @param       parameters     The input parameter list
   @return      CPL_ERROR_NONE iff OK

   This function is called at the end of every recipe. The output frame set is 
   printed, and the number of warnings produced by the recipe is summarized.

   See also @c xsh_begin().
*/
/*---------------------------------------------------------------------------*/
cpl_error_code
xsh_end (const char *recipe_id, 
         cpl_frameset * frames,
	 cpl_parameterlist * parameters )
{
  int i;
  int warnings = xsh_msg_get_warnings ();

  /* Print product frames */
  {
    cpl_frame * current = NULL;
    int nframes = 0, j;

    nframes = cpl_frameset_get_size( frames ) ;
    for( j = 0 ; j<nframes ; j++ ) {
      current = cpl_frameset_get_frame( frames, j);
      if ( cpl_frame_get_group( current ) == CPL_FRAME_GROUP_PRODUCT ) {
	xsh_print_cpl_frame( current ) ;
      }
    }
  }
  (void) frames ; /* suppress warning */

  //If we need to delete some frames (like those with group=PRODUCT,
  //level=TEMPORARY,INTERMEDIATE), this would be the place to do it
  if ( xsh_parameters_get_temporary( recipe_id, parameters ) == 0 ) {
    xsh_msg( "---- Deleting Temporary Files" ) ;
    for( i = 0 ; i<NbTemp ; i++ ) {
      xsh_msg( "    '%s'", TempFiles[i] ) ;
      unlink( TempFiles[i] ) ;

    }
  } else {
     /* This to possibly remove duplicates frames 
    xsh_msg( "---- Deleting Double copies of Product Files" ) ;
    for( i = 0 ; i<NbProducts ; i++ ) {
      xsh_msg( "    '%s'", ProdFiles[i] ) ;
      unlink( ProdFiles[i] ) ;
    }  
     */
  }

  /* Summarize warnings, if any */
  if (warnings > 0) {
    xsh_msg_warning ("Recipe '%s' produced %d warning %s (excluding this one)",
		     recipe_id, xsh_msg_get_warnings (),
		     /* Plural? */ (warnings > 1) ? "s" : "");
  }

  /* in all case free the memory at the end */
  xsh_free_temporary_files();
  xsh_free_product_files();
  return cpl_error_get_code ();
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Read a property value from a property list
   @param    plist       Propertylist to read
   @param    keyword     Name of property to read
   @param    keywordtype Type of keyword
   @param    result      The value read

   @return   CPL_ERROR_NONE iff OK

   This function wraps  @c cpl_propertylist_get_int(), 
   @c cpl_propertylist_get_bool(), @c cpl_propertylist_get_double() and 
   @c cpl_propertylist_get_string().
   It checks existence and type of the requested keyword before reading
   and describes what went wrong if the property could not be read.

   @note The result is written to the variable pointed to by the
   parameter @em result. Because this is a void pointer, 
   it is the responsibility of the caller to make sure that the type 
    of this pointer variable corresponds to the requested @em keywordtype. 
   E.g. if @em keywordtype is CPL_TYPE_BOOL, then @em result must be an bool 
   pointer (bool *). If @em keywordtype isCPL_TYPE_STRING, then @em result 
   must be a char **, and so on.

*/
/*---------------------------------------------------------------------------*/
cpl_error_code
xsh_get_property_value (const cpl_propertylist * plist,
			const char *keyword, 
                        cpl_type keywordtype,
			void *result)
{
  cpl_type t;

  /* Check input */
  assure (plist != NULL, CPL_ERROR_NULL_INPUT, "Null property list");
  assure (keyword != NULL, CPL_ERROR_NULL_INPUT, "Null keyword");
  /* Check for existence... */
  assure (cpl_propertylist_has (plist, keyword), CPL_ERROR_DATA_NOT_FOUND,
	  "Keyword %s does not exist", keyword);
  /* ...and type of keyword */
  check_msg (t = cpl_propertylist_get_type (plist, keyword),
	     "Could not read type of keyword '%s'", keyword);
  assure (t == keywordtype, CPL_ERROR_TYPE_MISMATCH,
	  "Keyword '%s' has wrong type (%s). %s expected",
	  keyword, xsh_tostring_cpl_type (t),
	  xsh_tostring_cpl_type (keywordtype));
  /* Read the keyword */
  switch (keywordtype) {
  case CPL_TYPE_INT:
    check_msg (*((int *) result) = cpl_propertylist_get_int (plist, keyword),
	       "Could not get (integer) value of %s", keyword);
    break;
  case CPL_TYPE_BOOL:
    check_msg (*((bool *) result) = cpl_propertylist_get_bool (plist, keyword),
	       "Could not get (boolean) value of %s", keyword);
    break;
  case CPL_TYPE_DOUBLE:
    check_msg (*((double *) result) =
	       cpl_propertylist_get_double (plist, keyword),
	       "Could not get (double) value of %s", keyword);
    break;
  case CPL_TYPE_STRING:
    check_msg (*((const char **) result) =
	       cpl_propertylist_get_string (plist, keyword),
	       "Could not get (string) value of %s", keyword);
    break;
  default:
    assure (false, CPL_ERROR_INVALID_TYPE, "Unknown type");
  }

cleanup:
  return cpl_error_get_code ();
}

/*---------------------------------------------------------------------------*/
/**
   @brief        String duplication
   @param s 	 String to duplicate
   @return       A copy of @em s, or NULL on error.

   @note         The resulting string must be deallocated using @c cpl_free()
*/
/*---------------------------------------------------------------------------*/
char *
xsh_stringdup (const char *s)
{
  char *result = NULL;

  assure (s != NULL, CPL_ERROR_NULL_INPUT, "Null string");

  result = cpl_calloc (sizeof (char), strlen (s) + 1);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");

  sprintf (result, "%s", s);

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  return result;
}

/** 
 * From the time in seconds, create a string in the format:
 *    YYYYMMDD-HHMMSS
 * The date is UTC.
 * The function uses cpl_malloc to allocate memory for the string.
 * The space allocated must be freed with cpl_free
 * 
 * @param now Date in Unix/Linux format (seconds since 1970)
 * 
 * @return Pointer to the date string
 */
char *
xsh_sdate_utc( time_t *now )
{
  char *date = NULL;
  struct tm ttm;

  ttm = *gmtime( now ) ;
  XSH_CALLOC( date, char, 16); 

  sprintf( date, "%04d%02d%02d-%02d%02d%02d",
	   ttm.tm_year+1900, ttm.tm_mon+1, ttm.tm_mday,
	   ttm.tm_hour, ttm.tm_min, ttm.tm_sec ) ;

 cleanup:
  return date ;
  
}

/*---------------------------------------------------------------------------*/
/**
   @brief        String concatenation
   @param s1	 First string
   @param s2     Second string
   @return s1 concatenated with s2, or NULL on error.

   @note The resulting string must be deallocated using @c cpl_free()
*/
/*---------------------------------------------------------------------------*/
char *
xsh_stringcat (const char *s1, const char *s2)
{
  char *result = NULL;

  assure (s1 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s2 != NULL, CPL_ERROR_NULL_INPUT, "Null string");

  result = cpl_calloc (sizeof (char), strlen (s1) + strlen (s2) + 1);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");

  sprintf (result, "%s%s", s1, s2);

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  return result;
}

/*---------------------------------------------------------------------------*/
/**
   @brief        String concatenation
   @param s1	 First string
   @param s2     Second string
   @param s3     Third string
   @return s1 concatenated with s2 concatenated with s3, or NULL on error.

   @note The resulting string must be deallocated using @c cpl_free()
*/
/*---------------------------------------------------------------------------*/
char *
xsh_stringcat_3 (const char *s1, const char *s2, const char *s3)
{
  char *result = NULL;

  assure (s1 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s2 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s3 != NULL, CPL_ERROR_NULL_INPUT, "Null string");

  result =
    cpl_calloc (sizeof (char), strlen (s1) + strlen (s2) + strlen (s3) + 1);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");

  sprintf (result, "%s%s%s", s1, s2, s3);

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  return result;
}

/*---------------------------------------------------------------------------*/
/**
   @brief        String concatenation
   @param s1	 First string
   @param s2     Second string
   @param s3     Third string
   @param s4     Fourth string
   @return s1 concatenated with s2 concatenated with s3 concatenated
             with s4, or NULL on error.

   @note The resulting string must be deallocated using @c cpl_free()
*/
/*---------------------------------------------------------------------------*/
char *
xsh_stringcat_4 (const char *s1, const char *s2, const char *s3,const char *s4)
{
  char *result = NULL;

  assure (s1 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s2 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s3 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s4 != NULL, CPL_ERROR_NULL_INPUT, "Null string");

  result = cpl_calloc (sizeof (char), strlen (s1) + strlen (s2) +
		       strlen (s3) + strlen (s4) + 1);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");

  sprintf (result, "%s%s%s%s", s1, s2, s3, s4);

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  return result;
}

/*---------------------------------------------------------------------------*/
/**
   @brief        String concatenation
   @param s1	 First string
   @param s2     Second string
   @param s3     Third string
   @param s4     Fourth string
   @param s5     Fifth string
   @return s1 concatenated with s2 concatenated with s3 concatenated
             with s4 concatenated with s5, or NULL on error.

   @note The resulting string must be deallocated using @c cpl_free()
*/
/*---------------------------------------------------------------------------*/
char *
xsh_stringcat_5 (const char *s1, const char *s2, const char *s3,
		 const char *s4, const char *s5)
{
  char *result = NULL;

  assure (s1 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s2 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s3 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s4 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s5 != NULL, CPL_ERROR_NULL_INPUT, "Null string");

  result = cpl_calloc (sizeof (char), strlen (s1) + strlen (s2) + 
    strlen (s3) +strlen (s4) + strlen (s5) + 1);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");

  sprintf (result, "%s%s%s%s%s", s1, s2, s3, s4, s5);

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  return result;
}

/*---------------------------------------------------------------------------*/
/**
   @brief        String concatenation
   @param s1	 First string
   @param s2     Second string
   @param s3     Third string
   @param s4     Fourth string
   @param s5     Fifth string
   @param s6     Sixth string
   @return s1 concatenated with s2 concatenated with s3 concatenated
             with s4 concatenated with s5 concatenated with s6,
	     or NULL on error.

   @note The resulting string must be deallocated using @c cpl_free()
*/
/*---------------------------------------------------------------------------*/
char *
xsh_stringcat_6 (const char *s1, const char *s2, const char *s3,
		 const char *s4, const char *s5, const char *s6)
{
  char *result = NULL;

  assure (s1 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s2 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s3 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s4 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s5 != NULL, CPL_ERROR_NULL_INPUT, "Null string");
  assure (s6 != NULL, CPL_ERROR_NULL_INPUT, "Null string");

  result = cpl_calloc (sizeof (char),
		       strlen (s1) + strlen (s2) + strlen (s3) +
		       strlen (s4) + strlen (s5) + strlen (s6) + 1);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");

  sprintf (result, "%s%s%s%s%s%s", s1, s2, s3, s4, s5, s6);

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  return result;
}

/** 
 * @brief Concatenate an arbitrary number of strings.
 * 
 * @param s First string
 * @param  ...  Other strings (at least 1 more)
 * 
 * @return Pointer to concatenated string or NULL if error

 * @note The resulting string must be deallocated using @c cpl_free()
 * @note THE LAST STRING MUST BE a NULL ptr or AN EMPTY STRING ("").
 *       However, one should not just use the plain NULL macro in the parameter
 *       list, since this can lead to undefined behaviour. On some platforms the
 *       NULL macro might not expant to a pointer type, i.e. sizeof(NULL) might
 *       not equal sizeof(void*).
 *       Instead one should use code like the following:
 *       @code
 *         y = xsh_stringcat_any(x, (void*)NULL)
 *       @endcode
 *
 */
char *
xsh_stringcat_any (const char *s, ...)
{
  char *result = NULL;
  int size = 2;
  va_list av;

  va_start (av, s);
  result = cpl_malloc (2);
  assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	  "Memory allocation failed");
  result[0] = '\0';
  for (;;) {
    size += strlen (s) + 2;
    result = cpl_realloc (result, size);
    assure (result != NULL, CPL_ERROR_ILLEGAL_OUTPUT,
	    "Memory allocation failed");
    strcat (result, s);
    s = va_arg (av, char *);
    if (s == NULL || *s == '\0')
      break;
  }

cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE) {
    cpl_free (result);
    result = NULL;
  }

  va_end (av);
  return result;
}

/*---------------------------------------------------------------------------*/
/**
   @brief Sort an array and give is index table 
   @param base
   @param nmemb
   @param size
   @param compar
*/
/*---------------------------------------------------------------------------*/
int* xsh_sort(void* base, size_t nmemb, size_t size,
  int (*compar)(const void *, const void *)) {
  
  int i = 0;
  int * idx = NULL;
  xsh_sort_data* sort = NULL; 

  /* check input parameters */
  XSH_ASSURE_NOT_NULL(base);
  XSH_ASSURE_NOT_ILLEGAL(nmemb > 0);
  XSH_ASSURE_NOT_ILLEGAL(size > 0);
  XSH_ASSURE_NOT_NULL(compar);

  /* allocate memory */
  XSH_MALLOC(idx,int,nmemb);
  XSH_MALLOC(sort,xsh_sort_data,nmemb);

  /* fill the sort structure */
  for( i=0; i< (int)nmemb; i++) {
    sort[i].data = (void*)((size_t)base+i*size);
    sort[i].idx = i; 
  } 

  /* do the sort */
  qsort(sort,nmemb,sizeof(xsh_sort_data),compar);

  /* fill the index */
  for( i=0; i< (int)nmemb; i++) {
    idx[i] = sort[i].idx;         
  }

  cleanup:
    XSH_FREE(sort);
    return idx;
}

/**
@brief TO BE DESCRIBED
@param data
@param idx
@param size
 */
void xsh_reindex(double* data, int* idx, int size) {
  int i;

  /* check input parameters */
  XSH_ASSURE_NOT_NULL(data);
  XSH_ASSURE_NOT_NULL(idx);
  XSH_ASSURE_NOT_ILLEGAL(size >= 0);

  for(i=0; i< size; i++){
    int id;
    double temp;

    id = idx[i];
    while (id < i){
      id = idx[id];
    }
    temp = data[i];
    data[i] = data[id];
    data[id] = temp;
  }
  cleanup:
    return;
}

/**
@brief TO BE DESCRIBED
@param data
@param idx
@param size
 */
void xsh_reindex_float(float * data, int* idx, int size)
{
  int i;

  /* check input parameters */
  XSH_ASSURE_NOT_NULL(data);
  XSH_ASSURE_NOT_NULL(idx);
  XSH_ASSURE_NOT_ILLEGAL(size >= 0);

  for(i=0; i< size; i++){
    int id;
    float temp;

    id = idx[i];
    while (id < i){
      id = idx[id];
    }
    temp = data[i];
    data[i] = data[id];
    data[id] = temp;
  }
  cleanup:
    return;
}


/**
@brief TO BE DESCRIBED
@param data
@param idx
@param size
 */
void xsh_reindex_int( int * data, int* idx, int size)
{
  int i;

  /* check input parameters */
  XSH_ASSURE_NOT_NULL(data);
  XSH_ASSURE_NOT_NULL(idx);
  XSH_ASSURE_NOT_ILLEGAL(size >= 0);

  for(i=0; i< size; i++){
    int id;
    int temp;

    id = idx[i];
    while (id < i){
      id = idx[id];
    }
    temp = data[i];
    data[i] = data[id];
    data[id] = temp;
  }
  cleanup:
    return;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate memory
   @param    mem     to deallocate
*/
/*---------------------------------------------------------------------------*/
void xsh_free(const void *mem)
{
    cpl_free((void *)mem); /* No, it is not a bug. The cast is safe */
    return;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate an image and set the pointer to NULL
   @param    i        Image to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_image (cpl_image ** i)
{
  if (i && *i) {
    cpl_image_delete (*i);
    *i = NULL;
  }
}



/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a table and set the pointer to NULL
   @param    t        table to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_table (cpl_table ** t)
{
  if (t && *t) {
    cpl_table_delete (*t);
    *t = NULL;
  }
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate an image mask and set the pointer to NULL
   @param    m        Mask to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_mask (cpl_mask ** m)
{
  if (m && *m) {
    cpl_mask_delete (*m);
    *m = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate an image list and set the pointer to NULL
   @param    i        Image list to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_imagelist (cpl_imagelist ** i)
{
  if (i && *i) {
    cpl_imagelist_delete (*i);
    *i = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a property list and set the pointer to NULL
   @param    p        Property list to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_propertylist (cpl_propertylist ** p)
{
  if (p && *p) {
    cpl_propertylist_delete (*p);
    *p = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a polynomial and set the pointer to NULL
   @param    p        Polynomial to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_polynomial (cpl_polynomial ** p)
{
  if (p && *p) {
    cpl_polynomial_delete (*p);
    *p = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a matrix and set the pointer to NULL
   @param    m        Matrix to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_matrix (cpl_matrix ** m)
{
  if (m && *m) {
    cpl_matrix_delete (*m);
    *m = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a parameter list and set the pointer to NULL
   @param    p        Parameter list to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_parameterlist (cpl_parameterlist ** p)
{
  if (p && *p) {
    cpl_parameterlist_delete (*p);
    *p = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a parameter and set the pointer to NULL
   @param    p        Parameter to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_parameter (cpl_parameter ** p)
{
  if (p && *p) {
    cpl_parameter_delete (*p);
    *p = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a frame set and set the pointer to NULL
   @param    f        Frame set to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_frameset (cpl_frameset ** f)
{
  if (f && *f) {
    cpl_frameset_delete (*f);
    *f = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a frame and set the pointer to NULL
   @param    f        Frame to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_frame (cpl_frame ** f)
{
  if (f && *f) {
    cpl_frame_delete (*f);
    *f = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a vector and set the pointer to NULL
   @param    v        Vector to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_vector (cpl_vector ** v)
{
  if (v && *v) {
    cpl_vector_delete (*v);
    *v = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate an array and set the pointer to NULL
   @param    m        Array to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_array (cpl_array ** m)
{
  if (m && *m) {
    cpl_array_delete (*m);
    *m = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Deallocate a stats object and set the pointer to NULL
   @param    s        Stats object to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_free_stats (cpl_stats ** s)
{
  if (s && *s) {
    cpl_stats_delete (*s);
    *s = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
  @brief
    Unwrap an image and set the pointer to NULL
  @param i
    Image to unwrap
*/
/*---------------------------------------------------------------------------*/
void xsh_unwrap_image( cpl_image **i)
{
  if ( i && *i) {
    cpl_image_unwrap( *i);
    *i = NULL;
  }
}

/*---------------------------------------------------------------------------*/
/**
  @brief Unwrap a vector and set the pointer to NULL
  @param v Vector to unwrap
*/
/*---------------------------------------------------------------------------*/
void
xsh_unwrap_vector (cpl_vector ** v)
{
  if (v && *v) {
    cpl_vector_unwrap (*v);
    *v = NULL;
  }
}


/*---------------------------------------------------------------------------*/
/**
  @brief Unwrap an array and set the pointer to NULL
  @param a Array to unwrap
*/
/*---------------------------------------------------------------------------*/
void
xsh_unwrap_array (cpl_array ** a)
{
  if (a && *a) {
    cpl_array_unwrap (*a);
    *a = NULL;
  }
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Unwrap a bi-vector and set the pointer to NULL
   @param    b        Bi-vector to deallocate
*/
/*---------------------------------------------------------------------------*/
void
xsh_unwrap_bivector_vectors (cpl_bivector ** b)
{
  if (b && *b) {
    cpl_bivector_unwrap_vectors (*b);
    *b = NULL;
  }
}
/*---------------------------------------------------------------------------*/

/**
@brief show time
@param comment comment to print
 */
void xsh_show_time( const char *comment )
{
  struct rusage tm0 ;

  getrusage( 0, &tm0 ) ;
  xsh_msg( "%s - User: %u.%06u - Syst: %u.%06u",
	   comment, (unsigned)tm0.ru_utime.tv_sec, 
           (unsigned)tm0.ru_utime.tv_usec,
	   (unsigned)tm0.ru_stime.tv_sec, 
           (unsigned)tm0.ru_stime.tv_usec ) ;
  return ;
}

/* Swap macros */
#define XSH_DOUBLE_SWAP(a,b) { register double t=(a);(a)=(b);(b)=t; }
#define XSH_FLOAT_SWAP(a,b) { register float t=(a);(a)=(b);(b)=t; }
#define XSH_INT_SWAP(a,b) { register int t=(a);(a)=(b);(b)=t; }

#define XSH_PIX_STACK_SIZE 50


/*----------------------------------------------------------------------------*/
/**
  @brief Compute median, stdev and mean for the tab
  @param[in] tab the input array
  @param[in] size the size of input array
  @param[out] median the median of array
  @param[out] mean the mean of array
  @param[out] stdev the stdev of array
  @return void
*/
void 
xsh_tools_get_statistics(double* tab, int size, double* median,
  double* mean, double* stdev)
{
  cpl_vector* tab_vec = NULL;
  int i = 0;

  /* check input parameters */
  XSH_ASSURE_NOT_NULL( tab);
  XSH_ASSURE_NOT_ILLEGAL( size >= 0);
  XSH_ASSURE_NOT_NULL( median);
  XSH_ASSURE_NOT_NULL( mean);
  XSH_ASSURE_NOT_NULL( stdev);

  /* Created vector */
  check (tab_vec = cpl_vector_new( size));
  for( i=0; i< size; i++){
    check( cpl_vector_set( tab_vec, i, tab[i]));
  }
  
  check( *median = cpl_vector_get_median( tab_vec));
  check( *stdev = cpl_vector_get_stdev( tab_vec));
  check( *mean = cpl_vector_get_mean( tab_vec));

  cleanup:
    xsh_free_vector( &tab_vec);
    return; 
}
/**
  @brief    Sort a double array
  @param    pix_arr     the array to sort
  @param    n           the array size
  @return   the #_cpl_error_code_ or CPL_ERROR_NONE

  From the cpl_tools_sort_double.
  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT
  - CPL_ERROR_ILLEGAL_INPUT
 */
/*----------------------------------------------------------------------------*/
cpl_error_code 
xsh_tools_sort_double( double  *   pix_arr, int n )
{
  int         i, ir, j, k, l;
  int     *   i_stack ;
  int         j_stack ;
  double      a ;

  /* Check entries */
  if ( pix_arr == NULL ) {
    return CPL_ERROR_NULL_INPUT ;
  }

  ir = n ;
  l = 1 ;
  j_stack = 0 ;
  i_stack = cpl_malloc(XSH_PIX_STACK_SIZE * sizeof(double)) ;
  for (;;) {
    if (ir-l < 7) {
      for (j=l+1 ; j<=ir ; j++) {
	a = pix_arr[j-1];
	for (i=j-1 ; i>=1 ; i--) {
	  if (pix_arr[i-1] <= a) break;
	  pix_arr[i] = pix_arr[i-1];
	}
	pix_arr[i] = a;
      }
      if (j_stack == 0) break;
      ir = i_stack[j_stack-- -1];
      l  = i_stack[j_stack-- -1];
    } else {
      k = (l+ir) >> 1;
      XSH_DOUBLE_SWAP(pix_arr[k-1], pix_arr[l])
	if (pix_arr[l] > pix_arr[ir-1]) {
	  XSH_DOUBLE_SWAP(pix_arr[l], pix_arr[ir-1])
            }
      if (pix_arr[l-1] > pix_arr[ir-1]) {
	XSH_DOUBLE_SWAP(pix_arr[l-1], pix_arr[ir-1])
	  }
      if (pix_arr[l] > pix_arr[l-1]) {
	XSH_DOUBLE_SWAP(pix_arr[l], pix_arr[l-1])
	  }
      i = l+1;
      j = ir;
      a = pix_arr[l-1];
      for (;;) {
	do i++; while (pix_arr[i-1] < a);
	do j--; while (pix_arr[j-1] > a);
	if (j < i) break;
	XSH_DOUBLE_SWAP(pix_arr[i-1], pix_arr[j-1]);
      }
      pix_arr[l-1] = pix_arr[j-1];
      pix_arr[j-1] = a;
      j_stack += 2;
      if (j_stack > XSH_PIX_STACK_SIZE) {
	/* Should never reach here */
	cpl_free(i_stack);
	return CPL_ERROR_ILLEGAL_INPUT ;
      }
      if (ir-i+1 >= j-l) {
	i_stack[j_stack-1] = ir;
	i_stack[j_stack-2] = i;
	ir = j-1;
      } else {
	i_stack[j_stack-1] = j-1;
	i_stack[j_stack-2] = l;
	l = i;
      }
    }
  }
  cpl_free(i_stack) ;
  return CPL_ERROR_NONE ;
}


/**
  @brief    Sort a float array
  @param    pix_arr     the array to sort
  @param    n           the array size
  @return   the #_cpl_error_code_ or CPL_ERROR_NONE

  From the cpl_tools_sort_double.
  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT
  - CPL_ERROR_ILLEGAL_INPUT
 */
/*----------------------------------------------------------------------------*/
cpl_error_code 
xsh_tools_sort_float( float  *   pix_arr, int n )
{
  int         i, ir, j, k, l;
  int     *   i_stack ;
  int         j_stack ;
  float      a ;

  /* Check entries */
  if ( pix_arr == NULL ) {
    return CPL_ERROR_NULL_INPUT ;
  }

  ir = n ;
  l = 1 ;
  j_stack = 0 ;
  i_stack = cpl_malloc(XSH_PIX_STACK_SIZE * sizeof(float)) ;
  for (;;) {
    if (ir-l < 7) {
      for (j=l+1 ; j<=ir ; j++) {
	a = pix_arr[j-1];
	for (i=j-1 ; i>=1 ; i--) {
	  if (pix_arr[i-1] <= a) break;
	  pix_arr[i] = pix_arr[i-1];
	}
	pix_arr[i] = a;
      }
      if (j_stack == 0) break;
      ir = i_stack[j_stack-- -1];
      l  = i_stack[j_stack-- -1];
    } else {
      k = (l+ir) >> 1;
      XSH_FLOAT_SWAP(pix_arr[k-1], pix_arr[l])
	if (pix_arr[l] > pix_arr[ir-1]) {
	  XSH_FLOAT_SWAP(pix_arr[l], pix_arr[ir-1])
            }
      if (pix_arr[l-1] > pix_arr[ir-1]) {
	XSH_FLOAT_SWAP(pix_arr[l-1], pix_arr[ir-1])
	  }
      if (pix_arr[l] > pix_arr[l-1]) {
	XSH_FLOAT_SWAP(pix_arr[l], pix_arr[l-1])
	  }
      i = l+1;
      j = ir;
      a = pix_arr[l-1];
      for (;;) {
	do i++; while (pix_arr[i-1] < a);
	do j--; while (pix_arr[j-1] > a);
	if (j < i) break;
	XSH_FLOAT_SWAP(pix_arr[i-1], pix_arr[j-1]);
      }
      pix_arr[l-1] = pix_arr[j-1];
      pix_arr[j-1] = a;
      j_stack += 2;
      if (j_stack > XSH_PIX_STACK_SIZE) {
	/* Should never reach here */
	cpl_free(i_stack);
	return CPL_ERROR_ILLEGAL_INPUT ;
      }
      if (ir-i+1 >= j-l) {
	i_stack[j_stack-1] = ir;
	i_stack[j_stack-2] = i;
	ir = j-1;
      } else {
	i_stack[j_stack-1] = j-1;
	i_stack[j_stack-2] = l;
	l = i;
      }
    }
  }
  cpl_free(i_stack) ;
  return CPL_ERROR_NONE ;
}


/**
  @brief    Sort an integer array
  @param    pix_arr     the array to sort
  @param    n           the array size
  @return   the #_cpl_error_code_ or CPL_ERROR_NONE

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT
  - CPL_ERROR_ILLEGAL_INPUT
 */
cpl_error_code 
xsh_tools_sort_int( int * pix_arr, int n)
{
  int         i, ir, j, k, l;
  int *       i_stack ;
  int         j_stack ;
  int         a ;

  /* Check entries */
  if ( pix_arr == NULL ) {
    return CPL_ERROR_NULL_INPUT ;
  }

  ir = n ;
  l = 1 ;
  j_stack = 0 ;
  i_stack = cpl_malloc(XSH_PIX_STACK_SIZE * sizeof(double)) ;
  for (;;) {
    if (ir-l < 7) {
      for (j=l+1 ; j<=ir ; j++) {
	a = pix_arr[j-1];
	for (i=j-1 ; i>=1 ; i--) {
	  if (pix_arr[i-1] <= a) break;
	  pix_arr[i] = pix_arr[i-1];
	}
	pix_arr[i] = a;
      }
      if (j_stack == 0) break;
      ir = i_stack[j_stack-- -1];
      l  = i_stack[j_stack-- -1];
    } else {
      k = (l+ir) >> 1;
      XSH_INT_SWAP(pix_arr[k-1], pix_arr[l])
	if (pix_arr[l] > pix_arr[ir-1]) {
	  XSH_INT_SWAP(pix_arr[l], pix_arr[ir-1])
            }
      if (pix_arr[l-1] > pix_arr[ir-1]) {
	XSH_INT_SWAP(pix_arr[l-1], pix_arr[ir-1])
	  }
      if (pix_arr[l] > pix_arr[l-1]) {
	XSH_INT_SWAP(pix_arr[l], pix_arr[l-1])
	  }
      i = l+1;
      j = ir;
      a = pix_arr[l-1];
      for (;;) {
	do i++; while (pix_arr[i-1] < a);
	do j--; while (pix_arr[j-1] > a);
	if (j < i) break;
	XSH_INT_SWAP(pix_arr[i-1], pix_arr[j-1]);
      }
      pix_arr[l-1] = pix_arr[j-1];
      pix_arr[j-1] = a;
      j_stack += 2;
      if (j_stack > XSH_PIX_STACK_SIZE) {
	/* Should never reach here */
	cpl_free(i_stack);
	return CPL_ERROR_ILLEGAL_INPUT ;
      }
      if (ir-i+1 >= j-l) {
	i_stack[j_stack-1] = ir;
	i_stack[j_stack-2] = i;
	ir = j-1;
      } else {
	i_stack[j_stack-1] = j-1;
	i_stack[j_stack-2] = l;
	l = i;
      }
    }
  }
  cpl_free(i_stack) ;
  return CPL_ERROR_NONE ;
}

/** 
 * @brief Calculates the median value of an array of double
 * 
 * @param array The input array
 * @param size The size of the array
 * 
 * @return The median value
 *
 * The first step is to sort in ascending ordre. Then the median is
 * calculated: if size is an odd number, the median is the value of the
 * size/2+1-th element.
 * If size is an even number, the median is the average of the 2 elements
 * size/2 and size/2+1.
 * The input array is MODIFIED.
 */
double xsh_tools_get_median_double( double *array, int size )
{
  double result = 0. ;

  /* First sort array */
  xsh_tools_sort_double( array, size ) ;

  /* Then get median */
  if ( (size % 2) == 1 ) result = *(array+(size/2)) ;
  else {
    double min, max ;

    min = *(array+(size/2)-1) ;
    max = *(array+(size/2) ) ;
    result = (min+max)/2. ;
  }

  return result ;
}

/**
@brief get max of a list of doubles after running median
@param tab list of values
@param size number of values
@param wsize window size for running median
 */
int 
xsh_tools_running_median_1d_get_max( double * tab, int size, int wsize )
{
  int position = 0;
  int i ;
  double /*wtab[128] ;*/ * wtab = NULL ;
  double max = -1000000. ;

  XSH_ASSURE_NOT_NULL( tab ) ;
  XSH_MALLOC( wtab, double, (wsize*2)*2 ) ;
  /*
    loop over tab
    get window
    get median
    if > max, keep position
  */
  //xsh_msg( ">>>> Running Median" ) ;

  for( i = wsize ; i<(size-wsize) ; i++ ) {
    int j, k ;
    double f_max;

    //xsh_msg( "    Position: %d (%d elem)", i, (wsize*2)+1 ) ;
    for( k=0, j = i-wsize ; j<=(i+wsize) ; j++, k++ ) {
      wtab[k] = tab[j] ;
      //xsh_msg( "         Value[%d]: %lf", k, wtab[k] ) ;
    }
    if ( (f_max=xsh_tools_get_median_double(wtab, (wsize*2) + 1)) > max ) {
      max = f_max ;
      position = i ;
    }
  }

    
 cleanup:
  XSH_FREE( wtab ) ;
  return position ;
}


/*----------------------------------------------------------------------------*/
/**
   @brief computes min & max in ab array
   @param size size of array
   @param tab  array
   @param min  minimum
   @param max  maximum
   @return void
*/
/*----------------------------------------------------------------------------*/
 

void xsh_tools_min_max(int size, double *tab, double *min, double *max)
{

  int i;

  XSH_ASSURE_NOT_NULL(tab);
  XSH_ASSURE_NOT_ILLEGAL(size > 0);
  XSH_ASSURE_NOT_NULL(min);
  XSH_ASSURE_NOT_NULL(max);

  *min = tab[0];
  *max = tab[0];

  for(i=1; i < size; i++) {
    if (tab[i] < *min){
      *min = tab[i];
    }
    else if ( tab[i] > *max) {
      *max = tab[i];
    }
  }

  cleanup:
    return;
}

/**
  @brief
    Compute tchebitchev Tn(X) first coefficient for tchebitchev polynomial
  @param n
    index of the last term to be computed (0 to n)
  @param X
    value of X in evaluation of the polynomial
  @return
    the result of evaluation of the n first terms of tchebitchev polynomial
 */

cpl_vector* xsh_tools_tchebitchev_poly_eval( int n, double X)
{
  cpl_vector *result = NULL;

  XSH_ASSURE_NOT_ILLEGAL( n >=0);
  check( result = cpl_vector_new( n+1));
  check( cpl_vector_set(result, 0, 1.0));
  
  if (n > 0){
    int indice = 2;
    check( cpl_vector_set(result, 1, X));
    while( indice <= n){
      double T_indice = 0.0;
      double T_indice_1 = 0.0;
      double T_indice_2 = 0.0;
      
      check( T_indice_1 = cpl_vector_get( result, indice-1));
      check( T_indice_2 = cpl_vector_get( result, indice-2));
      T_indice = 2*X*T_indice_1-T_indice_2;
      check( cpl_vector_set( result, indice, T_indice));
      indice++;
    }
  }
  cleanup:
    if ( cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_vector( &result);
    }
    return result;
}


/*----------------------------------------------------------------------------*/
/**
   @brief computes Tchebitchev transformation
   @param size  saze of array
   @param pos  position array
   @param min  minimum
   @param max  maximum
   @param tcheb_pos  transformed position array
   @return Tchebischev transformation applied on input array
*/
/*----------------------------------------------------------------------------*/
 

void 
xsh_tools_tchebitchev_transform_tab(int size, double* pos, double min,
  double max, double* tcheb_pos)
{
  int i;
  double a,b;

  XSH_ASSURE_NOT_NULL(pos);
  XSH_ASSURE_NOT_NULL(tcheb_pos);
  XSH_ASSURE_NOT_ILLEGAL(size > 0);
  XSH_ASSURE_NOT_ILLEGAL(min < max);
  
  a = 2/ (max-min);
  b = 1-2*max/(max-min);
 
  for(i=0; i < size; i++) {
    tcheb_pos[i] = pos[i]*a+b;
    if ( tcheb_pos[i] < -1. ) tcheb_pos[i] = -1. ;
    if ( tcheb_pos[i] > 1. ) tcheb_pos[i] = 1. ;
  }

  cleanup:
    return;
}


/*----------------------------------------------------------------------------*/
/**
   @brief computes Tchebitchev transformation
   @param pos  position
   @param min  minimum
   @param max  maximum
   @return Tchebischev transformation
*/
/*----------------------------------------------------------------------------*/

double 
xsh_tools_tchebitchev_transform(double pos, double min,  double max)
{
  double a,b;
  double res = 0.0;

  XSH_ASSURE_NOT_ILLEGAL(min < max);

  a = 2/ (max-min);
  b = 1-2*max/(max-min);

  res = pos*a+b;
  if(res <= -1.000001) {
    xsh_msg_dbg_medium("OUT_OF_RANGE res <= -1.000001 for %f [%f,%f]", 
      pos, min , max);
  }
  if(res >= +1.000001) {
    xsh_msg_dbg_medium("OUT_OF_RANGE res >= +1.000001 for %f [%f,%f]",
      pos, min , max);
  }

  //XSH_ASSURE_NOT_ILLEGAL( res >= -1.000001);
  //XSH_ASSURE_NOT_ILLEGAL( res <= 1.000001);

  cleanup:
    return res;
}

/*----------------------------------------------------------------------------*/
/**
   @brief computes reverse Tchebitchev transformation
   @param pos  position
   @param min  minimum
   @param max  maximum
   @return inverse Tchebischev transformation
*/
/*----------------------------------------------------------------------------*/
double 
xsh_tools_tchebitchev_reverse_transform(double pos, double min,  double max)
{
  double a,b;
  double res = 0.0;

  XSH_ASSURE_NOT_ILLEGAL(min < max);

  a = 2/ (max-min);
  b = 1-2*max/(max-min);

  res = (pos-b)/a;

  cleanup:
    return res;
}


/*----------------------------------------------------------------------------*/
/**
   @brief perform spline fit
   @param img  input image
   @param grid input grid specifying evaluation points
   @return updated image with result of spline fit to grid points
*/
/*----------------------------------------------------------------------------*/
void 
xsh_image_fit_spline(cpl_image* img, xsh_grid* grid)
{
  int nx, ny;
  int i = 0, ja, jb, idx = 0, vxsize, size;
  double *data = NULL;
  int *ylines = NULL;
  int *xline = NULL;
  double *vline = NULL;
  int nbylines;
  xsh_grid_point *pointA = NULL;
  xsh_grid_point *pointB = NULL;

  /* check input parameters */
  XSH_ASSURE_NOT_NULL( img);
  XSH_ASSURE_NOT_NULL( grid);
  XSH_ASSURE_NOT_ILLEGAL( cpl_image_get_type(img) == CPL_TYPE_DOUBLE);

  check( data = cpl_image_get_data_double(img));
  check( nx = cpl_image_get_size_x(img));
  check( ny = cpl_image_get_size_y(img));
  check( size = xsh_grid_get_index(grid));
  
  ja = 0;
  jb = ja+1;
  nbylines = 0;
  vxsize = 0;

  XSH_MALLOC( ylines, int, ny);
  XSH_MALLOC( xline, int, nx);
   XSH_MALLOC( vline, double, nx);

  /* interpolate in X direction */
  while( jb < size) {
    double a = 0.0, b = 0.0;
    int cur_y;

    nbylines++;
    vxsize = 1;
    /* get first point of the line */
    check( pointA = xsh_grid_point_get( grid, ja));
    check( pointB = xsh_grid_point_get( grid, jb));

    cur_y = pointA->y-1;
    ylines[nbylines-1]= cur_y;
    xline[vxsize-1] = pointA->x-1;
    vline[vxsize-1] = pointA->v;

    while( ( jb < size) && ( pointA->y == pointB->y) ){
      check( pointB = xsh_grid_point_get( grid, jb));

      if ( (pointB->x-1) != xline[vxsize-1]){
        xline[vxsize] = pointB->x-1;
        vline[vxsize] = pointB->v;
        vxsize++;
      }
      jb++;
    }
    XSH_ASSURE_NOT_ILLEGAL( vxsize >=2);

    for(idx=0; idx<vxsize-1; idx++){
      int nbpix = 0;
      int xa, xb;
      double va, vb;

      xa = xline[idx];
      xb = xline[idx+1];
     
      va = vline[idx];
      vb = vline[idx+1]; 

      a = ( vb - va) / ( xb - xa);
      b = va-a*xa;

      nbpix = xb-xa;

      for(i=0; i<= nbpix; i++){
        data[xa+i+cur_y*nx] = a*(xa+i)+b;  
      }
    }
    ja=jb;
    jb=ja+1;
  }
  /* interpolate in Y direction */

  xsh_msg("interpolate in Y ");

  for( ja=0; ja< nbylines-1; ja++) {
    int line1 = ylines[ja];
    int line2 = ylines[ja+1]; 

    for(i=0; i< nx; i++){
      double val1 = data[i+line1*nx];
      double val2 = data[i+line2*nx];
      double a = (val2-val1)/(line2-line1);
      double b = val1;
      int k;

      for(k=line1+1; k < line2; k++){
        data[i+k*nx] = a*(k-line1)+b;
      }
    }
  }

  cleanup:
    XSH_FREE( ylines);
    XSH_FREE( xline);
    XSH_FREE( vline);
    return;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    set debug level
   @param x  vector with independent variable
   @param y  vector with dependent variable
   @param result structure containing results (peakpos,sigma,area,offset,mse)
   @return  results of Gaussian fit
   @note wrapper to @c cpl_vector_fit_gaussian (assumes no errors on X,Y);
*/
/*----------------------------------------------------------------------------*/
void 
xsh_vector_fit_gaussian( cpl_vector * x, 
			 cpl_vector * y,
			 XSH_GAUSSIAN_FIT * result )
{
  XSH_ASSURE_NOT_NULL( x ) ;
  XSH_ASSURE_NOT_NULL( y ) ;
  XSH_ASSURE_NOT_NULL( result ) ;

  cpl_vector_fit_gaussian( x, NULL, y, NULL, CPL_FIT_ALL, &result->peakpos,
			   &result->sigma,
			   &result->area, &result->offset, &result->mse,
			   NULL, NULL ) ;
 cleanup:
  return ;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    set debug level
   @param level error level
   @return   debug level

*/
/*----------------------------------------------------------------------------*/
int xsh_debug_level_set( int level )
{
  int prev = XshDebugLevel ;

  XshDebugLevel = level ;

  return prev ;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    get debug level
   @return   debug level

*/
/*----------------------------------------------------------------------------*/
int 
xsh_debug_level_get( void )
{
  return XshDebugLevel ;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    set debug level
   @return   string equivalent to debug level

*/
/*----------------------------------------------------------------------------*/
const char * 
xsh_debug_level_tostring( void )
{
  switch ( XshDebugLevel ) {
  case XSH_DEBUG_LEVEL_NONE:
    return "none" ;
  case XSH_DEBUG_LEVEL_LOW:
    return "low" ;
  case XSH_DEBUG_LEVEL_MEDIUM:
    return "medium" ;
  case XSH_DEBUG_LEVEL_HIGH:
    return "high" ;
  default:
    return "unknown" ;
  }
}
/*----------------------------------------------------------------------------*/
/**
   @brief    set timestamp
   @param  ts time stamp index
   @return   timestamp

*/
/*----------------------------------------------------------------------------*/
int 
xsh_time_stamp_set( int ts )
{
  int prev = XshTimeStamp ;

  XshTimeStamp = ts ;

  return prev ;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    get timestamp
   @return   timestamp

*/
/*----------------------------------------------------------------------------*/
int 
xsh_time_stamp_get( void )
{
  return XshTimeStamp ;
}

/** 
 * Debugging utility. A call to this function dumps the memory usage
 * to stderr.
 * 
 * @param prompt A string output to stderr before memory dump
 */
void 
xsh_mem_dump( const char * prompt)
{
  fprintf( stderr, "\n******** %s *******\n", prompt ) ;
  cpl_memory_dump() ;
}

/* Binning functions */
/*---------------------------------------------------------------------------*/
/* 
  @brief
    Convert binning positions into unbin positions
  @param bin_data 
    The binning position
  @param binning
    The binning factor
  @return
    The no bin position
*/
/*---------------------------------------------------------------------------*/
double 
convert_bin_to_data( double bin_data, int binning)
{
  return (bin_data*binning-0.5*(binning-1));
}

/*---------------------------------------------------------------------------*/
/* 
  @brief
    Convert unbin positions into binning positions
  @param data 
    The no bin position
  @param binning
    The binning factor
  @return
    The binning position
*/
/*---------------------------------------------------------------------------*/
double 
convert_data_to_bin( double data, int binning)
{
  return (data+0.5*(binning-1))/binning;
}

/*
  Function to order a set of frames by DATE-OBS Keyword
*/
static double 
date_to_double( const char * the_date )
{
  int yy, mm, dd, hh, min, sec, millis ;
  int date, temps ;
  double fdate = 0 ;


  XSH_ASSURE_NOT_NULL( the_date ) ;

  sscanf( the_date, "%64d%*c%64d%*c%64d%*c%64d%*c%64d%*c%64d%*c%64d",
	  &yy, &mm, &dd, &hh, &min, &sec, &millis ) ;

  date = yy*10000 + mm*100 + dd ;
  temps = hh*10000000 + min*100000 + sec*1000 + millis ;
  fdate = (double)date + (double)temps/1000000000. ;

 cleanup:
  return fdate ;

}

typedef struct {
  double frame_date ;
  int frame_idx ;
  cpl_frame * frame ;
  const char * frame_name ;
} FRAME_DATE_IDX ;

static int 
compare_frame_date( const void * one, const void * two )
{
  FRAME_DATE_IDX * first = (FRAME_DATE_IDX *)one,
    * scnd = (FRAME_DATE_IDX *)two ;

  if ( first->frame_date > scnd->frame_date ) return 1 ;
  else if ( first->frame_date == scnd->frame_date ) return 0 ;
  else return -1 ;
}

/******************************************************************************/
/******************************************************************************/
  
/*----------------------------------------------------------------------------*/
/**
   @brief    Order frameset by date
   @param    frameset input frameset
   @return   updated frameset where input frames are sorted by date

*/
/*----------------------------------------------------------------------------*/
cpl_frameset* 
xsh_order_frameset_by_date( cpl_frameset *frameset)
{
  int nb, i ;
  FRAME_DATE_IDX *frame_date = NULL;
  cpl_frameset *result = NULL ;
  cpl_propertylist *header = NULL;

  XSH_ASSURE_NOT_NULL( frameset);

  check( nb = cpl_frameset_get_size( frameset));
  if ( nb <= 1 ) {
    check( result = cpl_frameset_duplicate( frameset));
  }
  else{
    XSH_CALLOC( frame_date, FRAME_DATE_IDX, nb);

    /* Read all dates and convert into computable format */
    for( i = 0 ; i < nb ; i++){
      const char *fname = NULL ;
      cpl_frame *frame = NULL ;
      const char *the_date = NULL;

      /* Get frame file name */
      check( frame = cpl_frameset_get_frame( frameset, i));
      check( fname = cpl_frame_get_filename( frame));

      /* Load frame propertylist */
      check( header = cpl_propertylist_load( fname, 0));
      /* Get date as a string */
      check( the_date = xsh_pfits_get_date_obs( header));
      /* Convert and store */
      frame_date[i].frame_date = date_to_double( the_date);
      frame_date[i].frame_idx = i;
      frame_date[i].frame = frame;
      frame_date[i].frame_name = fname;

      xsh_free_propertylist( &header);
    }
    /* Now order by date */
    qsort( frame_date, nb, sizeof( FRAME_DATE_IDX ), compare_frame_date ) ;

    if ( xsh_debug_level_get() > XSH_DEBUG_LEVEL_NONE ) {
      for( i = 0 ; i<nb ; i++ ) {
        xsh_msg( "%d: %.9lf '%s'", frame_date[i].frame_idx,
          frame_date[i].frame_date, frame_date[i].frame_name);
      }
    }
    /* Create the ordered frameset */
    check( result = cpl_frameset_new() ) ;

    /* Populate the new frameset */
    for( i = 0 ; i <nb ; i++ ){
      check( cpl_frameset_insert( result, 
        cpl_frame_duplicate(frame_date[i].frame)));
    }
  }
  cleanup:
    if ( cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frameset( &result);
    }
    xsh_free_propertylist( &header);
    XSH_FREE( frame_date);
    return result;
}
/******************************************************************************/

/*----------------------------------------------------------------------------*/
/**
 @brief    Fit a 2d polynomial to three table columns
 @param    t             The table
 @param    X1             Name of table column containing 1st independent variable
 @param    X2             Name of table column containing 2nd independent variable
 @param    Y              Name of table column containing dependent variable
 @param    sigmaY         Uncertainty of dependent variable. If NULL, constant
 uncertainties are assumed.
 @param    degree1        Degree of polynomial fit (1st variable)
 @param    degree2        Degree of polynomial fit (2nd variable)
 @param    polynomial_fit  If non-NULL, name of column to add. The fitted value.
 @param    residual_square If non-NULL, name of column to add. The squared residual of the fit.
 @param    variance_fit    If non-NULL, name of column to add. Variance of the fitted value.
 @param[out]    mse        Mean squared error of the residuals. May be NULL.
 @param[out]    red_chisq  Reduced chi square of the fit. May be NULL.
 @param[out]    variance   Variance of the fit-polynomial (which is in itself a
 polynomial; see also @c xsh_polynomial_fit_2d() ). May be NULL.
 @param    kappa           If positive, the value of kappa used in a kappa sigma-clipping.
 Ignored if negative.
 @param    min_reject      Minimum number of outliers worth rejecting. Stop iterating (for
 efficiency) if less than this relative number of outliers
 (e.g. 0.001) are detected. Negative to disable
 @return   Fitted polynomial

 This function fits column @em Y (must be of type CPL_TYPE_DOUBLE) as function
 of @em X1 (CPL_TYPE_DOUBLE or CPL_TYPE_INT) and @em X2 (CPL_TYPE_DOUBLE or CPL_TYPE_INT).
 The column @em sigmaY contains the Y-uncertainties. If NULL, constant uncertainty
 equal to 1 is assumed.

 If non-NULL the columns specified by the parameters @em polynomial_fit, @em residual_square
 and @em variance_fit are added to the table (containing the fitted value, the squared
 residual and the variance of the fitted value, for each point).

 If non-NULL, the @em mean_squared_error and @em red_chisq (reduced chi square) are
 calculated.

 If non-NULL the parameter @em variance will contain the polynomial that defines
 the variance of the fit (i.e. as function of @em x1 and @em x2 ).

 To calculate variances or reduced chi square, the parameter @em sigmaY must be non-NULL.

 If @em kappa is positive, a kappa-sigma clipping is performed (iteratively, until there
 are no points with residuals worse than kappa*sigma). The rejected points (rows)
 are physically removed from the table.

 Also see @c xsh_polynomial_regression_1d() .
 */
/*----------------------------------------------------------------------------*/

polynomial *
xsh_polynomial_regression_2d(cpl_table *t, const char *X1, const char *X2,
    const char *Y, const char *sigmaY, int degree1, int degree2,
    const char *polynomial_fit, const char *residual_square,
    const char *variance_fit, double *mse, double *red_chisq,
    polynomial **variance, double kappa, double min_reject) {
  int N;
  int rejected;
  int total_rejected;
  double *x1 = NULL;
  double *x2 = NULL;
  double *y = NULL;
  double *res = NULL;
  double *sy = NULL;
  polynomial *p = NULL; /* Result */
  polynomial *variance_local = NULL;
  cpl_vector *vx1 = NULL;
  cpl_vector *vx2 = NULL;
  cpl_bivector *vx = NULL;
  cpl_vector *vy = NULL;
  cpl_vector *vsy = NULL;
  cpl_type type;

  /* Check input */
  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
  assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT,
      "No such column: %s", X1);
  assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT,
      "No such column: %s", X2);
  assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT,
      "No such column: %s", Y);
  assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
      CPL_ERROR_INCOMPATIBLE_INPUT,
      "Cannot calculate variances without sigmaY");
  if (sigmaY != NULL) {
    assure( cpl_table_has_column(t, sigmaY), CPL_ERROR_ILLEGAL_INPUT,
        "No such column: %s", sigmaY);
  }
  if (polynomial_fit != NULL) {
    assure( !cpl_table_has_column(t, polynomial_fit), CPL_ERROR_ILLEGAL_INPUT,
        "Table already has '%s' column", polynomial_fit);
  }
  if (residual_square != NULL) {
    assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT,
        "Table already has '%s' column", residual_square);
  }
  if (variance_fit != NULL) {
    assure( !cpl_table_has_column(t, variance_fit), CPL_ERROR_ILLEGAL_INPUT,
        "Table already has '%s' column", variance_fit);
  }

  /* Check column types */
  type = cpl_table_get_column_type(t, X1);
  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
      CPL_ERROR_INVALID_TYPE,
      "Input column '%s' has wrong type (%s)", X1, xsh_tostring_cpl_type(type));
  type = cpl_table_get_column_type(t, X2);
  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
      CPL_ERROR_INVALID_TYPE,
      "Input column '%s' has wrong type (%s)", X2, xsh_tostring_cpl_type(type));
  type = cpl_table_get_column_type(t, Y);
  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
      CPL_ERROR_INVALID_TYPE,
      "Input column '%s' has wrong type (%s)", Y, xsh_tostring_cpl_type(type));
  if (sigmaY != NULL) {
    type = cpl_table_get_column_type(t, sigmaY);
    assure(
        type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
        CPL_ERROR_INVALID_TYPE,
        "Input column '%s' has wrong type (%s)", sigmaY, xsh_tostring_cpl_type(type));
  }

  /* In the case that these temporary columns already exist, a run-time error will occur */
  check_msg( cpl_table_cast_column(t, X1, "_X1_double", CPL_TYPE_DOUBLE),
      "Could not cast table column to double");
  check_msg( cpl_table_cast_column(t, X2, "_X2_double", CPL_TYPE_DOUBLE),
      "Could not cast table column to double");
  check_msg( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
      "Could not cast table column to double");
  if (sigmaY != NULL) {
    check_msg( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
        "Could not cast table column to double");
  }

  total_rejected = 0;
  rejected = 0;
  check_msg( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
      "Could not create column");

  do {
    /* WARNING!!! Code duplication (see below). Be careful
     when updating */
    check_msg(
        ( N = cpl_table_get_nrow(t), x1 = cpl_table_get_data_double(t, "_X1_double"), x2 = cpl_table_get_data_double(t, "_X2_double"), y = cpl_table_get_data_double(t, "_Y_double"), res= cpl_table_get_data_double(t, "_residual_square")),
        "Could not read table data");

    if (sigmaY != NULL) {
      check_msg(sy = cpl_table_get_data_double(t, "_sY_double"),
          "Could not read table data");
    } else {
      sy = NULL;
    }

    assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");

    /* Wrap vectors */
    xsh_unwrap_vector(&vx1);
    xsh_unwrap_vector(&vx2);
    xsh_unwrap_vector(&vy);

    vx1 = cpl_vector_wrap(N, x1);
    vx2 = cpl_vector_wrap(N, x2);
    vy = cpl_vector_wrap(N, y);
    if (sy != NULL) {
      xsh_unwrap_vector(&vsy);
      vsy = cpl_vector_wrap(N, sy);
    } else {
      vsy = NULL;
    }

    /* Wrap up the bi-vector */
    xsh_unwrap_bivector_vectors(&vx);
    vx = cpl_bivector_wrap_vectors(vx1, vx2);

    /* Fit! */
    xsh_polynomial_delete(&p);
    check_msg(
        p = xsh_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, NULL, NULL, NULL),
        "Could not fit polynomial");

    /* If requested, calculate residuals and perform kappa-sigma clipping */
    if (kappa > 0) {
      double sigma2; /* sigma squared */
      int i;

      cpl_table_fill_column_window_double(t, "_residual_square", 0,
          cpl_table_get_nrow(t), 0.0);

      for (i = 0; i < N; i++) {
        double yval, yfit;

        yval = y[i];
        yfit = xsh_polynomial_evaluate_2d(p, x1[i], x2[i]);
        res[i] = (yfit - yval) * (yfit - yval);
      }

      /* For robustness, estimate sigma as (third quartile) / 0.6744
       * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
       * The third quartile is estimated as the median of the absolute residuals,
       * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
       *     sigma^2  ~= median(residual^2) / 0.6744^2
       */
      sigma2 = cpl_table_get_column_median(t, "_residual_square")
          / (0.6744 * 0.6744);

      /* Remove points with residual^2 > kappa^2 * sigma^2 */
      check_msg(
          rejected = xsh_erase_table_rows(t, "_residual_square", CPL_GREATER_THAN, kappa*kappa*sigma2),
          "Could not remove outlier points");
      /* Note! All pointers to table data are now invalid! */

      xsh_msg_debug(
          "%d of %d points rejected in kappa-sigma clipping. rms=%f", rejected, N, sqrt(sigma2));

      /* Update */
      total_rejected += rejected;
      N = cpl_table_get_nrow(t);
    }

    /* Stop also if there are too few points left to make the fit.
     * Needed number of points = (degree1+1)(degree2+1) coefficients
     *      plus one extra point for chi^2 computation.   */
  } while (rejected > 0 && rejected > min_reject * (N + rejected)
      && N >= (degree1 + 1) * (degree2 + 1) + 1);

  if (kappa > 0) {
    xsh_msg_debug(
        "%d of %d points (%f %%) rejected in kappa-sigma clipping", total_rejected, N + total_rejected, (100.0*total_rejected)/(N + total_rejected));
  }

  /* Final fit */
  {
    /* Need to convert to vector again. */

    /* WARNING!!! Code duplication (see above). Be careful
     when updating */
    check_msg(
        ( N = cpl_table_get_nrow(t), x1 = cpl_table_get_data_double(t, "_X1_double"), x2 = cpl_table_get_data_double(t, "_X2_double"), y = cpl_table_get_data_double(t, "_Y_double"), res= cpl_table_get_data_double(t, "_residual_square")),
        "Could not read table data");

    if (sigmaY != NULL) {
      check_msg(sy = cpl_table_get_data_double(t, "_sY_double"),
          "Could not read table data");
    } else {
      sy = NULL;
    }

    assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");

    /* Wrap vectors */
    xsh_unwrap_vector(&vx1);
    xsh_unwrap_vector(&vx2);
    xsh_unwrap_vector(&vy);

    vx1 = cpl_vector_wrap(N, x1);
    vx2 = cpl_vector_wrap(N, x2);
    vy = cpl_vector_wrap(N, y);
    if (sy != NULL) {
      xsh_unwrap_vector(&vsy);
      vsy = cpl_vector_wrap(N, sy);
    } else {
      vsy = NULL;
    }

    /* Wrap up the bi-vector */
    xsh_unwrap_bivector_vectors(&vx);
    vx = cpl_bivector_wrap_vectors(vx1, vx2);
  }

  xsh_polynomial_delete(&p);
  if (variance_fit != NULL || variance != NULL) {
    /* If requested, also compute variance */
    check_msg(
        p = xsh_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, mse, red_chisq, &variance_local),
        "Could not fit polynomial");
  } else {
    check_msg(
        p = xsh_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, mse, red_chisq, NULL),
        "Could not fit polynomial");
  }

  cpl_table_erase_column(t, "_residual_square");

  /* Add the fitted values to table as requested */
  if (polynomial_fit != NULL || residual_square != NULL) {
    int i;
    double *pf;

    check_msg( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
        "Could not create column");

    cpl_table_fill_column_window_double(t, "_polynomial_fit", 0,
        cpl_table_get_nrow(t), 0.0);

    x1 = cpl_table_get_data_double(t, "_X1_double");
    x2 = cpl_table_get_data_double(t, "_X2_double");
    pf = cpl_table_get_data_double(t, "_polynomial_fit");

    for (i = 0; i < N; i++) {
#if 0        
      double x1val, x2val, yfit;

      check_msg(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
              x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
              yfit = xsh_polynomial_evaluate_2d(p, x1val, x2val),

              cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
          "Could not evaluate polynomial");

#else
      pf[i] = xsh_polynomial_evaluate_2d(p, x1[i], x2[i]);
#endif
    }

    /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
    if (residual_square != NULL) {
      check_msg(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
      t, "_polynomial_fit"), cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
      cpl_table_multiply_columns(t, residual_square, residual_square)),
      /* RS := RS^2 */
      "Could not calculate Residual of fit");
    }

    /* Keep the polynomial_fit column if requested */
    if (polynomial_fit != NULL) {
      cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
    } else {
      cpl_table_erase_column(t, "_polynomial_fit");
    }
  }

  /* Add variance of poly_fit if requested */
  if (variance_fit != NULL) {
    int i;
    double *vf;

    check_msg( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE),
        "Could not create column");

    cpl_table_fill_column_window_double(t, variance_fit, 0,
        cpl_table_get_nrow(t), 0.0);

    x1 = cpl_table_get_data_double(t, "_X1_double");
    x2 = cpl_table_get_data_double(t, "_X2_double");
    vf = cpl_table_get_data_double(t, variance_fit);

    for (i = 0; i < N; i++) {
#if 0
      double x1val, x2val, yfit_variance;
      check_msg(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
              x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
              yfit_variance = xsh_polynomial_evaluate_2d(variance_local,
                  x1val, x2val),

              cpl_table_set_double(t, variance_fit, i, yfit_variance)),
          "Could not evaluate polynomial");
#else
      vf[i] = xsh_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
#endif

    }
  }

  check_msg(
      ( cpl_table_erase_column(t, "_X1_double"), cpl_table_erase_column(t, "_X2_double"), cpl_table_erase_column(t, "_Y_double")),
      "Could not delete temporary columns");

  if (sigmaY != NULL) {
    check_msg( cpl_table_erase_column(t, "_sY_double"),
        "Could not delete temporary column");
  }

  cleanup: xsh_unwrap_bivector_vectors(&vx);
  xsh_unwrap_vector(&vx1);
  xsh_unwrap_vector(&vx2);
  xsh_unwrap_vector(&vy);
  xsh_unwrap_vector(&vsy);
  /* Delete 'variance_local', or return through 'variance' parameter */
  if (variance != NULL) {
    *variance = variance_local;
  } else {
    xsh_polynomial_delete(&variance_local);
  }
  if (cpl_error_get_code() != CPL_ERROR_NONE) {
    xsh_polynomial_delete(&p);
  }

  return p;
}



/*----------------------------------------------------------------------------*/
/**
   @brief    Select table rows
   @param    t        Table
   @param    column   Column name
   @param    operator Logical operator
   @param    value    Value used for comparison
   @return   Number of selected rows

   A row is selected if and only if the value in @em column is in the
   relation @em operator to the specified @em value. The specified column must
   have type CPL_TYPE_DOUBLE, CPL_TYPE_FLOAT or CPL_TYPE_INT. If integer,
   the integer nearest to @em value is used for the comparison.

   Also see @c cpl_table_and_selected_<type>().

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

int
xsh_select_table_rows(cpl_table *t,  
		      const char *column,
		      cpl_table_select_operator operator,
		      double value)
{
    int result = 0;
    cpl_type type;
    
    assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
    assure( cpl_table_has_column(t, column), CPL_ERROR_INCOMPATIBLE_INPUT, 
        "No such column: %s", column);

    type = cpl_table_get_column_type(t, column);

    assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_FLOAT ||
        type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
        "Column '%s' must be double or int. %s found", column, 
        xsh_tostring_cpl_type(type));

    check_msg( cpl_table_select_all(t), "Error selecting rows");
    
    if      (type == CPL_TYPE_DOUBLE)
    {
        result = cpl_table_and_selected_double(t, column, operator, value);
    }
    else if (type == CPL_TYPE_FLOAT)
    {
        result = cpl_table_and_selected_float(t, column, operator, value);
    }
    else if (type == CPL_TYPE_INT)
    {
        result = cpl_table_and_selected_int(t, column, operator, 
                                                xsh_round_double(value));
    }
    else { /*impossible*/ passure(false, ""); }
    
  cleanup:
    return result;

}




/*---------------------------------------------------------------------------*/
/**
   @brief    Erase table rows
   @param    t        Table
   @param    column   Column name
   @param    operator Logical operator
   @param    value    Value used for comparison
   @return   Number of erased rows

   A table row is erased if and only if the value in @em column is in the
   relation @em operator to the specified @em value. The specified column must
   have type CPL_TYPE_DOUBLE or CPL_TYPE_INT. If integer, the integer nearest
   to @em value is used for the comparison.

   The table selection flags are reset.

   Also see @c cpl_table_and_selected_<type>().

*/
/*---------------------------------------------------------------------------*/
int
xsh_erase_table_rows(cpl_table *t, 
		     const char *column,
		     cpl_table_select_operator operator, 
		     double value)
{
    int result = 0;
    
    assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
    assure( cpl_table_has_column(t, column), CPL_ERROR_INCOMPATIBLE_INPUT, 
        "No such column: %s", column);

    check_msg( result = xsh_select_table_rows(t, column, operator, value),
       "Error selecting rows");

    check_msg( cpl_table_erase_selected(t), "Error deleting rows");

  cleanup:
    return result;
}
/*---------------------------------------------------------------------------*/
/**
  @brief Inverse the flux of a PRE frame
  @param in The pre frame to inverse
  @param filename filename
  @param instr instrument setting

  @return The new inverse flux frame
*/
/*---------------------------------------------------------------------------*/
cpl_frame* xsh_frame_inv( cpl_frame* in, const char *filename,
  xsh_instrument* instr)
{
  xsh_pre *pre = NULL;
  cpl_frame *result = NULL;
  const char* tag = "INV_PRE";

  XSH_ASSURE_NOT_NULL( in);
  XSH_ASSURE_NOT_NULL( instr);

  check( pre = xsh_pre_load( in, instr));
  check( xsh_pre_multiply_scalar( pre, -1.0));
  check( result = xsh_pre_save( pre, filename, tag, 1));  
  check( cpl_frame_set_tag( result, tag));

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frame( &result);
    }
   xsh_pre_free( &pre);
   return result;
}
/*---------------------------------------------------------------------------*/

/*---------------------------------------------------------------------------*/
/**
   @brief    Computes absolute value of a frame
   @param    in input frame
   @param    instr instrument setting
   @param    sign input frame
   @return   ||in||
*/
/*---------------------------------------------------------------------------*/
cpl_frame* xsh_frame_abs(  cpl_frame* in,  xsh_instrument* instr, 
  cpl_frame** sign)
{
  xsh_pre *pre = NULL;
  cpl_frame *result = NULL;
  cpl_frame *sign_frame = NULL;
  char name[256];
  const char* tag = "ABS_PRE";
  const char* sign_tag = "SIGN_PRE";
  const char *filename = NULL;
  cpl_image *sign_img = NULL;

  XSH_ASSURE_NOT_NULL( in);
  XSH_ASSURE_NOT_NULL( sign);

  check( filename = cpl_frame_get_filename( in));
  check( pre = xsh_pre_load( in, instr));
  check( sign_img = xsh_pre_abs( pre));
  sprintf( name ,"ABS_%s", filename);
  check( result = xsh_pre_save( pre, name, tag, 1));
  check( cpl_frame_set_tag( result, tag));
  sprintf( name ,"SIGN_%s", filename);
  check( cpl_image_save( sign_img, name, CPL_BPP_32_SIGNED, 
    NULL,CPL_IO_DEFAULT));  
  xsh_add_temporary_file(name);
  check( sign_frame = cpl_frame_new());
  check( cpl_frame_set_filename( sign_frame, name));
  check( cpl_frame_set_tag( sign_frame, sign_tag));
  *sign = sign_frame;

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frame( &result);
    }
    xsh_free_image( &sign_img);
    xsh_pre_free( &pre);
    return result;
}


/*---------------------------------------------------------------------------*/
/**
@brief save an spectrum frame
@param frm frame
@param name_o output filename
@return void
 */
void
xsh_frame_spectrum_save(cpl_frame* frm,const char* name_o)
{
   xsh_spectrum* s=NULL;
   //const char* name=NULL;
   const char* tag=NULL;
   cpl_frame* loc_frm=NULL;
   //name=cpl_frame_get_filename(frm);
   s=xsh_spectrum_load(frm);
   loc_frm=xsh_spectrum_save(s,name_o,tag);
   cpl_frame_set_filename(frm,name_o);

   xsh_spectrum_free(&s);
   xsh_free_frame(&loc_frm);
   return;
}

/*---------------------------------------------------------------------------*/
/**
@brief save an image frame
@param frm frame
@param name_o output filename
@return void
 */
void
xsh_frame_image_save(cpl_frame* frm,const char* name_o)
{
   cpl_image* ima=NULL;
   const char* name=NULL;
   int i=0;
   int next=cpl_frame_get_nextensions(frm);
   int type=CPL_TYPE_FLOAT;
   cpl_propertylist* plist=NULL;
   name=cpl_frame_get_filename(frm);

   for(i=0;i<=next;i++) {
       ima=cpl_image_load(name,CPL_TYPE_UNSPECIFIED,0,i);
       type = cpl_image_get_type(ima);
       plist=cpl_propertylist_load(name,i);
       if(i==0) {
           cpl_image_save(ima,name_o,type,plist,CPL_IO_DEFAULT);
       } else{
           cpl_image_save(ima,name_o,type,plist,CPL_IO_EXTEND);
       }
       xsh_free_image(&ima);
       xsh_free_propertylist(&plist);
   }

   return; 
}


/**
   @brief    Save a table frame
   @param    frame input table frame
   @param    name_o file name
   @return   void
*/
void
xsh_frame_table_save(cpl_frame* frame,const char* name_o)
{
   const char* fname=NULL;
 
   int nbext=0;
   int extension ;
   cpl_table *tbl_ext = NULL;
   cpl_propertylist *tbl_ext_header = NULL;
   cpl_propertylist *primary_header = NULL;
   int i=0;

   fname=cpl_frame_get_filename(frame);
   nbext = cpl_frame_get_nextensions( frame);
 
   for( i = 0 ; i<nbext ; i++ ) {
   
    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,
			  name_o, extension));
    xsh_free_table( &tbl_ext);
    xsh_free_propertylist( &tbl_ext_header);

  }

  cleanup:
   xsh_free_table( &tbl_ext);
   xsh_free_propertylist( &tbl_ext_header);

   return; 
}
/*---------------------------------------------------------------------------*/
/**
   @brief    Computes product of two input frames
   @param    in input frame
   @param    instr instrument structure
   @param    sign input frame

   @return   in*sign
*/
/*---------------------------------------------------------------------------*/
cpl_frame* xsh_frame_mult(  cpl_frame* in,  xsh_instrument* instr,
  cpl_frame* sign)
{
  xsh_pre *pre = NULL;
  cpl_frame *result = NULL;
  cpl_image *sign_img = NULL;
  const char* name = NULL;
  const char* tag = "MULT_IMG_PRE";

  XSH_ASSURE_NOT_NULL( in);
  XSH_ASSURE_NOT_NULL( sign);

  check( name = cpl_frame_get_filename( sign));
  check( pre = xsh_pre_load( in, instr));
  check( sign_img = cpl_image_load( name, CPL_TYPE_INT, 0, 0));
  check( xsh_pre_multiply_image( pre, sign_img));
  check( result = xsh_pre_save( pre, "RESTORE_PRE.fits", tag, 1));
  check( cpl_frame_set_tag( result, tag));

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frame( &result);
    }
    xsh_free_image( &sign_img);
    xsh_pre_free( &pre);
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief  
    Monitor Flux level along the orders traces given by an input table
  @param frm_ima 
    The input frame image whose flux is to be monitored
  @param frm_tab
    input frame table with order traces
  @param instrument
    instrument (arm setting)

  @return
    The input frame image FITS header is updated with flux level QC parameters 
*/
/*---------------------------------------------------------------------------*/


cpl_error_code
xsh_monitor_flux(cpl_frame* frm_ima,const cpl_frame* frm_tab, 
  xsh_instrument *instrument, const char* qc_key_prefix)
{

  int ord_min=0;
  int ord_max=0;
  int i=0;
  const char* name_ima=NULL;
  const char* name_tab=NULL;
  cpl_table* tab=NULL;
  cpl_image* ima=NULL;
  cpl_image* qua=NULL;
  cpl_table* ext=NULL;
  int next=0;
  double* cx=NULL;
  double* cy=NULL;
  int ix=0;
  int iy=0;
  double flux_min_init=FLT_MAX;
  double flux_max_init=-FLT_MAX;

  double flux_min_ord=flux_min_init;
  double flux_max_ord=flux_max_init;

  double flux_min=flux_min_init;
  double flux_max=flux_max_init;
  double* pima=NULL;
  int* pqua=NULL;
  double flux=0;
  int qual=0;
  cpl_propertylist* plist=NULL;
  char qc_flux_min[40];
  char qc_flux_max[40];
  int sx=0;
  int sy=0;
  int j=0;
  int binx=1;
  int biny=1;
  int decode_bp=instrument->decode_bp;
  cpl_ensure_code(frm_ima != NULL, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(frm_tab != NULL, CPL_ERROR_NULL_INPUT);
  xsh_msg("monitor flux");
  check(name_ima=cpl_frame_get_filename(frm_ima));
  check(name_tab=cpl_frame_get_filename(frm_tab));

  check(plist=cpl_propertylist_load(name_ima,0));

  if( xsh_instrument_get_arm( instrument) != XSH_ARM_NIR){
    binx=xsh_pfits_get_binx(plist);
    biny=xsh_pfits_get_biny(plist);
  }
  check(tab=cpl_table_load(name_tab,2,0));
  check(ima=cpl_image_load(name_ima,CPL_TYPE_DOUBLE,0,0));
  check(qua=cpl_image_load(name_ima,CPL_TYPE_INT,0,2));
  check(sx=cpl_image_get_size_x(ima));
  check(sy=cpl_image_get_size_y(ima));
  //xsh_msg("image=%s",name_ima);
  //xsh_msg("sx=%d sy=%d binx=%d biny=%d",sx,sy,binx,biny);
  //check(cpl_image_save(ima,"pippo.fits",CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));

  check(pima=cpl_image_get_data_double(ima));
  check(pqua=cpl_image_get_data_int(qua));
  check(ord_min=cpl_table_get_column_min(tab,"ABSORDER"));
  check(ord_max=cpl_table_get_column_max(tab,"ABSORDER"));
  //xsh_msg("ord_min=%d ord_max=%d",ord_min,ord_max);

  for(i=ord_min;i<=ord_max;i++) {
      flux_min_ord=flux_min_init;
      flux_max_ord=flux_max_init;

      check(next=cpl_table_and_selected_int(tab,"ABSORDER",CPL_EQUAL_TO,i));
      ext=cpl_table_extract_selected(tab);
      cx=cpl_table_get_data_double(ext,"CENTER_X");
      cy=cpl_table_get_data_double(ext,"CENTER_Y");

      for(j=0;j<next;j++) {

          ix=(int)(cx[j]/binx+0.5);
          iy=(int)(cy[j]/biny+0.5);

          if( ( (ix>=0) && (ix<sx) ) &&
                          ( (iy>=0) && (iy<sy) ) ) {
              check(flux=pima[ix+sx*iy]);
              check(qual=pqua[ix+sx*iy]);
              if(!isnan(flux) && ((qual & decode_bp)==0)) {
                  if(flux<flux_min_ord) {
                      flux_min_ord=flux;
                      continue;
                  }
                  if(flux>flux_max_ord) {
                      flux_max_ord=flux;
                  }

              }
          }


      }
    xsh_free_table(&ext);
    cpl_table_select_all(tab);

    if(next>1) {
      flux_min=(flux_min_ord<flux_min)? flux_min_ord:flux_min;
      flux_max=(flux_max_ord>flux_max)? flux_max_ord:flux_max;
    }

    sprintf(qc_flux_min,"%s%d%s",qc_key_prefix,i," MIN");
    sprintf(qc_flux_max,"%s%d%s",qc_key_prefix,i," MAX");

    //xsh_msg("order=%d next=%d flux_min=%g flux_max=%g",i,next,flux_min_ord,flux_max_ord);
    cpl_propertylist_append_double(plist,qc_flux_min,flux_min_ord);
    cpl_propertylist_set_comment(plist,qc_flux_min,XSH_QC_FLUX_MIN_C);
    cpl_propertylist_append_double(plist,qc_flux_max,flux_max_ord);
    cpl_propertylist_set_comment(plist,qc_flux_max,XSH_QC_FLUX_MAX_C);
  }
  
  sprintf(qc_flux_min,"%s%s",qc_key_prefix," MIN");
  sprintf(qc_flux_max,"%s%s",qc_key_prefix," MAX");
  cpl_propertylist_append_double(plist,qc_flux_min,flux_min);
  cpl_propertylist_set_comment(plist,qc_flux_min,XSH_QC_FLUX_MIN_C);
  cpl_propertylist_append_double(plist,qc_flux_max,flux_max);
  cpl_propertylist_set_comment(plist,qc_flux_max,XSH_QC_FLUX_MAX_C);
  check(xsh_update_pheader_in_image_multi(frm_ima,plist));

 cleanup:
  xsh_free_table(&ext);
  xsh_free_image(&ima);
  xsh_free_image(&qua);
  xsh_free_table(&tab);
  xsh_free_propertylist(&plist);


  return cpl_error_get_code();

}

/*---------------------------------------------------------------------------*/
/**
  @brief
    Update FITS header
  @param frame
    The frame whose frame need to be updated
  @param pheader
    The primary header to copy to the frame

  @return
    The error code
*/
/*---------------------------------------------------------------------------*/

cpl_error_code
xsh_update_pheader_in_image_multi(cpl_frame *frame, 
                                  const cpl_propertylist* pheader)
{
   const char *fname = NULL;
  int nbext=0;
  int i=0;
  cpl_image *image = NULL ;
  char cmd[256];
  int extension=0 ;
  cpl_image* ext_img=NULL;
  cpl_propertylist* ext_header=NULL;

  XSH_ASSURE_NOT_NULL(frame);
  nbext = cpl_frame_get_nextensions( frame);
  xsh_msg_dbg_medium("nbext=%d",nbext);
  check( fname = cpl_frame_get_filename( frame));
  check( image = cpl_image_load( fname, CPL_TYPE_FLOAT, 0, 0));

 
  //xsh_plist_dump(pheader);

  cpl_image_save(image, "tmp.fits", CPL_BPP_IEEE_FLOAT, pheader,
		      CPL_IO_DEFAULT ) ;
  xsh_free_image(&image);
  xsh_msg_dbg_medium("fname=%s",fname);
  for( i = 1 ; i<=nbext ; i++ ) {

    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 ;
     }
    else {
      extension = CPL_IO_EXTEND ;
      check(cpl_image_save( ext_img, "tmp.fits", CPL_BPP_IEEE_FLOAT,ext_header,
			    extension));
    }
    xsh_free_image( &ext_img) ;
    xsh_free_propertylist( &ext_header) ;
  }

  sprintf(cmd,"mv tmp.fits %s",fname);
  system(cmd);
  system("rm -f tmp.fits");


  cleanup:
  xsh_free_image( &ext_img) ;
  xsh_free_propertylist( &ext_header) ;
  xsh_free_image(&image);

  return cpl_error_get_code();
}

/**
   @brief    Computes median error on a data set
   @param    vect  input data
   @return   median error
*/
/*---------------------------------------------------------------------------*/
double xsh_vector_get_err_median( cpl_vector *vect)
{
  double err_median =0.0;
  int i, vect_size =0;
  double *data = NULL;

  XSH_ASSURE_NOT_NULL( vect);

  check( vect_size = cpl_vector_get_size( vect));
  check( data = cpl_vector_get_data( vect));

  if (vect_size > 1){
    for( i=0; i< vect_size; i++){
      err_median += data[i]*data[i];
    }

    err_median = sqrt( M_PI / 2.0 * 
      ((double) vect_size / ((double) vect_size- 1.))) *
        (1./(double)vect_size) * sqrt (err_median);
  }
  else{
    err_median = data[0];
  }

  cleanup:
    return err_median;
}
/*---------------------------------------------------------------------------*/
/**
   @brief    Computes mean error on a data set
   @param    vect  input data
   @return   mean error
*/

/*---------------------------------------------------------------------------*/
double xsh_vector_get_err_mean( cpl_vector *vect)
{
  double err_mean =0.0;
  int i, vect_size =0;
  double *data = NULL;

  XSH_ASSURE_NOT_NULL( vect);

  check( vect_size = cpl_vector_get_size( vect));
  check( data = cpl_vector_get_data( vect));

  for( i=0; i< vect_size; i++){
    err_mean += data[i]*data[i];
  }
  err_mean = sqrt( err_mean)/(double)vect_size;

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


/*--------------------------------------------------------------------------*/
/**
   @brief    Computes round(x)
   @param    x  input
   @return   round(x)
*/
/*--------------------------------------------------------------------------*/
long xsh_round_double(double x)
{
    return (x >=0) ? (long)(x+0.5) : (long)(x-0.5);
}

/*---------------------------------------------------------------------------*/
/**
   @brief   Minimum of two numbers
   @param   x        First number
   @param   y        Second number  
   @return  Minimum of @em x and @em y
  
   See also @c xsh_round_double() .
*/
/*---------------------------------------------------------------------------*/
inline int
xsh_min_int(int x, int y)
{
    return (x <=y) ? x : y;
}

/*---------------------------------------------------------------------------*/
/**
   @brief   Maximum of two numbers
   @param   x        First number
   @param   y        Second number  
   @return  Maximum of @em x and @em y
  
   See also @c xsh_round_double() .
*/
/*---------------------------------------------------------------------------*/
inline int
xsh_max_int(int x, int y)
{
    return (x >= y) ? x : y;
}


/*---------------------------------------------------------------------------*/
/**
   @brief   Minimum of two numbers
   @param   x        First number
   @param   y        Second number  
   @return  Minimum of @em x and @em y
  
   See also @c xsh_round_double() .
*/
/*---------------------------------------------------------------------------*/
inline double
xsh_min_double(double x, double y)
{
    return (x <=y) ? x : y;
}


/*---------------------------------------------------------------------------*/
/**
   @brief   Maximum of two numbers
   @param   x        First number
   @param   y        Second number  
   @return  Maximum of @em x and @em y
  
   See also @c xsh_round_double() .
*/
/*---------------------------------------------------------------------------*/
inline double
xsh_max_double(double x, double y)
{
    return (x >=y) ? x : y;
}


/*--------------------------------------------------------------------------*/
/**
   @brief    Computes x^y
   @param    x  base
   @param    y  order 
   @return   x^y
*/
/*--------------------------------------------------------------------------*/
double xsh_pow_int(double x, int y)
{
    double result = 1.0;

    /* Invariant is:   result * x ^ y   */
    while(y != 0)
    {
        if (y % 2 == 0)
        {
            x *= x;
            y /= 2;
        }
        else
        {
            if (y > 0)
            {
                result *= x;
                y -= 1;
            }
            else
            {
                result /= x;
                y += 1;
            }
        }
    }
    return result;
}

/**
 * @brief
 *   Convert all uppercase characters in a string into lowercase
 *   characters.
 *
 * @param s  The string to convert.
 *
 * @return Returns a pointer to the converted string.
 *
 * Walks through the given string and turns uppercase characters into
 * lowercase characters using @b tolower().
 *
 * @see xsh_string_tolower()
 */

const char*
xsh_string_tolower(char* s)
{

    char *t = s;

    assert(s != NULL);

    while (*t) {
        *t = tolower(*t);
        t++;
    }

    return s;

}


/**
 * @brief
 *   Convert all lowercase characters in a string into uppercase
 *   characters.
 *
 * @param s  The string to convert.
 *
 * @return Returns a pointer to the converted string.
 *
 * Walks through the given string and turns lowercase characters into
 * uppercase characters using @b toupper().
 *
 * @see xsh_string_tolower()
 */


const char*
xsh_string_toupper(char* s)
{

    char *t = s;

    assert(s != NULL);

    while (*t) {
        *t = toupper(*t);
        t++;
    }

    return s;

}


/*----------------------------------------------------------------------------*/
/**
   @brief        Spline interpolation based on Hermite polynomials
   @param xp     x-value to interpolate
   @param x      x-values
   @param y      y-values
   @param n      array length
   @param istart    (input/output) initial row (set to 0 to search all row)
      
   @return The interpolated value.

   The x column must be sorted (ascending or descending) and all x column
   values must be different.

   Adopted from: Cristian Levin - ESO La Silla, 1-Apr-1991
*/
/*----------------------------------------------------------------------------*/
double 
xsh_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
{
    double yp1, yp2, yp = 0;
    double xpi, xpi1, l1, l2, lp1, lp2;
    int i;

    if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) )    return 0.0;
    if ( x[0] >  x[n-1] && (xp > x[0] || xp < x[n-1]) )    return 0.0;

    if ( x[0] <= x[n-1] )
    {
        for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
        ;
    }
    else
    {
        for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
        ;
    }

    *istart = i;
    i--;
    
    lp1 = 1.0 / (x[i-1] - x[i]);
    lp2 = -lp1;

    if ( i == 1 )
    {
        yp1 = (y[1] - y[0]) / (x[1] - x[0]);
    }
    else
    {
        yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
    }

    if ( i >= n - 1 )
    {
        yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
    }
    else
    {
        yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
    }

    xpi1 = xp - x[i];
    xpi  = xp - x[i-1];
    l1   = xpi1*lp1;
    l2   = xpi*lp2;

    yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 + 
         y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 + 
         yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;

    return yp;
}


/*----------------------------------------------------------------------------*/
/**
   @brief        Spline interpolation based on Hermite polynomials
   @param xp     x-value to interpolate
   @param t      Table containing the columns to interpolate
   @param column_x  Column of x-values
   @param column_y  Column of y-values
   @param istart    (input/output) initial row (set to 0 to search all row)
      
   @return The interpolated value.
*/
/*----------------------------------------------------------------------------*/

double 
xsh_spline_hermite_table( double xp, const cpl_table *t, const char *column_x, 
                const char *column_y, int *istart )
{
    double result = 0;
    int n;

    const double *x, *y;
    
    check_msg( x = cpl_table_get_data_double_const(t, column_x),
       "Error reading column '%s'", column_x);
    check_msg( y = cpl_table_get_data_double_const(t, column_y),
       "Error reading column '%s'", column_y);

    n = cpl_table_get_nrow(t);

    result = xsh_spline_hermite(xp, x, y, n, istart);

  cleanup:
    return result;
}



/**
@brief converts a fits image to a spectral vector
@name xsh_image_to_vector()
@param spectrum 1-D Fits image that should be converted to a spectral vector
@return spectral vector with length lx*ly 
@note input image is destroyed
*/

cpl_vector * 
xsh_image_to_vector( cpl_image * spectrum )
{
    cpl_vector * result =NULL;
    cpl_type type=CPL_TYPE_FLOAT;

    int i =0;
    int ilx=0;
    int ily=0;
  
    int* pi=NULL;
    float* pf=NULL;
    double* pd=NULL;
    double* pv=NULL;

    int size=0;

       
    XSH_ASSURE_NOT_NULL_MSG(spectrum,"NULL input spectrum (1D) image!Exit.");
    ilx=cpl_image_get_size_x(spectrum);
    ily=cpl_image_get_size_y(spectrum);
    size=ilx*ily;

    result=cpl_vector_new(size);
    pv=cpl_vector_get_data(result);

    switch(type) {

       case CPL_TYPE_INT:
          pi=cpl_image_get_data_int(spectrum);
          for ( i = 0 ; i < size ; i++ ) pv[i] = (double) pi[i] ;
          break;
  
       case CPL_TYPE_FLOAT:
          pf=cpl_image_get_data_float(spectrum);
          for ( i = 0 ; i < size ; i++ ) pv[i] = (double) pf[i] ;
          break;

       case CPL_TYPE_DOUBLE:
          pd=cpl_image_get_data_double(spectrum);
          for ( i = 0 ; i < size ; i++ ) pv[i] = (double) pd[i] ;
          break;

       default:
          xsh_msg_error("Wrong input image data type %d",type);
    }
 
  cleanup:

    return result ;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Convert a vector to a 1d image
  @param    vector to convert       
  @param    type   of image       

  @return   a new allocated 1d image whose elements are the same as the vector
  @em The image need to be allocated .

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

cpl_image*
xsh_vector_to_image(const cpl_vector* vector,cpl_type type)
{
   int i=0;
   cpl_image* image=NULL;
   int size=0;
   const double* pv=NULL;
   int* pi=NULL;
   float* pf=NULL;
   double* pd=NULL;


   size=cpl_vector_get_size(vector);
   image=cpl_image_new(size,1,type);
   pv=cpl_vector_get_data_const(vector);
   if(type == CPL_TYPE_INT) {
      pi=cpl_image_get_data_int(image);
      for(i=0;i<size;i++) {
         pi[i]=pv[i];
      }
   } else if (type == CPL_TYPE_FLOAT) {
      pf=cpl_image_get_data_float(image);
      for(i=0;i<size;i++) {
         pf[i]=pv[i];
      }
   } else if (type == CPL_TYPE_DOUBLE) {
      pd=cpl_image_get_data_double(image);
      for(i=0;i<size;i++) {
         pd[i]=pv[i];
      }
   } else {
      assure( false, CPL_ERROR_INVALID_TYPE,
              "No CPL type to represent BITPIX = %d", type);
   }

  cleanup:
   if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_image(&image);
   }

   return image;

}

/*--------------------------------------------------------------------------*/
/**
   @brief    Multiply input frame by response frame
   @param    merged_sci  The input object frame
   @param    response    The input response 
   @param    tag_o       The output frame pro catg
   @return   The corrected frame
*/
/*--------------------------------------------------------------------------*/
cpl_frame*
xsh_util_multiply_by_response(cpl_frame* merged_sci, cpl_frame* response,
                              const char* tag_o)
{
   cpl_frame* result=NULL;
   cpl_image* data_sci=NULL;
   cpl_image* errs_sci=NULL;
   cpl_image* qual_sci=NULL;

   cpl_image* data_tmp=NULL;
   cpl_image* errs_tmp=NULL;

   cpl_vector* data_vec=NULL;
   cpl_vector* errs_vec=NULL;
   cpl_vector* qual_vec=NULL;

   cpl_propertylist* hdat=NULL;
   cpl_propertylist* herr=NULL;
   cpl_propertylist* hqua=NULL;
   cpl_propertylist* plist=NULL;

   cpl_table* response_table=NULL;

   const char* name_s=NULL;
   //const char* tag_s=NULL;
   const char* name_r=NULL;

   char* name_o=NULL;
   double lambda_start=0;
   double lambda_step=0;
   int bin=0;
   int naxis=0;
   int nbins   = 0;
   int ntraces = 0;

   double *fluxcal_science_data  = NULL;
   double *fluxcal_science_noise = NULL;

   XSH_ASSURE_NOT_NULL_MSG(merged_sci,"NULL input merged frame!Exit.");
   XSH_ASSURE_NOT_NULL_MSG(response,"NULL input response frame!Exit.");

   check(name_s=cpl_frame_get_filename(merged_sci));
   //check(tag_s=cpl_frame_get_tag(merged_sci));
   name_o=cpl_sprintf("%s.fits",tag_o);

   check(hdat=cpl_propertylist_load(name_s,0));
   check(herr=cpl_propertylist_load(name_s,1));
   check(hqua=cpl_propertylist_load(name_s,2));

   naxis=xsh_pfits_get_naxis(hdat);

   if(naxis == 1) {

      check(data_vec=cpl_vector_load(name_s,0));
      check(errs_vec=cpl_vector_load(name_s,1));

      check(data_sci=xsh_vector_to_image(data_vec,XSH_PRE_DATA_TYPE));
      check(errs_sci=xsh_vector_to_image(errs_vec,XSH_PRE_ERRS_TYPE));

      xsh_free_vector(&data_vec);
      xsh_free_vector(&errs_vec);

   } else {

      check(data_sci=cpl_image_load(name_s,XSH_PRE_DATA_TYPE,0,0));
      check(errs_sci=cpl_image_load(name_s,XSH_PRE_ERRS_TYPE,0,1));
      check(qual_sci=cpl_image_load(name_s,XSH_PRE_QUAL_TYPE,0,2));

   }

   data_tmp=cpl_image_cast(data_sci,CPL_TYPE_DOUBLE);
   errs_tmp=cpl_image_cast(errs_sci,CPL_TYPE_DOUBLE);
   xsh_free_image(&data_sci);
   xsh_free_image(&errs_sci);

   check(name_r=cpl_frame_get_filename(response));
   check(response_table=cpl_table_load(name_r,1,0));

/* in case the input response was obtained on a binned frame we need 
   to correct it to un-binned data. We get biny that corresponds to 
   the bin along wave dispersion direction 
   plist=cpl_propertylist_load(name_r,0);
   binx=xsh_pfits_get_biny(plist);
   cpl_table_multiply_scalar(response_table,"FLUX",binx);
   xsh_free_propertylist(&plist);
*/

   /* 
    * Flux calibrate reduced spectrum 
    *  flux := flux * response
    */
   xsh_msg("Multiply by response function");

   check(nbins   = cpl_image_get_size_x(data_tmp));
   check(ntraces = cpl_image_get_size_y(data_tmp));

   check(fluxcal_science_data  = cpl_image_get_data_double(data_tmp));
   check(fluxcal_science_noise = cpl_image_get_data_double(errs_tmp));
                 
   check_msg( lambda_start = xsh_pfits_get_crval1(hdat),
          "Error reading start wavelength from reduced science header");
   check_msg( lambda_step = xsh_pfits_get_cdelt1(hdat),
          "Error reading bin width from header");

  check(cpl_table_cast_column(response_table,"LAMBDA","DLAMBDA",CPL_TYPE_DOUBLE));
  check(cpl_table_cast_column(response_table,"FLUX","DFLUX",CPL_TYPE_DOUBLE));

   for (bin = 1; bin <= nbins; bin++)
   {
      double lambda;
      double response;
      int trace;       /* Spatial traces (for 2d extracted spectra) */
      int istart = 0;

      lambda = lambda_start + (bin-1) * lambda_step;
      check_msg( response = 
             xsh_spline_hermite_table(lambda, response_table, 
                                       "DLAMBDA", "DFLUX", &istart),
             "Error interpolating response curve at lambda = %f wlu", lambda);

      xsh_msg_dbg_medium("response=%g",response);

      for (trace = 1; trace <= ntraces; trace++)
      {
         /* Don't check for bad pixels here, also correct those.
          * The fluxcal image has the same bad pixels as the reduced_science
          * image */

         fluxcal_science_data [(bin-1) + (trace-1)*nbins] *= response;
         /* the following gives problems on some XSH data */
         fluxcal_science_noise[(bin-1) + (trace-1)*nbins] *= response;
         /* Do not propagate the error of the response 
            curve which is negligibly small (and unknown at this point!).
         */
      }
   }

   data_sci=cpl_image_cast(data_tmp,XSH_PRE_DATA_TYPE);
   errs_sci=cpl_image_cast(errs_tmp,XSH_PRE_ERRS_TYPE);
   xsh_free_image(&data_tmp);
   xsh_free_image(&errs_tmp);

   cpl_table_erase_column(response_table,"DLAMBDA");
   cpl_table_erase_column(response_table,"DFLUX");
   check( xsh_pfits_set_pcatg( hdat, tag_o));
   xsh_pfits_set_extname( hdat, "FLUX");

   xsh_pfits_set_bunit(hdat,XSH_BUNIT_FLUX_ABS_C);
   check(xsh_plist_set_extra_keys(hdat,"IMAGE","DATA","RMSE",
                                   "FLUX","ERRS","QUAL",0));

   xsh_pfits_set_bunit(herr,XSH_BUNIT_FLUX_ABS_C);
   xsh_pfits_set_extname( herr, "ERRS");
   check(xsh_plist_set_extra_keys(herr,"IMAGE","DATA","RMSE",
                                   "FLUX","ERRS","QUAL",1));


   xsh_pfits_set_extname( hqua, "QUAL");
   check(xsh_plist_set_extra_keys(hqua,"IMAGE","DATA","RMSE",
                                   "FLUX","ERRS","QUAL",2));



   if(naxis==1) {
      check(data_vec=xsh_image_to_vector(data_sci));
      check(errs_vec=xsh_image_to_vector(errs_sci));

      xsh_pfits_set_bunit(hdat,XSH_BUNIT_FLUX_ABS_C);
      check(cpl_vector_save(data_vec,name_o,XSH_SPECTRUM_DATA_BPP,hdat,CPL_IO_DEFAULT));
      xsh_pfits_set_bunit(herr,XSH_BUNIT_FLUX_ABS_C);
      check(cpl_vector_save(errs_vec,name_o,XSH_SPECTRUM_ERRS_BPP,herr,CPL_IO_EXTEND));
      check(qual_vec=cpl_vector_load(name_s,2));
      check(cpl_vector_save(errs_vec,name_o,XSH_SPECTRUM_ERRS_BPP,hqua,CPL_IO_EXTEND));


   } else {
      xsh_pfits_set_bunit(hdat,XSH_BUNIT_FLUX_ABS_C);
      check(cpl_image_save(data_sci,name_o,XSH_PRE_DATA_BPP,hdat,CPL_IO_DEFAULT));
      xsh_pfits_set_bunit(herr,XSH_BUNIT_FLUX_ABS_C);
      check(cpl_image_save(errs_sci,name_o,XSH_PRE_ERRS_BPP,herr,CPL_IO_EXTEND));
      check(cpl_image_save(qual_sci,name_o,XSH_PRE_QUAL_BPP,hqua,CPL_IO_EXTEND));
   }
   /* the qual ext is treated separately: we duplicate it to product */

   result=xsh_frame_product(name_o,tag_o,CPL_FRAME_TYPE_IMAGE,CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

  cleanup:
 
   cpl_free(name_o);

   xsh_free_image(&data_sci);
   xsh_free_image(&errs_sci);
   xsh_free_image(&qual_sci);
   xsh_free_image(&data_sci);
   xsh_free_image(&errs_sci);

   xsh_free_vector(&data_vec);
   xsh_free_vector(&errs_vec);
   xsh_free_vector(&qual_vec);

   xsh_free_table(&response_table);
   xsh_free_propertylist(&hdat);
   xsh_free_propertylist(&herr);
   xsh_free_propertylist(&hqua);
   xsh_free_propertylist(&plist);
 
  return result;
}

/*--------------------------------------------------------------------------*/
/**
   @brief    Multiply input frame by response frame
   @param    extracted_sci  The input object frame
   @param    response    The input response 
   @param    tag_o       the output frame pro.catg
   @return   The corrected frame
*/
/*--------------------------------------------------------------------------*/
cpl_frame*
xsh_util_multiply_by_response_ord(cpl_frame* extracted_sci, cpl_frame* response,
                              const char* tag_o)
{
   cpl_frame* result=NULL;
   cpl_image* data_sci=NULL;
   cpl_image* errs_sci=NULL;
   cpl_image* qual_sci=NULL;

   cpl_image* data_tmp=NULL;
   cpl_image* errs_tmp=NULL;

   cpl_vector* data_vec=NULL;
   cpl_vector* errs_vec=NULL;
   cpl_vector* qual_vec=NULL;

   cpl_propertylist* hdat=NULL;
   cpl_propertylist* herr=NULL;
   cpl_propertylist* hqua=NULL;
   cpl_propertylist* plist=NULL;

   cpl_table* response_table=NULL;

   const char* name_s=NULL;
   //const char* tag_s=NULL;
   const char* name_r=NULL;
   char* name_o=NULL;
   double lambda_start=0;
   double lambda_step=0;
   int bin=0;
   int naxis=0;
           
   int nbins   = 0;
   int ntraces = 0;
   
   int next_sci = 0;
   int next_res = 0;
   int ext = 0;
   int order=0;

   double *fluxcal_science_data  = NULL;
   double *fluxcal_science_noise = NULL;
 
   XSH_ASSURE_NOT_NULL_MSG(extracted_sci,"NULL input extracted frame!Exit.");
   XSH_ASSURE_NOT_NULL_MSG(response,"NULL input response frame!Exit.");

   check(name_s=cpl_frame_get_filename(extracted_sci));
   //check(tag_s=cpl_frame_get_tag(extracted_sci));

   name_o=cpl_sprintf("%s.fits",tag_o);
   next_sci=cpl_frame_get_nextensions(extracted_sci);
   next_res=cpl_frame_get_nextensions(response);
   xsh_msg("Multiply by response function");
   check(name_r=cpl_frame_get_filename(response));

/* in case the input response was obtained on a binned frame we need 
   to correct it to un-binned data. We get biny that corresponds to 
   the bin along wave dispersion direction 
   plist=cpl_propertylist_load(name_r,0);
   cpl_propertylist_dump(plist,stdout);
   binx=xsh_pfits_get_biny(plist);
   xsh_free_propertylist(&plist);
*/
   for(ext=0, order=0;ext<next_sci;ext+=3,order++) {
     xsh_free_propertylist(&hdat);
     xsh_free_propertylist(&herr);
     xsh_free_propertylist(&hqua);

     check(hdat=cpl_propertylist_load(name_s,ext+0));
     check(herr=cpl_propertylist_load(name_s,ext+1));
     check(hqua=cpl_propertylist_load(name_s,ext+2));

     naxis=xsh_pfits_get_naxis(hdat);

     if(naxis == 1) {

       check(data_vec=cpl_vector_load(name_s,ext+0));
       check(errs_vec=cpl_vector_load(name_s,ext+1));

       xsh_free_image(&data_sci);
       xsh_free_image(&errs_sci);
       check(data_sci=xsh_vector_to_image(data_vec,XSH_PRE_DATA_TYPE));
       check(errs_sci=xsh_vector_to_image(errs_vec,XSH_PRE_ERRS_TYPE));

       xsh_free_vector(&data_vec);
       xsh_free_vector(&errs_vec);

     } else {

       xsh_free_image(&data_sci);
       xsh_free_image(&errs_sci);
       xsh_free_image(&qual_sci);
       check(data_sci=cpl_image_load(name_s,XSH_PRE_DATA_TYPE,0,ext+0));
       check(errs_sci=cpl_image_load(name_s,XSH_PRE_ERRS_TYPE,0,ext+1));
       check(qual_sci=cpl_image_load(name_s,XSH_PRE_QUAL_TYPE,0,ext+2));

     }

     xsh_free_image(&data_tmp);
     xsh_free_image(&errs_tmp);
     data_tmp=cpl_image_cast(data_sci,CPL_TYPE_DOUBLE);
     errs_tmp=cpl_image_cast(errs_sci,CPL_TYPE_DOUBLE);
     xsh_free_image(&data_sci);
     xsh_free_image(&errs_sci);
     xsh_free_table(&response_table);
     if(next_res>1) {
     check(response_table=cpl_table_load(name_r,order+1,0));
     //cpl_table_multiply_scalar(response_table,"FLUX",binx);
     } else {
     check(response_table=cpl_table_load(name_r,next_res,0));
     //cpl_table_multiply_scalar(response_table,"FLUX",binx);
     }
     /* 
      * Flux calibrate reduced spectrum 
      *  flux := flux * response
      */ 
     check(nbins   = cpl_image_get_size_x(data_tmp));
     check(ntraces = cpl_image_get_size_y(data_tmp));

     check(fluxcal_science_data  = cpl_image_get_data_double(data_tmp));
     check(fluxcal_science_noise = cpl_image_get_data_double(errs_tmp));
                 
     check_msg( lambda_start = xsh_pfits_get_crval1(hdat),
		"Error reading start wavelength from reduced science header");
     check_msg( lambda_step = xsh_pfits_get_cdelt1(hdat),
		"Error reading bin width from header");
     
     check(cpl_table_cast_column(response_table,"LAMBDA","DLAMBDA",CPL_TYPE_DOUBLE));
     check(cpl_table_cast_column(response_table,"RESPONSE","DFLUX",CPL_TYPE_DOUBLE));

     for (bin = 1; bin <= nbins; bin++)
       {
	 double lambda;
	 double response;
	 int trace;       /* Spatial traces (for 2d extracted spectra) */
	 int istart = 0;

	 lambda = lambda_start + (bin-1) * lambda_step;
	 check_msg( response = 
		    xsh_spline_hermite_table(lambda, response_table, 
					     "DLAMBDA", "DFLUX", &istart),
		    "Error interpolating response curve at lambda = %f wlu", lambda);

	 xsh_msg_dbg_medium("ext=%d response=%g",ext,response);

	 for (trace = 1; trace <= ntraces; trace++)
	   {
	     /* Don't check for bad pixels here, also correct those.
	      * The fluxcal image has the same bad pixels as the reduced_science
	      * image */

	     fluxcal_science_data [(bin-1) + (trace-1)*nbins] *= response;
	     /* the following gives problems on some XSH data */
	     fluxcal_science_noise[(bin-1) + (trace-1)*nbins] *= response;
             /* Do not propagate the error of the response 
		curve which is negligibly small (and unknown at this point!).
	     */
	   }
       }

     data_sci=cpl_image_cast(data_tmp,XSH_PRE_DATA_TYPE);
     errs_sci=cpl_image_cast(errs_tmp,XSH_PRE_ERRS_TYPE);
     xsh_free_image(&data_tmp);
     xsh_free_image(&errs_tmp);

     cpl_table_erase_column(response_table,"DLAMBDA");
     cpl_table_erase_column(response_table,"DFLUX");
     check( xsh_pfits_set_pcatg( hdat, tag_o));

     xsh_pfits_set_extname( hdat, "FLUX");
     xsh_pfits_set_bunit(hdat,XSH_BUNIT_FLUX_ABS_C);
     check(xsh_plist_set_extra_keys(hdat,"IMAGE","DATA","RMSE",
                                   "FLUX","ERRS","QUAL",0));

     xsh_pfits_set_bunit(herr,XSH_BUNIT_FLUX_ABS_C);
     xsh_pfits_set_extname( herr, "ERRS");
     check(xsh_plist_set_extra_keys(herr,"IMAGE","DATA","RMSE",
                                    "FLUX","ERRS","QUAL",1));


     xsh_pfits_set_extname( hqua, "QUAL");
     check(xsh_plist_set_extra_keys(hqua,"IMAGE","DATA","RMSE",
                                   "FLUX","ERRS","QUAL",2));




     if(naxis==1) {
       check(data_vec=xsh_image_to_vector(data_sci));
       check(errs_vec=xsh_image_to_vector(errs_sci));
       if(ext==0) {
	 check(cpl_vector_save(data_vec,name_o,XSH_SPECTRUM_DATA_BPP,hdat,CPL_IO_DEFAULT));
       } else {
	 check(cpl_vector_save(data_vec,name_o,XSH_SPECTRUM_DATA_BPP,hdat,CPL_IO_EXTEND));
       }
       check(cpl_vector_save(errs_vec,name_o,XSH_SPECTRUM_ERRS_BPP,herr,CPL_IO_EXTEND));
       check(qual_vec=cpl_vector_load(name_s,ext+2));
       check(cpl_vector_save(qual_vec,name_o,XSH_SPECTRUM_ERRS_BPP,hqua,CPL_IO_EXTEND));
       xsh_free_vector(&data_vec);
       xsh_free_vector(&errs_vec);
       xsh_free_vector(&qual_vec);
     } else {
       if(ext==0) {
	 check(cpl_image_save(data_sci,name_o,XSH_PRE_DATA_BPP,hdat,CPL_IO_DEFAULT));
       } else {
	 check(cpl_image_save(data_sci,name_o,XSH_PRE_DATA_BPP,hdat,CPL_IO_EXTEND));
       }
       check(cpl_image_save(errs_sci,name_o,XSH_PRE_ERRS_BPP,herr,CPL_IO_EXTEND));
       check(cpl_image_save(qual_sci,name_o,XSH_PRE_QUAL_BPP,hqua,CPL_IO_EXTEND));
     }

   } /* end loop on extensions */

   /* the qual ext is treated separately: we duplicate it to product */
   result=xsh_frame_product(name_o,tag_o,CPL_FRAME_TYPE_IMAGE,CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);
   
  cleanup:
 
   cpl_free(name_o);

   xsh_free_image(&data_sci);
   xsh_free_image(&errs_sci);
   xsh_free_image(&qual_sci);
   xsh_free_image(&data_sci);
   xsh_free_image(&errs_sci);

   xsh_free_vector(&data_vec);
   xsh_free_vector(&errs_vec);
   xsh_free_vector(&qual_vec);

   xsh_free_table(&response_table);
   xsh_free_propertylist(&hdat);
   xsh_free_propertylist(&herr);
   xsh_free_propertylist(&hqua);
   xsh_free_propertylist(&plist);
 
  return result;
}

static cpl_error_code
xsh_util_get_infsup(double* piw,
                    double w,
                    int i_start,
                    int i_end,
                    int* i_inf,
                    int* i_sup)
{

   int i=0;
   for(i = i_start;i < i_end;i++) {
      if (piw[i] < w) {
         *i_inf=i;
         *i_sup=i+1;
      }
   }

   return cpl_error_get_code();
}


static double
xsh_spectrum_integrate(double* pif,
                       double* piw,
                       int i1_inf,
                       int i1_sup,
                       int i2_inf,
                       int i2_sup,
                       double wave,
                       double wstep)
{
  
   double sum1=0;
   double sum2=0;
   double sum3=0;
   int i=0;

   /* The following is to suppress compiler warnings: [-Wunused-parameter] */
   (void) i1_inf;
   (void) i2_sup;
   (void) wave;
   (void) wstep;

   /* main contribute */
   for(i=i1_sup;i<i2_inf;i++) {
      /*
      simple integration
      */ 
      sum2+=pif[i]*(piw[i+1]-piw[i]);
      /*
      mean 2 point
      sum2+=pif[i]*(piw[i+1]-piw[i-1])*0.5; 
      Simplex 5 points
      sum2+=(1/3*pif[i-1]+4/3*pif[i]+1/3*pif[i+1])*(piw[i+1]-piw[i-1])*0.5;
      */
      /* Bode's 5 points formula  
      sum2+=(14/45*pif[i-2]+64/45*pif[i-1]+24/45*pif[i]+64/45*pif[i+1]+14/45*pif[i+2])*(piw[i+1]-piw[i-1])*0.5;
      */
     

   }
   /* extra bit from signal on fractional inf/sup pixel 
   sum1=(wave-piw[i1_inf])*pif[i1_inf];
   sum3=(piw[i2_sup]-wave)*pif[i2_sup];
   */
   return (sum1+sum2+sum3);
}

/*---------------------------------------------------------------------------*/
/** 
 * @brief resample a spectrum
 * 
 * @param[in] frame_inp  input spectrum 
 * @param[in] wstep output spectrum wavelength step
 * @param[in] wmin min wave on the given arm 
 * @param[in] wmax max wave on the given arm 
 * @param[in] instr instrument setting 
 * 
 * @return 1D resampled spectrum frame
 */
/*---------------------------------------------------------------------------*/
cpl_frame* 
xsh_spectrum_resample(cpl_frame* frame_inp, 
                      const double wstep, 
                      const double wmin,
                      const double wmax, 
		      xsh_instrument* instr)
{

   cpl_frame* result=NULL;
   cpl_table* tab_inp=NULL;
   cpl_table* tab_out=NULL;
   int nrow_inp=0;
   int nrow_out=0;
   int i=0;
  
   double wave_min=0;
   double wave_max=0;
   double wave_start=0;

   const char* fname=NULL;
   double* pow=NULL;
   double* pof=NULL;
   double* piw=NULL;
   double* pif=NULL;
 
   double wo1=0;
   double wo2=0;

   int istep=0;

   int i1_inf=0;
   int i1_sup=0;
   int i2_inf=0;
   int i2_sup=0;

   int i_start=0;
   int i_end=0;
   double hstep=0;
   const char* tag=NULL;
   char* name=NULL;
   cpl_propertylist* plist=NULL;
 
   
   check(fname=cpl_frame_get_filename(frame_inp));
   tag=cpl_frame_get_tag(frame_inp);
   plist=cpl_propertylist_load(fname,0);

 

   tab_inp=cpl_table_load(fname,1,0);
   nrow_inp=cpl_table_get_nrow(tab_inp);
   wave_min=cpl_table_get_column_min(tab_inp,"LAMBDA");
   wave_max=cpl_table_get_column_max(tab_inp,"LAMBDA");
  
   wave_min=(wave_min>wmin) ? wave_min : wmin;
   wave_max=(wave_max<wmax) ? wave_max : wmax;

   /* for comodity we start from a rounded value in nm */
   wave_start=floor(wave_min);
   /* make sure that starting wave in UVB is not too small that atm ext 
      is not defined */
   if( xsh_instrument_get_arm(instr) == XSH_ARM_UVB){
      wave_start=(wave_start>XSH_ATM_EXT_UVB_WAV_MIN)? wave_start : XSH_ATM_EXT_UVB_WAV_MIN;
   }
   xsh_msg("Resample ref flux std spectrum to %g [nm] step",wstep);
/* 
  xsh_msg("wave_min %g wave_max %g wave_start %g wstep %g",
           wave_min,wave_max,wave_start,wstep);
*/
   /* prepare table to hold results */
   nrow_out=ceil((wave_max-wave_start)/wstep);
   tab_out=cpl_table_new(nrow_out);

   cpl_table_new_column(tab_out,"LAMBDA",CPL_TYPE_DOUBLE);
   cpl_table_new_column(tab_out,"FLUX",CPL_TYPE_DOUBLE);
   cpl_table_new_column(tab_out,"BIN_WIDTH",CPL_TYPE_DOUBLE);

   cpl_table_fill_column_window_double(tab_out,"LAMBDA",0,nrow_out,0.);
   cpl_table_fill_column_window_double(tab_out,"FLUX",0,nrow_out,0.);
   cpl_table_fill_column_window_double(tab_out,"BIN_WIDTH",0,nrow_out,wstep);

   /* get pointers to data to speed-up computation */
   pow=cpl_table_get_data_double(tab_out,"LAMBDA");
   pof=cpl_table_get_data_double(tab_out,"FLUX");

   piw=cpl_table_get_data_double(tab_inp,"LAMBDA");
   pif=cpl_table_get_data_double(tab_inp,"FLUX");

   hstep=0.5*wstep;

   i_start=0;
   i_end=nrow_inp;

   /* extra i step to ensure a range large enough to find a sup */
   istep=(int) (wstep/(wave_max-wave_min)*nrow_inp+0.5);
   istep*=4;
/*
   xsh_msg("nrow_inp %d nrow_out %d istep %d hstep %g",
           nrow_inp,nrow_out,istep,hstep);
*/
   for(i=0;i<nrow_out;i++) {
      pow[i]=wave_start+i*wstep;
      wo1=pow[i]-hstep;
      wo2=pow[i]+hstep;
   i_start=0;
   i_end=nrow_inp;
      
      /*
      if(wo1>480 && wo1 < 490) {
      xsh_msg("wo1 %g wo2 %g",wo1, wo2);
      xsh_msg("wt0 piw_start %g piw_end %g",piw[i_start],piw[i_end]);
      }
      */
      /* get indexes corresponding to sup/inf waves */
      xsh_util_get_infsup(piw,wo1,i_start,i_end,&i1_inf,&i1_sup);

      /*
      if(wo1>480 && wo1 < 490) {
      xsh_msg("it1 i_start %d i_end %d i1_inf %d i1_sup %d i2_inf %d i2_sup %d",
               i_start, i_end, i1_inf, i1_sup, i2_inf, i2_sup);
      xsh_msg("wt1 piw_inf %g piw_sup %g",piw[i1_inf],piw[i1_sup]);
      }
      //reset i_start and i_end to restrict the search to a narrow range
      i_start=(i1_sup<nrow_inp)? i1_sup : 0;
      i_end=(i1_sup+istep<nrow_inp) ? i1_sup+istep : nrow_inp;


      if(wo1>480 && wo1 < 490) {
      xsh_msg("wt2 piw_start %g piw_end %g",piw[i_start],piw[i_end]);

      xsh_msg("st2 i_start %d i_end %d i1_inf %d i1_sup %d i2_inf %d i2_sup %d",
               i_start, i_end, i1_inf, i1_sup, i2_inf, i2_sup);
      }
      */
      xsh_util_get_infsup(piw,wo2,i_start,i_end,&i2_inf,&i2_sup);

      /*
      if(wo1>480 && wo1 < 490) {
      xsh_msg("st3 i_start %d i_end %d i1_inf %d i1_sup %d i2_inf %d i2_sup %d",
               i_start, i_end, i1_inf, i1_sup, i2_inf, i2_sup);
      xsh_msg("wt3 piw_inf %g piw_sup %g",piw[i2_inf],piw[i2_sup]);
      }
   
      i_start=(i2_inf<nrow_inp) ? i2_inf : nrow_inp;
      i_end=(i2_sup+istep<nrow_inp) ? i2_sup+istep : nrow_inp;
      
      if(wo1>480 && wo1 < 490) {
      xsh_msg("st4 i_start %d i_end %d i1_inf %d i1_sup %d i2_inf %d i2_sup %d",
               i_start, i_end, i1_inf, i1_sup, i2_inf, i2_sup);
      xsh_msg("wt4 piw_inf %g piw_sup %g",piw[i2_inf],piw[i2_sup]);
      }
      
      if(wo1>480 && wo1 < 490) {
      xsh_msg("st4 i_start %d i_end %d i1_inf %d i1_sup %d i2_inf %d i2_sup %d",
               i_start, i_end, i1_inf, i1_sup, i2_inf, i2_sup);
      xsh_msg("i1 piw_inf %g piw_sup %g",piw[i1_inf],piw[i1_sup]);
      xsh_msg("i2 piw_inf %g piw_sup %g",piw[i2_inf],piw[i2_sup]);
      }
      */

      /* integrate spectrum on the found range */
      pof[i]=xsh_spectrum_integrate(pif,piw,i1_inf,i1_sup,
                                    i2_inf,i2_sup,pow[i],wstep);

      /*
      if(wo1>480 && wo1 < 490) {
         xsh_msg("flux[%g]=%g",pow[i],pof[i]);
      }
      */
   }

   cpl_table_and_selected_double(tab_out,"LAMBDA",CPL_LESS_THAN,wmin);
   cpl_table_erase_selected(tab_out);
   cpl_table_and_selected_double(tab_out,"LAMBDA",CPL_GREATER_THAN,wmax);
   cpl_table_erase_selected(tab_out);

   name=cpl_sprintf("RESAMPLED_%s_%s.fits",tag,
                    xsh_instrument_arm_tostring( instr));

   check(cpl_table_save(tab_out,plist,NULL,name,CPL_IO_DEFAULT));
   xsh_add_temporary_file(name);
   result=xsh_frame_product(name,tag,CPL_FRAME_TYPE_TABLE,
                            CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);


  cleanup:
   xsh_free_propertylist(&plist);
   xsh_free_table(&tab_inp);
   xsh_free_table(&tab_out);
   cpl_free(name);
  
   return result;
}

/*--------------------------------------------------------------------------*/
/**
   @brief    Compute mean frame from a list of (IMAGE) framesets
   @param    set        The input frameset
   @param    instrument The instrument structure 
   @return   The mean frameset
*/
/*--------------------------------------------------------------------------*/
cpl_frame*
xsh_util_frameset_collapse_mean(cpl_frameset* set,
                           xsh_instrument* instrument)
{
   cpl_frame* result=NULL;
   cpl_frame* frm=NULL;

   cpl_image* ima=NULL;
   cpl_image* err=NULL;

   cpl_image* ima_sum=NULL;
   cpl_image* err_sum=NULL;
   cpl_image* qua_sum=NULL;
   cpl_propertylist* hdat=NULL;
   cpl_propertylist* herr=NULL;
   cpl_propertylist* hqua=NULL;
   char* name=NULL;
   char* tag=NULL;
   const char* fname=NULL;
   int size=0;
   int i=0;

   /* we first sum */
   size=cpl_frameset_get_size(set);
   for(i=0;i<size;i++) {

      frm=cpl_frameset_get_frame(set,i);
      fname=cpl_frame_get_filename(frm);

      ima=cpl_image_load(fname,XSH_PRE_DATA_TYPE,0,0);
      err=cpl_image_load(fname,XSH_PRE_ERRS_TYPE,0,1);
      /* errors are summed in quadrature */
      cpl_image_multiply(err,err);
      if(i==0) {
         ima_sum=cpl_image_duplicate(ima);
         err_sum=cpl_image_duplicate(err);
      } else {
         cpl_image_add(ima_sum,ima);
         cpl_image_add(err_sum,err);
      }

      xsh_free_image(&ima);
      xsh_free_image(&err);

   }
 
   /* when we average */
   cpl_image_divide_scalar(ima_sum,size);
   cpl_image_divide_scalar(err_sum,size);

   /* as was the quadratic error we need to get the square root */
   check(cpl_image_power(err_sum,0.5));

   /* for the qual image we assume is ok the one of 1st frame */
   qua_sum=cpl_image_load(fname,XSH_PRE_QUAL_TYPE,0,2);

   frm=cpl_frameset_get_frame(set,0);
   fname=cpl_frame_get_filename(frm);
   hdat=cpl_propertylist_load(fname,0);
   herr=cpl_propertylist_load(fname,1);
   hqua=cpl_propertylist_load(fname,2);
 
   name=cpl_sprintf("SKY_AVG_%s.fits",xsh_instrument_arm_tostring( instrument));
   tag=cpl_sprintf("SKY_AVG_%s",xsh_instrument_arm_tostring( instrument));

   check(cpl_image_save(ima_sum,name,XSH_PRE_DATA_BPP,hdat,CPL_IO_DEFAULT));
   check(cpl_image_save(err_sum,name,XSH_PRE_ERRS_BPP,herr,CPL_IO_EXTEND));
   check(cpl_image_save(qua_sum,name,XSH_PRE_QUAL_BPP,hqua,CPL_IO_EXTEND));
   result=xsh_frame_product(name,tag,CPL_FRAME_TYPE_IMAGE,
                            CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);
   xsh_add_temporary_file(name);

 cleanup:
 
   xsh_free_image(&ima);
   xsh_free_image(&err);

   xsh_free_image(&ima_sum);
   xsh_free_image(&err_sum);
   xsh_free_image(&qua_sum);

   xsh_free_propertylist(&hdat);
   xsh_free_propertylist(&herr);
   xsh_free_propertylist(&hqua);

   cpl_free(name);
   cpl_free(tag);

   return result;
}



/*---------------------------------------------------------------------------*/
/**
   @brief    Normalize spectrum slice
   @param    name_s  spectrum filename
   @param    tag_o  output frame pro catg
   @param    ext     extension value
   @param    binx    X bin size
   @param    gain    detector's gain
   @param    exptime exposure time
   @param    airmass airmass
   @param    tbl_atm_ext atmospheric extinction table
   @return   CPL error code

   The spectrum is divided by exposure time, gain and (optionally) binning. 
   Also corrected for atmospheric extinction using the provided table of
   extinction coefficients.

   Bad pixels are propagated.xsh_utils.h
*/
cpl_error_code
xsh_normalize_spectrum_image_slice(const char* name_s, 
				   const char* tag_o,
				   const int ext,
				   const int bin_size,
				   const double gain,
				   const double exptime,
				   const double airmass,
				   const cpl_table* tbl_atm_ext) 
{


  cpl_image* data_ima=NULL;
  cpl_image* errs_ima=NULL;
  cpl_image* qual_ima=NULL;
  cpl_image* data_nrm=NULL;
  cpl_image* errs_nrm=NULL;

  cpl_image* data_tmp=NULL;
  cpl_image* errs_tmp=NULL;

  cpl_image* data_nrm_tmp=NULL;
  cpl_image* errs_nrm_tmp=NULL;

  cpl_vector* data_vec=NULL;
  cpl_vector* errs_vec=NULL;
  cpl_vector* qual_vec=NULL;

  cpl_propertylist* hdat=NULL;
  cpl_propertylist* herr=NULL;
  cpl_propertylist* hqua=NULL;
  int naxis=0;
  char name_o[256];

  sprintf(name_o,"%s.fits",tag_o);

  xsh_free_propertylist(&hdat);
  xsh_free_propertylist(&herr);
  xsh_free_propertylist(&hqua);

  hdat=cpl_propertylist_load(name_s,ext+0);
  herr=cpl_propertylist_load(name_s,ext+1);
  hqua=cpl_propertylist_load(name_s,ext+2);


  naxis=xsh_pfits_get_naxis(hdat);
  xsh_pfits_set_pcatg(hdat,tag_o);
  if(naxis == 1) {

    check(data_vec=cpl_vector_load(name_s,ext+0));
    check(errs_vec=cpl_vector_load(name_s,ext+1));
    xsh_free_image(&data_ima);
    xsh_free_image(&errs_ima);
    check(data_ima=xsh_vector_to_image(data_vec,XSH_PRE_DATA_TYPE));
    check(errs_ima=xsh_vector_to_image(errs_vec,XSH_PRE_ERRS_TYPE));
    xsh_free_vector(&data_vec);
    xsh_free_vector(&errs_vec);

  } else {

    xsh_free_image(&data_ima);
    xsh_free_image(&errs_ima);
    xsh_free_image(&qual_ima);
    check(data_ima=cpl_image_load(name_s,XSH_PRE_DATA_TYPE,0,ext+0));
    check(errs_ima=cpl_image_load(name_s,XSH_PRE_ERRS_TYPE,0,ext+1));
    check(qual_ima=cpl_image_load(name_s,XSH_PRE_QUAL_TYPE,0,ext+2));

  }
  xsh_free_image(&data_tmp);
  xsh_free_image(&errs_tmp);
  data_tmp=cpl_image_cast(data_ima,CPL_TYPE_DOUBLE);
  errs_tmp=cpl_image_cast(errs_ima,CPL_TYPE_DOUBLE);
 
  xsh_free_image(&data_nrm_tmp);
  xsh_free_image(&errs_nrm_tmp);
   
  check(data_nrm_tmp=xsh_normalize_spectrum_image(data_tmp,errs_tmp,hdat,
						  bin_size,gain,exptime,airmass,1,
						  tbl_atm_ext,&errs_nrm_tmp)); 
    
  xsh_free_image(&data_nrm);
  xsh_free_image(&errs_nrm);
  check(data_nrm=cpl_image_cast(data_nrm_tmp,CPL_TYPE_FLOAT));
  check(errs_nrm=cpl_image_cast(errs_nrm_tmp,CPL_TYPE_FLOAT));

  if(naxis==1) {
    xsh_free_vector(&data_vec);
    xsh_free_vector(&errs_vec);

    check(data_vec=xsh_image_to_vector(data_nrm));
    check(errs_vec=xsh_image_to_vector(errs_nrm));

    if(ext==0) {
      check(cpl_vector_save(data_vec,name_o,XSH_SPECTRUM_DATA_BPP,hdat,CPL_IO_DEFAULT));
    } else {
      check(cpl_vector_save(data_vec,name_o,XSH_SPECTRUM_DATA_BPP,hdat,CPL_IO_EXTEND));
    }
    check(cpl_vector_save(errs_vec,name_o,XSH_SPECTRUM_ERRS_BPP,herr,CPL_IO_EXTEND));
    xsh_free_vector(&qual_vec);
    check(qual_vec=cpl_vector_load(name_s,ext+2));
    check(cpl_vector_save(qual_vec,name_o,XSH_SPECTRUM_ERRS_BPP,hqua,CPL_IO_EXTEND));


  } else {
    if(ext==0) {
      check(cpl_image_save(data_nrm,name_o,XSH_PRE_DATA_BPP,hdat,CPL_IO_DEFAULT));
    } else {
      check(cpl_image_save(data_nrm,name_o,XSH_PRE_DATA_BPP,hdat,CPL_IO_EXTEND));
    }
    check(cpl_image_save(errs_nrm,name_o,XSH_PRE_ERRS_BPP,herr,CPL_IO_EXTEND));
    check(cpl_image_save(qual_ima,name_o,XSH_PRE_QUAL_BPP,hqua,CPL_IO_EXTEND));

  }
  /* the qual ext is treated separately: we duplicate it to product */


 cleanup:
  xsh_free_image(&data_ima);
  xsh_free_image(&errs_ima);
  xsh_free_image(&qual_ima);
  xsh_free_image(&data_nrm);
  xsh_free_image(&errs_nrm);
  xsh_free_image(&data_tmp);
  xsh_free_image(&errs_tmp);
  xsh_free_image(&data_nrm_tmp);
  xsh_free_image(&errs_nrm_tmp);

  xsh_free_propertylist(&hdat);
  xsh_free_propertylist(&herr);
  xsh_free_propertylist(&hqua);

  xsh_free_vector(&data_vec);
  xsh_free_vector(&errs_vec);
  xsh_free_vector(&qual_vec);

  return cpl_error_get_code();
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Normalize a spectrum
   @param    obj_frame           The 1d (merged) or 2d (non-merged or 2d extracted+merged) spectrum to be normalized
   @param    atm_ext_frame      The frame of atmospheric extinction spectrum
   @param    correct_binning    Flag to divide or not by the x-binning factor
   @param    instrument         Instrument setting (XSH ARM..)
   @param    tag_o              pro catg of output frame

   @return   The normalized spectrum

   The spectrum is divided by exposure time, gain and (optionally) binning. 
   Also corrected for atmospheric extinction using the provided table of
   extinction coefficients.

   Bad pixels are propagated.xsh_utils.h
*/
/* Needs to be updated for multi extension (ORDER-BY-ORDER) */
cpl_frame *
xsh_normalize_spectrum(const cpl_frame *obj_frame, 
                       const cpl_frame *atm_ext_frame,
                       cpl_boolean correct_binning,
                       xsh_instrument* instrument,
                       const char* tag_o)
{

  cpl_frame* result=NULL;
  const char* name_s=NULL;
  const char* aname=NULL;

  cpl_table* tbl_atm_ext=NULL;
  cpl_propertylist* hdat=NULL;

  char* name_o=NULL;
  int binx=1;
  double gain=0;
  double exptime=0;
  double airmass=0;

  XSH_ASSURE_NOT_NULL_MSG(obj_frame,"Null input object frame");
  XSH_ASSURE_NOT_NULL_MSG(atm_ext_frame,"Null input atm ext frame");

  name_s=cpl_frame_get_filename(obj_frame);
  aname=cpl_frame_get_filename(atm_ext_frame);
  tbl_atm_ext=cpl_table_load(aname,1,0);

  cpl_table_cast_column( tbl_atm_ext,"LAMBDA","D_LAMBDA",CPL_TYPE_DOUBLE);
  cpl_table_cast_column( tbl_atm_ext,XSH_ATMOS_EXT_LIST_COLNAME_K,"D_EXTINCTION",CPL_TYPE_DOUBLE);

  /* observed frame scaling factors */
  hdat=cpl_propertylist_load(name_s,0);
  exptime = xsh_pfits_get_exptime(hdat);
  if( xsh_instrument_get_arm(instrument) == XSH_ARM_NIR){
    /* we assume gain in units of ADU/e- as ESO standard */
    gain=1./2.12;
  } else {
    gain = xsh_pfits_get_gain(hdat);
  }

  if (correct_binning) {
    /* x-binning of rotated image is y-binning of raw image */
    //binx  = xsh_pfits_get_biny(hdat);
  } else {
    xsh_msg_dbg_medium("Spectrum will not be normalized to unit binning");
    binx = 1;
  }
  airmass=xsh_pfits_get_airm_mean(hdat);
  name_o=cpl_sprintf("%s.fits",tag_o);

  check(xsh_normalize_spectrum_image_slice(name_s,tag_o,0,binx,gain,
					   exptime,airmass,tbl_atm_ext)); 
 
  result=xsh_frame_product(name_o,tag_o,CPL_FRAME_TYPE_IMAGE,CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

 cleanup:

  xsh_free_table(&tbl_atm_ext);
  xsh_free_propertylist(&hdat);
  cpl_free(name_o);

  return result;

}




/*---------------------------------------------------------------------------*/
/**
   @brief    Normalize a spectrum
   @param    obj_frame           The 1d (merged) or 2d (non-merged or 2d extracted+merged) spectrum to be normalized
   @param    atm_ext_frame     The frame with atmospheric extinction spectrum
   @param    correct_binning    Flag indicating whether or not to divide by the x-binning factor
   @param    instrument         instrument arm
   @param    tag_o              output product tag
   @return   The normalized spectrum

   The spectrum is divided by exposure time, gain and (optionally) binning. 
   Also corrected for atmospheric extinction using the provided table of
   extinction coefficients.

   Bad pixels are propagated.xsh_utils.h
*/
/* Needs to be updated for multi extension (ORDER-BY-ORDER) */
cpl_frame *
xsh_normalize_spectrum_ord(const cpl_frame *obj_frame, 
			   const cpl_frame *atm_ext_frame,
			   cpl_boolean correct_binning,
			   xsh_instrument* instrument,
			   const char* tag_o)
{

  cpl_frame* result=NULL;
  const char* name_s=NULL;
  const char* aname=NULL;

  cpl_table* tbl_atm_ext=NULL;
  cpl_propertylist* hdat=NULL;
  char* name_o=NULL;

  int next=0;
  int ext=0;
  int binx=1;
  int biny=1;
  int bin_size=1;
  double gain=0;
  double exptime=0;
  double airmass=0;

  XSH_ASSURE_NOT_NULL_MSG(obj_frame,"Null input object frame");
  XSH_ASSURE_NOT_NULL_MSG(atm_ext_frame,"Null input atm ext frame");

  next=cpl_frame_get_nextensions( obj_frame);
  name_s=cpl_frame_get_filename(obj_frame);

  aname=cpl_frame_get_filename(atm_ext_frame);
  tbl_atm_ext=cpl_table_load(aname,1,0);
  check(cpl_table_cast_column( tbl_atm_ext,"LAMBDA","D_LAMBDA",CPL_TYPE_DOUBLE));
  if(!cpl_table_has_column(tbl_atm_ext,XSH_ATMOS_EXT_LIST_COLNAME_K)){
     xsh_msg_warning("You are using an obsolete atm extinction line table");
     cpl_table_duplicate_column(tbl_atm_ext,XSH_ATMOS_EXT_LIST_COLNAME_K,
                                tbl_atm_ext,XSH_ATMOS_EXT_LIST_COLNAME_OLD);
  }
  check(cpl_table_cast_column( tbl_atm_ext,XSH_ATMOS_EXT_LIST_COLNAME_K,"D_EXTINCTION",CPL_TYPE_DOUBLE));
  name_o=cpl_sprintf("%s.fits",tag_o);

  hdat=cpl_propertylist_load(name_s,0);
  /* observed frame scaling factors */
  check(exptime = xsh_pfits_get_exptime(hdat));
  if( xsh_instrument_get_arm(instrument) == XSH_ARM_NIR){
    /* we assume gain in units of ADU/e- as ESO standard */
    gain=1./2.12;
  } else {
     check(gain = xsh_pfits_get_gain(hdat));
  }

  if (correct_binning && (xsh_instrument_get_arm(instrument) != XSH_ARM_NIR)) {
    /* x-binning of rotated image is y-binning of raw image */
    check(binx  = xsh_pfits_get_binx(hdat));
    check(biny  = xsh_pfits_get_biny(hdat));
    bin_size=binx*biny;
  } else {
    xsh_msg_dbg_medium("Spectrum will not be normalized to unit binning");
  }
  check(airmass=xsh_pfits_get_airm_mean(hdat));

  for(ext=0;ext<next;ext+=3) {
    check(xsh_normalize_spectrum_image_slice(name_s,tag_o,ext,bin_size,gain,
				             exptime,airmass,tbl_atm_ext)); 
  }/* end loop over extention */

  result=xsh_frame_product(name_o,tag_o,CPL_FRAME_TYPE_IMAGE,CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

 cleanup:

  xsh_free_table(&tbl_atm_ext);
  xsh_free_propertylist(&hdat);
  cpl_free(name_o);

  return result;

}

/*---------------------------------------------------------------------------*/
/**
   @brief    Normalize a spectrum
   @param    spectrum           The 1d (merged) or 2d (non-merged or 2d
                                extracted+merged) spectrum to be normalized
   @param    spectrum_error     Error (1 sigma) of @em spectrum, or NULL.
   @param    spectrum_header    Header describing the geometry of the input spectrum
   @param    binx               x bin
   @param    gain               detector's gain
   @param    exptime            observed object's exposure time
   @param    airmass            observed object's airmass
   @param    n_traces           Number of spatial bins (1 unless 2d extracted)
   @param    atm_extinction     The table of extinction coefficients
   @param    scaled_error       (output) If non-NULL, error of output spectrum
   @return   The normalized spectrum

   The spectrum is divided by exposure time, gain and (optionally) binning. 
   Also corrected for atmospheric extinction using the provided table of
   extinction coefficients.

   Bad pixels are propagated.xsh_utils.h
*/
/* Needs to be updated for multi extension (ORDER-BY-ORDER) */
/*----------------------------------------------------------------------------*/
cpl_image *
xsh_normalize_spectrum_image(const cpl_image *spectrum, 
                             const cpl_image *spectrum_error,
                             const cpl_propertylist *spectrum_header,
                             const int bin_size,
                             const double gain, 
                             const double exptime,
                             const double airmass,
                             const int n_traces,
                             const cpl_table *atm_extinction,
                             cpl_image **scaled_error)
{
    cpl_image *scaled = NULL;
    int norders, ny, nx;
    double cor_fct=gain*exptime*bin_size;
    XSH_ASSURE_NOT_NULL_MSG(spectrum,"Null input spectrum");
    XSH_ASSURE_NOT_NULL_MSG(scaled_error,"Null input scaled error");
    XSH_ASSURE_NOT_NULL_MSG(spectrum_error, "Null input spectrum error");
    XSH_ASSURE_NOT_NULL_MSG(spectrum_header,"Null input spectrum header");
    XSH_ASSURE_NOT_NULL_MSG(atm_extinction,"Null input atmospheric extinction table");

    nx = cpl_image_get_size_x(spectrum);
    ny = cpl_image_get_size_y(spectrum);


    if (spectrum_error != NULL)
    {
        assure( nx == cpl_image_get_size_x(spectrum_error) &&
            ny == cpl_image_get_size_y(spectrum_error), CPL_ERROR_INCOMPATIBLE_INPUT,
            "Error spectrum geometry differs from spectrum: %" CPL_SIZE_FORMAT "x%" CPL_SIZE_FORMAT " vs. %dx%d",
            cpl_image_get_size_x(spectrum_error),
            cpl_image_get_size_y(spectrum_error),
            nx, ny);
    }
    
    assure( ny % n_traces == 0, CPL_ERROR_INCOMPATIBLE_INPUT,
        "Spectrum image height (%d) is not a multiple of "
        "the number of traces (%d). Confused, bailing out",
        ny, n_traces);
    
    norders = ny / n_traces;

    /*
     * Correct for exposure time, gain, bin 
     */
    assure( exptime > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive exposure time: %f s", exptime);
    assure( gain    > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %f", gain);
    assure( bin_size    > 0, CPL_ERROR_ILLEGAL_INPUT, "Illegal binning: %d", bin_size);
    
    xsh_msg_dbg_medium("Correcting for exposure time = %f s, gain = %f, bin_size = %d", exptime, gain, bin_size);
    
    check_msg(scaled=cpl_image_divide_scalar_create(spectrum,cor_fct),
       "Error correcting spectrum for gain, exposure time, binning");
    
    if (scaled_error != NULL)
    {
      check_msg( *scaled_error=cpl_image_divide_scalar_create(spectrum_error, 
							      cor_fct),
           "Error correcting rebinned spectrum for gain, exposure time, binning");
    }
    
    /* 
     * Correct for atmospheric extinction 
     */
    {
    double dlambda, lambda_start;
    int order;

    xsh_msg_dbg_medium("Correcting for extinction through airmass %f", airmass);       
    check_msg( dlambda = xsh_pfits_get_cdelt1(spectrum_header),
           "Error reading bin width from header");

    for (order = 1; order <= norders; order++)
        {
        int trace;

        /* If spectrum was already merged, then read crval1,
         * otherwise read wstart for each order
         */
        
        if (norders == 1)
            {
            check_msg( lambda_start = xsh_pfits_get_crval1(spectrum_header),
                   "Error reading start wavelength from header");    
            }
        else
            {
            /* Here need to be updated for multi extension (ORDER-BY-ORDER) */
            check_msg( lambda_start =  xsh_pfits_get_crval1(spectrum_header),
                   "Error reading start wavelength from header");    
            }

        for (trace = 1; trace <= n_traces; trace++)
            {
            int spectrum_row = (order - 1)*n_traces + trace;
            int x;
            
            for (x = 1; x <= nx; x++)
                {
                int pis_rejected1;
                int pis_rejected2;
                double flux;
                double dflux = 0;
                double extinction;
                double lambda;

                lambda = lambda_start + (x-1) * dlambda;
                
                flux  = cpl_image_get(scaled, x, spectrum_row, &pis_rejected1);
                if (scaled_error != NULL)
                    {
                    dflux = cpl_image_get(*scaled_error, x, 
                                  spectrum_row, &pis_rejected2);
                    }

                if (!pis_rejected1 && (scaled_error == NULL || !pis_rejected2))
                    {
                       int istart = 0;

                       /* Read extinction (units: magnitude per airmass) */
                    check_msg( extinction = 
                           xsh_spline_hermite_table(
                           lambda, atm_extinction,
                           "D_LAMBDA", "D_EXTINCTION", &istart),
                           "Error interpolating extinction coefficient");
                    
                    /* Correct for extinction using
                     * the magnitude/flux relation
                     * m = -2.5 log_10 F
                     *  => 
                     * F = 10^(-m*0.4)
                     *
                     * m_top-of-atmosphere = m - ext.coeff*airmass
                     * F_top-of-atmosphere = F * 10^(0.4 * ext.coeff*airmass)
                     */
 
                    cpl_image_set(
                        scaled, x, spectrum_row,
                        flux * pow(10, 0.4 * extinction * airmass));
                    if (scaled_error != NULL)
                        {
                        cpl_image_set(
                            *scaled_error, x, spectrum_row,
                            dflux * pow(10, 0.4 * extinction * airmass));
                        }
                    }
                else
                    {
                    cpl_image_reject(scaled, x, spectrum_row);
                    if (scaled_error != NULL)
                        {
                        cpl_image_reject(*scaled_error, x, spectrum_row);
                        }
                    }
                } /* for each x */

            } /* for each (possibly only 1) trace */

        } /* for each (possibly only 1) order */
    }

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE)
    {
        xsh_free_image(&scaled);
        if (scaled_error != NULL)
        {
            xsh_free_image(scaled_error);
        }
    }
    
    return scaled;
}

static double
xsh_iterpol_linear(double* data_x,double* data_y,int ndata,double x,
int* i_inf,int* i_sup)
{
  int i=0;
  double y=0;
  //int i_min=0;
  //int i_max=0;
  double x1=data_x[*i_inf];
  double x2=data_x[*i_sup];
  double y1=data_y[*i_inf];
  double y2=data_y[*i_sup];
  //x1=x2=y1=y2=0;
  //i_min=((*i_inf)>0) ? (*i_inf):0;
  //i_max=((*i_sup)<ndata) ? (*i_sup):ndata;
  //xsh_msg("i_min=%d i_max=%d",i_min,i_max);
  //for(i=i_min;i<i_max;i++) {
  for(i=1;i<ndata-1;i++) {
    //xsh_msg("data_x[%d]=%g,data_y[%d]=%g,x=%g",i,data_x[i],i,data_y[i],x);
    if(data_x[i]>x) {
      y1=data_y[i-1];
      y2=data_y[i];
      x1=data_x[i-1];
      x2=data_x[i];
      *i_inf=i-1;
      *i_sup=i+1;
      break;
    }
  }
  //xsh_msg("i_inf=%d i_sup=%d",*i_inf,*i_sup);
  y=(y2-y1)/(x2-x1)*(x-x1)+y1;
  //xsh_msg("x1=%g x2=%g y1=%g y2=%g x=%g y=%g",x1,x2,y1,y2,x,y);
 
  return y;
}

/**
@brief spectra interpolation
@param table_frame table frame containing the spectrum
@param wstep wave step
@param wmin wave min
@param wmax wave max
 */
cpl_frame*
xsh_spectrum_interpolate_linear(cpl_frame* table_frame,
                       const double wstep,
                       const double wmin,
                       const double wmax)
{

   cpl_frame* result=NULL;
   cpl_table* table_i=NULL;
   cpl_table* table_o=NULL;
   const char* name_i=NULL;
   const char* tag_i=NULL;

   char* name_o=NULL;
   char* tag_o=NULL;

   cpl_propertylist* plist=NULL;
   int nrows_i=0;
   int nrows_o=0;
   int row=0;
 
   double* pwave_i=NULL;
   double* pflux_i=NULL;
   double* pwave_o=NULL;
   double* pflux_o=NULL;
   int i_inf=0;
   int i_sup=0;

   //int istart = 0;

   XSH_ASSURE_NOT_NULL_MSG(table_frame,"Null input table frame");
   XSH_ASSURE_NOT_ILLEGAL_MSG(wmax>wmin,"wmax  < wmin");
   XSH_ASSURE_NOT_ILLEGAL_MSG(wstep>0,"wstep  <= 0");

   name_i=cpl_frame_get_filename(table_frame);
   tag_i=cpl_frame_get_tag(table_frame);
   //xsh_msg("name_i=%s",name_i);
   check(table_i=cpl_table_load(name_i,1,0));
   nrows_i=cpl_table_get_nrow(table_i);
   plist=cpl_propertylist_load(name_i,0);
   nrows_o=(int)((wmax-wmin)/wstep+0.5);
   table_o=cpl_table_new(nrows_o);
   cpl_table_new_column(table_o,"LAMBDA",CPL_TYPE_DOUBLE);
   cpl_table_new_column(table_o,"FLUX",CPL_TYPE_DOUBLE);
   check(cpl_table_fill_column_window_double(table_o,"LAMBDA",0,nrows_o,0.));
   check(cpl_table_fill_column_window_double(table_o,"FLUX",0,nrows_o,0.));
   check(pwave_i=cpl_table_get_data_double(table_i,"LAMBDA"));
   check(pflux_i=cpl_table_get_data_double(table_i,"FLUX"));
   check(pwave_o=cpl_table_get_data_double(table_o,"LAMBDA"));
   check(pflux_o=cpl_table_get_data_double(table_o,"FLUX"));
   i_inf=0;
   i_sup=nrows_o;

   for (row = 0; row < nrows_o; row++)
   {

      pwave_o[row]= wmin + row * wstep;
      pflux_o[row]= xsh_iterpol_linear(pwave_i,pflux_i,nrows_i,pwave_o[row],
				       &i_inf,&i_sup);

      //xsh_msg("interpolated flux[%g]=%g",pwave_o[row],pflux_o[row]);
   }
   tag_o=cpl_sprintf("INTERPOL_%s",tag_i);
   name_o=cpl_sprintf("INTERPOL_%s.fits",tag_i);
   xsh_pfits_set_pcatg(plist,tag_o);
   check(cpl_table_save(table_o,plist,NULL,name_o,CPL_IO_DEFAULT));
   check(result=xsh_frame_product(name_o,tag_o,CPL_FRAME_TYPE_TABLE,
                                  CPL_FRAME_GROUP_PRODUCT,
                                  CPL_FRAME_LEVEL_FINAL));
   xsh_add_temporary_file(name_o);
 cleanup:


   xsh_free_table(&table_i);
   xsh_free_table(&table_o);
   xsh_free_propertylist(&plist);
   cpl_free(name_o);
   cpl_free(tag_o);

   return result;

}




/**
@brief spectra interpolation
@param table_frame table frame containing the spectrum
@param wstep wave step
@param wmin wave min
@param wmax wave max
 */
cpl_frame*
xsh_spectrum_interpolate(cpl_frame* table_frame,
                       const double wstep,
                       const double wmin,
                       const double wmax)
{

   cpl_frame* result=NULL;
   cpl_table* table_i=NULL;
   cpl_table* table_o=NULL;
   const char* name_i=NULL;
   const char* tag_i=NULL;

   char* name_o=NULL;
   char* tag_o=NULL;

   cpl_propertylist* plist=NULL;
   int nrows=0;
   int row=0;
   double wave=0;
   double flux_o=0;
   double* pwave=NULL;
   double* pflux=NULL;

   int istart = 0;
   double flux_med =0;
   XSH_ASSURE_NOT_NULL_MSG(table_frame,"Null input table frame");
   XSH_ASSURE_NOT_ILLEGAL_MSG(wmax>wmin,"wmax  < wmin");
   XSH_ASSURE_NOT_ILLEGAL_MSG(wstep>0,"wstep  <= 0");

   name_i=cpl_frame_get_filename(table_frame);

   tag_i=cpl_frame_get_tag(table_frame);
   check(table_i=cpl_table_load(name_i,1,0));
   flux_med=cpl_table_get_column_median(table_i,"FLUX");
   cpl_table_divide_scalar(table_i,"FLUX",flux_med);

   plist=cpl_propertylist_load(name_i,0);
   nrows=(int)((wmax-wmin)/wstep+0.5);
   table_o=cpl_table_new(nrows);

   cpl_table_new_column(table_o,"LAMBDA",CPL_TYPE_DOUBLE);

   cpl_table_new_column(table_o,"FLUX",CPL_TYPE_DOUBLE);

   check(pwave=cpl_table_get_data_double(table_o,"LAMBDA"));

   check(pflux=cpl_table_get_data_double(table_o,"FLUX"));


   check(cpl_table_fill_column_window_double(table_o,"LAMBDA",0,nrows,0.));
   check(cpl_table_fill_column_window_double(table_o,"FLUX",0,nrows,0.));

   check(pwave=cpl_table_get_data_double(table_o,"LAMBDA"));
   check(pflux=cpl_table_get_data_double(table_o,"FLUX"));


   for (row = 0; row < nrows; row++)
   {

      wave = wmin + row * wstep;
                   
      check_msg( flux_o = xsh_spline_hermite_table(wave, table_i, 
                                                   "LAMBDA", "FLUX", &istart),
                 "Error interpolating curve at lambda = %f wlu", wave);
      pwave[row]=wave;
      pflux[row]=flux_o;

      xsh_msg_dbg_medium("interpolated flux[%g]=%g",wave,flux_o);
   }

   cpl_table_multiply_scalar(table_i,"FLUX",flux_med);
   cpl_table_multiply_scalar(table_o,"FLUX",flux_med);

   tag_o=cpl_sprintf("INTERPOL_%s",tag_i);
   name_o=cpl_sprintf("INTERPOL_%s.fits",tag_i);
   xsh_pfits_set_pcatg(plist,tag_o);
   check(cpl_table_save(table_o,plist,NULL,name_o,CPL_IO_DEFAULT));
   check(result=xsh_frame_product(name_o,tag_o,CPL_FRAME_TYPE_TABLE,
                                  CPL_FRAME_GROUP_PRODUCT,
                                  CPL_FRAME_LEVEL_FINAL));

   xsh_add_temporary_file(name_o);

 cleanup:


   xsh_free_table(&table_i);
   xsh_free_table(&table_o);
   xsh_free_propertylist(&plist);
   cpl_free(name_o);
   cpl_free(tag_o);


   return result;

}

/******************************************************************************/
/******************************************************************************/
/**
 @brief mean clip of an array
 @param array array of values to be clipped
 @param kappa kappa value of kappa sigma clip
 @param niter number of iterations
 @param frac_min minimum accepable fraction of good pixels
 @param[out] mean  mean of values after clipping
 @param[out] stdev sigma of values after clipping
 */
void 
xsh_array_clip_mean( cpl_array *array, 
                     double kappa, 
                     int niter, 
                     double frac_min, 
                     double *mean, 
                     double *stdev)
{
  int  i, j, size;
  double mean_val;
  double sigma, frac;
  int *flags = NULL;
  int nb_rejected = 0, total_rejected=0;
  double* pval=NULL;

  XSH_ASSURE_NOT_NULL( array);
  XSH_ASSURE_NOT_NULL( mean);  
  XSH_ASSURE_NOT_NULL( stdev); 

  check( mean_val = cpl_array_get_mean( array));
  check( sigma = cpl_array_get_stdev( array));
  check( size =  cpl_array_get_size( array));
  
  XSH_CALLOC( flags, int, size);

  xsh_msg_dbg_medium("Iteration %d/%d", 0, niter);
  xsh_msg_dbg_medium("Accepted fraction %f Mean %f sigma %f", 1.0, mean_val, sigma);


  check(pval=cpl_array_get_data_double(array));
  for( i=1; i<= niter; i++) {
    xsh_msg_dbg_medium("Iteration %d/%d", i, niter);
    nb_rejected = 0;
    for( j=0; j< size; j++){

      if ( flags[j] == 0 && fabs( pval[j]-mean_val) > kappa*sigma){
        nb_rejected++;
        flags[j]=1;
        check( cpl_array_set_invalid( array, j));
      }
    }
    if ( nb_rejected == 0){
      xsh_msg("No more points are rejected. Iterations are stopped.");
      break;
    }
    total_rejected += nb_rejected;
    frac = 1-(double)total_rejected/(double)size;
    if (frac < frac_min){
      xsh_msg("Minimal fraction of accepted points %f is reached (%f). Iterations are stopped",
        frac_min, frac);
      break;
    }

    check( mean_val = cpl_array_get_mean( array));
    check( sigma = cpl_array_get_stdev( array));
    xsh_msg("Accepted fraction %f Mean %f sigma %f", frac, mean_val, sigma);
  }

  xsh_msg("End of clipping : Mean %f sigma %f", mean_val, sigma);
  *mean = mean_val;
  *stdev = sigma;

  cleanup:
    XSH_FREE( flags);
    return;
}
/******************************************************************************/
/**
 @brief median clip of an array
 @param array array of values to be clipped
 @param kappa kappa value of kappa sigma clip
 @param niter number of iterations
 @param frac_min minimum accepable fraction of good pixels
 @param[out] median  median of values after clipping
 @param[out] stdev sigma of values after clipping
 */


void 
xsh_array_clip_median( cpl_array *array, 
                       double kappa, 
                       int niter,
                       double frac_min, 
                       double *median, 
                       double *stdev)
{
  int  i, j, size;
  double median_val;
  double sigma, frac;
  int *flags = NULL;
  int nb_rejected = 0, total_rejected=0;
  double* pval=NULL;

  XSH_ASSURE_NOT_NULL( array);
  XSH_ASSURE_NOT_NULL( median);
  XSH_ASSURE_NOT_NULL( stdev);

  check( median_val = cpl_array_get_median( array));
  check( sigma = cpl_array_get_stdev( array));
  check( size =  cpl_array_get_size( array));

  XSH_CALLOC( flags, int, size);

  xsh_msg("Iteration %d/%d", 0, niter);
  xsh_msg("Accepted fraction %f Median %f sigma %f", 1.0, median_val, sigma);
  check(pval=cpl_array_get_data_double(array));
  for( i=1; i<= niter; i++) {
    xsh_msg("Iteration %d/%d", i, niter);
    nb_rejected = 0;
    for( j=0; j< size; j++){

      if ( flags[j] == 0 && fabs( pval[j]-median_val) > kappa*sigma){
        nb_rejected++;
        flags[j]=1;
        check( cpl_array_set_invalid( array, j));
      }
    }
    if ( nb_rejected == 0){
      xsh_msg("No more points are rejected. Iterations are stopped.");
      break;
    }
    total_rejected += nb_rejected;
    frac = 1-(double)total_rejected/(double)size;
    if (frac < frac_min){
      xsh_msg("Minimal fraction of accepted points %f is reached (%f). Iterations are stopped", 
        frac_min, frac);
      break;
    }
    check( median_val = cpl_array_get_median( array));
    check( sigma = cpl_array_get_stdev( array));
    xsh_msg("Accepted fraction %f Median %f sigma %f", frac, median_val, sigma);
  }
  xsh_msg("End of clipping : Median %f sigma %f", median_val, sigma);
  *median = median_val;
  *stdev = sigma;

  cleanup:
    XSH_FREE( flags);
    return;
}

/**
@brief clip outliers from a 1D poly fit
@param pos_vect vector with positions
@param val_vect vector with values
 @param kappa kappa value of kappa sigma clip
 @param niter number of iterations
 @param frac_min minimum accepable fraction of good pixels
 @param deg degree of polynomial
 @param polyp polynomial
 @param chisq chi square
 @param flagsp flag parameter
 */
void 
xsh_array_clip_poly1d( cpl_vector *pos_vect, 
                       cpl_vector *val_vect,
                       double kappa, 
                       int niter, 
                       double frac_min, 
                       int deg, 
                       cpl_polynomial **polyp, 
                       double *chisq, 
                       int **flagsp)
{
  int  i, j, size;
  double frac, sigma;
  int *flags = NULL;
  int nb_rejected = 0, total_rejected=0;
  cpl_polynomial *poly = NULL;
  cpl_vector *temp_pos = NULL, *temp_val = NULL;
  double *positions = NULL;
  double *values = NULL;
  int ngood=0;

  XSH_ASSURE_NOT_NULL( pos_vect);
  XSH_ASSURE_NOT_NULL( val_vect);

  XSH_ASSURE_NOT_NULL( polyp);
  XSH_ASSURE_NOT_NULL( flagsp);

  check( poly = xsh_polynomial_fit_1d_create( pos_vect, val_vect, deg, 
    chisq));
  check( size =  cpl_vector_get_size( pos_vect));

  XSH_CALLOC( flags, int, size);
  XSH_CALLOC( positions, double, size);
  XSH_CALLOC( values, double, size);

  ngood = size;
  sigma = sqrt(*chisq);

  xsh_msg_dbg_medium("Iteration %d/%d", 0, niter);
  xsh_msg_dbg_medium("Accepted fraction %f Polynomial deg %d sigma %f",
    1.0, deg, sigma);

  for( i=1; i<= niter; i++) {
    xsh_msg_dbg_medium("Iteration %d/%d", i, niter);
    nb_rejected = 0;

    for( j=0; j< size; j++){
      double pos=0.0, val=0.0, pol_val=0.0;

      check( pos = cpl_vector_get( pos_vect, j));
      check( val = cpl_vector_get( val_vect, j));
      check( pol_val = cpl_polynomial_eval_1d( poly, pos, NULL)); 

      if ( flags[j] == 0 && fabs( pol_val-val) > kappa*sigma){
        nb_rejected++;
        flags[j]=2;
      }
    }
    if ( nb_rejected == 0){
      xsh_msg_dbg_medium("No more points are rejected. Iterations are stopped.");
      break;
    }
    total_rejected += nb_rejected;
    frac = 1-(double)total_rejected/(double)size;
    if (frac < frac_min){
      xsh_msg("Minimal fraction of accepted points %f is reached (%f). Iterations are stopped",
        frac_min, frac);
      break;
    }

    ngood = 0;
    for( j=0; j< size; j++){
      if( flags[j] == 0){
        positions[ngood] = cpl_vector_get( pos_vect, j);
        values[ngood] = cpl_vector_get( val_vect, j);
        ngood++;
      }
      else{
        flags[j] = 1;
      }
    }
    check( temp_pos = cpl_vector_wrap( ngood, positions));
    check( temp_val = cpl_vector_wrap( ngood, values));

    xsh_free_polynomial( &poly);

    check( poly = xsh_polynomial_fit_1d_create( temp_pos, temp_val, deg,
      chisq));

    sigma = sqrt(*chisq);

    xsh_msg_dbg_medium("Accepted fraction %f Polynomial deg %d sigma %f",
      frac, deg, sigma);
    xsh_unwrap_vector( &temp_pos);
    xsh_unwrap_vector( &temp_val); 
  }

  for( j=0; j< size; j++){
    if( flags[j] == 2){
      flags[j] = 0;
    }
  }    
  *polyp = poly;
  *flagsp = flags;

  cleanup:
    XSH_FREE( positions);
    XSH_FREE( values);
    xsh_unwrap_vector( &temp_pos);
    xsh_unwrap_vector( &temp_val);
    return;
}

cpl_error_code 
xsh_rectify_params_set_defaults(cpl_parameterlist* pars,
                                const char* rec_id,
                                xsh_instrument* inst,
                                xsh_rectify_param * rectify_par)
{
   cpl_parameter* p=NULL;
 
   check(p=xsh_parameters_find(pars,rec_id,"rectify-bin-slit"));
   if(cpl_parameter_get_double(p) <= 0) {
      if (xsh_instrument_get_arm(inst) == XSH_ARM_UVB){
        rectify_par->rectif_bin_space=XSH_SLIT_BIN_SIZE_PIPE_UVB;
        cpl_parameter_set_double(p,XSH_SLIT_BIN_SIZE_PIPE_UVB);
      } else if (xsh_instrument_get_arm(inst) == XSH_ARM_VIS){
        rectify_par->rectif_bin_space=XSH_SLIT_BIN_SIZE_PIPE_VIS;
        cpl_parameter_set_double(p,XSH_SLIT_BIN_SIZE_PIPE_VIS);
      } else if (xsh_instrument_get_arm(inst) == XSH_ARM_NIR){
        rectify_par->rectif_bin_space=XSH_SLIT_BIN_SIZE_PIPE_NIR;
        cpl_parameter_set_double(p,XSH_SLIT_BIN_SIZE_PIPE_NIR);
      }
   }
   check(p=xsh_parameters_find(pars,rec_id,"rectify-bin-lambda"));
   if(cpl_parameter_get_double(p) <= 0) {
      if (xsh_instrument_get_arm(inst) == XSH_ARM_UVB){
        rectify_par->rectif_bin_lambda=XSH_WAVE_BIN_SIZE_PIPE_UVB;
        cpl_parameter_set_double(p,XSH_WAVE_BIN_SIZE_PIPE_UVB);
      } else if (xsh_instrument_get_arm(inst) == XSH_ARM_VIS){
        rectify_par->rectif_bin_lambda=XSH_WAVE_BIN_SIZE_PIPE_VIS;
        cpl_parameter_set_double(p,XSH_WAVE_BIN_SIZE_PIPE_VIS);
      } else if (xsh_instrument_get_arm(inst) == XSH_ARM_NIR){
        rectify_par->rectif_bin_lambda=XSH_WAVE_BIN_SIZE_PIPE_NIR;
        cpl_parameter_set_double(p,XSH_WAVE_BIN_SIZE_PIPE_NIR);
      }
   }

 cleanup:
 
  return cpl_error_get_code();

}

/******************************************************************************/
struct data {
  size_t n;
  double * y;
  double * x;
  int deg;
};

static int
expb_f (const gsl_vector * x, void *data, 
	gsl_vector * f)
{
  int i;
  int n = ((struct data *)data)->n;
  double *y = ((struct data *)data)->y;
  double *xtab = ((struct data *) data)->x;

  double area = gsl_vector_get (x, 0);
  double a = gsl_vector_get (x, 1);
  double b = gsl_vector_get( x,2);
  double c = gsl_vector_get( x,3);
  double x0 = gsl_vector_get( x,4);
  double sigma = gsl_vector_get( x,5);

  for (i = 0; i < n; i++)
  {
    /* Model Yi = area/sqrt(2PI*sigma^2)* exp(-(x-x0)^2/(2sigma^2) + a + bx +cx^2 */
    double t = xtab[i];
    double height = area/sqrt(2*M_PI*sigma*sigma);
    double W = ((t-x0)*(t-x0))/(2*sigma*sigma);
      
    double Yi = height*exp(-W)+a+b*t+c*t*t;
      
    gsl_vector_set (f, i, Yi - y[i]);
  }

  return GSL_SUCCESS;
}

static int
expb_df (const gsl_vector * x, void *data, 
	 gsl_matrix * J)
{
  int i;
  int n = ((struct data *)data)->n;
  double *xtab = ((struct data *) data)->x;

  double area = gsl_vector_get (x, 0);
  double x0 = gsl_vector_get (x, 4);
  double sigma =  gsl_vector_get( x,5);
  int deg = ((struct data *)data)->deg;
  for (i = 0; i < n; i++)
    {
      /* Jacobian matrix J(i,j) = dfi / dxj, */
      /* where fi = (Yi - yi)/sigma[i],      */
      /*       Yi = A * exp(-lambda * i) + b  */
      /* and the xj are the parameters (A,lambda,b) */
      double t = xtab[i];
      
      double W = ((t-x0)*(t-x0))/(2*sigma*sigma);
      double e = 0.0;
      
      
      /* df /area */
      e = exp(-W)/sqrt(2*M_PI*sigma*sigma);
      gsl_matrix_set (J, i, 0, e);
      
      /* df / da */
      e = 1;
      gsl_matrix_set (J, i, 1, e);

      /* df /db */
      if (deg >= 1){
         e = t;
      }
      else {
        e = 0;
      }
      gsl_matrix_set (J, i, 2, e);
      
      /* df/dc */
      if (deg == 2) {
        e = t*t;
      }
      else {
        e = 0;
      }
      gsl_matrix_set (J, i, 3, e);

      /* df / x0 */
      e = area/(2*M_PI*sigma)*(t-x0)/sigma*exp(-0.5*pow((t-x0)/sigma,2));
      gsl_matrix_set (J, i, 4, e);
                 
      /* df /sigma */
      e = (sqrt(2)*area*x0*x0-pow(2,1.5)*area*t*x0+sqrt(2)*area*t*t-sqrt(2)*area*sigma*sigma)*exp(-W)/(2*sqrt(M_PI)*sigma*sigma*sigma*sigma);
      gsl_matrix_set (J, i, 5, e);
      
    }
  return GSL_SUCCESS;
}

static int
expb_fdf (const gsl_vector * x, void *data,
	  gsl_vector * f, gsl_matrix * J)
{
  expb_f (x, data, f);
  expb_df (x, data, J);

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

/******************************************************************************/
/******************************************************************************/
void xsh_gsl_init_gaussian_fit( cpl_vector *xpos_vect, cpl_vector *ypos_vect,
  double *init_par)
{
  double flux_max, flux_min, intensity;
  int i, size;
  double init_area, init_sigma, init_x0=0, init_offset;
  double flux_sum =0.0;
  double hflux, flux25, flux75;
  double init25=0, init75=0;
  
  XSH_ASSURE_NOT_NULL( xpos_vect);
  XSH_ASSURE_NOT_NULL( ypos_vect);

  size = cpl_vector_get_size( xpos_vect);
  flux_min = cpl_vector_get_min( ypos_vect);
  flux_max = cpl_vector_get_max( ypos_vect);
  intensity = flux_max-flux_min;
  
  init_offset = flux_min;
  
  for (i = 0; i < size; i++){
    double yval;
    
    yval = cpl_vector_get( ypos_vect, i);  
    flux_sum += yval-init_offset;
  }
  
  hflux = flux_sum/2.0;
  flux25 = flux_sum*0.25;
  flux75 = flux_sum*0.75;
  flux_sum =0.0;
  
  for (i = 0; i < size; i++){
    double yval;
    
    yval = cpl_vector_get( ypos_vect, i);
    
    flux_sum += yval-init_offset;
    
    if ( (init25 == 0) && flux_sum > flux25){
      init25 = (i+i-1)/2.0;
    }
    
    if ( (init_x0 == 0) && flux_sum > hflux){
      init_x0 = (i+i-1)/2.0;
    }
    
    if ( (init75 == 0) && flux_sum > flux75){
      init75 = (i+i-1)/2.0;
      break;
    }
        
  }
  init_sigma = (init75-init25)/(2*0.6744);
  init_area = intensity*sqrt(2*M_PI*init_sigma*init_sigma);
  
  xsh_msg_dbg_high("DV FIT area %f x0 %f sigma %f offset %f", 
    init_area, init_x0, init_sigma, init_offset);
  
  init_par[0] = init_area;
  init_par[1] = init_offset;
  init_par[2] = 0;
  init_par[3] = 0;
  init_par[4] = init_x0;  
  init_par[5] = init_sigma;
  
  cleanup:
    return;
}
/******************************************************************************/
  
/******************************************************************************/
/******************************************************************************/
void xsh_gsl_fit_gaussian( cpl_vector *xpos_vect, cpl_vector *ypos_vect, 
  int deg,
  double *params, double *errs, int *status)
{
  const gsl_multifit_fdfsolver_type *T;
  gsl_multifit_fdfsolver *s=NULL;
  int iter = 0;
  const size_t p = 6;
  gsl_matrix *covar = gsl_matrix_alloc (p, p);


#if defined GSL_MAJOR_VERSION && GSL_MAJOR_VERSION >= 2
  gsl_matrix *J;
#endif
  int n=0;
  struct data d = { n, NULL, NULL,deg};
  gsl_multifit_function_fdf f;
  gsl_vector* x = NULL;
  double area, offset, b, c, x0, sigma;
  double chi, dof, cte;
  int size;
  double *xpos = NULL;
  double *ypos = NULL;
  
  /* gsl fit */
  XSH_ASSURE_NOT_NULL( xpos_vect);
  XSH_ASSURE_NOT_NULL( ypos_vect);
  XSH_ASSURE_NOT_NULL( params);  
  XSH_ASSURE_NOT_NULL( errs); 
  XSH_ASSURE_NOT_NULL( status);
  
  
  size = cpl_vector_get_size( xpos_vect);
  xpos = cpl_vector_get_data( xpos_vect);
  ypos = cpl_vector_get_data( ypos_vect);
  
  x = gsl_vector_calloc (p);
  
  area = params[0];
  offset = params[1];
  b = params[2];
  c = params[3];
  x0 = params[4];
  sigma = params[5];
  
  gsl_vector_set( x, 0, area);
  gsl_vector_set( x, 1, offset);
  gsl_vector_set( x, 2, b);
  gsl_vector_set( x, 3, c);
  gsl_vector_set( x, 4, x0);
  gsl_vector_set( x, 5, sigma);
  
  n = size; 
  d.n = size;
  d.y = ypos;
  d.x = xpos;
  d.deg = deg;
  
  f.f = &expb_f;
  f.df = &expb_df;
  f.fdf = &expb_fdf;
  f.n = n;
  f.p = p;
  f.params = &d;
     
  /* This is the data to be fitted */
  T = gsl_multifit_fdfsolver_lmsder;
  s = gsl_multifit_fdfsolver_alloc (T, n, p);
  gsl_multifit_fdfsolver_set (s, &f, x);

  xsh_msg_dbg_high ("iter: %3u area % 15.8f a % 15.8f b % 15.8f c % 15.8f x0 % 15.8f sigma % 15.8f |f(x)| = %g\n",
               iter,
               gsl_vector_get (s->x, 0),
	       gsl_vector_get (s->x, 1),
	       gsl_vector_get (s->x, 2),
	       gsl_vector_get (s->x, 3), 
	       gsl_vector_get (s->x, 4),
	       gsl_vector_get (s->x, 5),
	       gsl_blas_dnrm2 (s->f));     
  do
  {
    iter++;
    *status = gsl_multifit_fdfsolver_iterate (s);
     
    xsh_msg_dbg_high ("iter: %3u area % 15.8f a % 15.8f b % 15.8f c % 15.8f x0 % 15.8f sigma % 15.8f |f(x)| = %g\n",
               iter,
               gsl_vector_get (s->x, 0),
	       gsl_vector_get (s->x, 1),
	       gsl_vector_get (s->x, 2),
	       gsl_vector_get (s->x, 3), 
	       gsl_vector_get (s->x, 4),
	       gsl_vector_get (s->x, 5),
	       gsl_blas_dnrm2 (s->f));
     
    if (*status)
      break;
     
    *status = gsl_multifit_test_delta (s->dx, s->x,
                                             1e-2, 1e-2);

  }
  while ( *status == GSL_CONTINUE && iter < 500);
  
#if defined GSL_MAJOR_VERSION && GSL_MAJOR_VERSION >= 2
  J = gsl_matrix_alloc(n, p);
  gsl_multifit_fdfsolver_jac(s, J);
  gsl_multifit_covar (J, 0.0, covar);
  gsl_matrix_free (J);
#else
  gsl_multifit_covar (s->J, 0.0, covar);
#endif

  
  params[0] = gsl_vector_get( s->x, 0);
  params[1] = gsl_vector_get( s->x, 1);
  params[2] = gsl_vector_get( s->x, 2);
  params[3] = gsl_vector_get( s->x, 3);
  params[4] = gsl_vector_get( s->x, 4);
  params[5] = gsl_vector_get( s->x, 5);
  
  chi = gsl_blas_dnrm2(s->f);
  dof = n-p;
  cte = GSL_MAX_DBL(1, chi / sqrt(dof)); 
  
  errs[0] = cte * sqrt(gsl_matrix_get(covar,0,0));
  errs[1] = cte * sqrt(gsl_matrix_get(covar,1,1));
  errs[2] = cte * sqrt(gsl_matrix_get(covar,2,2));
  errs[3] = cte * sqrt(gsl_matrix_get(covar,3,3));
  errs[4] = cte * sqrt(gsl_matrix_get(covar,4,4));
  errs[5] = cte * sqrt(gsl_matrix_get(covar,5,5));
  
  
  cleanup:
  
    gsl_multifit_fdfsolver_free (s);
    gsl_matrix_free (covar);
    gsl_vector_free( x);
    return;
}

/**
  @name    xsh_xcorrelate
  @memo    Cross-correlation of two 1d signals.
  @param   line_i        The reference signal.
  @param   width_i       Number of samples in reference signal.
  @param   line_t        Candidate signal to compare.
  @param   width_t       Number of samples in candidate signal.
  @param   half_search   Half-size of the search domain.
  @param   delta         Output sinfo_correlation offset.
  @return  Maximum cross-correlation value as a double.
  @doc

  Two signals are expected in input of this function: a reference
  signal (line_i) and a candidate signal (line_t) . 
  They are expected to be roughly the same signal up to an offset (delta)

  A cross-correlation is computed on 2*half_search+1 values. The
  maximum of likelihood is the maximum cross-correlation value between
  signals. The offset 'delta' corresponding to this position is returned.

  Returns -100.0 in case of error. Normally, the cross-sinfo_correlation
  coefficient is normalized so it should stay between -1 and +1.
 */

double*
xsh_function1d_xcorrelate(
    double *    line_i,
    int         width_i,
    double *    line_t,
    int         width_t,
    int         half_search,
    int         normalise,
    double *    xcorr_max,
    double *    delta
)
{
    double * xcorr ;
    double   mean_i, mean_t ;
    double   rms_i, rms_t ;
    double   sum, sqsum ;
    double   norm ;
    int      maxpos ;
    int      nsteps ;
    int      i ;
    int      step ;
    int      nval ;
    int STEP_MIN=-half_search;
    int STEP_MAX=half_search;

    /* Compute normalization factors */
    sum = sqsum = 0.00 ;
    for (i=0 ; i<width_i ; i++) {
        sum += line_i[i] ;
        sqsum += line_i[i] * line_i[i];
    }

    mean_i = sum / (double) width_i ;
    sqsum /= (double)width_i ;
    rms_i = sqsum - mean_i*mean_i ;

    sum = sqsum = 0.00 ;
    for (i=0 ; i<width_t ; i++) {
        sum += line_t[i] ;
        sqsum += line_t[i] * line_t[i];
    }
    mean_t = sum / (double)width_t ;
    sqsum /= (double)width_t ;
    rms_t = sqsum - mean_t*mean_t ;

    norm = 1.00 / sqrt(rms_i * rms_t);

    nsteps = (STEP_MAX - STEP_MIN) +1 ;
    xcorr = cpl_malloc(nsteps * sizeof(double));
    if(normalise==0) {
      mean_t=0;
      norm=1;
    }
    for (step=STEP_MIN ; step<=STEP_MAX ; step++) {
        xcorr[step-STEP_MIN] = 0.00 ;
        nval = 0 ;
        for (i=0 ; i<width_t ; i++) {
            if ((i+step > 0) &&
                (i+step < width_i)) {
            xcorr[step-STEP_MIN] += (line_t[i] - mean_t) *
                                    (line_i[i+step] - mean_i) *
                                    norm ;
                nval++ ;
            }
        }
        xcorr[step-STEP_MIN] /= (double) nval ;
    }

    *xcorr_max = xcorr[0] ;
    maxpos    = 0 ;
    for (i=0 ; i<nsteps ; i++) {
        if (xcorr[i]>(*xcorr_max)) {
            maxpos = i ;
            *xcorr_max = xcorr[i];
        }
    }

    cpl_vector* vcor=cpl_vector_wrap(nsteps,xcorr);
    double a=xcorr[maxpos-1];
    double b=xcorr[maxpos+1];
    double c=xcorr[maxpos];
    double fraction=(a-b)/(2.*a+2.*b-4.*c);
    //cpl_vector_save(vcor,"vcor_correlate.fits",CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT);
    cpl_vector_unwrap(vcor);

    //xsh_msg("STEP_MIN=%d maxpos=%d",STEP_MIN,maxpos);
    //xsh_msg("fraction=%g a=%g b=%g c=%g delta=%g",fraction,a,b,c,0.5*(b-a));
    (*delta) =  (double)STEP_MIN + (double)maxpos;
    *delta-=fraction;
    //xsh_msg("fraction=%g a=%g b=%g c=%g diff=%g delta=%g",fraction,a,b,c,0.5*(b-a),*delta);
    return xcorr;
}

/**@}*/
