/*                                                                              *
 *   This file is part of the ESO UVES Pipeline                                 *
 *   Copyright (C) 2004,2005 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-16 15:36:11 $
 * $Revision: 1.204 $
 * $Name: not supported by cvs2svn $
 */

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

/*---------------------------------------------------------------------------*/
/**
 * @defgroup uves_utils  Utility functions
 *
 * This module contains various functions that are shared between multiple recipes
 */
/*---------------------------------------------------------------------------*/

/*-----------------------------------------------------------------------------
                            Includes
 ----------------------------------------------------------------------------*/
#include <uves_utils.h>
#include <uves_utils_cpl.h>
#include <irplib_ksigma_clip.h>
/*
 * System Headers
 */
#include <errno.h>
#include <uves.h>
#include <uves_extract_profile.h>
#include <uves_plot.h>
#include <uves_dfs.h>
#include <uves_pfits.h>
#include <uves_utils_wrappers.h>
#include <uves_wavecal_utils.h>
#include <uves_msg.h>
#include <uves_dump.h>
#include <uves_error.h>

#include <irplib_utils.h>

#include <cpl.h>
#include <uves_time.h> /* iso time */

#include <ctype.h>  /* tolower */
#include <stdbool.h>
#include <float.h>

/*-----------------------------------------------------------------------------
                            Defines
 ----------------------------------------------------------------------------*/
// The following macros are used to provide a fast
// and readable way to convert C-indexes to FORTRAN-indexes.
#define C_TO_FORTRAN_INDEXING(a) &a[-1]
#define FORTRAN_TO_C_INDEXING(a) &a[1]

/**@{*/
/*-----------------------------------------------------------------------------
                            Functions prototypes
 ----------------------------------------------------------------------------*/


static cpl_error_code 
uves_cosrout(cpl_image* ima,
             cpl_image** msk,
             const double ron, 
             const double gain,
             const int ns,
             const double sky,
             const double rc,
             cpl_image** flt,
             cpl_image** out);

static cpl_image * 
uves_gen_lowpass(const int xs, 
                  const int ys, 
                  const double sigma_x, 
                  const double sigma_y);

static cpl_error_code 
uves_find_next(cpl_image** msk,
               const int first_y,
               int* next_x,
	       int* next_y);

static cpl_error_code
uves_sort(const int kmax,float* inp, int* ord);

/*-----------------------------------------------------------------------------
                            Implementation
 ----------------------------------------------------------------------------*/


/*---------------------------------------------------------------------------*/
/** 
 * @brief  Remove cosmic ray events on single ccd exposure and replace them by interpolation on neighbourhood pixels.
   @author P.Magain, M.Remy, Institut d'Astrophysique de Liege
           Ported to UVES pipe from MIDAS rcosmic.for
   @param  ima input image
   @param  flt median filter of input image
   @param  out output image
   @param  sky mean value of the sky background
   @param  ron Readout noise in ADU units.
   @param  gain Inverse gain factor (e-/ADU)
   @param  ns threshold for the detection of cosmic rays
   @param  nc critical ratio for discrimination of objects and cosmic rays
   @param  msk name of an optional frame containing the value 1 for cosmic
              rays and 0 for all other pixels
   @note   The detection threshold is in units of the theoretical noise
           sigma of each pixel; it's default value is 4. The default for
           `rc' is 2.

   @doc
         a) The algorithm works as follows:
         1. The input image is filtered in the following way:
         FILTER/MEDIAN inframe middumma 1,1,0.0 NA
         For Long-Slit spectra of extended sources, the algorithm may be
         more efficient if the median filter works only along the slit.
         2. The input image is compared with the filtered image. All pixels
         with an intensity I  greater than  Im+ns*sigma  are suspicious and
         may be cosmic rays (Im is the filtered intensity of a pixel and
         sigma is given by: sigma**2 = ron**2+I/gain).
         3. All suspicious pixels are grouped into sets of contiguous points.
         In each of these sets, the pixel with the maximum intensity Imax is
         selected. If (Imax-sky) is greater than rc*(Iaver-sky), Iaver being
         an average of the intensities of the first eight neighbours of that
         pixel, the whole set of points is considered as a cosmic ray event.
         4. The intensities of the pixels affected by cosmic rays are
         replaced by a median value calculated over the nearest neighbours of
         the group to which they belong.
         b) In many situations, rc is the most critical parameter and requires
         careful fine-tuning. If it is choosen too small, small sources such
         as stars may be affected. If rc is too large, the filter may not
         remove weak partical hits superimposed to reasonably well exposed
         extended sources.

 * @return newly allocated parametrlist or NULL on error
 */
/*---------------------------------------------------------------------------*/

cpl_error_code
uves_rcosmic(cpl_image* ima,
             cpl_image** flt,
             cpl_image** out,
             cpl_image** msk,
             const double sky,
             const double ron,
             const double gain,
             const int ns,
             const double rc)

{


/*


      PROGRAM RCOSMIC
      INTEGER*4 IAV,I
      INTEGER*4 STATUS,MADRID,SIZEX,IOMODE
      INTEGER*4 NAXIS,NPIX(2),IMNI,IMNO,IMNF,IMNC
      INTEGER*8 PNTRI,PNTRF,PNTRO,PNTRC
      INTEGER*4 KUN,KNUL
      CHARACTER*60 IMAGE,OBJET,COSMIC
      CHARACTER*72 IDENT1,IDENT2,IDENT3
      CHARACTER*48 CUNIT
      DOUBLE PRECISION START(2),STEP(2)
      REAL*4 SKY,GAIN,RON,NS,RC,PARAM(5),CUTS(2)
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      COMMON/VMR/MADRID(1)
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
      DATA IDENT1 /' '/
      DATA IDENT2 /' '/
      DATA IDENT3 /'cosmic ray mask '/
      DATA CUNIT /' '/
      CALL STSPRO('RCOSMIC')
      CALL STKRDC('IN_A',1,1,60,IAV,IMAGE,KUN,KNUL,STATUS)
      CALL STIGET(IMAGE,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
     1                2,NAXIS,NPIX,START,STEP
     1                ,IDENT1,CUNIT,PNTRI,IMNI,STATUS)

      CALL STKRDR('PARAMS',1,5,IAV,PARAM,KUN,KNUL,STATUS)
      CALL STIGET('middumma',D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
     1                2,NAXIS,NPIX,START,STEP
     1                ,IDENT2,CUNIT,PNTRF,IMNF,STATUS)
      SKY = PARAM(1)
      GAIN = PARAM(2)
      RON = PARAM(3)
      NS = PARAM(4)
      RC = PARAM(5)

*/


   check_nomsg(*flt=cpl_image_duplicate(ima));
   check_nomsg(uves_filter_image_median(flt,1,1,false));



/*

      CALL STKRDC('OUTIMA',1,1,60,IAV,OBJET,KUN,KNUL,STATUS)
      CALL STIPUT(OBJET,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
     1                 NAXIS,NPIX,START,STEP
     1                ,IDENT1,CUNIT,PNTRO,IMNO,STATUS)

      SIZEX = 1
      DO I=1,NAXIS
         SIZEX = SIZEX*NPIX(I)
      ENDDO
      CALL STKRDC('COSMIC',1,1,60,IAV,COSMIC,KUN,KNUL,STATUS)
      IF (COSMIC(1:1).EQ.'+') THEN
            COSMIC = 'dummy_frame'
            IOMODE = F_X_MODE
      ELSE
            IOMODE = F_O_MODE
      ENDIF    
      CALL STIPUT(COSMIC,D_I2_FORMAT,IOMODE,F_IMA_TYPE
     1                 ,NAXIS,NPIX,START,STEP
     1                ,IDENT3,CUNIT,PNTRC,IMNC,STATUS)
      CALL COSROUT(MADRID(PNTRI),MADRID(PNTRC),NPIX(1),NPIX(2),
     1             RON,GAIN,NS,SKY,RC
     1            ,MADRID(PNTRF),MADRID(PNTRO))

      CUTS(1) = 0
      CUTS(2) = 1
      IF (IOMODE.EQ.F_O_MODE) 
     + CALL STDWRR(IMNC,'LHCUTS',CUTS,1,2,KUN,STATUS)
      CALL DSCUPT(IMNI,IMNO,' ',STATUS) 
      CALL STSEPI
      END


*/

   check_nomsg(uves_cosrout(ima,msk,ron,gain,ns,sky,rc,flt,out));
  cleanup:
  return CPL_ERROR_NONE;
}


/*---------------------------------------------------------------------------*/
/** 
 * @brief  Perform kappa-sigma clip.
   @author C. Izzo
   @param  values values to be checked
   @param  klow   kappa to clip too low level values
   @param  khigh  kappa to clip too high values
   @param  kiter  number of iterations

   @note   In first iteration a median is the reference value for robustness

 * @return 
 */
/*---------------------------------------------------------------------------*/
static double 
uves_ksigma_vector(cpl_vector *values,double klow, double khigh, int kiter)
{
    cpl_vector *accepted;
    double  mean  = 0.0;
    double  sigma = 0.0;
    double *data  = cpl_vector_get_data(values);
    int     n     = cpl_vector_get_size(values);
    int     ngood = n;
    int     count = 0;
    int     i;
 
    /*
     * At first iteration the mean is taken as the median, and the
     * standard deviation relative to this value is computed.
     */

    check_nomsg(mean = cpl_vector_get_median(values));

    for (i = 0; i < n; i++) {
        sigma += (mean - data[i]) * (mean - data[i]);
    }
    sigma = sqrt(sigma / (n - 1));

    while (kiter) {
        count = 0;
        for (i = 0; i < ngood; i++) {
            if (data[i]-mean < khigh*sigma && mean-data[i] < klow*sigma) {
                data[count] = data[i];
                ++count;
            }
        }

        if (count == 0) // This cannot happen at first iteration.
            break;      // So we can break: we have already computed a mean.

        /*
         * The mean must be computed even if no element was rejected
         * (count == ngood), because at first iteration median instead
         * of mean was computed.
         */

        check_nomsg(accepted = cpl_vector_wrap(count, data));
        check_nomsg(mean = cpl_vector_get_mean(accepted));
        if(count>1) {
           check_nomsg(sigma = cpl_vector_get_stdev(accepted));
        }
        check_nomsg(cpl_vector_unwrap(accepted));

        if (count == ngood) {
            break;
        }
        ngood = count;
        --kiter;
    }
  cleanup:

    return mean;
}


/**
 * @brief
 *   Stack images using k-sigma clipping
 *
 * @param imlist      List of images to stack
 * @param klow        Number of sigmas for rejection of lowest values
 * @param khigh       Number of sigmas for rejection of highest values
 * @param kiter       Max number of iterations
 *
 * @return Stacked image.
 *
 * At the first iteration the value of sigma is computed relatively to
 * the median value of all pixels at a given image position. For the
 * next iterations the sigma is computed in the standard way. If
 * at some iteration all points would be rejected, the mean computed
 * at the previous iteration is returned.
 */

cpl_image *
uves_ksigma_stack(const cpl_imagelist *imlist, double klow, double khigh, int kiter)
{
    int         ni, nx, ny, npix;
    cpl_image  *out_ima=NULL;
    cpl_imagelist  *loc_iml=NULL;
    double      *pout_ima=NULL;
    cpl_image  *image=NULL;
    const double     **data=NULL;
    double     *med=NULL;
    cpl_vector *time_line=NULL;
  
    double     *ptime_line=NULL;
    int         i, j;
   double mean_of_medians=0;

    passure(imlist != NULL, "Null input imagelist!");

    ni         = cpl_imagelist_get_size(imlist);
    loc_iml        = cpl_imagelist_duplicate(imlist);
    image      = cpl_imagelist_get(loc_iml, 0);
    nx         = cpl_image_get_size_x(image);
    ny         = cpl_image_get_size_y(image);
    npix       = nx * ny;

    out_ima    = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
    pout_ima   = cpl_image_get_data_double(out_ima);

    time_line  = cpl_vector_new(ni);
   
    ptime_line = cpl_vector_get_data(time_line);

    data = cpl_calloc(sizeof(double *), ni);
    med  = cpl_calloc(sizeof(double), ni);

    for (i = 0; i < ni; i++) {
        image = cpl_imagelist_get(loc_iml, i);
        med[i]=cpl_image_get_median(image);
        cpl_image_subtract_scalar(image,med[i]);
        data[i] = cpl_image_get_data_double(image);
        mean_of_medians+=med[i];
    }
    mean_of_medians/=ni;

    for (i = 0; i < npix; i++) {
        for (j = 0; j < ni; j++) {
             ptime_line[j] = data[j][i];
         }
        check_nomsg(pout_ima[i] = uves_ksigma_vector(time_line, klow, khigh, kiter)); 
    }
 
    cpl_image_add_scalar(out_ima,mean_of_medians);

  cleanup:
    cpl_free(data);
    cpl_free(med);
    cpl_vector_delete(time_line);
    uves_free_imagelist(&loc_iml);

    return out_ima;

} 



/**
 * @brief
 *   Generates wave map
 * @param ima_sci (to get dimensions)
 * @param context recipe context
 * @param parameters input params
 * @param ordertable order table
 * @param linetable  line table
 * @param order_locations order traces polynomial description
 * @param dispersion_relation wavelength solution
 * @param first_abs_order min abs order 
 * @param last_abs_order  max abs order
 * @param slit_size  slit size in pixels
 * @param flats             List of flats to stack
 * @param ordertable        Input order table
 * @param order_locations   polynomial description of order locations
 *
 * @return wavemap image (that need to be deallocated from caller)
 * @doc Generates an image that at each point has an intensity equal to
 * the corresponding pixels
 * for each order
 *     for each x
 *         with y position on the order trace
 *         determines the wavelength corresponding to (x,y,m)  
 *         and set it to the corresponding map(x,y,m) pixel.
 *         We assume that point at the same x,m have same waveleng for each
 *         y along the extraction slit.
 *     endfor
 *  endfor
 *
 */
cpl_image *
uves_get_wave_map(
                  cpl_image * ima_sci,
		  const char *context,
                  const cpl_parameterlist *parameters,
		  const cpl_table *ordertable,
		  const cpl_table *linetable,
		  const polynomial* order_locations,
		  const polynomial *dispersion_relation,
		  const int first_abs_order,
		  const int last_abs_order,
		  const int slit_size)
{

  cpl_image* wave_map=NULL;
  double* pwmap=NULL;
  int ord_min=0;
  int ord_max=0;
  int i=0;
  int j=0;
  double xpos=0;
  double ypos=0;
  double wlen=0;
  
  int nx=0;
  int ny=0;
  int aord=0;
  int order=0;
  int jj=0;
  int norders=0;
  int hs=0;

  uves_msg("Creating wave map");
  /* set half slit size */
  hs=slit_size/2;

  /* get wave map size */ 
  nx = cpl_image_get_size_x(ima_sci);
  ny = cpl_image_get_size_y(ima_sci);
     
  /* get ord min-max */
  ord_min=cpl_table_get_column_min(ordertable,"Order");
  ord_max=cpl_table_get_column_max(ordertable,"Order");
  norders=ord_max-ord_min+1;

  check_nomsg(wave_map=cpl_image_new(nx,ny,CPL_TYPE_DOUBLE));
  pwmap=cpl_image_get_data_double(wave_map);

  for (order = 1; order <= norders; order++){
    /* wave solution need absolute order value */
    aord = uves_absolute_order(first_abs_order, last_abs_order, order);
    for (i=0;i<nx;i++) {
      xpos=(double)i;
      wlen=uves_polynomial_evaluate_2d(dispersion_relation,xpos,aord)/aord;
      ypos=uves_polynomial_evaluate_2d(order_locations,xpos,order);
      for (jj=-hs;jj<hs;jj++) {
	j=(int)(ypos+jj+0.5);
        /* check the point is on the detector */
	if( (j>0) && ( (j*nx+i)<nx*ny) ) {
	  pwmap[j*nx+i]=wlen;
	}
      }
    }
  }

  /*
  check_nomsg(cpl_image_save(wave_map,"wmap.fits",CPL_BPP_IEEE_FLOAT,NULL,
			     CPL_IO_DEFAULT));
  */
 cleanup:
  return wave_map;
}







