xsh_utils.c

Go to the documentation of this file.

/*                                                                            *
 *   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.
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
/*
#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;
}
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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;
}
 
 
/*----------------------------------------------------------------------------*/
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 ;
}
 
 
 
 
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;
 
}
 
 
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;
 
}
 
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;
 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
 
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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();
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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();
 
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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();
 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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();
 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
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;
 
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
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;
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
/*---------------------------------------------------------------------------*/
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
 
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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();
 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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();
 
}
 
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_init (void)
{
  xsh_error_reset ();
  xsh_msg_init ();
}
 
 
/*---------------------------------------------------------------------------*/
 
char * xsh_get_basename(const char *filename)
{
  char *p ;
  p = strrchr (filename, '/');
  return p ? p + 1 : (char *) filename;
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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 ;
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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++;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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; 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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++;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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 ();
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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 ();
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
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 ;
  
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
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;
}
 
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;
}
 
 
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;
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void xsh_free(const void *mem)
{
    cpl_free((void *)mem); /* No, it is not a bug. The cast is safe */
    return;
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_image (cpl_image ** i)
{
  if (i && *i) {
    cpl_image_delete (*i);
    *i = NULL;
  }
}
 
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_table (cpl_table ** t)
{
  if (t && *t) {
    cpl_table_delete (*t);
    *t = NULL;
  }
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_mask (cpl_mask ** m)
{
  if (m && *m) {
    cpl_mask_delete (*m);
    *m = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_imagelist (cpl_imagelist ** i)
{
  if (i && *i) {
    cpl_imagelist_delete (*i);
    *i = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_propertylist (cpl_propertylist ** p)
{
  if (p && *p) {
    cpl_propertylist_delete (*p);
    *p = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_polynomial (cpl_polynomial ** p)
{
  if (p && *p) {
    cpl_polynomial_delete (*p);
    *p = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_matrix (cpl_matrix ** m)
{
  if (m && *m) {
    cpl_matrix_delete (*m);
    *m = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_parameterlist (cpl_parameterlist ** p)
{
  if (p && *p) {
    cpl_parameterlist_delete (*p);
    *p = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_parameter (cpl_parameter ** p)
{
  if (p && *p) {
    cpl_parameter_delete (*p);
    *p = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_frameset (cpl_frameset ** f)
{
  if (f && *f) {
    cpl_frameset_delete (*f);
    *f = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_frame (cpl_frame ** f)
{
  if (f && *f) {
    cpl_frame_delete (*f);
    *f = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_vector (cpl_vector ** v)
{
  if (v && *v) {
    cpl_vector_delete (*v);
    *v = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_array (cpl_array ** m)
{
  if (m && *m) {
    cpl_array_delete (*m);
    *m = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_free_stats (cpl_stats ** s)
{
  if (s && *s) {
    cpl_stats_delete (*s);
    *s = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void xsh_unwrap_image( cpl_image **i)
{
  if ( i && *i) {
    cpl_image_unwrap( *i);
    *i = NULL;
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_unwrap_vector (cpl_vector ** v)
{
  if (v && *v) {
    cpl_vector_unwrap (*v);
    *v = NULL;
  }
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_unwrap_array (cpl_array ** a)
{
  if (a && *a) {
    cpl_array_unwrap (*a);
    *a = NULL;
  }
}
 
/*----------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
void
xsh_unwrap_bivector_vectors (cpl_bivector ** b)
{
  if (b && *b) {
    cpl_bivector_unwrap_vectors (*b);
    *b = NULL;
  }
}
/*---------------------------------------------------------------------------*/
 
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
 
 
/*----------------------------------------------------------------------------*/
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; 
}
/*----------------------------------------------------------------------------*/
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 ;
}
 
 
/*----------------------------------------------------------------------------*/
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 ;
}
 
 
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 ;
}
 
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 ;
}
 
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 ;
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
 
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;
}
 
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;
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
 
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;
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
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;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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;
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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 ;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
int xsh_debug_level_set( int level )
{
  int prev = XshDebugLevel ;
 
  XshDebugLevel = level ;
 
  return prev ;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
int 
xsh_debug_level_get( void )
{
  return XshDebugLevel ;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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" ;
  }
}
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
int 
xsh_time_stamp_set( int ts )
{
  int prev = XshTimeStamp ;
 
  XshTimeStamp = ts ;
 
  return prev ;
}
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
int 
xsh_time_stamp_get( void )
{
  return XshTimeStamp ;
}
 
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 ;
}
 
/******************************************************************************/
/******************************************************************************/
  
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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;
}
/******************************************************************************/
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
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;
}
 
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
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;
 
}
 
 
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
/*---------------------------------------------------------------------------*/
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
 
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
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; 
}
 
 
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; 
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
 
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();
 
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
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();
}
 
/*---------------------------------------------------------------------------*/
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;
}
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
/*---------------------------------------------------------------------------*/
 
 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
long xsh_round_double(double x)
{
    return (x >=0) ? (long)(x+0.5) : (long)(x-0.5);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
inline int
xsh_min_int(int x, int y)
{
    return (x <=y) ? x : y;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
inline int
xsh_max_int(int x, int y)
{
    return (x >= y) ? x : y;
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
inline double
xsh_min_double(double x, double y)
{
    return (x <=y) ? x : y;
}
 
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
inline double
xsh_max_double(double x, double y)
{
    return (x >=y) ? 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;
}
 
const char*
xsh_string_tolower(char* s)
{
 
    char *t = s;
 
    assert(s != NULL);
 
    while (*t) {
        *t = tolower(*t);
        t++;
    }
 
    return s;
 
}
 
 
const char*
xsh_string_toupper(char* s)
{
 
    char *t = s;
 
    assert(s != NULL);
 
    while (*t) {
        *t = toupper(*t);
        t++;
    }
 
    return s;
 
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
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;
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
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;
}
 
 
 
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 ;
}
 
 
/*----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
 
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;
 
}
 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
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] *= fabs(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;
}
 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
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] *= fabs(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);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
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;
}
 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
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;
}
 
 
 
/*---------------------------------------------------------------------------*/
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();
}
 
 
/*---------------------------------------------------------------------------*/
/* 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;
 
}
 
 
 
 
/*---------------------------------------------------------------------------*/
/* 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;
 
}
 
/*---------------------------------------------------------------------------*/
/* 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;
}
 
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;
 
}
 
 
 
 
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;
 
}
 
/******************************************************************************/
/******************************************************************************/
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;
}
/******************************************************************************/
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;
}
 
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();
 
}
 
 
cpl_error_code
xsh_remove_crh_single_params_set_defaults(cpl_parameterlist* pars,
                                const char* rec_id,
                                xsh_instrument* inst,
                                xsh_remove_crh_single_param * crh_single_par)
                                {
    cpl_parameter* p=NULL;
 
    check(p=xsh_parameters_find(pars,rec_id,"removecrhsingle-niter"));
    if (cpl_parameter_get_int(p) < 0) {
        if (xsh_instrument_get_arm(inst) == XSH_ARM_NIR){
            crh_single_par->nb_iter=XSH_REMOVE_CRH_SINGLE_NIR;
            cpl_parameter_set_int(p,XSH_REMOVE_CRH_SINGLE_NIR);
        } else if (xsh_instrument_get_arm(inst) == XSH_ARM_UVB ||
                   xsh_instrument_get_arm(inst) == XSH_ARM_VIS) {
            crh_single_par->nb_iter=XSH_REMOVE_CRH_SINGLE_UVB_VIS;
            cpl_parameter_set_int(p,XSH_REMOVE_CRH_SINGLE_UVB_VIS);
        }
    }
 
    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;
    }
        
  }
  //could replace 0.6744 with HDRL/CPL function for FWHM to SIGMA conversion
  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;
}
 
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;
}
 
/* Helper function to sort frameset by MJD. 
   Used by cpl_frameset_sort in get_average_airm_iwv_from_raws().
*/
int raw_mjd_frame_compare(const cpl_frame* f1,const cpl_frame* f2){
    int result = 0;
    cpl_propertylist* p1 = cpl_propertylist_load(cpl_frame_get_filename(f1),0);
    cpl_propertylist* p2 = cpl_propertylist_load(cpl_frame_get_filename(f2),0);
    if(p1 != NULL && p2 != NULL && cpl_propertylist_has(p1,"MJD-OBS") && cpl_propertylist_has(p2,"MJD-OBS")){
        double mjd1 = cpl_propertylist_get_double(p1,"MJD-OBS");
        double mjd2 = cpl_propertylist_get_double(p2,"MJD-OBS");
        if(mjd1 < mjd2) { 
            result = -1;
        } else if (mjd1 > mjd2){
           result = 1;
        }
    } 
    //otherwise they are equal (0)
    cpl_propertylist_delete(p1);
    cpl_propertylist_delete(p2);
    return result;
}
 
 
cpl_error_code get_average_qc_from_raws(cpl_frameset* fset,xsh_instrument* instrument,cpl_propertylist* qclist){
  /* Create a duplicate of the frameset sorted by MJD */
  cpl_frameset* fraws = cpl_frameset_duplicate(fset);
  cpl_frameset_sort(fraws,raw_mjd_frame_compare);
 
  int nraws = cpl_frameset_get_size(fraws);
  if(nraws > 0){
    //calculate QC NUM SAT
    int nsat_max = 0;
 
    for (int f = 0; f < nraws; f++) {
      cpl_frame* frm = cpl_frameset_get_frame(fset, f);
      const char* fname = cpl_frame_get_filename(frm);
      cpl_image* img = cpl_image_load(fname,CPL_TYPE_DOUBLE,0,0);
      cpl_propertylist* hdr = cpl_propertylist_load(fname,0);
      if(img){
        double thresh = 60000.0; 
        if(xsh_instrument_get_arm(instrument) == XSH_ARM_NIR){
            thresh = 42000;
        }
        
        double* idata = cpl_image_get_data_double(img);
        int nsat = 0;
        int nx = cpl_image_get_size_x(img);
        int ny = cpl_image_get_size_y(img);
        for(int i=0;i<nx*ny;i++){
          if(idata[i] > thresh){
              nsat++;
          }
        }
        if(nsat > nsat_max){
            nsat_max = nsat;
        }
      }
      cpl_image_delete(img);
      cpl_propertylist_delete(hdr);
    }
   
    cpl_propertylist_update_int(qclist,"ESO QC NUM SAT",nsat_max);
    
    //get first and last raw frames
    cpl_frame* raw1 = cpl_frameset_get_frame(fraws,0);
    cpl_frame* raw2 = cpl_frameset_get_frame(fraws,nraws-1);
    cpl_propertylist* rhdr1 = cpl_propertylist_load(cpl_frame_get_filename(raw1),0);
    cpl_propertylist* rhdr2 = cpl_propertylist_load(cpl_frame_get_filename(raw2),0);
    if (rhdr1 != NULL && rhdr2 != NULL){
        if(cpl_propertylist_has(rhdr1,"ESO TEL AIRM START") && cpl_propertylist_has(rhdr2,"ESO TEL AIRM END")){
            cpl_propertylist_update_double(qclist,"ESO QC AIRM AVG",
            0.5*(cpl_propertylist_get_double(rhdr1,"ESO TEL AIRM START") + cpl_propertylist_get_double(rhdr2,"ESO TEL AIRM END")));
        }
        if(cpl_propertylist_has(rhdr1,"ESO TEL AIRM START") && !cpl_propertylist_has(rhdr2,"ESO TEL AIRM END")){
            cpl_propertylist_update_double(qclist,"ESO QC AIRM AVG",cpl_propertylist_get_double(rhdr1,"ESO TEL AIRM START")); 
        }
        if(!cpl_propertylist_has(rhdr1,"ESO TEL AIRM START") && cpl_propertylist_has(rhdr2,"ESO TEL AIRM END")){
            cpl_propertylist_update_double(qclist,"ESO QC AIRM AVG",cpl_propertylist_get_double(rhdr2,"ESO TEL AIRM END")); 
        }
 
        if(cpl_propertylist_has(rhdr1,"ESO TEL AMBI IWV START") && cpl_propertylist_has(rhdr2,"ESO TEL AMBI IWV END")){
            cpl_propertylist_update_double(qclist,"ESO QC IWV AVG",
            0.5*(cpl_propertylist_get_double(rhdr1,"ESO TEL AMBI IWV START") + cpl_propertylist_get_double(rhdr2,"ESO TEL AMBI IWV END")));
        }
        if(cpl_propertylist_has(rhdr1,"ESO TEL AMBI IWV START") && !cpl_propertylist_has(rhdr2,"ESO TEL AMBI IWV END")){
            cpl_propertylist_update_double(qclist,"ESO QC IWV AVG",cpl_propertylist_get_double(rhdr1,"ESO TEL AMBI IWV START")); 
        }
        if(!cpl_propertylist_has(rhdr1,"ESO TEL AMBI IWV START") && cpl_propertylist_has(rhdr2,"ESO TEL AMBI IWV END")){
            cpl_propertylist_update_double(qclist,"ESO QC IWV AVG",cpl_propertylist_get_double(rhdr2,"ESO TEL AMBI IWV END")); 
        }
 
 
        if(cpl_propertylist_has(rhdr1,"ESO TEL AMBI FWHM START") && cpl_propertylist_has(rhdr2,"ESO TEL AMBI FWHM END")){
            cpl_propertylist_update_double(qclist,"ESO QC FWHM AVG",
            0.5*(cpl_propertylist_get_double(rhdr1,"ESO TEL AMBI FWHM START") + cpl_propertylist_get_double(rhdr2,"ESO TEL AMBI FWHM END")));
        }
        if(cpl_propertylist_has(rhdr1,"ESO TEL AMBI FWHM START") && !cpl_propertylist_has(rhdr2,"ESO TEL AMBI FWHM END")){
            cpl_propertylist_update_double(qclist,"ESO QC FWHM AVG",cpl_propertylist_get_double(rhdr1,"ESO TEL AMBI FWHM START")); 
        }
        if(!cpl_propertylist_has(rhdr1,"ESO TEL AMBI FWHM START") && cpl_propertylist_has(rhdr2,"ESO TEL AMBI FWHM END")){
            cpl_propertylist_update_double(qclist,"ESO QC FWHM AVG",cpl_propertylist_get_double(rhdr2,"ESO TEL AMBI FWHM END")); 
        }
    }
 
 
    cpl_propertylist_delete(rhdr1);
    cpl_propertylist_delete(rhdr2);
  }
  cpl_frameset_delete(fraws);
 
  return cpl_error_get_code();
}
 
cpl_error_code get_chromatic_eff(cpl_frame* eff,cpl_propertylist* qclist){
  if(eff != NULL){
    cpl_propertylist* ehdr = cpl_propertylist_load(cpl_frame_get_filename(eff),0);
    if(ehdr != NULL && cpl_propertylist_has(ehdr,"ESO QC EFF MED ORD 1") && cpl_propertylist_has(ehdr,"ESO QC EFF MED ORD 9")){
        double ord1 = cpl_propertylist_get_double(ehdr,"ESO QC EFF MED ORD 1");
        double ord9 = cpl_propertylist_get_double(ehdr,"ESO QC EFF MED ORD 9");
        if(ord1 != 0.0){
            cpl_propertylist_update_double(qclist,"ESO QC CHROMATIC EFF",ord9/ord1);
        }
    }
    cpl_propertylist_delete(ehdr);
  }
  return cpl_error_get_code();
}
 
cpl_error_code 
calc_curve_qc(cpl_image* im,xsh_instrument* instrument,cpl_propertylist* qclist)
{
    cpl_error_reset();
    //Check that the image loaded but don't quit if missing
    if(im != NULL){
        //x positions at which to fit gaussians across the spatial direction
        //default values are for UVB
        int xpos[2] = {2000,12000};
        double ypos[2];
        //consider 100 pix wide window 
        int wx =100;
        int dw = cpl_image_get_size_x(im);
        int dy = cpl_image_get_size_y(im);
 
        //using half the image width here is robust against any binning issues we may encounter
        double xcen = dw*0.5;
        //xcen = 6427
 
        if ( xsh_instrument_get_arm(instrument) == XSH_ARM_VIS){
            xpos[0] = 1000;
            xpos[1] = 22000;
            //xcen = 12159;
        }
        if ( xsh_instrument_get_arm(instrument) == XSH_ARM_NIR){
            xpos[0] = 3500;
            xpos[1] = 19000;
            //xcen = 12375;
        }
        /* populate ypos containing centroid positions of spatial dir trace */
        int llx, lly, urx, ury;
        cpl_error_code err = CPL_ERROR_NONE;
        for (int idx=0;idx < 2;idx++){
            llx = xpos[idx]-wx*0.5;
            urx = xpos[idx]+wx*0.5;
            
            //need to restrict these to the central trace; but need to account for restricted y range later...
            lly = (int)(dy*0.5-15);
            ury = (int)(dy*0.5+15);
 
            //ensure the median deals with cosmics and other bad pixels
            cpl_image* windowed = cpl_image_extract(im,llx,lly,urx,ury);
            cpl_image* wim = cpl_image_collapse_median_create(windowed,1,0,0);
            cpl_image_delete(windowed);
            
            double* wdata = cpl_image_get_data_double(wim);
            if(wdata == NULL){
                cpl_msg_info(cpl_func,"failed to load data from image window"); 
            }
 
            //make sure we work using the new image dimensions, rather than the full dy
            int wdata_dy = cpl_image_get_size_y(wim);
            //vectors containing the slit data
            cpl_vector* sx = cpl_vector_new(wdata_dy);
            cpl_vector* sy = cpl_vector_wrap(wdata_dy,wdata);
           
            for (int i=0;i<wdata_dy;i++){
                cpl_vector_set(sx,i,i);
            }
            double cenpos=0.5*wdata_dy;
            double sigma=0.0;
            double area=0.0;
            double offset=0.0;
            //cpl_msg_info(cpl_func,"sy[0] %e sy[1]: %e\n",cpl_vector_get(sy,0),cpl_vector_get(sy,1));
            err = cpl_vector_fit_gaussian(sx,NULL,sy,NULL,CPL_FIT_ALL,&cenpos,&sigma,&area,&offset,NULL,NULL,NULL);
            //cpl_msg_info(cpl_func,"fit %d: cenpos: %e err: %s\n",idx,cenpos+lly,cpl_error_get_message());
            //adding lly puts the cenpos back in the absolute y coord sys
            ypos[idx] = cenpos+lly;
            cpl_vector_delete(sx);
            cpl_vector_unwrap(sy);
            cpl_image_delete(wim);
            //cpl_free(wdata);
        }
        if(err == CPL_ERROR_NONE) { 
            //since we have only two points, we can exactly calculate the straight line
            double b = (ypos[1]-ypos[0])/(xpos[1]-xpos[0]);
            double a = ypos[0]-b*(xpos[0]-xcen);
            cpl_propertylist_update_double(qclist,"ESO QC CURVE 0",a);
            cpl_propertylist_update_double(qclist,"ESO QC CURVE 1",b);
            cpl_propertylist_update_double(qclist,"ESO QC CURVE X",xcen);
        }
    }
  cpl_error_reset();
  return cpl_error_get_code();
}
 
/* Functions needed by cpl_fit_lvmq */
static int qc_linfunc(const double x[], const double p[], double *f)
{
    //a + b*(x-x0)
    //p[0] == a
    //p[1] == b
    //p[2] == x0 (constant, not fit)
    *f = p[0] + p[1]*(x[0]-p[2]);
    return 0;
}
static int qc_dlinfunc(const double x[], const double p[], double f[])
{
    // d/da(qc_linfunc)
    f[0] = 1;
    // d/db(qc_linfunc)
    f[1] = x[0]-p[2];
    // d/dx0(qc_linfunc)
    f[2] = -p[1];
    return 0;
}
 
cpl_error_code 
calc_flat_slit_qc(cpl_image* im,int xa1, int xa2, cpl_propertylist* qclist)
{
    int dy = cpl_image_get_size_y(im);
    double chi_sq;
    int drop_ll = (dy*0.5)-10;
    int drop_ur = dy-((dy*0.5)+10);
    cpl_image* dup = cpl_image_duplicate(im);
    cpl_image* slit = cpl_image_collapse_median_create(dup,0,drop_ll,drop_ur);
 
    float * sdata = cpl_image_get_data_float(slit);
    int coord0 = (xa2-xa1)/2;
    int nvals = xa2-xa1;
    cpl_vector* sy = cpl_vector_new(nvals);
    cpl_vector* sye = cpl_vector_new(nvals);
    cpl_vector* sx = cpl_vector_new(nvals);   
 
    int count = 0;
    for (int i=xa1;i<xa2;i++){
        cpl_vector_set(sx,count,i);
        cpl_vector_set(sy,count,sdata[i]);
        //sye contains errors needed to compute covariance matrix 
        cpl_vector_set(sye,count,1.0);
        count = count + 1;
    }
    //Calculate the RMS using a copy of the slit y values
    cpl_vector* sycalc = cpl_vector_duplicate(sy);
    double mean = cpl_vector_get_mean(sycalc);
    cpl_vector_subtract_scalar(sycalc,mean);
    cpl_vector_multiply(sycalc,sycalc);
    double rms = sqrt(cpl_vector_get_mean(sycalc));
 
    cpl_propertylist_append_double(qclist,"ESO QC FLAT SLIT RMS",rms);
    
    cpl_matrix* coeff = cpl_matrix_new(nvals,1);
    for (int i=0;i<nvals;i++){
        cpl_matrix_set(coeff,i,0,cpl_vector_get(sx,i));
    }
 
    cpl_matrix* covar = cpl_matrix_new(3,3);
 
    //Variables for the fitting function. Initial guess for each.
    cpl_vector* guess = cpl_vector_new(3);
    cpl_vector_set(guess,0,0);
    cpl_vector_set(guess,1,0);
    cpl_vector_set(guess,2,coord0);
    //Only fit the first two and not coord0 (constant)
    int ia[3] = {1,1,0};
    cpl_error_code err= cpl_fit_lvmq(coeff,NULL,sy,sye,guess,ia,qc_linfunc,qc_dlinfunc,CPL_FIT_LVMQ_TOLERANCE,CPL_FIT_LVMQ_COUNT,CPL_FIT_LVMQ_MAXITER,NULL,&chi_sq,&covar);
    /*if(err == CPL_ERROR_NULL_INPUT){ cpl_msg_info(cpl_func,"CPL_ERROR_NULL_INPUT"); }
    if(err == CPL_ERROR_ILLEGAL_INPUT){ cpl_msg_info(cpl_func,"CPL_ERROR_ILLEGAL_INPUT"); }
    if(err == CPL_ERROR_INCOMPATIBLE_INPUT){ cpl_msg_info(cpl_func,"CPL_ERROR_INCOMPATIBLE_INPUT"); }
    if(err == CPL_ERROR_ILLEGAL_OUTPUT){ cpl_msg_info(cpl_func,"CPL_ERROR_ILLEGAL_OUTPUT"); }
    if(err == CPL_ERROR_CONTINUE){ cpl_msg_info(cpl_func,"CPL_ERROR_CONTINUE"); }
    if(err == CPL_ERROR_SINGULAR_MATRIX){ cpl_msg_info(cpl_func,"CPL_ERROR_SINGULAR_MATRIX"); }
    */
 
    /*convert the gradient error to that matching the output of scipy.optimization.curve_fit(absolute_sigma=False)
      N.B. the default covariance matrix returned from cpl_fit_lvmq gives results
           corresponding to scipy.optimization.curve_fit(absolute_sigma=True)
      The previous QC scripts were run with default absolute_sigma=False, so we use grad_err_other here
    */
    //double grad_err=sqrt(cpl_matrix_get(covar,1,1));
    double grad_err_other = sqrt(cpl_matrix_get(covar,1,1)* (chi_sq));
    double grad = cpl_vector_get(guess,1);
    //cpl_msg_info(cpl_func,"grad %e grad_err %e grad_err_other %e chi_sq %e\n",cpl_vector_get(guess,1),grad_err,grad_err_other,chi_sq);
    cpl_propertylist_append_double(qclist,"ESO QC FLAT SLIT B",grad);
    cpl_propertylist_append_double(qclist,"ESO QC FLAT SLIT DB",grad_err_other);
 
    cpl_image_delete(slit);
    
    cpl_error_reset();
    return cpl_error_get_code();
}
 
cpl_error_code 
calc_resp_qc(cpl_table* mtab, cpl_table* rtab,xsh_instrument* instrument, int lower,int upper,const char* label, cpl_propertylist* qclist)
{
    //cpl_msg_info(cpl_func,"Calling calc_resp_qc");
    //mtab = master = response generated by the recipe
    cpl_table* mtab2 = cpl_table_duplicate(mtab); 
    cpl_table_new_column(mtab2,"SIGMA",CPL_TYPE_DOUBLE);
    cpl_size mrows = cpl_table_get_nrow(mtab2); 
    //cpl_size mrows = cpl_table_get_nrow(mtab);
    //rtab = ref = response that we are comparing against (optional in the SOF)
    cpl_size rrows = cpl_table_get_nrow(rtab);
 
 
    if(mrows != rrows){
        return CPL_ERROR_NONE;
    }
    //a vector to note which data not to fit (i.e. set to very large values) 
    //cpl_vector* sigma = cpl_vector_new(mrows); 
 
    float* tmplam = cpl_table_get_data_float(mtab2,"LAMBDA");
 
    cpl_table_select_all(mtab2);
    cpl_table_select_all(rtab);
 
    //need to select the rows that we want to deal with
    //once that is done, we can do the fitting
    for(int i=0;i<mrows;i++){
        cpl_table_set_double(mtab2,"SIGMA",i,1.0);
        //cpl_vector_set(sigma,i,1.0);
        if (xsh_instrument_get_arm(instrument) == XSH_ARM_UVB) {
            if(i < lower || i > upper ){
                cpl_table_set_double(mtab2,"SIGMA",i,1e20);
                cpl_table_unselect_row(mtab2,i);
                cpl_table_unselect_row(rtab,i);
            }
            //D2 CALCS
            /*if(i < 408 || i > 4074){
                cpl_table_set_double(mtab2,"SIGMA",i,1e20);
                cpl_table_unselect_row(mtab2,i);
                cpl_table_unselect_row(rtab,i);
            }*/
            //QTH CALCS
            /*if(i < 4741 || i > 13408){
                cpl_table_set_double(mtab2,"SIGMA",i,1e20);
                cpl_table_unselect_row(mtab2,i);
                cpl_table_unselect_row(rtab,i);
            }*/
        }
        if (xsh_instrument_get_arm(instrument) == XSH_ARM_VIS) {
            if(i < 1765){
                cpl_table_set_double(mtab2,"SIGMA",i,1e20);
                //cpl_vector_set(sigma,i,1e20);
                cpl_table_unselect_row(mtab2,i);
                cpl_table_unselect_row(rtab,i);
            }
        }
        if (xsh_instrument_get_arm(instrument) == XSH_ARM_NIR) {
            if( (tmplam[i] > 1350 && tmplam[i] < 1480) || (tmplam[i] > 1770 && tmplam[i] < 2080)){
                //cpl_vector_set(sigma,i,1e20);
                cpl_table_set_double(mtab2,"SIGMA",i,1e20);
                //since the above ranges fall within the spectrum, no need to remove entirely
                //just set sigma to be very high
                //cpl_table_unselect_row(mtab2,i);
                //cpl_table_unselect_row(rtab,i);
            }
        }
    }
    mtab2 = cpl_table_extract_selected(mtab2);
    rtab = cpl_table_extract_selected(rtab);
    //update mrows 
    mrows = cpl_table_get_nrow(mtab2);
 
    float* mlam = cpl_table_get_data_float(mtab2,"LAMBDA");
    double* msigma = cpl_table_get_data_double(mtab2,"SIGMA");
    float* rlam = cpl_table_get_data_float(rtab,"LAMBDA");
    float* mresp = cpl_table_get_data_float(mtab2,"RESPONSE");
    float* rresp = cpl_table_get_data_float(rtab,"RESPONSE");
    /*Now extract the actual values we want to fit from the tables */
 
    cpl_vector* vm_lam = cpl_vector_new(mrows);
    cpl_vector* vr_lam = cpl_vector_new(mrows);
    cpl_vector* vm_resp= cpl_vector_new(mrows);
    cpl_vector* vr_resp= cpl_vector_new(mrows);
    cpl_vector* sigma = cpl_vector_new(mrows);
 
    cpl_vector* cr = cpl_vector_new(mrows); 
    for(int i=0;i<mrows;i++){
        cpl_vector_set(vm_lam,i,mlam[i]);
        cpl_vector_set(sigma,i,msigma[i]);
        cpl_vector_set(vr_lam,i,rlam[i]);
        cpl_vector_set(vm_resp,i,mresp[i]);
        cpl_vector_set(vr_resp,i,rresp[i]);
        cpl_vector_set(cr,i,1.0);
        if(cpl_vector_get(cr,i) > 0 && cpl_vector_get(vr_resp,i) > 0){
            cpl_vector_set(cr,i,cpl_vector_get(vm_resp,i)/cpl_vector_get(vr_resp,i));
        } else {
            if(i >= 1){
                cpl_vector_set(cr,i,cpl_vector_get(cr,i-1));
            }
            cpl_vector_set(sigma,i,1e20);
        }
    }
    //value for constant in fit
    double lam0 = cpl_vector_get(vm_lam,(int)(mrows*0.5));
    cpl_msg_info(cpl_func,"lam0: %e\n",lam0);
 
    //setup the data structures needed for the fitting...
    cpl_vector* guess = cpl_vector_new(3);
    cpl_vector_set(guess,0,0);
    cpl_vector_set(guess,1,0);
    cpl_vector_set(guess,2,lam0);
 
    cpl_matrix* covar = cpl_matrix_new(3,3);
    double chi_sq;
    
    //only fit first two params; third one (lam0) is constant
    int ia[3] = {1,1,0};
    
    cpl_matrix* coeff = cpl_matrix_new(mrows,1);
    for(int i=0;i<mrows;i++){
        cpl_matrix_set(coeff,i,0,cpl_vector_get(vm_lam,i));
    }
    //yvals = cr vector
    //yvals err = sigma vector
 
    cpl_error_code err= cpl_fit_lvmq(coeff,NULL,cr,sigma,guess,ia,qc_linfunc,qc_dlinfunc,CPL_FIT_LVMQ_TOLERANCE,CPL_FIT_LVMQ_COUNT,CPL_FIT_LVMQ_MAXITER,NULL,&chi_sq,&covar);
    double a = cpl_vector_get(guess,0);
    double b = cpl_vector_get(guess,1);
    double da= sqrt(cpl_matrix_get(covar,0,0)* (chi_sq));
    double db= sqrt(cpl_matrix_get(covar,1,1)* (chi_sq));
    
    if (xsh_instrument_get_arm(instrument) == XSH_ARM_UVB) {
        char* kw = NULL;
        kw = cpl_sprintf("ESO QC RESP SPEC A %s",label);
        cpl_propertylist_append_double(qclist,kw,a);
        kw = cpl_sprintf("ESO QC RESP SPEC B %s",label);
        cpl_propertylist_append_double(qclist,kw,b);
        kw = cpl_sprintf("ESO QC RESP SPEC DA %s",label);
        cpl_propertylist_append_double(qclist,kw,da);
        kw = cpl_sprintf("ESO QC RESP SPEC DB %s",label);
        cpl_propertylist_append_double(qclist,kw,db);
        cpl_free(kw);
    } else {
        cpl_propertylist_append_double(qclist,"ESO QC RESP SPEC A",a);
        cpl_propertylist_append_double(qclist,"ESO QC RESP SPEC B",b);
        cpl_propertylist_append_double(qclist,"ESO QC RESP SPEC DA",da);
        cpl_propertylist_append_double(qclist,"ESO QC RESP SPEC DB",db);
    }
    cpl_table_delete(mtab2);
    cpl_error_reset();
    return cpl_error_get_code();
}