/**
 * @brief
 *   Stack images using k-sigma clipping
 *
 * @param flats             List of flats to stack
 * @param ordertable        Input order table
 * @param order_locations   polynomial description of order locations
 *
 * @return Stacked image.
 *
 * The input list of flats is analized to compute
 * for each flat
 *     for each order
 *         The median flux on a number of windows of given X * Y size.
 *         The mean flux  of the values computed on each order is computed.
 *     endfor
 *     Finally the mean flux of all means is computed.
 *     The flat is normalized by the computed mean
 *  endfor
 */
cpl_image *
uves_flat_create_normalized_master2(cpl_imagelist * flats,
                                    const cpl_table *ordertable,
                                    const polynomial* order_locations,
                                    const cpl_image* mflat)
{

   cpl_imagelist* flats_norm=NULL;

   cpl_image* master_flat=NULL;
   /* cpl_image* img=NULL; */
   cpl_image* flat=NULL;
   cpl_image* flat_mflat=NULL;

   cpl_vector* vec_flux=NULL;
   double* pvec_flux=NULL;

   int ni=0;
   int i=0;
   int sx=0;
   int sy=0;
   int ord_min=0;
   int ord_max=0;
   int nord=0;
   int nsam=10;
   int x_space=10;
   int llx=0;
   int lly=0;
   int urx=0;
   int ury=0;
   int hbox_sx=0;
   int hbox_sy=0;
   int ord=0;
   int absord=0;
   int pos_x=0;
   int pos_y=0;
   double x=0;
   double y=0;
   double flux_median=0;
   double mean_explevel=0;
   /* double exptime=0; */
   int is=0;
   int k=0;

   ni=cpl_imagelist_get_size(flats);
   
   /* evaluate medain on many windows distribuited all over orders of flats */
   sx         = cpl_image_get_size_x(mflat);
   sy         = cpl_image_get_size_y(mflat);


   ord_min=cpl_table_get_column_min(ordertable,"Order");
   ord_max=cpl_table_get_column_max(ordertable,"Order");
   nord=ord_max-ord_min+1;

   hbox_sx=(int)((sx-2*x_space)/(2*nsam)+0.5);
   flats_norm=cpl_imagelist_new();
   for(i=0;i<ni;i++) {
   uves_free_vector(&vec_flux);
   vec_flux=cpl_vector_new(nord*nsam);
   pvec_flux=cpl_vector_get_data(vec_flux);
     uves_free_image(&flat_mflat);
     uves_free_image(&flat);
      check_nomsg(flat = cpl_image_duplicate(cpl_imagelist_get(flats, i)));
      /* normalize flats by master flat */
      flat_mflat=cpl_image_duplicate(flat);
      cpl_image_divide(flat_mflat,mflat);
      
      k=0;
      for(ord=0;ord<nord;ord++) {
         absord=ord+ord_min;
         pos_x=-hbox_sx;
         for(is=0;is<nsam;is++) {
            pos_x+=(2*hbox_sx+x_space);
            x=(int)(pos_x+0.5);

            check_nomsg(y=uves_polynomial_evaluate_2d(order_locations, 
                                                      x, absord));
            pos_y=(int)(y+0.5);

            check_nomsg(llx=uves_max_int(pos_x-hbox_sx,1));
            check_nomsg(lly=uves_max_int(pos_y-hbox_sy,1));
            check_nomsg(llx=uves_min_int(llx,sx));
            check_nomsg(lly=uves_min_int(lly,sy));

            check_nomsg(urx=uves_min_int(pos_x+hbox_sx,sx));
            check_nomsg(ury=uves_min_int(pos_y+hbox_sy,sy));
            check_nomsg(urx=uves_max_int(urx,1));
            check_nomsg(ury=uves_max_int(ury,1));

            check_nomsg(llx=uves_min_int(llx,urx));
            check_nomsg(lly=uves_min_int(lly,ury));

	    check_nomsg(pvec_flux[k]=0);

            check_nomsg(pvec_flux[k]=cpl_image_get_median_window(flat_mflat,llx,lly,urx,ury));

            k++;
         }

      }

      flux_median=cpl_vector_get_median(vec_flux);
      uves_msg("Flat %d normalize factor iter2: %g",i,flux_median);
      cpl_image_divide_scalar(flat,flux_median);
      cpl_imagelist_set(flats_norm,cpl_image_duplicate(flat),i);
      mean_explevel+=flux_median;
   }
   mean_explevel/=ni;
   
   check_nomsg(cpl_imagelist_multiply_scalar(flats_norm,mean_explevel));

   check( master_flat = cpl_imagelist_collapse_median_create(flats_norm),
          "Error computing median");




  cleanup:

   uves_free_imagelist(&flats_norm);
   uves_free_vector(&vec_flux);
   uves_free_image(&flat_mflat);
   uves_free_image(&flat);
   uves_check_rec_status(0);
   return master_flat;

}


/**
 * @brief
 *   Stack images using k-sigma clipping
 *
 * @param flats             List of flats to stack
 * @param ordertable        Input order table
 * @param order_locations   polynomial description of order locations
 *
 * @return Stacked image.
 *
 * The input list of flats is analized to compute
 * for each flat
 *     for each order
 *         The median flux on a number of windows of given X * Y size.
 *         The mean flux  of the values computed on each order is computed.
 *     endfor
 *     Finally the mean flux of all means is computed.
 *     The flat is normalized by the computed mean
 *  endfor
 */

cpl_image *
uves_flat_create_normalized_master(cpl_imagelist * flats,
                                   const cpl_table *ordertable,
                                   const polynomial* order_locations,
				   const cpl_vector* gain_vals ,
				   double* fnoise)
{
   int         ni;
   cpl_image  *image=NULL;
   cpl_image* master_flat=NULL;
   cpl_imagelist* flats_norm=NULL;
   int   k=0;
   int ord_min=0;
   int ord_max=0;
   int nord=0;
   double flux_mean=0;
   int nsam=10;
   int x_space=10;
   int hbox_sx=0;
   int hbox_sy=10;
   int is=0;
   int pos_x=0;
   int pos_y=0;
   int llx=0;
   int lly=0;
   int urx=0;
   int ury=0;

   double x=0;
   double y=0;
   int sx=0;
   int sy=0;
   cpl_vector* vec_flux_ord=NULL;
   cpl_vector* vec_flux_sam=NULL;
   double* pvec_flux_ord=NULL;
   double* pvec_flux_sam=NULL;
   int absord=0;
   int ord=0;
   const double* pgain_vals=NULL;
   double fnoise_local=0;

   passure(flats != NULL, "Null input flats imagelist!");
   passure(order_locations != NULL, "Null input order locations polinomial!");

   ni         = cpl_imagelist_get_size(flats);

   image      = cpl_image_duplicate(cpl_imagelist_get(flats, 0));
   sx         = cpl_image_get_size_x(image);
   sy         = cpl_image_get_size_y(image);

   uves_free_image(&image);
   ord_min=cpl_table_get_column_min(ordertable,"Order");
   ord_max=cpl_table_get_column_max(ordertable,"Order");
   nord=ord_max-ord_min+1;
   vec_flux_ord=cpl_vector_new(nord);
   vec_flux_sam=cpl_vector_new(nsam);
   pvec_flux_ord=cpl_vector_get_data(vec_flux_ord);
   pvec_flux_sam=cpl_vector_get_data(vec_flux_sam);
   hbox_sx=(int)((sx-2*x_space)/(2*nsam)+0.5);
   flats_norm=cpl_imagelist_new();
   pgain_vals=cpl_vector_get_data_const(gain_vals);

   for(k=0;k<ni;k++) {
      uves_free_image(&image);
      image = cpl_image_duplicate(cpl_imagelist_get(flats, k));
      for(ord=0;ord<nord;ord++) {
         absord=ord+ord_min;
         pos_x=-hbox_sx;
         for(is=0;is<nsam;is++) {
            pos_x+=(2*hbox_sx+x_space);
            x=(int)(pos_x+0.5);

            check_nomsg(y=uves_polynomial_evaluate_2d(order_locations, 
                                                      x, absord));
            pos_y=(int)(y+0.5);

            llx=uves_max_int(pos_x-hbox_sx,1);
            lly=uves_max_int(pos_y-hbox_sy,1);
            llx=uves_min_int(llx,sx);
            lly=uves_min_int(lly,sy);

            urx=uves_min_int(pos_x+hbox_sx,sx);
            ury=uves_min_int(pos_y+hbox_sy,sy);
            urx=uves_max_int(urx,1);
            ury=uves_max_int(ury,1);

            llx=uves_min_int(llx,urx);
            lly=uves_min_int(lly,ury);

            check_nomsg(pvec_flux_sam[is]=cpl_image_get_median_window(image,llx,lly,urx,ury));

         }
         pvec_flux_ord[ord]=cpl_vector_get_mean(vec_flux_sam);
      }

      flux_mean=cpl_vector_get_mean(vec_flux_ord);
      uves_msg("Flat %d normalize factor inter1: %g",k,flux_mean);
      fnoise_local+=pgain_vals[k]*flux_mean;
      cpl_image_divide_scalar(image,flux_mean);
      cpl_imagelist_set(flats_norm,cpl_image_duplicate(image),k);
   }
   *fnoise=1./sqrt(fnoise_local);
   check( master_flat = cpl_imagelist_collapse_median_create(flats_norm),
          "Error computing median");
 
   uves_msg("FNOISE %g ",*fnoise);
  cleanup:

   uves_free_vector(&vec_flux_ord);
   uves_free_vector(&vec_flux_sam);
   uves_free_image(&image);
   uves_free_imagelist(&flats_norm);


   return master_flat;

}

/*---------------------------------------------------------------------------*/
/** 
 * @brief  Remove cosmic ray events on single ccd exposure and replace them by interpolation on neighbourhood pixels.
   @author P.Magain, M.Remy, Institut d'Astrophysique de Liege
           Ported to UVES pipe from MIDAS rcosmic.for
   @param  ima input image
   @param  flt median filter of input image
   @param  out output image
   @param  bkg mean value of the background
   @param  ron Readout noise in ADU units.
   @param  gain Inverse gain factor (e-/ADU)
   @param  ns threshold for the detection of cosmic rays
   @param  nc critical ratio for discrimination of objects and cosmic rays
   @param  msk name of an optional frame containing the value 1 for cosmic
              rays and 0 for all other pixels
   @note   The detection threshold is in units of the theoretical noise
           sigma of each pixel; it's default value is 4. The default for
           `rc' is 2.

   @doc


 * @return 
 */
/*---------------------------------------------------------------------------*/

static cpl_error_code 
uves_cosrout(cpl_image* ima,
             cpl_image** msk,
             const double ron, 
             const double gain,
             const int ns,
             const double sky,
             const double rc,
             cpl_image** flt,
             cpl_image** out)
{


/*

      SUBROUTINE COSROUT(AI,COSMIC,I_IMA,J_IMA,RON,GAIN,
     1                   NS,SKY,RC,AM,AO)
      INTEGER I_IMA,J_IMA,NUM
      INTEGER ORD(10000)
      INTEGER K,L
      INTEGER IDUMAX,JDUMAX,I1,I2,J1,II,JJ
      INTEGER I,J,IMAX,JMAX,IMIN,JMIN
      INTEGER FIRST(2),NEXT(2)
      INTEGER*2 COSMIC(I_IMA,J_IMA)
      REAL*4 VECTEUR(10000),FMAX,ASUM,RC
      REAL*4 AI(I_IMA,J_IMA),AO(I_IMA,J_IMA),AM(I_IMA,J_IMA)
      REAL*4 SIGMA,SKY,S1,S2
      REAL*4 RON,GAIN,NS,AMEDIAN

*/

  int sx=0;
  int sy=0;
  int i=0;
  int j=0;
  int k=1;
  int pix=0;
  int first[2];
  int next_x=0;
  int next_y=0;
  int i_min=0;
  int i_max=0;
  int j_min=0;
  int j_max=0;
  int idu_max=0;
  int jdu_max=0;
  int i1=0;
  int i2=0;
  int ii=0;
  int jj=0;
  int j1=0;
  int num=0;
  int l=0;
  int nmax=1e6;
  int ord[nmax];


  float* pi=NULL;
  float* po=NULL;
  float* pf=NULL;
  int* pm=NULL;
  float sigma=0;


  float vec[nmax];

  double f_max=0;
  double s1=0;
  double s2=0;
  double asum=0;
  double a_median=0;

  uves_msg_warning("sky=%g gain=%g ron=%g ns=%d rc=%g",sky,gain,ron,ns,rc);
  check_nomsg(sx=cpl_image_get_size_x(ima));
  check_nomsg(sy=cpl_image_get_size_y(ima));
  check_nomsg(pi=cpl_image_get_data_float(ima));
  //*flt=cpl_image_new(sx,sy,CPL_TYPE_FLOAT);
  *msk=cpl_image_new(sx,sy,CPL_TYPE_INT);

  check_nomsg(pf=cpl_image_get_data_float(*flt));
  check_nomsg(pm=cpl_image_get_data_int(*msk));

  check_nomsg(*out=cpl_image_duplicate(ima));
  check_nomsg(po=cpl_image_get_data_float(*out));

/*

      DO 10 J=1,J_IMA
      DO 5 I=1,I_IMA
      AO(I,J)=AI(I,J)
      COSMIC(I,J)= 0
    5 CONTINUE
   10 CONTINUE

C
C     La boucle suivante selectionne les pixels qui sont
C     significativ+ement au dessus de l'image filtree medianement.
C
C    The flowing loop selects the pixels that are much higher that the 
C    median filter image
C
C     COSMIC =-1 ----> candidate for cosmic
C            = 0 ----> not a cosmic
C            = 1 -----> a cosmic (at the end)
C            = 2 ----> member of the group
C            = 3 ----> member of a group which has been examined
C            = 4 ----> neighbourhood  of the group
      K=1
      DO 80 J=2,J_IMA-1
      DO 70 I=2,I_IMA-1
      SIGMA=SQRT(RON**2+AM(I,J)/GAIN)
      IF ((AI(I,J)-AM(I,J)).GE.(NS*SIGMA)) THEN
            COSMIC(I,J) = -1
            K = K+1
      ENDIF
   70 CONTINUE
   80 CONTINUE


*/


  uves_msg_warning("Set all pix to = -1 -> candidate for cosmic");
  k=1;
  for(j=1;j<sy-1;j++) {
    for(i=1;i<sx-1;i++) {
      pix=j*sx+i;
      sigma=sqrt(ron*ron+pf[pix]/gain);
      if ( (pi[pix]-pf[pix]) >= (ns*sigma) ) {
	pm[pix]=-1;
        k++;
      }
    }
  }


  /*

     La boucle suivante selectionne les pixels qui sont
     significativement au dessus de l'image filtree medianement.

     The flowing loop selects the pixels that are much higher that the 
     median filter image


     COSMIC =-1 ----> candidate for cosmic
            = 0 ----> not a cosmic
            = 1 -----> a cosmic (at the end)
            = 2 ----> member of the group
            = 3 ----> member of a group which has been examined
            = 4 ----> neighbourhood  of the group

  */


/*
  Ces pixels sont regroupes par ensembles connexes dans la boucle
  This pixels are gouped as grouped together if neibours
*/

  first[0]=1;
  first[1]=1;

 lab100:
  check_nomsg(uves_find_next(msk,first[1],&next_x, &next_y));

  if(next_x==-1) return CPL_ERROR_NONE;
  i=next_x;
  j=next_y;

  uves_msg_debug("p[%d,%d]=  2 -> member of the group",i,j);
  pix=j*sx+i;
  pm[pix]=2;

  i_min=i;
  i_max=i;
  j_min=j;
  j_max=j;
  idu_max=i;
  jdu_max=j;
  f_max=pi[pix];

 lab110:
  i1=0;
  i2=0;



/*
      FIRST(1) = 2
      FIRST(2) = 2
  100 CALL FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
      IF (NEXT(1).EQ.-1) RETURN
      I = NEXT(1)
      J = NEXT(2) 
      COSMIC(I,J) = 2
      IMIN = I
      IMAX = I 
      JMIN = J
      JMAX = J
      IDUMAX = I
      JDUMAX = J
      FMAX = AI(I,J)
  110 I1 = 0
      I2 = 0
      CONTINUE

*/

  for(l=0;l<2;l++) {
    for(k=0;k<2;k++) {
      ii=i+k-l;
      jj=j+k+l-3;
      pix=jj*sx+ii;
      if(pm[pix]==-1) {
	i1=ii;
	j1=jj;
	i_min=(i_min<ii) ? i_min: ii;
	i_max=(i_max>ii) ? i_max: ii;
	j_min=(j_min<jj) ? j_min: jj;
	j_max=(j_max>jj) ? j_max: jj;
        uves_msg_debug("p[%d,%d]= 2 -> member of the group",ii,jj);
	pm[pix]=2;
	if(pi[pix]>f_max) {
	  f_max=pi[pix];
	  idu_max=ii;
	  idu_max=jj;
	}
      } else if(pm[pix]==0) {
	pm[pix]=4;
        uves_msg_debug("p[%d,%d]= 4 -> neighbourhood  of the group",k,l);
      }
    }
  }


/*
      DO 125 L=1,2
          DO 115 K=1,2
               II = I+K-L
               JJ = J+K+L-3
               IF (COSMIC(II,JJ).EQ.-1) THEN
                   I1 = II
                   J1 = JJ  
                   IMIN = MIN(IMIN,II) 
                   IMAX = MAX(IMAX,II)
                   JMIN = MIN(JMIN,JJ)
                   JMAX = MAX(JMAX,JJ)
                   COSMIC(II,JJ) = 2
                   IF (AI(II,JJ).GT.FMAX) THEN
                         FMAX = AI(II,JJ)
                         IDUMAX = II
                         JDUMAX = JJ
                   ENDIF
                ELSE IF (COSMIC(II,JJ).EQ.0) THEN
                   COSMIC(II,JJ) = 4
                ENDIF
  115     CONTINUE 
  125 CONTINUE 

*/


  pix=j*sx+i;
  pm[pix]=3;
  uves_msg_debug("p[%d,%d]= 3 -> member of a group which has been examined",i,j);
  if(i1 != 0) {
    i=i1;
    j=j1;
    goto lab110;
  }


/*
      COSMIC(I,J) = 3
      IF (I1.NE.0) THEN
      I = I1
      J = J1
      GOTO 110
      ENDIF    
*/

  for(l=j_min;l<=j_max;l++){
    for(k=i_min;k<=i_max;k++){
      pix=l*sy+k;
      if(pm[pix] == 2) {
	i=k;
	j=l;
	goto lab110;
      }
    }
  }
  first[0] = next_x+1;
  first[1] = next_y; 


/*
      DO 140 L = JMIN,JMAX  
         DO 130 K = IMIN,IMAX
              IF (COSMIC(K,L).EQ.2) THEN
                 I = K
                 J = L
                 GOTO 110
              ENDIF
  130 CONTINUE
  140 CONTINUE   
      FIRST(1) = NEXT(1)+1
      FIRST(2) = NEXT(2) 

*/


  /*
  We start here the real work....
  1- decide if the pixel's group is a cosmic
  2-replace these values by another one
  */
  s1=pi[(jdu_max-1)*sx+idu_max-1]+
     pi[(jdu_max-1)*sx+idu_max+1]+
     pi[(jdu_max-1)*sx+idu_max]+
     pi[(jdu_max+1)*sx+idu_max];

  s2=pi[(jdu_max+1)*sy+idu_max-1]+
     pi[(jdu_max+1)*sy+idu_max+1]+
     pi[(jdu_max)*sy+idu_max-1]+
     pi[(jdu_max)*sy+idu_max+1];
  asum=(s1+s2)/8.-sky;


/*

C We start here the real work....
C 1- decide if the pixel's group is a cosmic
C 2-replace these values by another one
      
      S1 = AI(IDUMAX-1,JDUMAX-1) + 
     !     AI(IDUMAX+1,JDUMAX-1) +     
     !     AI(IDUMAX,JDUMAX-1)   +
     !     AI(IDUMAX,JDUMAX+1)

      S2 = AI(IDUMAX-1,JDUMAX+1) + 
     !     AI(IDUMAX+1,JDUMAX+1) +
     !     AI(IDUMAX-1,JDUMAX)   + 
     !     AI(IDUMAX+1,JDUMAX)
      ASUM = (S1+S2)/8.-SKY

*/

  if((f_max-sky) > rc*asum) {
    num=0;
    for( l = j_min-1; l <= j_max+1; l++) {
      for( k = i_min-1; k<= i_max+1;k++) {
	if(pm[l*sx+k]==4) {
	  vec[num]=pi[l*sx+k];
	  num++;
	}
      }
    }


/*

      IF ((FMAX-SKY).GT.RC*ASUM) THEN
         NUM = 1
         DO L = JMIN-1,JMAX+1
            DO K = IMIN-1,IMAX+1
               IF (COSMIC(K,L).EQ.4) THEN
                   VECTEUR(NUM) = AI(K,L)
                   NUM = NUM+1
               ENDIF    
            ENDDO
         ENDDO

*/

    uves_sort(num-1,vec,ord);
    a_median=vec[ord[(num-1)/2]];
    for(l = j_min-1; l <= j_max+1 ; l++){
      for(k = i_min-1 ; k <= i_max+1 ; k++){
	if(pm[l*sx+k] == 3) {
	   pm[l*sx+k]=1;
           uves_msg_debug("p[%d,%d]= 1 -> a cosmic (at the end)",k,l);

	   po[l*sx+k]=a_median;
	} else if (pm[l*sx+k] == 4) {
	   po[l*sx+k]=0;
	   po[l*sx+k]=a_median;//here we set to median instead than 0
	}
      }
    }


/*
         CALL SORT(NUM-1,VECTEUR,ORD)
         AMEDIAN = VECTEUR(ORD((NUM-1)/2))
         DO L = JMIN-1,JMAX+1
            DO K = IMIN-1,IMAX+1
               IF (COSMIC(K,L).EQ.3) THEN
                   COSMIC(K,L) = 1
                   AO(K,L) = AMEDIAN
               ELSE IF (COSMIC(K,L).EQ.4) THEN
                   COSMIC(K,L) = 0
               ENDIF
            ENDDO
         ENDDO
*/

  } else {
    for( l = j_min-1 ; l <= j_max+1 ; l++) {
      for( k = i_min-1 ; k <= i_max+1 ; k++) {
	if(pm[l*sx+k] != -1) {
           uves_msg_debug("p[%d,%d]= 0 -> not a cosmic",k,l);
	   pm[l*sx+k] = 0;
	}
      }
    }
  }


  if (next_x >0) goto lab100;


/*
      ELSE 
         DO L = JMIN-1,JMAX+1
            DO K = IMIN-1,IMAX+1
               IF (COSMIC(K,L).NE.-1) COSMIC(K,L) = 0
            ENDDO
          ENDDO
      ENDIF
        
      
 
      IF (NEXT(1).GT.0) GOTO 100
C
C
C
      RETURN
      END


*/


  cleanup:

  return CPL_ERROR_NONE;

}





static cpl_error_code 
uves_find_next(cpl_image** msk,
               const int first_y,
               int* next_x,
               int* next_y)
{
  int sx=cpl_image_get_size_x(*msk);
  int sy=cpl_image_get_size_y(*msk);
  int i=0;
  int j=0;
  int* pc=NULL;
  int pix=0;



  check_nomsg(pc=cpl_image_get_data_int(*msk));
  for(j=first_y;j<sy;j++) {
    for(i=1;i<sx;i++) {
      pix=j*sx+i;
      if(pc[pix]==-1) {
	*next_x=i;
	*next_y=j;
	return CPL_ERROR_NONE;
      }
    }
  }

  *next_x=-1;
  *next_y=-1;
  cleanup:
  return CPL_ERROR_NONE;

}

/*

      SUBROUTINE FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
      INTEGER I_IMA,J_IMA,FIRST(2),NEXT(2)
      INTEGER I,J
      INTEGER*2 COSMIC(I_IMA,J_IMA)
      DO J = FIRST(2), J_IMA
          DO I = 2, I_IMA
             IF (COSMIC(I,J).EQ.-1) THEN
                 NEXT(1) = I
                 NEXT(2) = J
                 RETURN
             ENDIF
          ENDDO
      ENDDO 
      NEXT(1) = -1
      NEXT(2) = -1
      RETURN
      END

*/


//Be carefull with F77 and C indexing
static cpl_error_code
uves_sort(const int kmax,float* inp, int* ord)
{
  int k=0;
  int j=0;
  int l=0;
  float f=0;
  int i_min=0;
  int i_max=0;
  int i=0;

  for(k=0;k<kmax;k++) {
    ord[k]=k;
  }

  if(inp[0]>inp[1]) {
    ord[0]=1;
    ord[1]=0;
  }

  for(j=2;j<kmax;j++) {
    f=inp[j];
    l=inp[j-1];

/*
      SUBROUTINE SORT(KMAX,INP,ORD)
      INTEGER KMAX,IMIN,IMAX,I,J,K,L
      INTEGER ORD(10000)
      REAL*4 INP(10000),F
      DO 4100 J=1,KMAX
      ORD(J)=J
 4100 CONTINUE
      IF (INP(1).GT.INP(2)) THEN 
             ORD(1)=2
             ORD(2)=1
      END IF
      DO 4400 J=3,KMAX
      F=INP(J)
      L=ORD(J-1)
*/

  if(inp[l]<=f) goto lab4400;
    l=ord[0];
    i_min=0;
    if(f<=inp[l]) goto lab4250;
    i_max=j-1;
  lab4200:
    i=(i_min+i_max)/2;
    l=ord[i];

/*
      IF (INP(L).LE.F) GO TO 4400
      L=ORD(1)
      IMIN=1
      IF (F.LE.INP(L)) GO TO 4250
      IMAX=J-1
 4200 I=(IMIN+IMAX)/2
      L=ORD(I)
*/

    if(inp[l]<f) {
      i_min=i;
    } else {
      i_max=i;
    }
    if(i_max>(i_min+1)) goto lab4200;
    i_min=i_max;
  lab4250:
    for(k=j-2;k>=i_min;k--) {
      ord[k+1]=ord[k];
    }
    ord[i_min]=j;
  lab4400:
    return CPL_ERROR_NONE;
  }
    return CPL_ERROR_NONE;
}

/*
      IF (INP(L).LT.F) THEN
              IMIN=I
              ELSE
              IMAX=I
      END IF
      IF (IMAX.GT.(IMIN+1)) GO TO 4200
      IMIN=IMAX
 4250 DO 4300 K=J-1,IMIN,-1
      ORD(K+1)=ORD(K)
 4300 CONTINUE
      ORD(IMIN)=J
 4400 CONTINUE
      RETURN
      END
*/

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

cpl_parameterlist* 
uves_parameterlist_duplicate(const cpl_parameterlist* pin){

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

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

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


const char*
uves_string_toupper(char* s)
{

    char *t = s;

    if( s == NULL) { 
       cpl_error_set(cpl_func,CPL_ERROR_NULL_INPUT); 
       return NULL;
    };
    while (*t) {
        *t = toupper(*t);
        t++;
    }

    return s;

}

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

const char*
uves_string_tolower(char* s)
{

    char *t = s;

    if( s == NULL) { 
       cpl_error_set(cpl_func,CPL_ERROR_NULL_INPUT); 
       return NULL;
    };
    while (*t) {
        *t = tolower(*t);
        t++;
    }

    return s;

}




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



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

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

        cpl_frameset_insert(subset, cpl_frame_duplicate(f));
    }

 cleanup:
    return subset;
}

/*----------------------------------------------------------------------------*/
/**
  @brief   Calculate x to the y'th
  @param   x
  @param   y   The exponent. May be positive or zero or negative.

  @note This function is (very much, on some platforms) faster
        than pow() from math.h when y is an integer

 */
/*----------------------------------------------------------------------------*/
double
uves_pow_int(double x, int y)
{
    double result = 1.0;

    /* Invariant is:   result * x ^ y   */
    

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






/*----------------------------------------------------------------------------*/
/**
   @brief    Get UVES library version number
   @param    major        (output) If non-null, the major version number
   @param    minor        (output) If non-null, the minor version number
   @param    micro        (output) If non-null, the micro version number
   @return   CPL_ERROR_NONE iff okay

*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_get_version(int *major, int *minor, int *micro)
{
    /* Macros are defined in config.h */
    if (major != NULL) *major = UVES_MAJOR_VERSION;
    if (minor != NULL) *minor = UVES_MINOR_VERSION;
    if (micro != NULL) *micro = UVES_MICRO_VERSION;

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
   @brief    Get UVES library binary version number
   @return   Binary version number

*/
/*----------------------------------------------------------------------------*/
int
uves_get_version_binary(void)
{
    return UVES_BINARY_VERSION;
}


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

   The function returns a pointer to the statically allocated license string.
   This string should not be modified using the returned pointer.
*/
/*----------------------------------------------------------------------------*/
const char *
uves_get_license(void)
{
    return
    "This file is part of the ESO UVES Instrument Pipeline\n"
    "Copyright (C) 2004,2005,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, 51 Franklin St, Fifth Floor, Boston, \n"
        "MA  02111-1307  USA" ;

    /* Note that long strings are unsupported in C89 */
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Check compile time and runtime library versions
   @return      CPL_ERROR_NONE iff OK

   The function returns error if CPL and QFITS version are not up to date.
   Running with versions older than required will cause subtle bugs.

   This function should be called from "make check" to verify an installation
*/
/*----------------------------------------------------------------------------*/
/* To change requirements, just edit these numbers */
#define REQ_CPL_MAJOR 3
#define REQ_CPL_MINOR 1
#define REQ_CPL_MICRO 0

#define REQ_QF_MAJOR 6
#define REQ_QF_MINOR 2
#define REQ_QF_MICRO 0

void
uves_check_version(void)
{
#ifdef CPL_VERSION_CODE
#if CPL_VERSION_CODE >= CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO)
    uves_msg_debug("Compile time CPL version code was %d "
                   "(version %d-%d-%d, code %d required)",
                   CPL_VERSION_CODE, REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO,
                   CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO));
#else
#error CPL version too old
#endif
#else  /* ifdef CPL_VERSION_CODE */
#error CPL_VERSION_CODE not defined. CPL version too old
#endif

    if (cpl_version_get_major() < REQ_CPL_MAJOR ||
    (cpl_version_get_major() == REQ_CPL_MAJOR && 
     (int) cpl_version_get_minor() < REQ_CPL_MINOR) || /* cast suppresses warning
                                                              about comparing unsigned < 0 */
    (cpl_version_get_major() == REQ_CPL_MAJOR &&
     cpl_version_get_minor() == REQ_CPL_MINOR && 
     (int) cpl_version_get_micro() < REQ_CPL_MICRO)
    )
    {
        uves_msg_warning("CPL version %s (%d.%d.%d) (detected) is not supported. "
                 "Please update to CPL version %d.%d.%d or later", 
                 cpl_version_get_version(),
                 cpl_version_get_major(),
                 cpl_version_get_minor(),
                 cpl_version_get_micro(),
                 REQ_CPL_MAJOR,
                 REQ_CPL_MINOR,
                 REQ_CPL_MICRO);
    }
    else
    {
        uves_msg_debug("Runtime CPL version %s (%d.%d.%d) detected (%d.%d.%d or later required)",
               cpl_version_get_version(),
               cpl_version_get_major(),
               cpl_version_get_minor(),
               cpl_version_get_micro(),
               REQ_CPL_MAJOR,
               REQ_CPL_MINOR,
               REQ_CPL_MICRO);
    }

    {
    const char *qfts_v = " ";
    char *suffix;
    
    long qfts_major;
    long qfts_minor;
    long qfts_micro;

    qfts_v = qfits_version();

    assure( qfts_v != NULL, CPL_ERROR_ILLEGAL_INPUT,
        "Error reading qfits version");

    /* Parse    "X.[...]" */
    qfts_major = strtol(qfts_v, &suffix, 10);
    assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
        CPL_ERROR_ILLEGAL_INPUT, 
        "Error parsing version string '%s'. "
        "Format 'X.Y.Z' expected", qfts_v);

    /* Parse    "Y.[...]" */
    qfts_minor = strtol(suffix+1, &suffix, 10);
    assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
        CPL_ERROR_ILLEGAL_INPUT,
        "Error parsing version string '%s'. "
        "Format 'X.Y.Z' expected", qfts_v);

    /* Parse    "Z" */
    qfts_micro = strtol(suffix+1, &suffix, 10);

    /* If qfits version is earlier than required ... */
    if (qfts_major < REQ_QF_MAJOR ||
        (qfts_major == REQ_QF_MAJOR && qfts_minor  < REQ_QF_MINOR) ||
        (qfts_major == REQ_QF_MAJOR && qfts_minor == REQ_QF_MINOR && 
         qfts_micro < REQ_QF_MICRO)
        )
        {
        uves_msg_warning("qfits version %s (detected) is not supported. "
                 "Please update to qfits version %d.%d.%d or later", 
                 qfts_v,
                 REQ_QF_MAJOR,
                 REQ_QF_MINOR,
                 REQ_QF_MICRO);
        }
    else
        {
        uves_msg_debug("qfits version %ld.%ld.%ld detected "
                   "(%d.%d.%d or later required)", 
                   qfts_major, qfts_minor, qfts_micro,
                   REQ_QF_MAJOR,
                   REQ_QF_MINOR,
                   REQ_QF_MICRO);
        }
    }
    
  cleanup:
    return;
}

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

   This function is called at the end of a recipe. The output frame set is 
   printed, and the number of warnings produced by the recipe (using uves_msg_warning())
   is summarized.
   See also @c uves_initialize().
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_end(const char *recipe_id, const cpl_frameset *frames)
{
    cpl_frameset *products = NULL;
    const cpl_frame *f;
    int warnings = uves_msg_get_warnings();

    recipe_id = recipe_id; /* Suppress warning about unused variable,
                  perhaps we the recipe_id later, so
                  keep it in the interface. */


    /* Print (only) output frames */

    products = cpl_frameset_new();
    assure_mem( products );

    for (f = cpl_frameset_get_first_const(frames);
     f != NULL;
     f = cpl_frameset_get_next_const(frames))
    {
        if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
        {
            check_nomsg(
            cpl_frameset_insert(products, cpl_frame_duplicate(f)));
        }
    }

/* Don't do this. EsoRex should.
   uves_msg_low("Output frames");
   check( uves_print_cpl_frameset(products),
   "Could not print output frames");
*/

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

  cleanup:
    uves_free_frameset(&products);
    return cpl_error_get_code();    
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Recipe initialization
   @param  frames         The input frame set
   @param  parlist        The input parameter list
   @param  recipe_id      Name of the recipe, e.g. @em uves_mbias
   @param  short_descr    A short description of what the recipe does
   @param  frames         The input frame set
   @return  current time in ISO 8601 format

   This function takes care of all the mandatory tasks that are common for every recipe
   before the beginning of the data reduction. This function
   - initializes error handling (by resetting the error state),
   - initializes messaging (thereby setting the severity level),
   - initializes plotting (by reading the plotting commands from the parameterlist
     and passing these to the plotting module),
   - makes sure that the CPL and qfits libraries are up to date,
     and prints a warning message if not,
   - defines the group of all input frames (see @c uves_dfs_set_groups()), and
   - prints the input frame set.
*/
/*----------------------------------------------------------------------------*/
char *
uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist, 
        const char *recipe_id, const char *short_descr)
{
    char *recipe_string = NULL;
    char *stars = NULL;     /* A string of stars */
    char *spaces1 = NULL;
    char *spaces2 = NULL;
    char *spaces3 = NULL;
    char *spaces4 = NULL;
    char *start_time = NULL;

    start_time = uves_sprintf("%s", uves_get_datetime_iso8601());

    check( uves_check_version(), "Library validation failed");

    /* Now read parameters and set specified message level */
    {
    const char *plotter_command;
    int msglevel;
    
    /* Read parameters using context = recipe_id */

        if (0) /* disabled */
            check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel", 
                                      CPL_TYPE_INT, &msglevel),
                   "Could not read parameter");
        else
            {
                msglevel = -1; /* max verbosity */
            }
    uves_msg_set_level(msglevel);
    check( uves_get_parameter(parlist, NULL, "uves", "plotter",
                  CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
    
    /* Initialize plotting */
    check( uves_plot_initialize(plotter_command), 
           "Could not initialize plotting");
    }    

    /* Print 
     *************************
     ***   PACAGE_STRING   ***
     *** Recipe: recipe_id ***
     *************************
     */
    recipe_string = uves_sprintf("Recipe: %s", recipe_id);
    {
    int field = uves_max_int(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(nspaces1 + 1, sizeof(char)); 
    spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
    spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char)); 
    spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
    for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
    for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
    for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
    for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';

    stars = cpl_calloc(nstars + 1, sizeof(char));
    for (i = 0; i < nstars; i++) stars[i] = '*';
    
    uves_msg("%s", stars);
    uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
    uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
    uves_msg("%s", stars);
    }

    uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);

    if (cpl_frameset_is_empty(frames)) {
        uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
                       "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
                       "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
                       "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
    }

    /* Set group (RAW/CALIB) of input frames */
    /* This is mandatory for the later call of 
       cpl_dfs_setup_product_header */
    check( uves_dfs_set_groups(frames), "Could not classify input frames");

    /* Print input frames */
    uves_msg_low("Input frames");
    check( uves_print_cpl_frameset(frames), "Could not print input frames" );

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


/*----------------------------------------------------------------------------*/
/**
   @brief    Optimally average images
   @param    image1      First image
   @param    noise1      Noise (one sigma) of first image
   @param    image2      Second image
   @param    noise2      Noise (one sigma) of second image
   @param    noise       (Output) Combined noise image. This may not be NULL.
   @return   The optimally combined image

   For each pixel the resultant flux is computed as 
   x =  (x1 / sigma_1^2 + x2 / sigma_2^2) 
      / ( 1 / sigma_1^2 +  1 / sigma_2^2)

   and the combined noise is

   1/sigma^2 = 1 / sigma_1^2 + 1 / sigma_2^2.

   Bad pixels are properly propagated (i.e. a resulting pixel is
   marked bad if both inputs are bad ; if only one input is good,
   this input is used as the output and the 'bad' input is ignored).

   @note If it turns out to be necessary, this function can be optimized
   by using 'image1_data[i]'
   rather than 'cpl_image_get(image1, x, y, &pis_rejected1)', i.e.
   avoid multiplication for each pixel

*/
/*----------------------------------------------------------------------------*/
cpl_image *
uves_average_images(const cpl_image *image1, const cpl_image *noise1,
            const cpl_image *image2, const cpl_image *noise2,
            cpl_image **noise)
{
    cpl_image *result = NULL;
    cpl_size nx, ny; 
    int x, y;

    /* Check input */
    assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
    assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
    assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
    assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
    assure( noise  != NULL, CPL_ERROR_NULL_INPUT, "Null image");

    assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
        "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
    assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
        "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
    
    nx = cpl_image_get_size_x(image1);
    ny = cpl_image_get_size_y(image1);

    assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT, 
        "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
        nx,   cpl_image_get_size_x(image2));
    assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT, 
        "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
        nx,   cpl_image_get_size_x(noise1));
    assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
        "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
        nx,   cpl_image_get_size_x(noise2));
    assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
        "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
        ny,   cpl_image_get_size_y(image2));
    assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
        "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
        ny,   cpl_image_get_size_y(noise1));
    assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
        "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
        ny,   cpl_image_get_size_y(noise2));
    
    result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
    *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);

    /* Do the calculation */
    for (y = 1; y <= ny; y++)
    {
        for (x = 1; x <= nx; x++)
        {
            double flux1, flux2;
            double sigma1, sigma2;
            int pis_rejected1, noise_rejected1;
            int pis_rejected2, noise_rejected2;

            flux1  = cpl_image_get(image1, x, y, &pis_rejected1);
            flux2  = cpl_image_get(image2, x, y, &pis_rejected2);
            sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
            sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);

            pis_rejected1 = pis_rejected1 || noise_rejected1;
            pis_rejected2 = pis_rejected2 || noise_rejected2;
            
            if (pis_rejected1 && pis_rejected2)
            {
                cpl_image_reject(result, x, y);
                cpl_image_reject(*noise, x, y);
            }
            else
            {
                /* At least one good pixel */

                double flux, sigma;
                
                if (pis_rejected1 && !pis_rejected2)
                {
                    flux = flux2;
                    sigma = sigma2;
                }
                else if (!pis_rejected1 && pis_rejected2)
                {
                    flux = flux1;
                    sigma = sigma1;
                }
                else
                {
                    /* Both pixels are good */
                    sigma =
                    1 / (sigma1*sigma1) +
                    1 / (sigma2*sigma2);
                    
                    flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
                    flux /= sigma;
                    
                    sigma = sqrt(sigma);
                }
                
                cpl_image_set(result, x, y, flux);
                cpl_image_set(*noise, x, y, sigma);
            }
        }
    }
    
  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE) 
    {
        uves_free_image(&result);
    }
    return result;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Initialize image header
   @param    ctype1   Value of CTYPE1 keyword
   @param    ctype2   Value of CTYPE2 keyword
   @param    bunit     Value of BUNIT keyword
   @param    crval1    Value of CRVAL1 keyword
   @param    crval2    Value of CRVAL2 keyword
   @param    crpix1    Value of CRPIX1 keyword
   @param    crpix2    Value of CRPIX2 keyword
   @param    cdelt1   Value of CDELT1 keyword
   @param    cdelt2   Value of CDELT2 keyword

   @return   Header containing the specified FITS keywords
*/
/*----------------------------------------------------------------------------*/
uves_propertylist *
uves_initialize_image_header(const char *ctype1, const char *ctype2, 
                             const char *cunit1, const char *cunit2,
                             const char *bunit,const double bscale,
                 double crval1, double crval2,
                 double crpix1, double crpix2,
                 double cdelt1, double cdelt2)
{
    uves_propertylist *header = NULL;  /* Result */

    header = uves_propertylist_new();

    check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
    check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
    check( uves_pfits_set_cunit1(header, cunit1), "Error writing keyword");
    if(cunit2 != NULL) {
      check( uves_pfits_set_cunit2(header, cunit2), "Error writing keyword");
    }
    check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
    if(bscale) {
       check( uves_pfits_set_bscale (header, bscale ), "Error writing keyword");
    }
    check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
    check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
    check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
    check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
    check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
    check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
    
  cleanup:
    return header;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Create noise image
   @param    image              Input image
   @param    image_header       Input image header
   @param    ncom               Number of combined frames
   @param    chip               CCD chip
   @return   The newly allocated noise image, or NULL on error.

   The noise image is calculated as a combination of read-out noise, discretization
   noise and photonic noise.
   
   The noise decreases accordingly if the number of combined frames,
   @em ncom, is more than one. Those frames are assumed to have been median stacked.

   (See source code for the exact error propagation formulas).

*/
/*----------------------------------------------------------------------------*/
cpl_image *
uves_define_noise(const cpl_image *image, 
                  const uves_propertylist *image_header,
                  int ncom, enum uves_chip chip)
{
    /*
          \/  __
           \_(__)_...
    */

    cpl_image *noise = NULL;      /* Result */

    /* cpl_image *in_med = NULL;     Median filtered input image */

    double ron;                   /* Read-out noise in ADU */
    double gain;
    int nx, ny, i;
    double *noise_data;
    const double *image_data;
    bool has_bnoise=false;
    bool has_dnoise=false;
    double bnoise=0;
    double dnoise=0;
    double dtime=0;
    double bnoise2=0;
    double dnoise2=0;
    double exptime=0;
    double exptime2=0;
    double tot_noise2=0;
    double var_bias_dark=0;

    /* Read, check input parameters */
    assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
    
    check( ron = uves_pfits_get_ron_adu(image_header, chip),
       "Could not read read-out noise");
    
    check( gain = uves_pfits_get_gain(image_header, chip),
       "Could not read gain factor");
    assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);

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

    /* For efficiency reasons, use pointers to image data buffers */
    assure(cpl_image_count_rejected(image) == 0, 
       CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
    assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
       CPL_ERROR_UNSUPPORTED_MODE, 
       "Input image is of type %s. double expected", 
       uves_tostring_cpl_type(cpl_image_get_type(image)));

    noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
    assure_mem( noise );

    noise_data = cpl_image_get_data_double(noise);

    image_data = cpl_image_get_data_double_const(image);


    if(image_header != NULL) {
       has_bnoise=uves_propertylist_contains(image_header,UVES_BNOISE);
       has_dnoise=uves_propertylist_contains(image_header,UVES_DNOISE);
    }

    if(has_bnoise) {
       bnoise=uves_propertylist_get_double(image_header,UVES_BNOISE);
       bnoise2=bnoise*bnoise;
    }

    if(has_dnoise) {
       dnoise=uves_propertylist_get_double(image_header,UVES_DNOISE);
       dnoise2=dnoise*dnoise;
       dtime=uves_propertylist_get_double(image_header,UVES_DTIME);
       exptime=uves_pfits_get_exptime(image_header);
       exptime2=exptime*exptime/dtime/dtime;
    }
    var_bias_dark=bnoise2+dnoise2*exptime2;
    uves_msg_debug("bnoise=%g dnoise=%g sci exptime=%g dark exptime=%g",
	     bnoise,dnoise,exptime,dtime);

    /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */

    /* This filter is disabled, as there is often structure on the scale
       of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
       structure *does* result in worse fits to the data.

       in_med = cpl_image_duplicate(image);
       assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
       
       uves_msg_low("Applying 3x3 median filter");
       
       check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
       image_data = cpl_image_get_data_double(in_med);
       
       uves_msg_low("Setting pixel flux uncertainty");
    */

    /* We assume median stacked input (master flat, master dark, ...) */
    double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
    double gain2=gain*gain;
        
    double quant_var = uves_max_double(0, (1 - gain2)/12.0);
    /* Quant. error =
     * sqrt((g^2-1)/12)
     */
    double flux_var_adu=0;
    double ron2=ron*ron;
    double inv_ncom_median_factor=1./(ncom * median_factor);
    for (i = 0; i < nx*ny; i++)
    {
         
        /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
        /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
        flux_var_adu =  uves_max_double(image_data[i],0)*gain;
        
        /* For a number, N, of averaged or median stacked "identical" frames
         * (gaussian distribution assumed), the combined noise is
         *
         *  sigma_N = sigma / sqrt(N*f)
         *
         *  where (to a good approximation)
         *        f ~= { 1    , N = 1
         *             { 2/pi , N > 1
         *
         *  (i.e. the resulting uncertainty is
         *   larger than for average stacked inputs where f = 1)
         */
        
        /* Slow: cpl_image_set(noise, x, y, ... ); */
        /* Slow: noise_data[(x-1) + (y-1)*nx] = 
                 sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
              ((MIDAS) ? 1 : ncom * median_factor)); */

        
      tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor)+
         var_bias_dark;

      /*
      tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor);
      */
        noise_data[i] = sqrt(tot_noise2);
    }

  cleanup:
    /* uves_free_image(&in_med); */
    if (cpl_error_get_code() != CPL_ERROR_NONE)
    {
        uves_free_image(&noise);
    }

    return noise;
}


/*----------------------------------------------------------------------------*/
/**
   @brief    Subtract bias
   @param    image                The image to be de-biased
   @param    master_bias          The bias image to subtract
   @return   CPL_ERROR_NONE iff okay

   Negative values are set to zero.

*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
{
    passure ( image != NULL, " ");
    passure ( master_bias != NULL, " ");

    check( cpl_image_subtract(image, master_bias),
       "Error subtracting bias");

    /* Due to different bad column correction in image/master_bias,
       it might happen that the image has become negative after 
       subtracting the bias. Disallow that. */

#if 0
    /* No, for backwards compatibility, allow negative values.
     * MIDAS has an inconsistent logic on this matter.
     * For master dark frames, the thresholding *is* applied,
     * but not for science frames. Therefore we have to
     * apply thresholding on a case-by-case base (i.e. from
     * the caller).
     */
    check( cpl_image_threshold(image, 
                   0, DBL_MAX,     /* Interval */
                   0, DBL_MAX),    /* New values */
       "Error thresholding image");
#endif

  cleanup:
    return cpl_error_get_code();
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Subtract dark
   @param    image                The image to be dark-subtracted
   @param    image_header         The image header
   @param    master_dark          The dark image to subtract
   @param    mdark_header          The master dark header
   @return   CPL_ERROR_NONE iff okay

   Before subtracting the dark frame, it is normalized to the same exposure
   time as the input image. Exposure times are read from the provided headers.

*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
           const cpl_image *master_dark,
           const uves_propertylist *mdark_header)
{
    cpl_image *normalized_mdark = NULL;
    double image_exptime = 0.0;
    double mdark_exptime = 0.0;

    passure ( image != NULL, " ");
    passure ( image_header != NULL, " ");
    passure ( master_dark != NULL, " ");
    passure ( mdark_header != NULL, " ");

    /* Normalize mdark to same exposure time as input image, then subtract*/
    check( image_exptime = uves_pfits_get_exptime(image_header), 
       "Error reading input image exposure time");
    check( mdark_exptime = uves_pfits_get_exptime(mdark_header), 
       "Error reading master dark exposure time");
    
    uves_msg("Rescaling master dark from %f s to %f s exposure time", 
         mdark_exptime, image_exptime);
    
    check( normalized_mdark = 
       cpl_image_multiply_scalar_create(master_dark,
                        image_exptime / mdark_exptime),
       "Error normalizing master dark");
    
    check( cpl_image_subtract(image, normalized_mdark), 
       "Error subtracting master dark");

    uves_msg_warning("noise rescaled master dark %g",cpl_image_get_stdev(normalized_mdark));


  cleanup:
    uves_free_image(&normalized_mdark);
    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get the absolute order number
   @param    first_abs_order   Absolute order number of row number 1 in the 
                               spectrum image
   @param    last_abs_order    Absolute order number of the highest row in the 
                               spectrum image
   @param    relative_order    Relative order number (row number in spectrum image)
   @return   The absolute order number

   This function converts from row number in a spectrum image to
   absolute (physical) order number.
   
*/
/*----------------------------------------------------------------------------*/
int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
{
    return (first_abs_order +
        (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Get average with iterative rejection
  @param    t           table, rows with outliers are removed
  @param    column      with data values 
  @param    residual2   name of temporary column used to store the squared
                        residuals (this column must not already exist)
  @param    kappa       rejection parameter
  @return   robust mean

  Outliers are rejected using robust estimation. The final average value is
  computed using the arithmetic mean, which has lower error than the median.

**/
/*----------------------------------------------------------------------------*/
double
uves_average_reject(cpl_table *t,
                    const char *column,
                    const char *residual2,
                    double kappa)
{
    double mean = 0, median, sigma2;
    int rejected;
    
    do {
        /* Robust estimation */
      check_nomsg(median = cpl_table_get_column_median(t, column));

        /* Create column
           residual2 = (column - median)^2   */
      check_nomsg(cpl_table_duplicate_column(t, residual2, t, column));
      check_nomsg(cpl_table_subtract_scalar(t, residual2, median));
      check_nomsg(cpl_table_multiply_columns(t, residual2, residual2));

        /* For a Gaussian distribution:
         * sigma    ~= median(|residual|) / 0.6744
         * sigma^2  ~= median(residual^2) / 0.6744^2  
         */

      check_nomsg(sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744));

        /* Reject values where
           residual^2 > (kappa*sigma)^2
        */
    check_nomsg( rejected = uves_erase_table_rows(t, residual2,
                                                      CPL_GREATER_THAN,
                                                      kappa*kappa*sigma2));
        
    check_nomsg(cpl_table_erase_column(t, residual2));

    } while (rejected > 0);

    check_nomsg(mean  = cpl_table_get_column_mean(t, column));
    
  cleanup:
    return mean;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Fit a 1d polynomial to two table columns
   @param    t             Table
   @param    X             Name of table column containing independent variable
   @param    Y             Name of table column containing dependent variable
   @param    sigmaY        Uncertainty of dependent variable. 
                           If NULL, constant uncertainties are assumed.
   @param    degree        Degree of polynomial fit
   @param    polynomial_fit Name of column to add
   @param    residual_square Name of column to add
   @param    mean_squared_error Mean squared error of the residuals
   @param    kappa         If positive, the value of kappa used in a kappa sigma-clipping.
   Ignored if negative. 

   @return   Fitted polynomial

   This function fits column @em Y as function of @em X. Both columns must have type
   CPL_TYPE_DOUBLE or CPL_TYPE_INT.

   If non-NULL the columns specified by the parameters @em polynomial_fit 
   and @em residual_square are added to the table (containing the fitted value
   and the squared residual for each point). If any of these columns already exist,
   an error is set.

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

   Note that rows with invalid values are not handled properly (the garbage values
   are used for the fitting). Therefore the input table should not have invalid
   rows.
*/
/*----------------------------------------------------------------------------*/
polynomial *
uves_polynomial_regression_1d(cpl_table *t,
                  const char *X, const char *Y, const char *sigmaY, 
                  int degree, 
                  const char *polynomial_fit, const char *residual_square,
                  double *mean_squared_error, double kappa)
{
    int N;
    int total_rejected = 0;  /* Rejected in kappa sigma clipping */
    int rejected = 0;
    double mse;                  /* local mean squared error */
    double *x;
    double *y;
    double *sy;
    polynomial *result = NULL;
    cpl_vector *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( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
    assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
    assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
    assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
    assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
        "No such column: %s", sigmaY);

    assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
        CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);

    assure( residual_square == NULL || !cpl_table_has_column(t, residual_square), 
        CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
    
    /* Check column types */
    type = cpl_table_get_column_type(t, Y);
    assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE, 
        "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
    type = cpl_table_get_column_type(t, X);
    assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
        "Input column '%s' has wrong type (%s)", X, uves_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, uves_tostring_cpl_type(type));
    }

    check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
       "Could not cast table column '%s' to double", X);
    check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
       "Could not cast table column '%s' to double", Y);
    if (sigmaY != NULL)
    {
        check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
           "Could not cast table column '%s' to double", sigmaY);
    } 
    

    total_rejected = 0;
    rejected = 0;
    check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
       "Could not create column");
    do{
    check( (N = cpl_table_get_nrow(t),
        x = cpl_table_get_data_double(t, "_X_double"),
        y = cpl_table_get_data_double(t, "_Y_double")),
           "Could not read table data");
    
    if (sigmaY != NULL) 
        {
        check( 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. "
            "No points to fit in poly 1d regression. At least 2 needed");

    assure( N > degree, CPL_ERROR_ILLEGAL_INPUT, "%d points to fit in poly 1d "
           "regression of degree %d. At least %d needed.",
            N,degree,degree+1);

    /* Wrap vectors */
    uves_unwrap_vector(&vx);
    uves_unwrap_vector(&vy);
    
    vx = cpl_vector_wrap(N, x);
    vy = cpl_vector_wrap(N, y);
       
    if (sy != NULL)
        {
        uves_unwrap_vector(&vsy);
        vsy = cpl_vector_wrap(N, sy);
        }
    else
        {
        vsy = NULL;
        }
     
    /* Fit! */
    uves_polynomial_delete(&result);
    check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse), 
           "Could not fit polynomial");
    
    /* If requested, calculate residuals and perform kappa-sigma clipping */
    if (kappa > 0)
        {
        double sigma2;   /* sigma squared */
        int i;
        
        for (i = 0; i < N; i++)
            {
            double xval, yval, yfit;
            
            check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
                yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
                yfit = uves_polynomial_evaluate_1d(result, xval),
    
                cpl_table_set_double(t, "_residual_square", i, 
                             (yfit-yval)*(yfit-yval))),
                "Could not evaluate polynomial");
            }
        
        /* 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( rejected = uves_erase_table_rows(t, "_residual_square", 
                            CPL_GREATER_THAN, kappa*kappa*sigma2),
               "Could not remove outlier points");
        
        uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
                   rejected, N, sqrt(mse));
        
        /* Update */
        total_rejected += rejected;
        N = cpl_table_get_nrow(t);
        }
    
} while (rejected > 0);
    
    cpl_table_erase_column(t,  "_residual_square");    
    
    if (kappa > 0)
    {    
        uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
              total_rejected,
              N + total_rejected,
              (100.0*total_rejected)/(N + total_rejected)
        );
    }
    
    if (mean_squared_error != NULL) *mean_squared_error = mse;
    
    /* Add the fitted values to table if requested */
    if (polynomial_fit != NULL || residual_square != NULL)
    {
        int i;
        
        check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
           "Could not create column");
        for (i = 0; i < N; i++){
        double xval;
        double yfit;
        
        check((
              xval = cpl_table_get_double(t, "_X_double", i, NULL),
              yfit = uves_polynomial_evaluate_1d(result, xval),
              cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
              "Could not evaluate polynomial");
        }
        
        /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
        if (residual_square != NULL)
        {
            check(( 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");
        }
    }
    
    check(( cpl_table_erase_column(t, "_X_double"),
        cpl_table_erase_column(t, "_Y_double")),
      "Could not delete temporary columns");
    
    if (sigmaY != NULL) 
    {
        check( cpl_table_erase_column(t, "_sY_double"), 
           "Could not delete temporary column");
    } 
    
  cleanup:
    uves_unwrap_vector(&vx);
    uves_unwrap_vector(&vy);
    uves_unwrap_vector(&vsy);
    if (cpl_error_get_code() != CPL_ERROR_NONE)
    {
        uves_polynomial_delete(&result);
    }
    
    return result;
}


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

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

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

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

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

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

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

polynomial *
uves_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;
    double *x2;
    double *y;
    double *res;
    double *sy;
    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");
    N  = cpl_table_get_nrow(t);
    assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "The table with column to compute regression has 0 rows!");
    assure( N > 8, CPL_ERROR_ILLEGAL_INPUT, "For poly regression you need at least 9 points. The table with column to compute regression has %d rows!",N);

    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, uves_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, uves_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, uves_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, uves_tostring_cpl_type(type));
    }

    /* In the case that these temporary columns already exist, a run-time error will occur */
    check( cpl_table_cast_column(t, X1    , "_X1_double", CPL_TYPE_DOUBLE), 
       "Could not cast table column to double");
    check( cpl_table_cast_column(t, X2    , "_X2_double", CPL_TYPE_DOUBLE),
       "Could not cast table column to double");
    check( cpl_table_cast_column(t,  Y    ,  "_Y_double", CPL_TYPE_DOUBLE), 
       "Could not cast table column to double");
    if (sigmaY != NULL)
    {
        check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
           "Could not cast table column to double");
    }
    
    total_rejected = 0;
    rejected = 0;
    check( 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(( 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 (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 */
    uves_unwrap_vector(&vx1);
    uves_unwrap_vector(&vx2);
    uves_unwrap_vector(&vy);

    vx1 = cpl_vector_wrap(N, x1);
    vx2 = cpl_vector_wrap(N, x2);
    vy  = cpl_vector_wrap(N, y);
    if (sy != NULL)
        {
        uves_unwrap_vector(&vsy);
        vsy = cpl_vector_wrap(N, sy);
        }
    else
        {
        vsy = NULL;
        }
    
    /* Wrap up the bi-vector */
    uves_unwrap_bivector_vectors(&vx);
    vx = cpl_bivector_wrap_vectors(vx1, vx2);
  
    /* Fit! */
    uves_polynomial_delete(&p);
        check( p =  uves_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  = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
                        res[i] = (yfit-y[i])*(yfit-y[i]);
            }
        
        /* 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( rejected = uves_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! */


        uves_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)
    {    
        uves_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(( 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 (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 */
    uves_unwrap_vector(&vx1);
    uves_unwrap_vector(&vx2);
    uves_unwrap_vector(&vy);

    vx1 = cpl_vector_wrap(N, x1);
    vx2 = cpl_vector_wrap(N, x2);
    vy  = cpl_vector_wrap(N, y);
    if (sy != NULL)
        {
        uves_unwrap_vector(&vsy);
        vsy = cpl_vector_wrap(N, sy);
        }
    else
        {
        vsy = NULL;
        }
    
    /* Wrap up the bi-vector */
    uves_unwrap_bivector_vectors(&vx);
    vx = cpl_bivector_wrap_vectors(vx1, vx2);
    }

    uves_polynomial_delete(&p);
    if (variance_fit != NULL || variance != NULL)
        {
            /* If requested, also compute variance */
            check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
                                              mse, red_chisq, &variance_local),
                   "Could not fit polynomial");
        }
    else
        {
            check( p = uves_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( 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(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
            x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
            yfit  = uves_polynomial_evaluate_2d(p, x1val, x2val),
            
            cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
            "Could not evaluate polynomial");

#else
                pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
#endif
        }
        
        /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
        if (residual_square != NULL)
        {
            check(( 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( 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(( x1val         = cpl_table_get_double(t, "_X1_double", i, NULL),
                x2val         = cpl_table_get_double(t, "_X2_double", i, NULL),
                yfit_variance = uves_polynomial_evaluate_2d(variance_local, 
                                    x1val, x2val),
                
                cpl_table_set_double(t, variance_fit, i, yfit_variance)),
               "Could not evaluate polynomial");
#else
                    vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
#endif

        }
    }
    
    
    check(( 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( cpl_table_erase_column(t, "_sY_double"),
           "Could not delete temporary column");
    }
    
  cleanup:
    uves_unwrap_bivector_vectors(&vx);
    uves_unwrap_vector(&vx1);
    uves_unwrap_vector(&vx2);
    uves_unwrap_vector(&vy);
    uves_unwrap_vector(&vsy);
    /* Delete 'variance_local', or return through 'variance' parameter */
    if (variance != NULL)
    {
        *variance = variance_local;
    }
    else
    {
        uves_polynomial_delete(&variance_local);
    }
    if (cpl_error_get_code() != CPL_ERROR_NONE)
    {
        uves_polynomial_delete(&p);
    }

    return p;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Fit a 2d polynomial to three table columns
   @param    t              The table
   @param    X1             Name of table column containing 1st independent variable
   @param    X2             Name of table column containing 2nd independent variable
   @param    Y              Name of table column containing dependent variable
   @param    sigmaY         Uncertainty of dependent variable. If NULL, constant
                            uncertainties are assumed.
   @param    polynomial_fit  If non-NULL, name of column to add. The fitted value.
   @param    residual_square If non-NULL, name of column to add. The squared residual of the fit.
   @param    variance_fit    If non-NULL, name of column to add. Variance of the fitted value.
   @param    mean_squared_error (out) Mean squared error of the residuals. May be NULL.
   @param    red_chisq          (out) Reduced chi square of the fit. May be NULL.
   @param    variance        (out) Variance of the fit-polynomial (which is in itself a
                             polynomial; see also @c uves_polynomial_fit_2d() ). May be NULL.
   @param    kappa           If positive, the value of kappa used in a kappa sigma-clipping.
                             Ignored if negative. 
   @param    maxdeg1         Maximum degree of 1st independent variable
   @param    maxdeg2         Maximum degree of 2nd independent variable
   @param    min_rms         Minimum RMS to aim for. Stop iterating (for efficiency) if
                             this precision is achieved. Set to negative to disable.
   @param    min_reject      Minimum number of outliers worth rejecting. Stop iterating (for
                             efficiency) if less than this relative number of outliers
                             (e.g. 0.001) are detected. Negative to disable
   @param    verbose         print messages at info level (true) or debug level (false)
   @param    min_val         minimum allowed value. A fit producing a value lower
                             than this number will be rejected. Set to NULL to disable
   @param    max_val         maximum allowed value
   @param    npos            size of positions array
   @param    positions       positions where the fitted solution must be inside the
                             limits given by min_val / max_val (for the solution
                 to be accepted)
   @return   Fitted polynomial

   This function is like @c uves_polynomial_regression_2d() except it automatically
   selects the best polynomial degrees based on the RMS of the fit.

   @note that when kappa-sigma clipping is involved, it becomes rather
   complicated to decide which are the optimal degrees, and for that
   reason this function is not expected to give good results for all
   possible kinds of input data.
*/
/*----------------------------------------------------------------------------*/

polynomial *
uves_polynomial_regression_2d_autodegree(cpl_table *t,
                     const char *X1, const char *X2, const char *Y,
                     const char *sigmaY,
                     const char *polynomial_fit,
                     const char *residual_square, 
                     const char *variance_fit,
                     double *mean_squared_error, double *red_chisq,
                     polynomial **variance, double kappa,
                     int maxdeg1, int maxdeg2, double min_rms,
                                         double min_reject,
                                         bool verbose,
                     const double *min_val,
                     const double *max_val,
                     int npos, double positions[][2])
{
    int deg1 = 0;               /* Current degrees                                  */
    int deg2 = 0;               /* Current degrees                                  */
    int i;

    double **mse = NULL;
    bool adjust1 = true;      /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
    bool adjust2 = true;      /*   (or held constant)            */
    bool finished = false;

    const char *y_unit;
    cpl_table *temp = NULL;
    polynomial *bivariate_fit = NULL;   /* Result */

    assure( (min_val == NULL && max_val == NULL) || positions != NULL,
        CPL_ERROR_NULL_INPUT,
        "Missing positions array");    

    check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
    if (y_unit == NULL)
    {
        y_unit = "";
    }

    assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT, 
       "Illegal max. degrees: (%d, %d)",
       maxdeg1, maxdeg2);

    mse = cpl_calloc(maxdeg1+1, sizeof(double *));
    assure_mem(mse);
    for (i = 0; i < maxdeg1+1; i++)
    {
        int j;
        mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
        assure_mem(mse);

        for (j = 0; j < maxdeg2+1; j++)
        {
            mse[i][j] = -1;
        }
    }

    temp = cpl_table_duplicate(t);
    assure_mem(temp);

    uves_polynomial_delete(&bivariate_fit);
    check( bivariate_fit = uves_polynomial_regression_2d(temp,
                             X1, X2, Y, sigmaY,
                             deg1,
                             deg2,
                             NULL, NULL, NULL,  /* new columns  */
                             &mse[deg1][deg2], NULL, /* chi^2/N */
                             NULL,              /* variance pol.*/
                             kappa, min_reject),
       "Error fitting polynomial");
    if (verbose)
        uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
                     deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
                     cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
                     cpl_table_get_nrow(t));
    else
        uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
                       deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
                     cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
                     cpl_table_get_nrow(t));
    /* Find best values of deg1, deg2 less than or equal to 8,8
       (the fitting algorithm is unstable after this point, anyway) */
    do
    {
        int new_deg1, new_deg2;
        double m;

        finished = true;

        adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
        adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
        
        /* Try the new degrees

                              (d1+1, d2  ) (d1+2, d2)
                       (d1, d2+1) (d1+1, d2+1)
                       (d1, d2+2)

           in the following order:

                                     1            3
                          1          2
                          3

               (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
        */
        for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
        for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
            if ( (
                 (new_deg1 == deg1+1 && new_deg2 == deg2   && adjust1) ||
                 (new_deg1 == deg1+2 && new_deg2 == deg2   && adjust1) ||
                 (new_deg1 == deg1   && new_deg2 == deg2+1 && adjust2) ||
                 (new_deg1 == deg1   && new_deg2 == deg2+2 && adjust2) ||
                 (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
                 )
             && mse[new_deg1][new_deg2] < 0)
            {
                int rejected = 0;

                uves_free_table(&temp);
                temp = cpl_table_duplicate(t);
                assure_mem(temp);

                uves_polynomial_delete(&bivariate_fit);
                bivariate_fit = uves_polynomial_regression_2d(temp,
                                      X1, X2, Y, sigmaY,
                                      new_deg1,
                                      new_deg2,
                                      NULL, NULL, NULL,
                                      &(mse[new_deg1]
                                        [new_deg2]),
                                      NULL,
                                      NULL,
                                      kappa, min_reject);

                if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
                {
                    uves_error_reset();

                                    if (verbose)
                                        uves_msg_low("(%d, %d)-degree: Singular matrix", 
                         new_deg1, new_deg2);
                                    else
                                        uves_msg_debug("(%d, %d)-degree: Singular matrix", 
                         new_deg1, new_deg2);
                    
                    mse[new_deg1][new_deg2] = DBL_MAX/2; 
                }
                else
                {
                    assure( cpl_error_get_code() == CPL_ERROR_NONE,
                        cpl_error_get_code(),
                        "Error fitting (%d, %d)-degree polynomial", 
                        new_deg1, new_deg2 );
                    
                    rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
                
                                    if (verbose)
                                        uves_msg_low("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
                                                     new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
                                                     rejected, cpl_table_get_nrow(t));
                                    else
                                        uves_msg_debug("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
                                                     new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
                                                     rejected, cpl_table_get_nrow(t));

                    /* Reject if fit produced bad values */
                    if (min_val != NULL || max_val != NULL)
                    {
                        for (i = 0; i < npos; i++)
                        {
                            double val = uves_polynomial_evaluate_2d(
                            bivariate_fit,
                            positions[i][0], positions[i][1]);
                            if (min_val != NULL && val < *min_val)
                            {
                                uves_msg_debug("Bad fit: %f < %f", 
                                       val,
                                       *min_val);
                                mse[new_deg1][new_deg2] = DBL_MAX/2; 
                                /* A large number, even if we add a bit */
                            }
                            if (max_val != NULL && val > *max_val)
                            {
                                uves_msg_debug("Bad fit: %f > %f", 
                                       val,
                                       *max_val);
                                mse[new_deg1][new_deg2] = DBL_MAX/2; 
                            }
                        }
                    }
                
                    /* For robustness, make sure that we don't accept a solution that
                       rejected too many points (say, 80%)
                    */
                    if (rejected >= (4*cpl_table_get_nrow(t))/5)
                    {
                        mse[new_deg1][new_deg2] = DBL_MAX/2; 
                    }
                    
                }/* if fit succeeded */
            }
        
        /* If fit is significantly better (say, 10% improvement in MSE) in either direction, 
         * (in (degree,degree)-space) then move in that direction.
         *
         * First try to move one step horizontal/vertical, 
         * otherwise try to move diagonally (i.e. increase both degrees),
         * otherwise move two steps horizontal/vertical
         *
         */
        m = mse[deg1][deg2];

        if      (adjust1                              
             && (m - mse[deg1+1][deg2])/m > 0.1
             && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
             /* The condition is read like this:
            if 
            - we are trying to move right, and
            - this is this is a better place than the current, and
                - this is better than moving down */
        )
        {
            deg1++;
            finished = false;
        }
        else if (adjust2 &&
             (m - mse[deg1][deg2+1])/m > 0.1
             && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
        )
        {
            deg2++;
            finished = false;
        }
        else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
        {
            deg1++;
            deg2++;
            finished = false;
        }
        else if (adjust1
             && (m - mse[deg1+2][deg2])/m > 0.1
             && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
        )
        {
            deg1 += 2;
            finished = false;
        }
        else if (adjust2 
             && (m - mse[deg1][deg2+2])/m > 0.1
             && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
        {
            deg2 += 2;
            finished = false;
        }

        /* For efficiency, stop if rms reached min_rms */   
        finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);

    } while (!finished);

    uves_polynomial_delete(&bivariate_fit);
    check( bivariate_fit = uves_polynomial_regression_2d(t,
                             X1, X2, Y, sigmaY,
                             deg1,
                             deg2,
                             polynomial_fit, residual_square, 
                             variance_fit,
                             mean_squared_error, red_chisq,
                             variance, kappa, min_reject),
       "Error fitting (%d, %d)-degree polynomial", deg1, deg2);

    if (verbose)
        uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
                     sqrt(mse[deg1][deg2]), y_unit);
    else
        uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
                     sqrt(mse[deg1][deg2]), y_unit);
    
  cleanup:
    if (mse != NULL)
    {
        for (i = 0; i < maxdeg1+1; i++)
        {
            if (mse[i] != NULL)
            {
                cpl_free(mse[i]);
            }
        }
        cpl_free(mse);
    }
    uves_free_table(&temp);
    
    return bivariate_fit;    
}

/*----------------------------------------------------------------------------*/
/**
   @brief          Remove named prefix from string
   @param s       string
   @param prefix   the prefix to remove
   @return  s without prefix, or NULL on error. This points to a position in 
   the string @em s, and therefore must not be deallocated.

   The function fails if @em prefix is not a prefix of @em s.
*/
/*----------------------------------------------------------------------------*/
const char *
uves_remove_string_prefix(const char *s, const char *prefix)
{
    const char *result = NULL;
    unsigned int prefix_length;

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

    prefix_length = strlen(prefix);

    assure( strlen(s) >= prefix_length &&
        strncmp(s, prefix, prefix_length) == 0,
        CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
        prefix, s);
    
    result = s + prefix_length;
    
  cleanup:
    return result;
}


/*----------------------------------------------------------------------------*/
/**
   @brief  Pseudo-random gaussian distributed number
   @return Pseudo-random gasssian value with mean zero, stdev 1, based
   on C's rand()

   It is probably a good idea to call srand() before using this function, for
   reasons of reproducability.
*/
/*----------------------------------------------------------------------------*/

double uves_gaussrand(void)
{
    static double V1, V2, S;
    static int phase = 0;
    double X;
    
    if(phase == 0) {
    do {
        double U1 = (double)rand() / RAND_MAX;
        double U2 = (double)rand() / RAND_MAX;
        
        V1 = 2 * U1 - 1;
        V2 = 2 * U2 - 1;
        S = V1 * V1 + V2 * V2;
    } while(S >= 1 || S == 0);
    
    X = V1 * sqrt(-2 * log(S) / S);
    } else
    X = V2 * sqrt(-2 * log(S) / S);
    
    phase = 1 - phase;
    
    return X;
}

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

double uves_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( x = cpl_table_get_data_double_const(t, column_x),
       "Error reading column '%s'", column_x);
    check( y = cpl_table_get_data_double_const(t, column_y),
       "Error reading column '%s'", column_y);

    n = cpl_table_get_nrow(t);

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

  cleanup:
    return result;
}

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

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

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

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

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

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

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

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

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

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

    return yp;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Natural cubic-spline interpolation.
   @param xp      x-value to interpolate
   @param x      x-array [1..n], must be sorted ascending
   @param y      y-array [1..n] 
   @param y2      y2-array [1..n] (2-nd derivatives)
   @param n       array size
   @param kstart  Start search index. Contains on output index
                  of largest x less than xp.

   @return the interpolated value

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

double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
{
    int klo, khi, k;
    double a, b, h, yp = 0;

    assure_nomsg( x  != NULL, CPL_ERROR_NULL_INPUT);
    assure_nomsg( y  != NULL, CPL_ERROR_NULL_INPUT);
    assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
    assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);

    klo = *kstart;
    khi = n;

    if ( xp < x[1] || xp > x[n] )
    {
        return 0.0;
    }
    else if ( xp == x[1] )
    {
        return(y[1]);
    }
    
    for ( k = klo; k < n && xp > x[k]; k++ )
    ;

    klo = *kstart = k-1;
    khi = k;

    h = x[khi] - x[klo];
    assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
        "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);

    a = (x[khi] - xp) / h;
    b = (xp - x[klo]) / h;

    yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
     (h*h) / 6.0;

  cleanup:
    return yp;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Determine if a table is sorted
   @param    t        Table
   @param    column   Column name, type must be double
   @param    reverse  Flag indicating to check for ascending (false) or
                      descending (true)
                      sort order
   @return   Non-zero iff table is sorted according to the specified column
*/
/*----------------------------------------------------------------------------*/
bool
uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
{
    bool is_sorted = true;       /* ... until proven false */
    int i;
    int N;
    double previous, current;    /* column values */

    passure(t != NULL, " ");
    passure(cpl_table_has_column(t, column), "No column '%s'", column);
    passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
    
    N = cpl_table_get_nrow(t);

    if (N > 1) 
    {
        previous = cpl_table_get_double(t, column, 0, NULL);
        
        for(i = 1; i < N && is_sorted; i++)
        {
            current = cpl_table_get_double(t, column, i, NULL);
            if (!reverse)
            {
                /* Check for ascending */
                is_sorted = is_sorted && ( current >= previous );
            }
            else
            {
                /* Check for descending */
                is_sorted = is_sorted && ( current <= previous );
            }
            
            previous = current;
        }
    }
    else
    {
        /* 0 or 1 rows. Table is sorted */        
    }
    
  cleanup:
    return is_sorted;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Create the table that describes fibre traces
   @return  The table which must be deallocated with @c cpl_table_delete() .

*/
/*----------------------------------------------------------------------------*/
cpl_table *
uves_ordertable_traces_new(void)
{
    cpl_table *result = NULL;
    
    check((
          result = cpl_table_new(0),
          cpl_table_new_column(result, "TraceID"  , CPL_TYPE_INT),
          cpl_table_new_column(result, "Offset"   , CPL_TYPE_DOUBLE),
          cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
    "Error creating table");
    
  cleanup:
    return result;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Add a trace
   @param   traces        The table containing information on the
                          position of fibre traces (FLAMES/UVES)
   @param   fibre_ID      The fibre ID number
   @param   fibre_offset  Offset of this fibre
   @param   fibre_mask    0 if fibre is disabled, 1 if it is enabled
   @return  CPL_ERROR_NONE iff okay
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_ordertable_traces_add(cpl_table *traces, 
               int fibre_ID, double fibre_offset, int fibre_mask)
{
    int size;

    assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
    
    /* Write to new table row */
    check((
          size = cpl_table_get_nrow(traces),
          cpl_table_set_size  (traces, size+1),
          cpl_table_set_int   (traces, "TraceID"  , size, fibre_ID),
          cpl_table_set_double(traces, "Offset"   , size, fibre_offset),
          cpl_table_set_int   (traces, "Tracemask", size, fibre_mask)),
      "Error updating table");

  cleanup:
    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
   @brief   Remove column units from a table
   @param   tname filename of the table containing units to be removed (FLAMES/UVES)
   @return  CPL_ERROR_NONE iff okay
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_tablename_remove_units(const char* tname)
{
   cpl_table* tab=NULL;
   uves_propertylist* head=NULL;
   tab=cpl_table_load(tname,1,0);
   head=uves_propertylist_load(tname,0);
   uves_table_remove_units(&tab);
   check_nomsg(uves_table_save(tab,head,NULL,tname,CPL_IO_DEFAULT));

  cleanup:
   uves_free_table(&tab);
   uves_free_propertylist(&head);
   return cpl_error_get_code();
}



/*----------------------------------------------------------------------------*/
/**
   @brief   Unify column units in tables
   @param   name2 of the table with reference units 
   @param   name1 of the table with new units 
   @return  CPL_ERROR_NONE iff okay
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_tablenames_unify_units(const char* tname2, const char* tname1)
{
   cpl_table* tab1=NULL;
   cpl_table* tab2=NULL;
   uves_propertylist* head2=NULL;

   tab1=cpl_table_load(tname1,1,0);

   tab2=cpl_table_load(tname2,1,0);
   head2=uves_propertylist_load(tname2,0);

   uves_table_unify_units(&tab2,&tab1);
   check_nomsg(uves_table_save(tab2,head2,NULL,tname2,CPL_IO_DEFAULT));

  cleanup:
   uves_free_table(&tab1);
   uves_free_table(&tab2);
   uves_free_propertylist(&head2);
   return cpl_error_get_code();

}



/*----------------------------------------------------------------------------*/
/**
   @brief   Remove column units from a table
   @param   tab The table containing units to be removed (FLAMES/UVES)
   @return  CPL_ERROR_NONE iff okay
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_table_remove_units(cpl_table **table)
{
    int ncols;
    const char* colname=NULL;
    int i=0;
    cpl_array *names=NULL;

    assure( *table != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
    ncols = cpl_table_get_ncol(*table);
    names = cpl_table_get_column_names(*table);
    for(i=0;i<ncols;i++) {
       colname=cpl_array_get_string(names, i);
       cpl_table_set_column_unit(*table,colname,NULL);
    }

  cleanup:
    uves_free_array(&names);

    return cpl_error_get_code();
}



/*----------------------------------------------------------------------------*/
/**
   @brief   Unify column units of table2 to table1
   @param   table2 The table with reference units 
   @param   table1 The table with new units 
   @return  CPL_ERROR_NONE iff okay
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
uves_table_unify_units(cpl_table **table2,  cpl_table **table1)
{
    int ncols1;
    int ncols2;
    const char* colname=NULL;
    const char* unit1=NULL;

    int i=0;
    cpl_array *names=NULL;

    assure( table1 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
    assure( *table2 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
    ncols1 = cpl_table_get_ncol(*table1);
    ncols2 = cpl_table_get_ncol(*table2);
    assure( ncols1 == ncols2, CPL_ERROR_NULL_INPUT, 
            "n columns (tab1) != n columns (tab2)");

    names = cpl_table_get_column_names(*table1);
    for(i=0;i<ncols1;i++) {
       colname=cpl_array_get_string(names, i);
       unit1=cpl_table_get_column_unit(*table1,colname);
       cpl_table_set_column_unit(*table2,colname,unit1);
    }

  cleanup:
    uves_free_array(&names);

    return cpl_error_get_code();
}

/*
 * modified on 2006/04/19
 *  jmlarsen:  float[5] -> const double[]
 *             changed mapping of indices to parameters
 *             Normalized the profile to 1 and changed meaning
 *             of (a[3], a[2]) to (integrated flux, stdev)
 *             Disabled debugging messages
 *
 * modified on 2005/07/29 to make dydapar a FORTRAN array
 * (indiced from 1 to N instead of 0 to N-1).
 * This allows the array to be passed to C functions expecting
 * FORTRAN-like arrays.
 *
 * modified on 2005/08/02 to make the function prototype ANSI
 * compliant (so it can be used with the levmar library).
 *
 * modified on 2005/08/16. The function now expects C-indexed
 * arrays as parameters (to allow proper integration). However, the
 * arrays are still converted to FORTRAN-indexed arrays internally.
 */

/**
@brief This subroutine gives the value of the Moffat (beta=4)+ linear 
    functions at     pixel of coordinates x estimated at one point 
@param x  input pixel coordinates
@param a  profile coefficients
@param y  Moffat profile values
@param dyda errors associated to y


*/
static void fmoffa_i(float x,const double a[],double *y,double dyda[])

 
     /*     int na;*/
{
  double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
  double a2i=0, m = 0, p = 0, dif =0;
  double sqrt5 = 2.23606797749979;

  *y=0.0;
//  a2i = 1.0/a[2];
  a2i = 1.0/(a[2]*sqrt5);

  dif=x-a[1];
  arg=dif*a2i;
  arg2=arg*arg;

  fac=1.0+arg2;
  fac2=fac*fac;
  fac4=fac2*fac2;
  fac4i = 1.0/fac4;
  
//  m = a[1]*fac4i;
  m = a[3]*fac4i * a2i*16/(5.0*M_PI);
  *y = m + a[4]*(1.0+dif*a[5]);  
  p = 8.0*m/fac*arg*a2i;

  dyda[3] = m/a[3];
  dyda[2] = p*dif/a[2] - m/a[2];

//  dyda[3]=fac4i;
  dyda[1]=p-a[4]*a[5];
//  dyda[2]=p*dif*a2i;
  dyda[4]=1.0+dif*a[5];
  dyda[5]=a[4]*dif;


#if 0
  {
     int i = 0, npar=5 ;
     printf("fmoffat_i \n");
     for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
     
     printf("fmoffat_i ");
     for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
     printf("\n");
  }
#endif
  
}

/**
@brief Moffat profile
@param x  input pixel coordinates
@param a  profile coefficients
@param y  Moffat profile values
@param dyda errors associated to y
@note

        This subroutine  gives  the value  of  the  Moffat (beta =  4,
    fixed)+ linear functions  at pixel of coordinates x integrated
    over  this pixel; the integration  is done  using the npoint=3
    Gauss-Legendre  integration formula. The weights and abscissae
    are modified to take into account the range of integration (in
    pratice, the values are divided by 2) .
    


*/
static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
//void fmoffa_c(x,a,y, dyda)


//     float x,*a,*y,*dyda;
/*int na;*/
{
  int npoint = 3;
  double const xgl[3] = {-0.387298334621,0.,0.387298334621};
  double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
  int i=0;
  int j=0;
  int npar = 5;
  double xmod = 0;
  double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
  double ypar;


  // Convert C-indexed arrays to FORTRAN-indexed arrays
  a    = C_TO_FORTRAN_INDEXING(a);
  dyda = C_TO_FORTRAN_INDEXING(dyda);

  *y = 0.0;
  for (i = 1;i<=npar;i++) dyda[i] = 0.;
  /*  printf("fmoffat_c ");
  for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
  /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
  /*  printf("\n");*/
  for (j=0; j < npoint; j++) 
      {
      xmod = x+xgl[j];

      fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
      
      *y = *y + ypar*wgl[j];
      
      for (i = 1; i <= npar; i++)
          {
          dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
          }

     /*      if (j == 2) 
    for (i = 1;i<=npar;i++) 
      {
        dyda[i] = dydapar[i];
      };
     */
    }

#if 0
      printf("fmoffat_c ");
      for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
      printf("\n");
#endif
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Evaluate a Moffat
   @param   x             The evaluation point
   @param   a             The parameters defining the gaussian
   @param   result        The function value
   @return  0 iff okay.
*/
/*----------------------------------------------------------------------------*/
int
uves_moffat(const double x[], const double a[], double *result)
{
    double dyda[5];

    fmoffa_c(x[0], a, result, dyda);

    return 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Evaluate Moffat derivative
   @param   x             The evaluation point
   @param   a             The parameters defining the gaussian
   @param   result        The function value
   @return  0 iff okay.
*/
/*----------------------------------------------------------------------------*/
int
uves_moffat_derivative(const double x[], const double a[], double result[])
{
    double y;

    fmoffa_c(x[0], a, &y, result);

    return 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Evaluate a gaussian
   @param   x             The evaluation point
   @param   a             The parameters defining the gaussian
   @param   result        The function value

   @return  0 iff okay.

   This function computes

   @em a3 +  @em a2 / sqrt(2 pi @em a1^2) *
   exp( -(@em x0 - @em a0)^2/(2 @em a1^2)).
  
   where @em a0, ..., @em a3 are the first four elements of @em a, and @em
   x0 is the first element of @em x .

   The function never fails.

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

int
uves_gauss(const double x[], const double a[], double *result)
{
    double my    = a[0];
    double sigma = a[1];

    if (sigma == 0)
    {
        /* Dirac's delta function */
        if (x[0] == my)
        {
            *result = DBL_MAX;
        }
        else
        {
            *result = 0;
        }
        return 0;
    }
    else
    {
        double A     = a[2];
        double B     = a[3];
        
        *result = B    +
        A/(sqrt(2*M_PI*sigma*sigma)) *
        exp(- (x[0] - my)*(x[0] - my)
            / (2*sigma*sigma));
    }
    
    return 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Evaluate the derivatives of a gaussian
   @param   x             The evaluation point
   @param   a             The parameters defining the gaussian
   @param   result        The derivatives wrt to parameters

   @return  0 iff okay.

   This function computes the partial derivatives of
   @em f(@em x0,@em a) =
   @em a3 +  @em a2 / sqrt(2 pi @em a1^2) *
   exp( -(@em x0 - @em a0)^2/(2 @em a1^2))
   with respect to @em a0, ..., @em a3.
   On successful evaluation, the i'th element of the @em result vector
   contains df/da_i.

   The function never returns failure.

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

int
uves_gauss_derivative(const double x[], const double a[], double result[])
{
    double my    = a[0];
    double sigma = a[1];
    double A     = a[2];
    /* a[3] not used */

    double factor;
   
    /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
     *
     * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
     *          = A * fac. * (x-my)  / s^2
     * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
     *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
     * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
     *          = fac.
     * df/dB    = 1
     */
    
    if (sigma == 0)
    {
        /* Derivative of Dirac's delta function */
        result[0] = 0;
        result[1] = 0;
        result[2] = 0;
        result[3] = 0;
        return 0;
    }

    factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
    / (sqrt(2*M_PI*sigma*sigma));

    result[0] = A * factor * (x[0]-my) / (sigma*sigma);
    result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
    result[2] = factor;
    result[3] = 1;

    return 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Evaluate a gaussian with linear background
   @param   x             The evaluation point
   @param   a             The parameters defining the gaussian
   @param   result        The function value

   @return  0 iff okay.

   This function computes

   @em a3 + a4*(@em x0 - @em a0)  +
   @em a2 / sqrt(2 pi @em a1^2) *
   exp( -(@em x0 - @em a0)^2/(2 @em a1^2)).
  
   where @em a0, ..., @em a4 are the first five elements of @em a, and @em
   x0 is the first element of @em x .

   The function never fails.

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

int
uves_gauss_linear(const double x[], const double a[], double *result)
{
    double my    = a[0];
    double sigma = a[1];

    if (sigma == 0)
    {
        /* Dirac's delta function */
        if (x[0] == my)
        {
            *result = DBL_MAX;
        }
        else
        {
            *result = 0;
        }
        return 0;
    }
    else
    {
        double A     = a[2];
        double B     = a[3];
        double C     = a[4];
        
        *result = B    + C*(x[0] - my) +
        A/(sqrt(2*M_PI*sigma*sigma)) *
        exp(- (x[0] - my)*(x[0] - my)
            / (2*sigma*sigma));
    }
    
    return 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief   Evaluate the derivatives of a gaussian with linear background
   @param   x             The evaluation point
   @param   a             The parameters defining the gaussian
   @param   result        The derivatives wrt to parameters

   @return  0 iff okay.

   This function computes the partial derivatives of

   @em f(@em x0,@em a) =
   @em a3 + a4*(x0 - @em a0) +
   @em a2 / sqrt(2 pi @em a1^2) *
   exp( -(@em x0 - @em a0)^2/(2 @em a1^2))

   with respect to @em a0, ..., @em a4.
   On successful evaluation, the i'th element of the @em result vector
   contains df/da_i.

   The function never returns failure.

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

int
uves_gauss_linear_derivative(const double x[], const double a[], double result[])
{
    double my    = a[0];
    double sigma = a[1];
    double A     = a[2];
    /* a[3] not used */
    double C     = a[4];

    double factor;
   
    /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
     *
     * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
     *          = A * fac. * (x-my)  / s^2   - C
     * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
     *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
     * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
     *          = fac.
     * df/dB    = 1
     *
     * df/dC    = x-my
     */
    
    if (sigma == 0)
    {
        /* Derivative of Dirac's delta function */
        result[0] = -C;
        result[1] = 0;
        result[2] = 0;
        result[3] = 0;
        result[4] = x[0];
        return 0;
    }

    factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
    / (sqrt(2*M_PI*sigma*sigma));

    result[0] = A * factor * (x[0]-my) / (sigma*sigma);
    result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
    result[2] = factor;
    result[3] = 1;
    result[4] = x[0] - my;

    return 0;
}




/*----------------------------------------------------------------------------*/
/**
   @brief   Reconstruct echelle image from spectrum
   @param   pos             position iterator
   @param   chip            CCD chip  (for header)
   @param   spectrum        object spectrum
   @param   sky             sky spectrum
   @param   cosmic_image    if non-NULL, image of cosmic rays. Values > 0 mark
                            CR hits
   @param   image_noise     (output) error bars
   @param   image_header    (output) describing the output image
   @return  simulated image
*/
/*----------------------------------------------------------------------------*/
cpl_image *
uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
                  const cpl_image *spectrum, const cpl_image *sky,
                  const cpl_image *cosmic_image,
                  const uves_extract_profile *profile,
                  cpl_image **image_noise, uves_propertylist **image_header)
{
    cpl_image *image = NULL;

    cpl_binary *bpm = NULL;
    bool loop_y = false;

    double ron = 3;
    double gain = 1.0; //fixme
    bool new_format = true;

    image        = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
    assure_mem( image );
    if (image_noise != NULL) {
        *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
        assure_mem( *image_noise );
        cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
    }

    if (image_header != NULL) {
        *image_header = uves_propertylist_new();
      
        uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
        uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
        uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
    }

    for (uves_iterate_set_first(pos,
                                1, pos->nx,
                                pos->minorder, pos->maxorder,
                                bpm,
                                loop_y);
         !uves_iterate_finished(pos); 
         uves_iterate_increment(pos)) {
      
        /* Manual loop over y */
        uves_extract_profile_set(profile, pos, NULL);
        for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {

            /* Get empirical and model profile */
            double flux, sky_flux;
            int bad;
            int spectrum_row = pos->order - pos->minorder + 1;
            double noise;
            double prof = uves_extract_profile_evaluate(profile, pos);
          
            if (sky != NULL)
                {
                    sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
                }
            else
                {
                    sky_flux = 0;
                }

            flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
          
            //fixme: check this formula
            noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
//          uves_msg_error("%f", prof);
            cpl_image_set(image, pos->x, pos->y, 
                          flux);
            if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
          
        }
    }

    if (cosmic_image != NULL) {
        double cr_val = 2*cpl_image_get_max(image);
        /* assign high pixel value to CR pixels */
        
        loop_y = true;
        
        for (uves_iterate_set_first(pos,
                                    1, pos->nx,
                                    pos->minorder, pos->maxorder,
                                    bpm,
                                    loop_y);
             !uves_iterate_finished(pos); 
             uves_iterate_increment(pos)) {
            
            int is_rejected;
            if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
                cpl_image_set(image, pos->x, pos->y, cr_val);
            }
        }
    }
    
  cleanup:
    return image;
}

void 
uves_frameset_dump(cpl_frameset* set)
{

  cpl_frame* frm=NULL;
  int sz=0;
  int i=0;

  cknull(set,"Null input frameset");
  check_nomsg(sz=cpl_frameset_get_size(set));
  check_nomsg(frm=cpl_frameset_get_first(set));
  do{
    uves_msg("frame %d tag %s filename %s group %d",
	     i,
             cpl_frame_get_tag(frm),
             cpl_frame_get_filename(frm),
             cpl_frame_get_group(frm));
    i++;
  } while ((frm=cpl_frameset_get_next(set)) != NULL);

  cleanup:

  return ;
}




/*-------------------------------------------------------------------------*/
/**
  @name        uves_image_smooth_x
  @memo        Smooth an image using a simple mean.
  @param       inp        Image to shift.
  @return      1 newly allocated image.
  @see         uves_spline_hermite
  @doc

  This function interpolate an image using hermite splines.

  The returned image is a newly allocated object, it must be deallocated
  using uves_image_delete().
 */
/*--------------------------------------------------------------------------*/

cpl_image *
uves_image_smooth_x(cpl_image * inp, const int r)
{

  /*
   @param xp     x-value to interpolate
   @param x      x-values
   @param y      y-values
   @param n      array length
   @param istart    (input/output) initial row (set to 0 to search all row)

  */
  float* pinp=NULL;
  float* pout=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;
  int k=0;

  cpl_image* out=NULL;

  cknull(inp,"Null in put image, exit");
  check_nomsg(out=cpl_image_duplicate(inp));
  check_nomsg(sx=cpl_image_get_size_x(inp));
  check_nomsg(sy=cpl_image_get_size_y(inp));
  check_nomsg(pinp=cpl_image_get_data_float(inp));
  check_nomsg(pout=cpl_image_get_data_float(out));
  for(j=0;j<sy;j++) {
    for(i=r;i<sx-r;i++) {
      for(k=-r;k<r;k++) {
	pout[j*sx+i]+=pinp[j*sx+i+k];
      }
      pout[j*sx+i]/=2*r;
    }
  }

 cleanup:

  if(cpl_error_get_code() != CPL_ERROR_NONE) {
    return NULL;
  } else {
    return out;

  }

}





/*-------------------------------------------------------------------------*/
/**
  @name        uves_image_smooth_x
  @memo        Smooth an image using a simple mean.
  @param       inp        Image to shift.
  @return      1 newly allocated image.
  @see         uves_spline_hermite
  @doc

  This function interpolate an image using hermite splines.

  The returned image is a newly allocated object, it must be deallocated
  using uves_image_delete().
 */
/*--------------------------------------------------------------------------*/

cpl_image *
uves_image_smooth_y(cpl_image * inp, const int r)
{

  /*
   @param xp     x-value to interpolate
   @param x      x-values
   @param y      y-values
   @param n      array length
   @param istart    (input/output) initial row (set to 0 to search all row)

  */
  float* pinp=NULL;
  float* pout=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;
  int k=0;

  cpl_image* out=NULL;

  cknull(inp,"Null in put image, exit");
  check_nomsg(out=cpl_image_duplicate(inp));
  check_nomsg(sx=cpl_image_get_size_x(inp));
  check_nomsg(sy=cpl_image_get_size_y(inp));
  check_nomsg(pinp=cpl_image_get_data_float(inp));
  check_nomsg(pout=cpl_image_get_data_float(out));
  for(j=r;j<sy-r;j++) {
    for(i=0;i<sx;i++) {
      for(k=-r;k<r;k++) {
	pout[j*sx+i]+=pinp[(j+k)*sx+i];
      }
      pout[j*sx+i]/=2*r;
    }
  }

 cleanup:

  if(cpl_error_get_code() != CPL_ERROR_NONE) {
    return NULL;
  } else {
    return out;

  }

}


/*-------------------------------------------------------------------------*/
/**
  @name        uves_image_smooth_mean_x
  @memo        Smooth an image using a simple mean.
  @param       inp        Image to shift.
  @return      1 newly allocated image.
  @see         uves_spline_hermite
  @doc

  This function interpolate an image using hermite splines.

  The returned image is a newly allocated object, it must be deallocated
  using uves_image_delete().
 */
/*--------------------------------------------------------------------------*/

cpl_image *
uves_image_smooth_mean_x(cpl_image * inp, const int r)
{

  /*
   @param xp     x-value to interpolate
   @param x      x-values
   @param y      y-values
   @param n      array length
   @param istart    (input/output) initial row (set to 0 to search all row)

  */
  float* pinp=NULL;
  float* pout=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;
  int k=0;

  cpl_image* out=NULL;

  cknull(inp,"Null in put image, exit");
  check_nomsg(out=cpl_image_duplicate(inp));
  check_nomsg(sx=cpl_image_get_size_x(inp));
  check_nomsg(sy=cpl_image_get_size_y(inp));
  check_nomsg(pinp=cpl_image_get_data_float(inp));
  check_nomsg(pout=cpl_image_get_data_float(out));
  for(j=0;j<sy;j++) {
    for(i=r;i<sx-r;i++) {
      for(k=-r;k<r;k++) {
	pout[j*sx+i]+=pinp[j*sx+i+k];
      }
      pout[j*sx+i]/=2*r;
    }
  }

 cleanup:

  if(cpl_error_get_code() != CPL_ERROR_NONE) {
    return NULL;
  } else {
    return out;

  }

}


/*-------------------------------------------------------------------------*/
/**
  @name        uves_image_smooth_median_x
  @memo        Smooth an image using a simple mean.
  @param       inp        Image to shift.
  @return      1 newly allocated image.
  @see         uves_spline_hermite
  @doc

  This function interpolate an image using hermite splines.

  The returned image is a newly allocated object, it must be deallocated
  using uves_image_delete().
 */
/*--------------------------------------------------------------------------*/

cpl_image *
uves_image_smooth_median_x(cpl_image * inp, const int r)
{

  /*
   @param xp     x-value to interpolate
   @param x      x-values
   @param y      y-values
   @param n      array length
   @param istart    (input/output) initial row (set to 0 to search all row)

  */
  float* pout=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;

  cpl_image* out=NULL;


  cknull(inp,"Null in put image, exit");
  check_nomsg(out=cpl_image_duplicate(inp));
  check_nomsg(sx=cpl_image_get_size_x(inp));
  check_nomsg(sy=cpl_image_get_size_y(inp));
  check_nomsg(pout=cpl_image_get_data_float(out));

  for(j=1;j<sy;j++) {
    for(i=1+r;i<sx-r;i++) {
      pout[j*sx+i]=(float)cpl_image_get_median_window(inp,i,j,i+r,j);
    }
  }

 cleanup:

  if(cpl_error_get_code() != CPL_ERROR_NONE) {
    return NULL;
  } else {
    return out;

  }

}

/*-------------------------------------------------------------------------*/
/**
  @name        uves_image_smooth_fft
  @memo        Smooth an image using a FFT.
  @param       inp  Image to filter
  @param       fx  Image to filter
  @return      1 newly allocated image.
  @doc
  This function applies a lowpass spatial filter of frequency fy along Y.

  The returned image is a newly allocated object, it must be deallocated
  using uves_free_image().
 */
/*--------------------------------------------------------------------------*/

cpl_image *
uves_image_smooth_fft(cpl_image * inp, const int fx)
{

  int sx=0;
  int sy=0;

  cpl_image* out=NULL;
  cpl_image* im_re=NULL;
  cpl_image* im_im=NULL;
  cpl_image* ifft_re=NULL;
  cpl_image* ifft_im=NULL;
  cpl_image* filter=NULL; 

  int sigma_x=fx;
  int sigma_y=0;

  cknull(inp,"Null in put image, exit");
  check_nomsg(im_re = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
  check_nomsg(im_im = cpl_image_cast(inp, CPL_TYPE_DOUBLE));

  // Compute FFT
  check_nomsg(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));

  check_nomsg(sx=cpl_image_get_size_x(inp));
  check_nomsg(sy=cpl_image_get_size_y(inp));
  sigma_x=sx;

  //Generates filter image
  check_nomsg(filter = uves_gen_lowpass(sx,sy,sigma_x,sigma_y));

  //Apply filter
  cpl_image_multiply(im_re,filter);
  cpl_image_multiply(im_im,filter);

  uves_free_image(&filter);

  check_nomsg(ifft_re = cpl_image_duplicate(im_re));
  check_nomsg(ifft_im = cpl_image_duplicate(im_im));

  uves_free_image(&im_re);
  uves_free_image(&im_im);

  //Computes FFT-INVERSE
  check_nomsg(cpl_image_fft(ifft_re,ifft_im,CPL_FFT_INVERSE));
  check_nomsg(out = cpl_image_cast(ifft_re, CPL_TYPE_FLOAT));

 cleanup:

  uves_free_image(&ifft_re);
  uves_free_image(&ifft_im);
  uves_free_image(&filter);
  uves_free_image(&im_re);
  uves_free_image(&im_im);

  if(cpl_error_get_code() != CPL_ERROR_NONE) {
    return NULL;
  } else {
    return out;
  }

}

/*-------------------------------------------------------------------------*/
/**
  @brief	Computes kappa-sigma clean mean (free bad pixels) for each input image of the input imagelist.
  @param	iml      input imagelist
  @param	kappa    value for kappa-sigma clip
  @return	vector with computed values for each image of the list

  The returned vector must be deallocated.
 */
/*--------------------------------------------------------------------------*/
cpl_vector * 
uves_imagelist_get_clean_mean_levels(cpl_imagelist* iml, double kappa)
{

   cpl_image* img=NULL;
   int size=0;
   int i=0;
   cpl_vector* values=NULL;
   double* pval=NULL;
   double mean=0;
   double stdev=0;
  
   check_nomsg(size=cpl_imagelist_get_size(iml));
   check_nomsg(values=cpl_vector_new(size));
   pval=cpl_vector_get_data(values);
   for(i=0;i<size;i++) {
      img=cpl_imagelist_get(iml,i);
      irplib_ksigma_clip(img,1,1,
                         cpl_image_get_size_x(img),
                         cpl_image_get_size_y(img),
                         5,kappa,1.e-5,&mean,&stdev);
      uves_msg("Ima %d mean level: %g",i+1,mean);
      pval[i]=mean;
   }

  cleanup:

   return values;
}


/*-------------------------------------------------------------------------*/
/**
  @brief	Subtract from input imagelist values specified in input vector.
  @param	iml      input imagelist
  @param	values   value to be subtracted
  @return	corrected imagelist

  The returned vector must be deallocated.
 */
/*--------------------------------------------------------------------------*/
cpl_error_code
uves_imagelist_subtract_values(cpl_imagelist** iml, cpl_vector* values)
{

   cpl_image* img=NULL;
   int size=0;
   int i=0;
   double* pval=NULL;
  
   check_nomsg(size=cpl_imagelist_get_size(*iml));
   pval=cpl_vector_get_data(values);
   for(i=0;i<size;i++) {
      img=cpl_imagelist_get(*iml,i);
      cpl_image_subtract_scalar(img,pval[i]);
      cpl_imagelist_set(*iml,img,i);
   }

  cleanup:

   return cpl_error_get_code();
}


/*-------------------------------------------------------------------------*/
/**
  @brief	Generate a low pass filter for FFT convolution .
  @param	xs	x size of the generated image.
  @param	ys	y size of the generated image.
  @param	sigma_x	Sigma for the gaussian distribution.
  @param	sigma_y      Sigma for the gaussian distribution.
  @return	1 newly allocated image.

  This function generates an image of a 2d gaussian, modified in such
  a way that the different quadrants have a quadrants of the gaussian
  in the corner. This image is suitable for FFT convolution.
  Copied from eclipse, src/iproc/generate.c

  The returned image must be deallocated.
 */
/*--------------------------------------------------------------------------*/
static cpl_image * 
uves_gen_lowpass(const int xs, 
                  const int ys, 
                  const double sigma_x, 
                  const double sigma_y)
{

    int i= 0.0;
    int j= 0.0;
    int hlx= 0.0;
    int hly = 0.0;
    double x= 0.0;
    double y= 0.0;
    double gaussval= 0.0;
    double inv_sigma_x=1./sigma_x;
    double inv_sigma_y=1./sigma_y;

    float *data;

    cpl_image 	*lowpass_image=NULL;


    lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
    if (lowpass_image == NULL) {
        uves_msg_error("Cannot generate lowpass filter <%s>",
                        cpl_error_get_message());
        return NULL;
    }

    hlx = xs/2;
    hly = ys/2;

    data = cpl_image_get_data_float(lowpass_image);
		
/* Given an image with pixels 0<=i<N, 0<=j<M then the convolution image
   has the following properties:

   ima[0][0] = 1
   ima[i][0] = ima[N-i][0] = exp (-0.5 * (i/sig_i)^2)   1<=i<N/2
   ima[0][j] = ima[0][M-j] = exp (-0.5 * (j/sig_j)^2)   1<=j<M/2
   ima[i][j] = ima[N-i][j] = ima[i][M-j] = ima[N-i][M-j] 
             = exp (-0.5 * ((i/sig_i)^2 + (j/sig_j)^2)) 
*/

    data[0] = 1.0;

    /* first row */
    for (i=1 ; i<=hlx ; i++) {
        x = i * inv_sigma_x;
        gaussval = exp(-0.5*x*x);
        data[i] = gaussval;
        data[xs-i] = gaussval;
    }

    for (j=1; j<=hly ; j++) {
        y = j * inv_sigma_y;
      /* first column */
        data[j*xs] = exp(-0.5*y*y);
        data[(ys-j)*xs] = exp(-0.5*y*y);

        for (i=1 ; i<=hlx ; i++) {
	/* Use internal symetries */
            x = i * inv_sigma_x;
            gaussval = exp (-0.5*(x*x+y*y));
            data[j*xs+i] = gaussval;
            data[(j+1)*xs-i] = gaussval;
            data[(ys-j)*xs+i] = gaussval;
            data[(ys+1-j)*xs-i] = gaussval;

        }
    }

    /* FIXME: for the moment, reset errno which is coming from exp()
            in first for-loop at i=348. This is causing cfitsio to
            fail when loading an extension image (bug in cfitsio too).
    */
    if(errno != 0)
        errno = 0;
    
    return lowpass_image;
}
/*-------------------------------------------------------------------------*/
/**
  @brief	Flag blemishes in a flat image
  @param	flat input image
  @param	head input header
  @return	output flag image or NULL 

 */
/*--------------------------------------------------------------------------*/
cpl_image*
uves_image_mflat_detect_blemishes(const cpl_image* flat, 
                                  const uves_propertylist* head)
{

   cpl_image* result=NULL;
   cpl_image* diff=NULL;
   cpl_image* flat_smooth=NULL;
   cpl_array* val=NULL;
   cpl_matrix* mx=NULL;

   int binx=0;
   int biny=0;
   int sx=0;
   int sy=0;
   int size=0;
   int i=0;
   int j=0;
   int k=0;
   int niter=3;
   int filter_width_x=7;
   int filter_width_y=7;

   double mean=0;
   double stdev=0;
   double stdev_x_4=0;

   double med_flat=0;

   double* pres=NULL;
   const double* pima=NULL;
   double* pval=NULL;
   double* pdif=NULL;
   int npixs=0;

   /* check input is valid */
   passure( flat !=NULL , "NULL input flat ");
   passure( head !=NULL , "NULL input head ");
  
   /* get image and bin sizes */
   sx=cpl_image_get_size_x(flat);
   sy=cpl_image_get_size_y(flat);
   npixs=sx*sy;

   binx=uves_pfits_get_binx(head);
   biny=uves_pfits_get_biny(head);

   /* set proper x/y filter width. Start values are 3 */
   if (binx>1) filter_width_x=5;
   if (biny>1) filter_width_y=5;


   /* create residuals image from smoothed flat */
   check_nomsg(mx=cpl_matrix_new(filter_width_x,filter_width_y));
  
  for(j=0; j< filter_width_y; j++){
    for(i=0; i< filter_width_x; i++){
      cpl_matrix_set( mx, i,j,1.0);
    }
  }
  
   check_nomsg(diff=cpl_image_duplicate(flat));

   check_nomsg(flat_smooth=uves_image_filter_median(flat,mx));
   /*
   check_nomsg(cpl_image_save(flat_smooth,"flat_smooth.fits",
			      CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
   */
   check_nomsg(cpl_image_subtract(diff,flat_smooth));
   /*
   check_nomsg(cpl_image_save(diff,"diff.fits",
			      CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
   */  
   /* compute median of flat */
   check_nomsg(med_flat=cpl_image_get_median(flat));

   /* prepare array of flat pixel values greater than the median */
   val=cpl_array_new(npixs,CPL_TYPE_DOUBLE);
   check_nomsg(cpl_array_fill_window_double(val,0,npixs,0));
   check_nomsg(pval=cpl_array_get_data_double(val));
   check_nomsg(pima=cpl_image_get_data_double_const(flat));
   check_nomsg(pdif=cpl_image_get_data_double(diff));
   k=0;
   for(i=0;i<npixs;i++) {
     if(pima[i]>med_flat) {
        pval[k]=pdif[i]; 
        k++;
     } 
   }   

   check_nomsg(cpl_array_set_size(val,k));
   
   /* computes 4 sigma clip mean of values */
   check_nomsg(mean=cpl_array_get_mean(val));
   check_nomsg(stdev=cpl_array_get_stdev(val));
   stdev_x_4=stdev*4.;
   check_nomsg(size=cpl_array_get_size(val));

   for(i=0;i<niter;i++) {
     for(k=0;k<size;k++) {
       if(fabs(pval[k]-mean)>stdev_x_4) {
	 cpl_array_set_invalid(val,k);
       }
     }
     mean=cpl_array_get_mean(val);
     stdev=cpl_array_get_stdev(val);
     stdev_x_4=stdev*4.;
   }

   /* compute absolute value of difference image */
   result=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
   pres=cpl_image_get_data_double(result);
   for(i=0;i<npixs;i++) {
     if(fabs(pdif[i])<stdev_x_4) {
       pres[i]=1.;
     }
   }

   /* save result to debug */
   /*
   check_nomsg(cpl_image_save(result,"blemish.fits",CPL_BPP_IEEE_FLOAT,NULL,
			CPL_IO_DEFAULT));
   */

 cleanup:
   uves_free_array(&val);
   uves_free_image(&diff);
   uves_free_image(&flat_smooth);
   uves_free_matrix(&mx);
   return result;
}


/**@}*/
