/*                                                                           *
 *   This file is part of the ESO X-shooter Pipeline                         *
 *   Copyright (C) 2006 European Southern Observatory                        *
 *                                                                           *
 *   This library is free software; you can redistribute it and/or modify    *
 *   it under the terms of the GNU General Public License as published by    *
 *   the Free Software Foundation; either version 2 of the License, or       *
 *   (at your option) any later version.                                     *
 *                                                                           *
 *   This program is distributed in the hope that it will be useful,         *
 *   but WITHOUT ANY WARRANTY; without even the implied warranty of          *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           *
 *   GNU General Public License for more details.                            *
 *                                                                           *
 *   You should have received a copy of the GNU General Public License       *
 *   along with this program; if not, write to the Free Software             *
 *   Foundation, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA    *
 *                                                                           */

/*
 * $Author: amodigli $
 * $Date: 2013-03-13 12:35:04 $
 * $Revision: 1.87 $
 * $Name: not supported by cvs2svn $
 */

#include <xsh_utils_wrappers.h>
#include <xsh_utils_image.h>
#include <xsh_error.h>
#include <xsh_utils.h>
#include <xsh_pfits_qc.h>
#include <xsh_pfits.h>
#include <xsh_dfs.h>
#include <xsh_data_pre.h>
#include <xsh_data_instrument.h>
#include <math.h>
#include <string.h>
#include <float.h>
#define FLAG    -1.e+9


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


static Stats * 
xsh_image_stats_on_rectangle ( cpl_image * im, 
                                   float      loReject,
                                   float      hiReject,
                                   int        llx, 
                                   int        lly, 
                                   int        urx, 
                                   int        ury );





static cpl_image* 
xsh_image_crop(const cpl_image *image,
		     int xlo, int ylo,
                    int xhi, int yhi);

static float 
xsh_clean_mean( float * array,
                  int     n_elements,
                  float   throwaway_low,
                  float   throwaway_high ) ;


static cpl_error_code
xsh_compute_geom_corr(
   const double dxdu,
   const double dydv,
   const double dxdv,
   const double dydu,
   const double du,
   const double dv,
   double* dA);


static double xsh_sinc(double x);
static void reverse_tanh_kernel(double * data, int nn);

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

/**@{*/


/**
 * @brief    Pixel area geometric trasformation computation
 * @param    dxdu    relative derivative dx/du
 * @param    dydv    relative derivative dy/dv
 * @param    dxdv    relative derivative dx/dv
 * @param    dydu    relative derivative dy/du
 * @param    du      incremental du
 * @param    dv      incremental dv
 * @param    dA      resulting pixel area change
 * @return   cpl_error_code 
 * @doc  http://wwwatnf.atnf.csiro.au/computing/software/midas/Hypertext/doc/95NOV/vol2/node19.html 
 */

static cpl_error_code
xsh_compute_geom_corr(
   const double dxdu,
   const double dydv,
   const double dxdv,
   const double dydu,
   const double du,
   const double dv,
   double* dA)
{


   *dA=fabs(dxdu*dydv-dxdv*dydu)*du*dv;
   return cpl_error_get_code();

}


/**
 * @brief    Pixel area geometric trasformation computation
 * @param    in    input image
 * @return   image containing in each pixel the geometric correction values
 * @doc  http://wwwatnf.atnf.csiro.au/computing/software/midas/Hypertext/doc/95NOV/vol2/node19.html 
 */

cpl_image*
xsh_image_compute_geom_corr(cpl_image* in)
{

   cpl_image* out=NULL;
   //float* pdata=NULL;
   int sx=0;
   int sy=0;
   register int i=0;
   register int j=0;
   double dxdu=0;
   double dydv=0;
   double dxdv=0;
   double dydu=0;
   double du=0;
   double dv=0;
   double dA=0;

   assure (in != NULL, CPL_ERROR_NULL_INPUT,"NULL input frame");
   check(sx=cpl_image_get_size_x(in));
   check(sy=cpl_image_get_size_y(in));

   //pdata=cpl_image_get_data_float(out);
   for(j=0;j<sy;j++) {
      for(i=0;i<sx;i++) {
         //Here we compute dxdu,dydv,dxdv,dydu,du,dv using some extra input
         //describing the transformation u=f(x,y) v=g(x,y) or the inverse
         // x=F(u,v) y=G(u,v)
         check(xsh_compute_geom_corr(dxdu,dydv,dxdv,dydu,du,dv,&dA));
      }
   }

  cleanup:

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




/*-------------------------------------------------------------------------*/
/**
  @name        xsh_generate_interpolation_kernel
  @memo        Generate an interpolation kernel to use in this module.
  @param    kernel_type        Type of interpolation kernel.
  @return    1 newly allocated array of doubles.
  @doc

  Provide the name of the kernel you want to generate. Supported kernel
  types are:

  \begin{tabular}{ll}
  NULL            &    default kernel, currently "tanh" \\
  "default"        &    default kernel, currently "tanh" \\
  "tanh"        &    Hyperbolic tangent \\
  "sinc2"        &    Square xsh_sinc \\
  "lanczos"        &    Lanczos2 kernel \\
  "hamming"        &    Hamming kernel \\
  "hann"        &    Hann kernel
  \end{tabular}

  The returned array of doubles is ready of use in the various re-sampling
  functions in this module. It must be deallocated using cpl_free().
 */
/*--------------------------------------------------------------------------*/

double   *
xsh_generate_interpolation_kernel(const char * kernel_type)
{
    double  *    tab ;
    int         i ;
    double      x ;
    double        alpha ;
    double        inv_norm ;
    int         samples = KERNEL_SAMPLES ;

    if (kernel_type==NULL) {
        tab = xsh_generate_interpolation_kernel("tanh") ;
    } else if (!strcmp(kernel_type, "default")) {
        tab = xsh_generate_interpolation_kernel("tanh") ;
    } else if (!strcmp(kernel_type, "sinc")) {
        tab = cpl_malloc(samples * sizeof(double)) ;
        tab[0] = 1.0 ;
        tab[samples-1] = 0.0 ;
        for (i=1 ; i<samples ; i++) {
            x = (double)KERNEL_WIDTH * (double)i/(double)(samples-1) ;
            tab[i] = xsh_sinc(x) ;
        }
    } else if (!strcmp(kernel_type, "sinc2")) {
        tab = cpl_malloc(samples * sizeof(double)) ;
        tab[0] = 1.0 ;
        tab[samples-1] = 0.0 ;
        for (i=1 ; i<samples ; i++) {
            x = 2.0 * (double)i/(double)(samples-1) ;
            tab[i] = xsh_sinc(x) ;
            tab[i] *= tab[i] ;
        }
    } else if (!strcmp(kernel_type, "lanczos")) {
        tab = cpl_malloc(samples * sizeof(double)) ;
        for (i=0 ; i<samples ; i++) {
            x = (double)KERNEL_WIDTH * (double)i/(double)(samples-1) ;
            if (fabs(x)<2) {
                tab[i] = xsh_sinc(x) * xsh_sinc(x/2) ;
            } else {
                tab[i] = 0.00 ;
            }
        }
    } else if (!strcmp(kernel_type, "hamming")) {
        tab = cpl_malloc(samples * sizeof(double)) ;
        alpha = 0.54 ;
        inv_norm  = 1.00 / (double)(samples - 1) ;
        for (i=0 ; i<samples ; i++) {
            x = (double)i ;
            if (i<(samples-1)/2) {
                tab[i] = alpha + (1-alpha) * cos(2.0*M_PI*x*inv_norm) ;
            } else {
                tab[i] = 0.0 ;
            }
        }
    } else if (!strcmp(kernel_type, "hann")) {
        tab = cpl_malloc(samples * sizeof(double)) ;
        alpha = 0.50 ;
        inv_norm  = 1.00 / (double)(samples - 1) ;
        for (i=0 ; i<samples ; i++) {
            x = (double)i ;
            if (i<(samples-1)/2) {
                tab[i] = alpha + (1-alpha) * cos(2.0*M_PI*x*inv_norm) ;
            } else {
                tab[i] = 0.0 ;
            }
        }
    } else if (!strcmp(kernel_type, "tanh")) {
        tab = xsh_generate_tanh_kernel(TANH_STEEPNESS) ;
    } else {
        xsh_msg_error("unrecognized kernel type [%s]: aborting generation",
                kernel_type) ;
        return NULL ;
    }

    return tab ;
}


/*-------------------------------------------------------------------------*/
/**
  @name        xsh_sinc
  @memo        Cardinal sine.
  @param    x    double value.
  @return    1 double.
  @doc

  Compute the value of the function xsh_sinc(x)=sin(pi*x)/(pi*x) at the
  requested x.
 */
/*--------------------------------------------------------------------------*/

static double
xsh_sinc(double x)
{
    if (fabs(x)<1e-4)
        return (double)1.00 ;
    else
        return ((sin(x * (double)M_PI)) / (x * (double)M_PI)) ;
}



/*-------------------------------------------------------------------------*/
/**
  @name        xsh_warp_image_generic
  @memo        Warp an image according to a polynomial transformation.
  @param    image_in        Image to warp.
  @param    kernel_type        Interpolation kernel to use.
  @param    poly_u            Polynomial transform in U.
  @param    poly_v            Polynomial transform in V.
  @return    1 newly allocated image.
  @doc

  Warp an image according to a polynomial transform. Provide two
  polynomials (see poly2d.h for polynomials in this library) Pu and Pv such
  as:

  \begin{verbatim}
  x = xsh_poly2d_compute(Pu, u, v)
  y = xsh_poly2d_compute(Pv, u, v)
  \end{verbatim}

  Attention! The polynomials define a reverse transform. (u,v) are
  coordinates in the warped image and (x,y) are coordinates in the original
  image. The transform you provide is used to compute from the warped
  image, which pixels contributed in the original image.

  The output image will have strictly the same size as in the input image.
  Beware that for extreme transformations, this might lead to blank images
  as result.

  See the function xsh_generate_interpolation_kernel() for possible kernel
  types. If you want to use a default kernel, provide NULL for kernel type.

  The returned image is a newly allocated objet, use cpl_image_delete() to
  deallocate it.

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

cpl_image *
xsh_warp_image_generic(
    cpl_image         *    image_in,
    char          *    kernel_type,
    cpl_polynomial    *    poly_u,
    cpl_polynomial    *    poly_v
)
{
    cpl_image    *    image_out ;
    int             i, j, k ;
    int             lx_out, ly_out ;
    double           cur ;
    double           neighbors[16] ;
    double           rsc[8],
                    sumrs ;
    double           x, y ;
    int             px, py ;
    int             pos ;
    int             tabx, taby ;
    double      *    kernel ;
    int                  leaps[16] ;
    int ilx=0;
    int ily=0;
    float* pidata=NULL;
    float* podata=NULL;
    cpl_vector* vx=NULL;
    if (image_in == NULL) return NULL ;


    /* Generate default interpolation kernel */
    kernel = xsh_generate_interpolation_kernel(kernel_type) ;
    if (kernel == NULL) {
        xsh_msg_error("cannot generate kernel: aborting resampling") ;
        return NULL ;
    }
    ilx=cpl_image_get_size_x(image_in);
    ily=cpl_image_get_size_y(image_in);
    pidata=cpl_image_get_data_float(image_in);

    /* Compute new image size   */
    lx_out = (int)ilx ;
    ly_out = (int)ily ;

    image_out = cpl_image_new(lx_out, ly_out,CPL_TYPE_FLOAT) ;
    podata=cpl_image_get_data_float(image_out);

    /* Pre compute leaps for 16 closest neighbors positions */

    leaps[0] = -1 - ilx ;
    leaps[1] =    - ilx ;
    leaps[2] =  1 - ilx ;
    leaps[3] =  2 - ilx ;

    leaps[4] = -1 ;
    leaps[5] =  0 ;
    leaps[6] =  1 ;
    leaps[7] =  2 ;

    leaps[8] = -1 + ilx ;
    leaps[9] =      ilx ;
    leaps[10]=  1 + ilx ;
    leaps[11]=  2 + ilx ;

    leaps[12]= -1 + 2*ilx ;
    leaps[13]=      2*ilx ;
    leaps[14]=  1 + 2*ilx ;
    leaps[15]=  2 + 2*ilx ;

    vx=cpl_vector_new(2); /* vector of size 2 = polynomial dimension */
    /* Double loop on the output image  */
    for (j=0 ; j < ly_out ; j++) {
        for (i=0 ; i< lx_out ; i++) {
            /* Compute the original source for this pixel   */
      cpl_vector_set(vx,0,(double)i);
      cpl_vector_set(vx,1,(double)j);
            x = cpl_polynomial_eval(poly_u, vx);
            y = cpl_polynomial_eval(poly_v, vx);

            /* Which is the closest integer positioned neighbor?    */
            px = (int)x ;
            py = (int)y ;

            if ((px < 1) ||
                (px > (ilx-3)) ||
                (py < 1) ||
                (py > (ily-3)))
                podata[i+j*lx_out] = (pixelvalue)0.0/0.0 ;
            else {
                /* Now feed the positions for the closest 16 neighbors  */
                pos = px + py * ilx ;
                for (k=0 ; k<16 ; k++)
                    neighbors[k] = (double)(pidata[(int)(pos+leaps[k])]) ;

                /* Which tabulated value index shall we use?    */
                tabx = (x - (double)px) * (double)(TABSPERPIX) ; 
                taby = (y - (double)py) * (double)(TABSPERPIX) ; 

                /* Compute resampling coefficients  */
                /* rsc[0..3] in x, rsc[4..7] in y   */

                rsc[0] = kernel[TABSPERPIX + tabx] ;
                rsc[1] = kernel[tabx] ;
                rsc[2] = kernel[TABSPERPIX - tabx] ;
                rsc[3] = kernel[2 * TABSPERPIX - tabx] ;
                rsc[4] = kernel[TABSPERPIX + taby] ;
                rsc[5] = kernel[taby] ;
                rsc[6] = kernel[TABSPERPIX - taby] ;
                rsc[7] = kernel[2 * TABSPERPIX - taby] ;

                sumrs = (rsc[0]+rsc[1]+rsc[2]+rsc[3]) *
                        (rsc[4]+rsc[5]+rsc[6]+rsc[7]) ;

                /* Compute interpolated pixel now   */
                cur =   rsc[4] * (  rsc[0]*neighbors[0] +
                                    rsc[1]*neighbors[1] +
                                    rsc[2]*neighbors[2] +
                                    rsc[3]*neighbors[3] ) +
                        rsc[5] * (  rsc[0]*neighbors[4] +
                                    rsc[1]*neighbors[5] +
                                    rsc[2]*neighbors[6] +
                                    rsc[3]*neighbors[7] ) +
                        rsc[6] * (  rsc[0]*neighbors[8] +
                                    rsc[1]*neighbors[9] +
                                    rsc[2]*neighbors[10] +
                                    rsc[3]*neighbors[11] ) +
                        rsc[7] * (  rsc[0]*neighbors[12] +
                                    rsc[1]*neighbors[13] +
                                    rsc[2]*neighbors[14] +
                                    rsc[3]*neighbors[15] ) ; 

                /* Affect the value to the output image */
                podata[i+j*lx_out] = (pixelvalue)(cur/sumrs) ;
                /* done ! */
            }       
        }
    }
    cpl_vector_delete(vx);
    cpl_free(kernel) ;
    return image_out ;
}


#define hk_gen(x,s) (((tanh(s*(x+0.5))+1)/2)*((tanh(s*(-x+0.5))+1)/2))

/*-------------------------------------------------------------------------*/
/**
  @name        xsh_generate_tanh_kernel
  @memo        Generate a hyperbolic tangent kernel.
  @param    steep    Steepness of the hyperbolic tangent parts.
  @return    1 pointer to a newly allocated array of doubles.
  @doc

  The following function builds up a good approximation of a box filter. It
  is built from a product of hyperbolic tangents. It has the following
  properties:

  \begin{itemize}
  \item It converges very quickly towards +/- 1.
  \item The converging transition is very sharp.
  \item It is infinitely differentiable everywhere (i.e. smooth).
  \item The transition sharpness is scalable.
  \end{itemize}

  The returned array must be deallocated using cpl_free().
 */
/*--------------------------------------------------------------------------*/

double * xsh_generate_tanh_kernel(double steep)
{
    double  *   kernel ;
    double  *   x ;
    double      width ;
    double      inv_np ;
    double      ind ;
    int         i ;
    int         np ;
    int         samples ;

    width   = (double)TABSPERPIX / 2.0 ; 
    samples = KERNEL_SAMPLES ;
    np      = 32768 ; /* Hardcoded: should never be changed */
    inv_np  = 1.00 / (double)np ;

    /*
     * Generate the kernel expression in Fourier space
     * with a correct frequency ordering to allow standard FT
     */
    x = cpl_malloc((2*np+1)*sizeof(double)) ;
    for (i=0 ; i<np/2 ; i++) {
        ind      = (double)i * 2.0 * width * inv_np ;
        x[2*i]   = hk_gen(ind, steep) ;
        x[2*i+1] = 0.00 ;
    }
    for (i=np/2 ; i<np ; i++) {
        ind      = (double)(i-np) * 2.0 * width * inv_np ;
        x[2*i]   = hk_gen(ind, steep) ;
        x[2*i+1] = 0.00 ;
    }

    /* 
     * Reverse Fourier to come back to image space
     */
    reverse_tanh_kernel(x, np) ;

    /*
     * Allocate and fill in returned array
     */
    kernel = cpl_malloc(samples * sizeof(double)) ;
    for (i=0 ; i<samples ; i++) {
        kernel[i] = 2.0 * width * x[2*i] * inv_np ;
    }
    cpl_free(x) ;
    return kernel ;
}


#define KERNEL_SW(a,b) tempr=(a);(a)=(b);(b)=tempr
/*-------------------------------------------------------------------------*/
/**
  @name        reverse_tanh_kernel
  @memo        Bring a hyperbolic tangent kernel from Fourier to normal space.
  @param    data    Kernel samples in Fourier space.
  @param    nn        Number of samples in the input kernel.
  @return    void
  @doc

  Bring back a hyperbolic tangent kernel from Fourier to normal space. Do
  not try to understand the implementation and DO NOT MODIFY THIS FUNCTION.
 */
/*--------------------------------------------------------------------------*/

static void 
reverse_tanh_kernel(double * data, int nn)
{
    unsigned long   n,
                    mmax,
                    m,
                    i, j,
                    istep ;
    double  wtemp,
            wr,
            wpr,
            wpi,
            wi,
            theta;
    double  tempr,
            tempi;

    n = (unsigned long)nn << 1;
    j = 1;
    for (i=1 ; i<n ; i+=2) {
        if (j > i) {
            KERNEL_SW(data[j-1],data[i-1]);
            KERNEL_SW(data[j],data[i]);
        }
        m = n >> 1;
        while (m>=2 && j>m) {
            j -= m;
            m >>= 1;
        }
        j += m;
    }
    mmax = 2;
    while (n > mmax) {
        istep = mmax << 1;
        theta = 2 * M_PI / mmax;
        wtemp = sin(0.5 * theta);
        wpr = -2.0 * wtemp * wtemp;
        wpi = sin(theta);
        wr  = 1.0;
        wi  = 0.0;
        for (m=1 ; m<mmax ; m+=2) {
            for (i=m ; i<=n ; i+=istep) {
                j = i + mmax;
                tempr = wr * data[j-1] - wi * data[j];
                tempi = wr * data[j]   + wi * data[j-1];
                data[j-1] = data[i-1] - tempr;
                data[j]   = data[i]   - tempi;
                data[i-1] += tempr;
                data[i]   += tempi;
            }
            wr = (wtemp = wr) * wpr - wi * wpi + wr;
            wi = wi * wpr + wtemp * wpi + wi;
        }
        mmax = istep;
    }
}
#undef KERNEL_SW



/*-------------------------------------------------------------------------*/
/**
  @name        xsh_show_interpolation_kernel
  @memo        Print out an interpolation kernel values on stdout.
  @param    kernel_name        Name of the kernel to print out.
  @return    void
  @doc

  Takes in input a kernel name, generates the corresponding kernel and
  prints it out on stdout, then discards the generated kernel.

  For debugging purposes mostly.
 */
/*--------------------------------------------------------------------------*/

void xsh_show_interpolation_kernel(char * kernel_name)
{
    double    *    ker ;
    int            i ;
    double        x ;


    ker = xsh_generate_interpolation_kernel(kernel_name) ;
    if (ker == NULL)
        return ;

    (void)fprintf(stdout, "# Kernel is %s\n", kernel_name) ;
    x = 0.00 ;
    for (i=0 ; i<KERNEL_SAMPLES ; i++) {
        (void)fprintf(stdout, "%g %g\n", x, ker[i]) ;
        x += 1.00 / (double)TABSPERPIX ;
    }
    cpl_free(ker) ;
    return ;
}

/**
 * @brief    Get robust empirical stdev of data
 * @param    image         image
 * @param    cut           pixels outside  median +- cut are ignored
 * @param    dstdev        (output) error of estimate
 * @return   empirical stdev (scatter around median, not mean)
 */
double 
xsh_image_get_stdev_robust(const cpl_image *image, 
				   double cut,
				   double *dstdev)
{
    cpl_mask *rejected = NULL;
    cpl_image *im = NULL;
    double median = 0;
    double robust_stdev = 0;

    assure (image != NULL, CPL_ERROR_NULL_INPUT,"NULL input frame");
    assure( cut > 0, CPL_ERROR_ILLEGAL_INPUT, "Illegal cut: %f", cut );
    assure( dstdev == NULL, CPL_ERROR_ILLEGAL_INPUT, "Unsupported");

    median = cpl_image_get_median(image);

    im = cpl_image_duplicate(image);
    cpl_image_subtract_scalar(im, median); 
    cpl_image_power(im, 2);
    /* Now squared residuals wrt median */
    
    rejected = cpl_mask_threshold_image_create(image,median - cut,
                                               median + cut);
    cpl_mask_not(rejected);
    cpl_image_reject_from_mask(im, rejected);

    robust_stdev = sqrt(cpl_image_get_mean(im));

  cleanup:
    xsh_free_image(&im);
    xsh_free_mask(&rejected);

    return robust_stdev;
}

/**
 * @brief    Get clean (3*sigma clip) empirical stdev of data
 * @param    image         image
 * @param    dstdev        (output) error of estimate
 * @return   empirical stdev (scatter around median, not mean)
 */
double xsh_image_get_stdev_clean(const cpl_image *image, 
				   double *dstdev)
{
    cpl_mask *rejected = NULL;
    cpl_image *im = NULL;
    double median = 0;
    double stdev = 0;
    double robust_stdev = 0;
    double kappa=3.0;
    double cut=0;

    assure (image != NULL, CPL_ERROR_NULL_INPUT,"NULL input frame");
    assure( dstdev == NULL, CPL_ERROR_ILLEGAL_INPUT, "Unsupported");

    median = cpl_image_get_median(image);
    stdev=cpl_image_get_stdev(image);
    cut=kappa*stdev;

    im = cpl_image_duplicate(image);
    cpl_image_subtract_scalar(im, median); 
    cpl_image_power(im, 2);
    /* Now squared residuals wrt median */
    
    rejected = cpl_mask_threshold_image_create(image,median - cut,
                                               median + cut);
    cpl_mask_not(rejected);
    cpl_image_reject_from_mask(im, rejected);

    robust_stdev = sqrt(cpl_image_get_mean(im));

  cleanup:
    xsh_free_image(&im);
    xsh_free_mask(&rejected);

    return robust_stdev;
}



/**
 * @brief    Compute fixed pattern noise in flat field
 * @param    master                master image
 * @param    convert_ADU           factor to convert from master units to ADU
 * @param    master_noise          master noise (ADU) for a shift of zero
 * @return   fixed pattern noise. The master noise is quadratically subtracted
 */
double
xsh_fixed_pattern_noise(const cpl_image *master,
                         double convert_ADU,
                         double master_noise)
{
    double master_fixed_pattern_noise=0;
    cpl_image *image1 = NULL;
    cpl_image *image2 = NULL;

    assure (master != NULL, CPL_ERROR_NULL_INPUT,"NULL input frame");

    /* Use central 101x101 window 
       and 101x101 window shifted (10, 10) from center
    */
    if (cpl_image_get_size_x(master) >= 121 &&
        cpl_image_get_size_y(master) >= 121) {
        
        int mid_x = (cpl_image_get_size_x(master) + 1) / 2;
        int mid_y = (cpl_image_get_size_y(master) + 1) / 2;
        
             
        image1=xsh_image_crop(master, 
                        mid_x - 50, mid_y - 50,
                        mid_x + 50, mid_y + 50);
        
              
        image2=xsh_image_crop(master, 
                        mid_x + 10 - 50, mid_y + 10 - 50,
                        mid_x + 10 + 50, mid_y + 10 + 50);

        cpl_image_subtract(image1, image2);

        master_fixed_pattern_noise = cpl_image_get_stdev(image1) / sqrt(2);

        /* Convert to ADU */
        master_fixed_pattern_noise *= convert_ADU;

        /* Subtract photon noise */
        if (master_fixed_pattern_noise >= master_noise) {
            
            master_fixed_pattern_noise = sqrt(master_fixed_pattern_noise*
                                              master_fixed_pattern_noise
                                              -
                                              master_noise*
                                              master_noise);
        }
        else {
            cpl_msg_warning(cpl_func,
                            "Zero-shift noise (%f ADU) is greater than "
                            "accumulated zero-shift and fixed pattern noise (%f ADU), "
                            "setting fixed pattern noise to zero",
                            master_noise,
                            master_fixed_pattern_noise);
            master_fixed_pattern_noise = 0;
        }
    }
    else {
        cpl_msg_warning(cpl_func,
                        "Master flat too small (%" CPL_SIZE_FORMAT "x%" CPL_SIZE_FORMAT "), "
                        "need size 121x121 to compute master flat "
                        "fixed pattern noise",
                        cpl_image_get_size_x(master),
                        cpl_image_get_size_y(master));
        master_fixed_pattern_noise = -1;
    }

  cleanup:
    xsh_free_image(&image1);
    xsh_free_image(&image2);

    return master_fixed_pattern_noise;
}

/**
 * @brief    Compute fixed pattern noise in bias
 * @param    first_raw             First raw bias frame
 * @param    second_raw            Second raw bias frame
 * @param    ron                   Read out noise (ADU) for a shift of zero
 * @return   fixed pattern noise. The ron is quadratically subtracted
 */
double
xsh_fixed_pattern_noise_bias(const cpl_image *first_raw,
                              const cpl_image *second_raw,
                              double ron)
{
    double bias_fixed_pattern_noise=0;
    cpl_image *image1 = NULL;
    cpl_image *image2 = NULL;
    int nx, ny;

    assure (first_raw != NULL, CPL_ERROR_NULL_INPUT,"NULL input image");
    assure (second_raw != NULL, CPL_ERROR_NULL_INPUT,"NULL input image");

    /* 
     * Extract the largest possible two windows shifted (10, 10) 
     */

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

 
    image1=xsh_image_crop(first_raw, 1, 1,nx - 10, ny - 10);
        
 
    image2=xsh_image_crop(second_raw, 11, 11,nx, ny);

    cpl_image_subtract(image1, image2);

    bias_fixed_pattern_noise = xsh_image_get_stdev_robust(image1, 50, NULL) 
                             / sqrt(2);

    /* 
     * Subtract ron quadratically
     */

    if (bias_fixed_pattern_noise > ron) {
            
        bias_fixed_pattern_noise = sqrt(bias_fixed_pattern_noise *
                                        bias_fixed_pattern_noise
                                        -
                                        ron * ron);
    }
    else {
        cpl_msg_warning(cpl_func,
                        "Zero-shift noise (%f ADU) is greater than "
                        "accumulated zero-shift and fixed pattern "
                        "noise (%f ADU), "
                        "setting fixed pattern noise to zero",
                        ron,
                        bias_fixed_pattern_noise);
        bias_fixed_pattern_noise = 0;
    }

  cleanup:
    xsh_free_image(&image1);
    xsh_free_image(&image2);

    return bias_fixed_pattern_noise;
}


/**
 * @brief    Crop image
 * @param    image         image
 * @param    xlo           lower left x
 * @param    ylo           lower left y
 * @param    xhi           upper right x
 * @param    yhi           upper right y
 * @return    cropped image
 * This function does a locale image extraction, that is
 * the parts outside the rectangular region (xlo, ylo) - (xhi, yhi)
 * are removed.
 *
 * Coordinates are inclusive, counting from 1
 */
static cpl_image* 
xsh_image_crop(const cpl_image *image,
		     int xlo, int ylo,
		     int xhi, int yhi)
{
    /* CPL is missing the function to locally extract an image,
       so this this inefficient CPL function */
    cpl_image *image_crop = NULL;
    assure( image != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null input image" );
    assure( 1 <= xlo && xlo <= xhi && xhi <= cpl_image_get_size_x(image) &&
            1 <= ylo && ylo <= yhi && yhi <= cpl_image_get_size_y(image),
            CPL_ERROR_ILLEGAL_INPUT, 
            "Cannot extraction region (%d, %d) - (%d, %d) of %" CPL_SIZE_FORMAT "x%" CPL_SIZE_FORMAT " image",
            xlo, ylo, xhi, yhi,
            cpl_image_get_size_x(image),
            cpl_image_get_size_y(image));

 

    check(image_crop = cpl_image_extract(image,xlo, ylo,xhi, yhi));

/* Not computed for the moment
    cpl_image *new_data = cpl_image_extract(image,xlo, ylo,xhi, yhi);
    cpl_image_delete(image);

    cpl_image* new_variance = cpl_image_extract(image->variance,
                                                xlo, ylo,
                                                xhi, yhi);
    cpl_image_delete(image->variance);

    image->data = new_data;
    image->variance = new_variance;
*/
  cleanup:
    if(cpl_error_get_code() != CPL_ERROR_NONE) {
      return NULL;
    } else {
      return image_crop;
    }
}



/**
 * @brief    Compute area change ratio for a 2D polynomial transformation.
 *
 * @param    out       Pre-allocated image to hold the result
 * @param    poly_x    Defines source x-pos corresponding to destination (u,v).
 * @param    poly_y    Defines source y-pos corresponding to destination (u,v).
 *
 * @return   CPL_ERROR_NONE or the relevant #_cpl_error_code_ on error
 *
 * @see cpl_image_warp_polynomial()
 *
 *
 * Given a polynomial transformation from (x, y) to (u, v) coordinate
 * systems, such as the one used in @c cpl_image_warp_polynomial() to
 * "warp" (or "map") an image onto another, this function creates an
 * image reporting for each pixel the scaling ratio between the unitary 
 * area in the system (u, v) and the same area before mapping, in the
 * system (x, y).
 *
 * This is trivially obtained by computing the absolute value of the
 * determinant of the Jacobian of the transformation for each pixel
 * of the image @em out.
 *
 * Typically this function would be used to determine a flux-conservation
 * correction map for the target image specified in function
 * @c cpl_image_warp_polynomial(). For example,
 *
 * @verbatim
 * cpl_image_warp_polynomial(out, in, poly_x, poly_y, xprof, xrad, yprof, yrad);
 * correction_map = cpl_image_new(cpl_image_get_size_x(out),
 *                                cpl_image_get_size_y(out),
 *                                cpl_image_get_type(out));
 * cpl_image_warp_polynomial_scale(correction_map, poly_x, poly_y);
 * out_flux_corrected = cpl_image_multiply_create(out, correction_map);
 * @endverbatim
 *
 * where @em out_flux_corrected is the resampled image @em out after
 * correction for flux conservation.
 *
 * @note
 *   The scale map produced by this function is not applicable for
 *   flux conservation in case the transformation implies severe
 *   undersampling of the original signal.
 *
 * Possible #_cpl_error_code_ set in this function:
 * - CPL_ERROR_NULL_INPUT if (one of) the input pointer(s) is NULL
 * - CPL_ERROR_ILLEGAL_INPUT if the polynomial dimensions are not 2
 * - CPL_ERROR_INVALID_TYPE if the passed image type is not supported
 */

cpl_error_code xsh_image_warp_polynomial_scale(cpl_image *out,
                                               const cpl_polynomial *poly_x,
                                               const cpl_polynomial *poly_y)
{
    cpl_polynomial *dxdu=NULL;
    cpl_polynomial *dxdv=NULL;
    cpl_polynomial *dydu=NULL;
    cpl_polynomial *dydv=NULL;

    cpl_vector     *val=NULL;
    double         *pval=NULL;

    double         *ddata=NULL;
    float          *fdata=NULL;

    int             nx, ny;
    int             i, j;


    if (out == NULL || poly_x == NULL || poly_y == NULL)
        return cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT);

    if (cpl_polynomial_get_dimension(poly_x) != 2 ||
        cpl_polynomial_get_dimension(poly_y) != 2)
        return cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);

    if (cpl_image_get_type(out) != CPL_TYPE_FLOAT &&
        cpl_image_get_type(out) != CPL_TYPE_DOUBLE)
        return cpl_error_set(cpl_func, CPL_ERROR_INVALID_TYPE);


    /*
     * Compute the partial derivatives of the transformation:
     */

    dxdu = cpl_polynomial_duplicate(poly_x);
    dxdv = cpl_polynomial_duplicate(poly_x);
    dydu = cpl_polynomial_duplicate(poly_y);
    dydv = cpl_polynomial_duplicate(poly_y);

    cpl_polynomial_derivative(dxdu, 0);
    cpl_polynomial_derivative(dxdv, 1);
    cpl_polynomial_derivative(dydu, 0);
    cpl_polynomial_derivative(dydv, 1);


    /*
     * This section is for assigning the (local) scaling factor
     * to each pixel of the reference image.
     */

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

    val = cpl_vector_new(2);
    pval = cpl_vector_get_data(val);

    switch (cpl_image_get_type(out)) {
    case CPL_TYPE_FLOAT:
        fdata = cpl_image_get_data_float(out);
        for (j=0; j < ny; j++) {
            pval[1] = j + 1;
            for (i=0; i < nx; i++) {
                pval[0] = i + 1;
                *fdata++ = cpl_polynomial_eval(dxdu, val)
                         * cpl_polynomial_eval(dydv, val)
                         - cpl_polynomial_eval(dxdv, val)
                         * cpl_polynomial_eval(dydu, val);
            }
        }
        break;
    case CPL_TYPE_DOUBLE:
        ddata = cpl_image_get_data_double(out);
        for (j=0; j < ny; j++) {
            pval[1] = j + 1;
            for (i=0; i < nx; i++) {
                pval[0] = i + 1;
                *ddata++ = cpl_polynomial_eval(dxdu, val)
                         * cpl_polynomial_eval(dydv, val)
                         - cpl_polynomial_eval(dxdv, val)
                         * cpl_polynomial_eval(dydu, val);
            }
        }
        break;
    default:

        /*
         * Impossible to reach this point. An assert(0) here
         * would be in order, but what the heck...
         */

        break;
    }

    cpl_vector_delete(val);
    cpl_polynomial_delete(dxdu);
    cpl_polynomial_delete(dxdv);
    cpl_polynomial_delete(dydu);
    cpl_polynomial_delete(dydv);


    /*
     * Ensure the scale factor is positive...
     */

    cpl_image_abs(out);

    return CPL_ERROR_NONE;

}


/**
 * @brief  Compute X Scharr filter transformation.
 * @param  in input image
 * @return X scarr filter image  
 * @ref http://en.wikipedia.org/wiki/Sobel_operator
*/
cpl_image*
xsh_scharr_x(cpl_image* in) {

  cpl_image* scharr_x=NULL;
  float* pscharr_x=NULL;
  float* pin=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;


  check(scharr_x=cpl_image_duplicate(in));
  check(pscharr_x=cpl_image_get_data_float(scharr_x));
  check(pin=cpl_image_get_data_float(in));
  check(sx=cpl_image_get_size_x(in));
  check(sy=cpl_image_get_size_y(in));

  for(i=1;i<sx-1;i++) {
    for(j=1;j<sy-1;j++) {
      pscharr_x[i+j*sx]=3*pin[i-1+(j+1)*sx]-3*pin[i+1+(j+1)*sx]+
                10*pin[i-1+j*sx]-10*pin[i+1+j*sx]+
	          3*pin[i-1+(j-1)*sx]-3*pin[i+1+(j-1)*sx];
    }
  }

 cleanup:
  return scharr_x;

}



/**
 * @brief  Compute Y Scharr filter transformation.
 * @param  in input image
 * @return Y scharr filter image  
 * @ref http://en.wikipedia.org/wiki/Sobel_operator
*/
cpl_image*
xsh_scharr_y(cpl_image* in) {

  cpl_image* scharr_y=NULL;
  float* pscharr_y=NULL;
  float* pin=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;


  check(scharr_y=cpl_image_duplicate(in));
  check(pscharr_y=cpl_image_get_data_float(scharr_y));
  check(pin=cpl_image_get_data_float(in));
  check(sx=cpl_image_get_size_x(in));
  check(sy=cpl_image_get_size_y(in));

  for(i=1;i<sx-1;i++) {
    for(j=1;j<sy-1;j++) {
      pscharr_y[i+j*sx]=3*pin[i-1+(j+1)*sx]+10*pin[i+(j+1)*sx]+3*pin[i+1+(j+1)*sx]+
	         -3*pin[i-1+(j-1)*sx]-10*pin[i+(j-1)*sx]-3*pin[i+1+(j-1)*sx];
    }
  }

 cleanup:
  return scharr_y;

}


/**
 * @brief  Compute X Sobel filter transformation.
 * @param  in input image
 * @return X scharr filter image  
 * @ref http://en.wikipedia.org/wiki/Sobel_operator
*/

cpl_image*
xsh_sobel_lx(cpl_image* in) {

  cpl_image* lx=NULL;
  float* plx=NULL;
  float* pin=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;


  check(lx=cpl_image_duplicate(in));
  check(plx=cpl_image_get_data_float(lx));
  check(pin=cpl_image_get_data_float(in));
  check(sx=cpl_image_get_size_x(in));
  check(sy=cpl_image_get_size_y(in));

  for(i=1;i<sx-1;i++) {
    for(j=1;j<sy-1;j++) {
      plx[i+j*sx]=pin[i-1+(j+1)*sx]-pin[i+1+(j+1)*sx]+
                2*pin[i-1+j*sx]-2*pin[i+1+j*sx]+
	          pin[i-1+(j-1)*sx]-pin[i+1+(j-1)*sx];
    }
  }

 cleanup:
  return lx;

}



/**
 * @brief  Compute Y Sobel filter transformation.
 * @param  in input image
 * @return Y scharr filter image  
 * @ref http://en.wikipedia.org/wiki/Sobel_operator
*/

cpl_image*
xsh_sobel_ly(cpl_image* in) {



  cpl_image* ly=NULL;
  float* ply=NULL;
  float* pin=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;


  check(ly=cpl_image_duplicate(in));
  check(ply=cpl_image_get_data_float(ly));
  check(pin=cpl_image_get_data_float(in));
  check(sx=cpl_image_get_size_x(in));
  check(sy=cpl_image_get_size_y(in));

  for(i=1;i<sx-1;i++) {
    for(j=1;j<sy-1;j++) {
      ply[i+j*sx]=pin[i-1+(j+1)*sx]+2*pin[i+(j+1)*sx]+pin[i+1+(j+1)*sx]+
	         -pin[i-1+(j-1)*sx]-2*pin[i+(j-1)*sx]-pin[i+1+(j-1)*sx];
    }
  }
 cleanup:
  return ly;

}

/**
@brief compute ron taking random windows of given size in a given region on 2 frames difference
@param frames input frameset
@param llx image lower left x
@param lly image lower left y
@param urx image upper left x
@param ury image upper left y
@param nsampl number of sampling window
@param hsize hal size of (square) window
@param reg_id parameter switch
@param ron output ron value
@param ron_err output error on ron value

*/

cpl_error_code
xsh_compute_ron(cpl_frameset* frames,
                int llx, 
                int lly, 
                int urx, 
                int ury,
                int nsampl, 
                int hsize,
		const int reg_id,
                double* ron, 
                double* ron_err)
{

   cpl_frame* bias1=NULL;
   cpl_frame* bias2=NULL;

   cpl_image* ima1=NULL;
   cpl_image* ima2=NULL;
   cpl_image* imad=NULL;
  
   const char* name1=NULL;
   const char* name2=NULL;
   int nx1=0;
   int ny1=0;
   int nx2=0;
   int ny2=0;
   cpl_size zone[4];
   int nfrm=0;
   cpl_propertylist* plist=NULL;
   //const char* name_o="BIAS_PAIR_DIFF.fits";


   check(nfrm=cpl_frameset_get_size(frames));

   if ( nfrm < 2 ) goto cleanup;

   check(bias1=cpl_frameset_get_frame(frames,0));
   check(bias2=cpl_frameset_get_frame(frames,1));
   check(name1=cpl_frame_get_filename(bias1));
   check(name2=cpl_frame_get_filename(bias2));
   check(ima1=cpl_image_load(name1,CPL_TYPE_FLOAT,0,0));
   check(ima2=cpl_image_load(name2,CPL_TYPE_FLOAT,0,0));

   check(nx1=cpl_image_get_size_x(ima1));
   check(nx2=cpl_image_get_size_x(ima2));

   check(ny1=cpl_image_get_size_y(ima1));
   check(ny2=cpl_image_get_size_y(ima2));

   if((nx1 != nx2) || (ny1 != ny2)) {
      xsh_error_msg("image1's size: [%d,%d] != from image2's size [%d,%d]",
		    nx1,ny1,nx2,ny2);
      goto cleanup;
   }
  
   check(plist=cpl_propertylist_load(name1,0));

   if(llx == -1) llx=1;
   if(lly == -1) lly=1;

   if(urx == -1) urx=nx1;
   if(ury == -1) ury=ny1;

   zone[0]=llx;
   zone[1]=urx;
   zone[2]=lly;
   zone[3]=ury;

   check(imad=cpl_image_duplicate(ima1));
   check(cpl_image_subtract(imad,ima2));

   check(cpl_flux_get_noise_window(imad, zone,hsize,nsampl,ron,ron_err));

 
   *ron/=sqrt(2);
   *ron_err/=sqrt(2);
  


   if(reg_id==1) {
      xsh_pfits_set_qc_ron1(plist,*ron);
      xsh_pfits_set_qc_ron1_err(plist,*ron_err);
   } else{
      xsh_pfits_set_qc_ron2(plist,*ron);
      xsh_pfits_set_qc_ron2_err(plist,*ron_err);
   }
   check(cpl_propertylist_append_string(plist,XSH_PCATG,"BIAS_PAIR_DIFF"));
   //check(cpl_image_save(imad,name_o,CPL_BPP_IEEE_FLOAT,plist,CPL_IO_DEFAULT));

  cleanup:
   xsh_free_image(&ima1);
   xsh_free_image(&ima2);
   xsh_free_image(&imad);
   xsh_free_propertylist(&plist);
   

 
   if (cpl_error_get_code()) {
      return -1 ;
   } else {
      return 0 ;
   }

 
}

/**
@brief search bad pixels
  
   @param darks sequence of darks (NDIT = 1) 
                 stored in a cube, at least 10 to get good statistics
   @param thresh_sigma_factor factor to determined standard deviation
                             in each pixel to determine the threshold
                             beyond which a pixel is declared as bad.
 
   @param low_threshold percentage (0...100) of extreme pixel values that is \
                    not considered for image statistics

   @param high_threshold percentage (0...100) of extreme pixel values that is \
                    not considered for image statistics

   @param  llx lower left X corner pix
   @param  lly upper left Y corner pix

   @param  urx lower right X corner pix
   @param  ury upper right Y corner pix

   @return Bad pixel mask image (1: good pixel, 0: bad pixel). 

   Job  this routine searches for static bad pixel positions
        This is done by building a cube of xsh_dark frames and examine 
        the noise variations in each pixel. If big deviations
        from a clean mean pixel noise occurr, the pixel is declared as bad.
 */

cpl_image * 
xsh_image_search_bad_pixels_via_noise(cpl_imagelist *  darks,
                                      float      thresh_sigma_factor,
                                      float      low_threshold,
                                      float      high_threshold,
                                      int llx,
                                      int lly,
                                      int urx,
                                      int ury)
{
   cpl_image * bp_map =NULL;
   int        z, n, i ;
   int        lx, ly ;
   int        row, col ;
   int        low_n, high_n ;
   float    * spectrum =NULL;
   double     pix_sum ;
   double     sqr_sum ;
   Stats    * stats =NULL;
   cpl_image* img_src=NULL;

   float* psrcdata=NULL;
   float* pbpdata=NULL;

   int lz=0;
    
   if ( NULL == darks )
   {
      xsh_msg_error("no input cube given!\n") ;
      return NULL ;
   }

   if ( thresh_sigma_factor <= 0. )
   {
      xsh_msg_error("factor is smaller or equal zero!\n") ;
      return NULL ;
   }
   if ( low_threshold < 0. || high_threshold < 0. || (low_threshold + high_threshold) >= 100.  )
   {
      xsh_msg_error("wrong reject percentage values!\n") ;
      return NULL ;
   }

   lz=cpl_imagelist_get_size(darks);
   if ( lz < 1 )
   {
      xsh_msg_error("not enough dark frames given for good statistics!") ;
      return NULL ;
   }
   img_src=cpl_imagelist_get(darks,0);
    
   lx = cpl_image_get_size_x(img_src) ;
   ly = cpl_image_get_size_y(img_src) ;

   if (llx == -1) llx=1;
   if (lly == -1) lly=1;

   if (urx == -1) urx=lx;
   if (ury == -1) ury=ly;

   llx = (llx<1) ? 1 : llx;
   lly = (lly<1) ? 1 : lly;

   urx = (urx>lx) ? lx : urx;
   ury = (ury>ly) ? lx : ury;


 
   low_n  = (int)(low_threshold/100. *(float)lz) ;
   high_n = (int)(high_threshold/100. *(float)lz) ;
  
   if (NULL == (bp_map = cpl_image_new (lx, ly,CPL_TYPE_FLOAT) ) )
   {
      xsh_msg_error("could not allocate new memory!\n") ;
      return NULL ;
   }
   pbpdata=cpl_image_get_data(bp_map);
   if (NULL == (spectrum = (float*) cpl_calloc(lz, sizeof(float)) ) )
   {
      xsh_msg_error("could not allocate new memory!\n") ;
      return NULL ;
   }


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

      for ( col = 0 ; col < lx ; col++ ) {

         for ( z = 0 ; z < lz ; z++ ) {
            img_src=cpl_imagelist_get(darks,z);
            psrcdata=cpl_image_get_data(img_src);
            spectrum[z] = psrcdata[col+lx*row] ;
         }
         xsh_pixel_qsort(spectrum, lz) ;
         n = 0  ;
         pix_sum = 0.; 
         sqr_sum = 0.; 
         for ( i = low_n ; i < lz - high_n ; i++ ) {
            pix_sum += (double)spectrum[i] ;
            sqr_sum += ((double)spectrum[i]*(double)spectrum[i]) ;
            n++ ;
         }
         /* compute the noise in each pixel */
         pix_sum /= (double)n ;
         sqr_sum /= (double)n ;

         pbpdata[col+lx*row] = (float)sqrt(sqr_sum - pix_sum*pix_sum) ;
      }
   }

   cpl_free(spectrum) ;
   if ( NULL == (stats = xsh_image_stats_on_rectangle(bp_map, 
                                                          low_threshold,
                                                          high_threshold, 
                                                          llx, lly,urx,ury)))
   {
      xsh_msg_error("could not get image statistics!\n") ;
      cpl_image_delete (bp_map) ;
      return NULL ;
   }


   /* now build the bad pixel mask */
   for ( row = 0 ; row < ly ; row++ ) {
      for ( col = 0 ; col < lx ; col++ ) {
         if (pbpdata[col+lx*row] >
             stats->cleanmean+thresh_sigma_factor*stats->cleanstdev ||
             pbpdata[col+lx*row] < 
             stats->cleanmean-thresh_sigma_factor*stats->cleanstdev) 
         {
             pbpdata[col+lx*row] = QFLAG_HOT_PIXEL ;
         }
         else
         {
             pbpdata[col+lx*row] = 0. ;
         }
      }
   }

   cpl_free (stats) ;
   return bp_map ;
}


/**
@brief computes the mean and standard deviation of a given 
       rectangle on an image by leaving the extreme intensity values.
   @name  xsh_image_stats_on_rectangle()
   @param im flatfield image to search for bad pix
   @param loReject percentage (0...100) of extrem values
                                            that should not be considere
   @param hiReject percentage (0...100) of extrem values
                                            that should not be considered
   @param llx lower left pixel position of rectangle
   @param lly lower left pixel position of rectangle
   @param urx upper right pixel position of rectangle
   @param ury upper right pixel position of rectangle
   @return data structure giving the mean and standard deviation 
 */

Stats * xsh_image_stats_on_rectangle ( cpl_image * im, 
                                float      loReject,
                                float      hiReject,
                                int        llx, 
                                int        lly, 
                                int        urx, 
                                int        ury )
{
    Stats * retstats=NULL;
    int i=0 ;
    int row=0;
    int col=0;
    int n=0;
    int npix=0;
    int lo_n=0;
    int hi_n=0;
    double pix_sum=0;
    double sqr_sum=0;
    float * pix_array=NULL;
    int im_lx=0;
    int im_ly=0;
    float* pim=NULL;

    if ( NULL == im )
    {
        xsh_msg_error("sorry, no input image given!") ;
        return NULL ;
    }
    if ( loReject+hiReject >= 100. )
    {
        xsh_msg_error("sorry, too much pixels rejected!") ;
        return NULL ;
    }
    if ( loReject < 0. || loReject >= 100. || 
         hiReject < 0. || hiReject >= 100. )
    {
        xsh_msg_error("sorry, negative reject values!") ;
        return NULL ;
    }

    im_lx=cpl_image_get_size_x(im);
    im_ly=cpl_image_get_size_y(im);
    if ( llx < 0 || lly < 0 || 
         urx < 0 || ury < 0 ||
         llx > im_lx || lly > im_ly ||
         urx > im_lx || ury > im_ly || 
         ury <= lly || urx <= llx )
    {
        xsh_msg_error("sorry, wrong pixel coordinates of rectangle!") ;
        xsh_msg_error("llx < 0 || lly < 0 ||urx < 0 || ury < 0 ||llx > im_lx || lly > im_ly ||urx > im_lx || ury > im_ly || ury <= lly || urx <= llx");
        xsh_msg_error("llx=%d lly=%d urx=%d ury=%d  im_lx=%d im_ly=%d",
                      llx,lly,urx,ury,im_lx,im_ly);
        return NULL ;
    }

     /* allocate memory */
    retstats = (Stats*) cpl_calloc(1, sizeof(Stats)) ;
    npix = (urx - llx + 1) * (ury - lly + 1) ;
    pix_array = (float*) cpl_calloc ( npix, sizeof(float) ) ;

    /*------------------------------------------------------------------------- 
     * go through the rectangle and copy the pixel values into an array.
     */
    n = 0 ;
    pim = cpl_image_get_data_float(im);
    int row_min=0;
    int row_max=0;
    int col_min=0;
    int col_max=0;

    col_min = (llx>0) ? llx : 0;
    row_min = (lly>0) ? lly : 0;
    col_max = (urx<im_lx) ? urx : im_lx-1;
    row_max = (ury<im_ly) ? ury : im_ly-1;

    for ( row = row_min ; row <= row_max ; row++ )
    {
        for ( col = col_min ; col <= col_max ; col++ )
        {
            if ( !isnan(pim[col + row*im_lx]) )
            {
                pix_array[n] = pim[col + row*im_lx] ;
                n++ ;
            }
    }
    }
    
    npix = n;
    /*if (n != npix)
    {
        xsh_msg_error("the computed number of pixel equals "
                        "not the counted number, impossible!") ;
        cpl_free(retstats) ;
        cpl_free(pix_array) ;
        return NULL ;
    }*/

    /* determining the clean mean is already done in the recipes */
    if ( FLT_MAX == (retstats->cleanmean = xsh_clean_mean(pix_array, 
                                           npix, loReject, hiReject)) )
    {    
        xsh_msg_error("xsh_clean_mean() did not work!") ;
        cpl_free(retstats) ;
        cpl_free(pix_array) ;
        return NULL ;
    } 

    /* now the clean standard deviation must be calculated */
    /* initialize sums */
    lo_n = (int) (loReject / 100. * (float)npix) ;
    hi_n = (int) (hiReject / 100. * (float)npix) ;
    pix_sum = 0. ;
    sqr_sum = 0. ;
    n = 0 ;
    for ( i = lo_n ; i <= npix - hi_n ; i++ )
    {
        pix_sum += (double)pix_array[i] ;
        sqr_sum += ((double)pix_array[i] * (double)pix_array[i]) ;
        n++ ;
    }

    if ( n == 0 )
    {    
        xsh_msg_error("number of clean pixels is zero!") ;
        cpl_free(retstats) ;
        cpl_free(pix_array) ;
        return NULL ;
    } 
    retstats -> npix = n ;
    pix_sum /= (double) n ;
    sqr_sum /= (double) n ;
    retstats -> cleanstdev = (float)sqrt(sqr_sum - pix_sum * pix_sum) ;
    cpl_free (pix_array) ;
    return retstats ;
}

#define PIX_SWAP(a,b) { pixelvalue temp=(a);(a)=(b);(b)=temp; }
#define PIX_STACK_SIZE 50

/**
  @name        xsh_pixel_qsort
  @memo        Sort an array of pixels by increasing pixelvalue.
  @param    pix_arr        Array to sort.
  @param    npix        Number of pixels in the array.
  @return    void
  @doc

  Optimized implementation of a fast pixel sort. The input array is
  modified.
 */
void 
xsh_pixel_qsort(pixelvalue *pix_arr, int npix)
{
    int         i,
                ir,
                j,
                k,
                l;
    int        i_stack[PIX_STACK_SIZE*sizeof(pixelvalue)] ;
    int         j_stack ;
    pixelvalue  a ;

    ir = npix ;
    l = 1 ;
    j_stack = 0 ;
    for (;;) {
        if (ir-l < 7) {
            for (j=l+1 ; j<=ir ; j++) {
                a = pix_arr[j-1];
                for (i=j-1 ; i>=1 ; i--) {
                    if (pix_arr[i-1] <= a) break;
                    pix_arr[i] = pix_arr[i-1];
                }
                pix_arr[i] = a;
            }
            if (j_stack == 0) break;
            ir = i_stack[j_stack-- -1];
            l  = i_stack[j_stack-- -1];
        } else {
            k = (l+ir) >> 1;
            PIX_SWAP(pix_arr[k-1], pix_arr[l])
            if (pix_arr[l] > pix_arr[ir-1]) {
                PIX_SWAP(pix_arr[l], pix_arr[ir-1])
            }
            if (pix_arr[l-1] > pix_arr[ir-1]) {
                PIX_SWAP(pix_arr[l-1], pix_arr[ir-1])
            }
            if (pix_arr[l] > pix_arr[l-1]) {
                PIX_SWAP(pix_arr[l], pix_arr[l-1])
            }
            i = l+1;
            j = ir;
            a = pix_arr[l-1];
            for (;;) {
                do i++; while (pix_arr[i-1] < a);
                do j--; while (pix_arr[j-1] > a);
                if (j < i) break;
                PIX_SWAP(pix_arr[i-1], pix_arr[j-1]);
            }
            pix_arr[l-1] = pix_arr[j-1];
            pix_arr[j-1] = a;
            j_stack += 2;
            if (j_stack > PIX_STACK_SIZE) {
                xsh_msg_error("stack too small : aborting");
                abort() ;
            }
            if (ir-i+1 >= j-l) {
                i_stack[j_stack-1] = ir;
                i_stack[j_stack-2] = i;
                ir = j-1;
            } else {
                i_stack[j_stack-1] = j-1;
                i_stack[j_stack-2] = l;
                l = i;
            }
        }
    }
}
#undef PIX_STACK_SIZE
#undef PIX_SWAP

/**
@brief his routine computes the clean mean of a given data
   @name xsh_clean_mean()
   @param array data array to average
   @param n_elements number of elements of the data array
   @param throwaway_low percentage of low value elements to be 
                         thrown away before averaging
   @param throwaway_high percentage of high value elements to be 
                          thrown away before averaging
   @return the clean mean of a data array
                        FLT_MAX in case of error 
   @doc
   this routine computes the clean mean of a given data array that means the 
   array is first sorted and a given percentage of the lowest and the 
   highest values is not considered for averaging
 */
float xsh_clean_mean( float * array, 
                  int     n_elements,
                  float   throwaway_low,
                  float   throwaway_high )
{
    int i, n ;
    int lo_n, hi_n ;
    float sum ;
    
    if ( array == NULL )
    {
        xsh_msg_error(" no array given in xsh_clean_mean!") ;
        return FLT_MAX ;
    }
  
    if ( n_elements <= 0 )
    {
        xsh_msg_error("wrong number of elements given") ;
        return FLT_MAX ;
    }

    if ( throwaway_low < 0. || throwaway_high < 0. ||
         throwaway_low + throwaway_high >= 100. )
    {
        xsh_msg_error("wrong throw away percentage given!") ;
        return FLT_MAX ;
    }

    lo_n = (int) (throwaway_low * (float)n_elements / 100.) ;
    hi_n = (int) (throwaway_high * (float)n_elements / 100.) ;

    /* sort the array */
    xsh_pixel_qsort( array, n_elements ) ;

    n = 0 ;
    sum = 0. ;
    for ( i = lo_n ; i < n_elements - hi_n ; i++ )
    {
        if ( !isnan(array[i]) )
        {
            sum += array[i] ;
            n++ ;
        }
    }
    if ( n == 0 )  
    {
        return FLAG ;
    }
    else
    {
        return sum/(float)n ;
    }
}

/*-------------------------------------------------------------------------*/
/**
  @name        xsh_image_smooth_fft
  @memo        Smooth an image using a FFT.
  @param       inp  Image to filter
  @param       fx  filter radii
  @param       fy  filter radii
  @return      1 newly allocated image.
  @doc
  This function applies a lowpass spatial filter of frequency fy along Y.
  @note works only with square size images
  The returned image is a newly allocated object, it must be deallocated
  using xsh_free_image().
 */
/*--------------------------------------------------------------------------*/

cpl_image *
xsh_image_smooth_fft(cpl_image * inp, const int fx, const int fy)
{

  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; 


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

  // Compute FFT
  check(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));
  check(sx=cpl_image_get_size_x(inp));
  check(sy=cpl_image_get_size_y(inp));


  //Generates filter image
  check(filter = xsh_gen_lowpass(sx,sy,fx,fy));

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

  xsh_free_image(&filter);

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

  xsh_free_image(&im_re);
  xsh_free_image(&im_im);

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

 cleanup:

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

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

}

/*-------------------------------------------------------------------------*/
/**
  @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 * 
xsh_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;
    int err_no=0;


    lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
    if (lowpass_image == NULL) {
        xsh_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 err_no 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(err_no != 0)
        err_no = 0;
    
    return lowpass_image;
}


/*-------------------------------------------------------------------------*/
/**
  @name        xsh_image_smooth_mean_y
  @memo        Smooth an image using a simple mean.
  @param       inp  Image to shift.
  @param       r    smoothing radii.
  @return      1 newly allocated image.
  @doc

  This function applies a running mean or radius r along y.

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

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


  double* pinp = NULL;
  double* pout = NULL;
  int sx = 0;
  int sy = 0;
  register int i = 0;
  register int j = 0;
  register int k = 0;
  register int pix=0;
  cpl_image* out=NULL;

  XSH_ASSURE_NOT_NULL( inp);  
  check( out = cpl_image_cast( inp, CPL_TYPE_DOUBLE));
  check(sx = cpl_image_get_size_x(inp));
  check(sy = cpl_image_get_size_y(inp));
  check(pinp = cpl_image_get_data_double(inp));
  check(pout = cpl_image_get_data_double(out));
  for( j=r; j<sy-r; j++) {
    pix=j*sx+i;
    for( i=0; i<sx; i++) {
      for( k=-r; k<r; k++) {
	pout[pix] += pinp[pix+k*sx];
      }
      pout[pix]/=(2*r);
    }
  }

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


/*-------------------------------------------------------------------------*/
/**
  @name        xsh_image_smooth_median_y
  @memo        Smooth an image using a simple mean.
  @param       inp    Image to shift.
  @param       r      smoothing radius 
  @return      1 newly allocated image.
  @doc

  This function applies a running median or radius r along y.

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

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


  double* pout=NULL;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;

  cpl_image* out=NULL;


  cknull_msg(inp,"Null in put image, exit");
 
  check(out=cpl_image_cast(inp,CPL_TYPE_DOUBLE));
  check(sx=cpl_image_get_size_x(inp));
  check(sy=cpl_image_get_size_y(inp));
  check(pout=cpl_image_get_data_double(out));

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

 cleanup:

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

  }

}


/*-------------------------------------------------------------------------*/
/**
  @name        xsh_image_smooth_mean_x
  @memo        Smooth an image using a simple mean.
  @param       inp  Image to shift.
  @param       r    smoothing radii.
  @return      1 newly allocated image.
  @doc

  This function applies a running mean or radius r along x.

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

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

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

  cpl_image* out=NULL;


  XSH_ASSURE_NOT_NULL( inp);
  check( out =  cpl_image_cast( inp, CPL_TYPE_DOUBLE));
  check( sx=cpl_image_get_size_x(inp));
  check( sy=cpl_image_get_size_y(inp));
  check( pinp=cpl_image_get_data_double(inp));
  check( pout=cpl_image_get_data_double(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        xsh_image_smooth_median_x
  @memo        Smooth an image using a simple mean.
  @param       inp    Image to shift.
  @param       r      smoothing radius 
  @return      1 newly allocated image.
  @doc

  This function applies a running median or radius r along x.

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

cpl_image *
xsh_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_msg(inp,"Null in put image, exit");
 
  check(out=cpl_image_cast(inp,CPL_TYPE_FLOAT));
  check(sx=cpl_image_get_size_x(inp));
  check(sy=cpl_image_get_size_y(inp));
  check(pout=cpl_image_get_data_float(out));

  for(j=1;j<sy;j++) {
    for(i=r+1;i<sx-r;i++) {
      pout[j*sx+i]=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        xsh_image_smooth_median_xy
  @memo        Smooth an image using a simple mean.
  @param       inp    Image to shift.
  @param       r      smoothing radius 
  @return      1 newly allocated image.
  @doc

  This function applies a running median or radius r along x.

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

cpl_image *
xsh_image_smooth_median_xy(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)

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

  cpl_image* out=NULL;


  cknull_msg(inp,"Null in put image, exit");
 
  check(out=cpl_image_cast(inp,CPL_TYPE_DOUBLE));
  check(sx=cpl_image_get_size_x(inp));
  check(sy=cpl_image_get_size_y(inp));
  check(pout=cpl_image_get_data_double(out));

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

 cleanup:

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

  }

}

/*-------------------------------------------------------------------------*/
/**
  @name    xsh_image_clean_badpixel
  @memo    Smooth an image using a simple median.
  @param   in    Image to smooth.
  @return  error code
  @doc

  This function applies a running median of radius r along y.
 */
/*--------------------------------------------------------------------------*/

cpl_error_code
xsh_image_clean_badpixel(cpl_frame* in)
{


  cpl_image* ima=NULL;
  cpl_image* err=NULL;
  cpl_image* qua=NULL;
  cpl_propertylist* hima=NULL;
  cpl_propertylist* herr=NULL;
  cpl_propertylist* hqua=NULL;


  const char* name=NULL;
  double* pima=NULL;
  int* pqua=NULL;
  int nx=0;
  int ny=0;
  int i=0;
  int j=0;
  int rx=5;
  int ry=5;

  name=cpl_frame_get_filename(in);
  hima=cpl_propertylist_load(name,0);
  herr=cpl_propertylist_load(name,1);
  hqua=cpl_propertylist_load(name,2);
  ima=cpl_image_load(name,CPL_TYPE_DOUBLE,0,0);
  err=cpl_image_load(name,CPL_TYPE_DOUBLE,0,1);
  qua=cpl_image_load(name,CPL_TYPE_INT,0,2);

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

  pima=cpl_image_get_data_double(ima);
  pqua=cpl_image_get_data_int(qua);

  for(j=ry;j<ny-ry;j++) {
    for(i=rx;i<nx-rx;i++) {
      if(pqua[i+j*nx]!=0) {
	pima[i+j*nx]=cpl_image_get_median_window(ima,i-rx,j-ry,i+rx,j+ry);
      }
    }
  }
  check(cpl_image_save(ima,name,XSH_PRE_DATA_BPP,hima,CPL_IO_DEFAULT));
  check(cpl_image_save(err,name,XSH_PRE_ERRS_BPP,herr,CPL_IO_EXTEND));
  check(cpl_image_save(qua,name,XSH_PRE_QUAL_BPP,hqua,CPL_IO_EXTEND));

 cleanup:
  xsh_free_image(&ima);
  xsh_free_image(&err);
  xsh_free_image(&qua);
  xsh_free_propertylist(&hima);
  xsh_free_propertylist(&herr);
  xsh_free_propertylist(&hqua);

  return cpl_error_get_code();

}


/*-------------------------------------------------------------------------*/
/**
  @name    xsh_image_fit_gaussian_max_pos_x_window
  @memo    Determine image peack position according Gaussian fit 
  @param   ima   input image
  @param   llx   lower left x 
  @param   urx   upper right x
  @param   ypos  Y position on image at which the Gaussian fit is performed 
  @return  peak position
  @doc
  Determine image peack position according Gaussian fit. 
  In case the Gaussian fit fails a centroid determination is performed.

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

double
xsh_image_fit_gaussian_max_pos_x_window(const cpl_image* ima,
					const int llx,
					const int urx,
                                        const int ypos)
{


  XSH_GAUSSIAN_FIT fit_res;
  int i=0;
  int nelem=0;
  int ix=0;
  int iy=ypos;

  double dy=0;
  cpl_vector* pix_pos=NULL;
  cpl_vector* pix_val=NULL;
  double x_centroid=0;


  nelem=urx-llx+1;
  check( pix_pos = cpl_vector_new( nelem ) ) ;
  check( pix_val = cpl_vector_new( nelem ) ) ;


  for( i = 0, ix = llx ; ix <= urx ; ix++, i++, dy += 1. ) {
    int rej ;
    double value ;

    cpl_error_reset() ;
    value = cpl_image_get(ima , ix, iy, &rej ) ;
    if ( cpl_error_get_code() != CPL_ERROR_NONE ) {
      xsh_msg_dbg_high( "       *** X,Y out of range %d,%d", ix, iy ) ;
      cpl_error_reset() ;
      continue ;
    }
    cpl_vector_set( pix_val, i, value ) ;
    cpl_vector_set( pix_pos, i, dy ) ;
  }

  xsh_vector_fit_gaussian( pix_pos, pix_val, &fit_res );
  if ( cpl_error_get_code() != CPL_ERROR_NONE ) {
    xsh_msg_dbg_high( "       *** X,Y out of range %d,%d", ix, iy ) ;
    cpl_error_reset() ;
    x_centroid=cpl_image_get_centroid_x_window(ima,llx,ypos,urx,ypos);
    //xsh_msg("x_centroid=%g",x_centroid);

  } else {
    //x_centroid=cpl_image_get_centroid_x_window(ima,llx,ypos,urx,ypos);
    x_centroid=llx+fit_res.peakpos;
  }
  
 cleanup:
  xsh_free_vector(&pix_pos);
  xsh_free_vector(&pix_val);

  return x_centroid;
}

/*-------------------------------------------------------------------------*/
/**
  @name    xsh_image_fit_gaussian_max_pos_y_window
  @memo    Determine image peack position according Gaussian fit 
  @param   ima   input image
  @param   lly   lower left y 
  @param   ury   upper right y
  @param   xpos  X position on image at which the Gaussian fit is performed 
  @return  peak position
  @doc
  Determine image peack position according Gaussian fit. 
  In case the Gaussian fit fails a centroid determination is performed.

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

static double
xsh_image_fit_gaussian_max_pos_y_window(const cpl_image* ima,
					const int lly,
					const int ury,
                                        const int xpos)
{


  XSH_GAUSSIAN_FIT fit_res;
  int j=0;
  int nelem=0;
  int jy=0;
  int jx=xpos;

  double dy=0;
  cpl_vector* pix_pos=NULL;
  cpl_vector* pix_val=NULL;
  double y_centroid=0;


  nelem=ury-lly+1;
  check( pix_pos = cpl_vector_new( nelem ) ) ;
  check( pix_val = cpl_vector_new( nelem ) ) ;


  for( j = 0, jy = lly ; jy <= ury ; jy++, j++, dy += 1. ) {
    int rej ;
    double value ;

    cpl_error_reset() ;
    value = cpl_image_get(ima , jx, jy, &rej ) ;
    if ( cpl_error_get_code() != CPL_ERROR_NONE ) {
      xsh_msg_dbg_high( "       *** X,Y out of range %d,%d", jx, jy ) ;
      cpl_error_reset() ;
      continue ;
    }
    cpl_vector_set( pix_val, j, value ) ;
    cpl_vector_set( pix_pos, j, dy ) ;
  }

  xsh_vector_fit_gaussian( pix_pos, pix_val, &fit_res );
  if ( cpl_error_get_code() != CPL_ERROR_NONE ) {
    xsh_msg_dbg_high( "       *** X,Y out of range %d,%d", jx, jy ) ;
    cpl_error_reset() ;
    y_centroid=cpl_image_get_centroid_y_window(ima,xpos,lly,xpos,ury);
    //xsh_msg("y_centroid=%g",y_centroid);

  } else {
    //y_centroid=cpl_image_get_centroid_y_window(ima,xpos,lly,xpos,ury);
    y_centroid=lly+fit_res.peakpos;
  }
  
 cleanup:
  xsh_free_vector(&pix_pos);
  xsh_free_vector(&pix_val);

  return y_centroid;
}



/**
  @brief
    Trace object position in an image
  @param data_ima
    The image where object traces need need to be found
  @param head
    The FITS header where to write QC
  @param hsize
    The half window size used in the object peack final search
  @param method
    The peack search method 0: Gaussian, 1: centroid


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

static cpl_table* 
xsh_image_qc_trace_window(cpl_image* data_ima,cpl_propertylist* head, 
const int hsize, const int method)
{

   cpl_table* table=NULL;
   int i=0;

   int naxis1=0;
   int naxis2=0;
   cpl_size mx=0;
   cpl_size my=0;
 
   int lly=0;
   int ury=0;
   int llx=0;
   int* px=NULL;
   double* pcy=NULL;
   double* pwav=NULL;
   double crval1=0;
   double cdelt1=0;
  
   crval1=xsh_pfits_get_crval1(head);
   cdelt1=xsh_pfits_get_cdelt1(head);

   naxis1=cpl_image_get_size_x(data_ima);
   naxis2=cpl_image_get_size_y(data_ima);
 
   table=cpl_table_new(naxis1);
   cpl_table_new_column(table,"X",CPL_TYPE_INT);
   cpl_table_new_column(table,"WAVELENGTH",CPL_TYPE_DOUBLE);
   cpl_table_new_column(table,"POS",CPL_TYPE_DOUBLE);

   cpl_table_fill_column_window_int(table,"X",0,naxis1,0);
   cpl_table_fill_column_window_double(table,"WAVELENGTH",0,naxis1,0.);
   cpl_table_fill_column_window_double(table,"POS",0,naxis1,0.);
 
   px=cpl_table_get_data_int(table,"X");
   pwav=cpl_table_get_data_double(table,"WAVELENGTH");
   pcy=cpl_table_get_data_double(table,"POS");

   for(i=0;i<naxis1;i++) {
      px[i]=i;
      pwav[i]=crval1+cdelt1*i;
      llx=i+1;
      check(cpl_image_get_maxpos_window(data_ima,llx,1,llx,naxis2,&mx,&my));
      lly=(my-hsize>0) ? my-hsize:1;
      ury=(my+hsize<=naxis2) ? my+hsize:naxis2;
      if(method == 0 ) {
         pcy[i]=xsh_image_fit_gaussian_max_pos_y_window(data_ima,lly,ury,llx);
      } else {
         check(pcy[i]=cpl_image_get_centroid_y_window(data_ima,llx,lly,llx,ury));
      }
   }

  cleanup:

   return table;
}

/**
  @brief
    Trace object position in an image
  @param frm_ima
    The image frame where object traces need need to be found
  @param instrument
    The instrument setting structure
  @param suffix
    The product filename suffix
  @param hsize
    The half window size used in the object peack final search
  @param method
    The peack search method 0: Gaussian, 1: centroid


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

cpl_frame* 
xsh_frame_image_qc_trace_window(cpl_frame* frm_ima,xsh_instrument* instrument,
                          const char* suffix,const int hsize, const int method)
{

   cpl_frame* result=NULL;
   cpl_table* table=NULL;
   cpl_image* data_ima=NULL;
   const char* name=NULL;
 
   cpl_propertylist* plist=NULL;
   char fname[256];
   char tag[50];
  
   check(name=cpl_frame_get_filename(frm_ima));
/* load data */
   check(data_ima=cpl_image_load(name,CPL_TYPE_DOUBLE,0,0));
   plist=cpl_propertylist_load(name,0);


   check(table=xsh_image_qc_trace_window(data_ima,plist,hsize,method));

   sprintf(tag,"MERGE3D_TRACE_OBJ_%s_%s",
           xsh_instrument_arm_tostring( instrument),suffix);
   sprintf(fname,"%s.fits",tag);

   check(cpl_table_save(table,plist,NULL,fname,CPL_IO_DEFAULT));

   result=xsh_frame_product(fname,tag,CPL_FRAME_TYPE_TABLE, 
                            CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

  cleanup:

   xsh_free_propertylist(&plist);
   xsh_free_table(&table);
   xsh_free_image(&data_ima);

   return result;
}

/**
  @brief
    Trace object position in an image
  @param frm_ima
    The image frame where object traces need to be found
  @param instrument
    The instrument setting structure
  @param suffix
    The product filename suffix
  @param hsize
    The half window size used in the object peack final search
  @param method
    The peack search method 0: Gaussian, 1: centroid


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

cpl_frame* 
xsh_frame_image_ext_qc_trace_window(cpl_frame* frm_ima,
                                    xsh_instrument* instrument,
                                    const char* suffix,
                                    const int hsize, 
                                    const int method)
{

  cpl_frame* result=NULL;
  cpl_table* table=NULL;
  cpl_table* table_tot=NULL;

  cpl_image* data_ima=NULL;
  const char* name=NULL;
 
  cpl_propertylist* phead=NULL;
  cpl_propertylist* xhead=NULL;

  char fname[256];
  char tag[50];
  int nbext=0;
  int k=0;
  int nrow=0;
  xsh_msg("Trace object position");
  check(name=cpl_frame_get_filename(frm_ima));
  nbext=cpl_frame_get_nextensions( frm_ima);
  /* load data */
  table_tot=cpl_table_new(0);
  phead=cpl_propertylist_load(name,0);
  for(k=0;k<nbext;k+=3){
    nrow=cpl_table_get_nrow(table_tot);
    //xsh_msg("nrow=%d",nrow);
    check(data_ima=cpl_image_load(name,CPL_TYPE_DOUBLE,0,k));
    xhead=cpl_propertylist_load(name,k);
 
    check(table=xsh_image_qc_trace_window(data_ima,xhead,hsize,method));
    if(k==0) check(cpl_table_copy_structure(table_tot,table));
    cpl_table_insert(table_tot,table,nrow);
    xsh_free_propertylist(&xhead);
    xsh_free_table(&table);
    xsh_free_image(&data_ima);
  }
  sprintf(tag,"OBJ_POS_ORD_%s_%s",
	  xsh_instrument_arm_tostring( instrument),suffix);
  sprintf(fname,"%s.fits",tag);

  check(cpl_table_save(table_tot,phead,NULL,fname,CPL_IO_DEFAULT));

  result=xsh_frame_product(fname,tag,CPL_FRAME_TYPE_TABLE, 
			   CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

  cleanup:

   xsh_free_propertylist(&phead);
   xsh_free_propertylist(&xhead);
   xsh_free_table(&table);
   xsh_free_table(&table_tot);
   xsh_free_image(&data_ima);

   return result;
}


/**
  @brief
    Computes residuals statistics on given wave ranges
  @param table
    The table object to compute residuals on column differences
  @param instrument
    The instrument setting structure
  @param plist
    The FITS header to hold results

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

static cpl_error_code
xsh_util_compute_qc_residuals(cpl_table* table, 
                              xsh_instrument* instrument,
                              cpl_propertylist* plist)
{
   cpl_table* qc_table=NULL;
   double res_min=0;
   double res_max=0;
   double res_med=0;
   double res_avg=0;
   double res_rms=0;
   double wmin=0;
   double wmax=0;

   if( xsh_instrument_get_arm(instrument) == XSH_ARM_UVB) {
      wmin=350;
      wmax=540;
   } else if( xsh_instrument_get_arm(instrument) == XSH_ARM_VIS){
      wmin=580;
      wmax=950;
   } else {
      wmin=1000;
      wmax=2200;
   }

   check(cpl_table_and_selected_double(table,"WAVELENGTH",CPL_GREATER_THAN,wmin)); 
   check(cpl_table_and_selected_double(table,"WAVELENGTH",CPL_LESS_THAN,wmax));
   check(qc_table=cpl_table_extract_selected(table));
   check(cpl_table_select_all(table));


   check(res_min=cpl_table_get_column_min(qc_table,"RES12"));
   check(res_max=cpl_table_get_column_max(qc_table,"RES12"));
   check(res_avg=cpl_table_get_column_mean(qc_table,"RES12"));
   check(res_med=cpl_table_get_column_median(qc_table,"RES12"));
   check(res_rms=cpl_table_get_column_stdev(qc_table,"RES12"));

   cpl_propertylist_append_double(plist,XSH_QC_TRACE12_MIN,res_min);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE12_MIN,"Minimum residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE12_MAX,res_max);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE12_MAX,"Maximum residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE12_AVG,res_avg);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE12_AVG,"Mean residuals");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE12_MED,res_med);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE12_MED,"Median residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE12_RMS,res_rms);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE12_RMS,"Stdev residuals");

   res_min=cpl_table_get_column_min(qc_table,"RES32");
   res_max=cpl_table_get_column_max(qc_table,"RES32");
   res_avg=cpl_table_get_column_mean(qc_table,"RES32");
   res_med=cpl_table_get_column_median(qc_table,"RES32");
   res_rms=cpl_table_get_column_stdev(qc_table,"RES32");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE32_MIN,res_min);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE32_MIN,"Minimum residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE32_MAX,res_max);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE32_MAX,"Maximum residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE32_AVG,res_avg);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE32_AVG,"Mean residuals");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE32_MED,res_med);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE32_MED,"Median residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE32_RMS,res_rms);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE32_RMS,"Stdev residuals");

   res_min=cpl_table_get_column_min(qc_table,"RES13");
   res_max=cpl_table_get_column_max(qc_table,"RES13");
   res_avg=cpl_table_get_column_mean(qc_table,"RES13");
   res_med=cpl_table_get_column_median(qc_table,"RES13");
   res_rms=cpl_table_get_column_stdev(qc_table,"RES13");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE13_MIN,res_min);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE13_MIN,"Minimum residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE13_MAX,res_max);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE13_MAX,"Maximum residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE13_AVG,res_avg);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE13_AVG,"Mean residuals");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE13_MED,res_med);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE13_MED,"Median residuals");
   cpl_propertylist_append_double(plist,XSH_QC_TRACE13_RMS,res_rms);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE13_RMS,"Stdev residuals");

  cleanup:
   xsh_free_table(&qc_table);
   return cpl_error_get_code();

}


/**
  @brief
    Fit cube traces and compute fit coeffs differences
  @param table
    The table object with columns to fit
  @param col_wav
    The column indicating the fit independent variable 
  @param col_ref
    The column indicating the fit dependent variable 
  @param col_fit
    The column indicating the fit result  
  @param qualifier
    A string indicating which trace the fit refers to  
  @param plist
    The FITS header to hold results

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

static cpl_error_code
xsh_cube_trace_fit(cpl_table** table,
                   const char* col_wav,
                   const char* col_ref, 
                   const char* col_fit,
                   const char* qualifier,
                   cpl_propertylist* plist)
{
   int nrow=0;
   int k=0;
   cpl_polynomial* pol=NULL;
   cpl_vector* vx=NULL;
   cpl_vector* vy=NULL;

   double* px=NULL;
   double* py=NULL;
   double* pf=NULL;
   int order=2;
   char key_name[25];
   cpl_size power=0;
   double coeff=0;


   nrow=cpl_table_get_nrow(*table);
   cpl_table_new_column(*table,col_fit,CPL_TYPE_DOUBLE);
   cpl_table_fill_column_window_double(*table,col_fit,0,nrow,0.);

   px=cpl_table_get_data_double(*table,col_wav);
   py=cpl_table_get_data_double(*table,col_ref);
   pf=cpl_table_get_data_double(*table,col_fit);

   vx = cpl_vector_wrap( nrow, px );
   vy = cpl_vector_wrap( nrow, py );

   pol=xsh_polynomial_fit_1d_create(vx,vy,order,NULL);

   for(k=0; k< nrow; k++){
      check( pf[k] = cpl_polynomial_eval_1d(pol,px[k],NULL));
   }

   /* stores fit coeffs to be used later */
   power=0;
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C0,qualifier);
   coeff = cpl_polynomial_get_coeff(pol, &power);
   cpl_propertylist_append_double(plist,key_name,coeff);
   cpl_propertylist_set_comment(plist,key_name,"order 0 fit coeff");
 
   power=1;
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C1,qualifier);
   coeff = cpl_polynomial_get_coeff(pol, &power);
   cpl_propertylist_append_double(plist,key_name,coeff);
   cpl_propertylist_set_comment(plist,key_name,"order 1 fit coeff");
 
   power=2;
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C2,qualifier);
   coeff = cpl_polynomial_get_coeff(pol, &power);
   cpl_propertylist_append_double(plist,key_name,coeff);
   cpl_propertylist_set_comment(plist,key_name,"order 2 fit coeff");
 

  cleanup:
   cpl_vector_unwrap(vx);
   cpl_vector_unwrap(vy);
   xsh_free_polynomial(&pol);
   return cpl_error_get_code();
}

/**
  @brief
    Computes differences between cube fit trace coefficients
  @param table
    The table object with columns to fit
  @param col_comp
    The table comparison's column
  @param col_ref
    The table reference's column

  @param plist
    The FITS header to hold results
    
  @return
    The error code
*/
/*---------------------------------------------------------------------------*/

static cpl_error_code
xsh_cube_trace_diff(const cpl_table* table, 
                    const char* col_comp,
                    const char* col_ref,
                    cpl_propertylist* plist)
{
   char key_name[25];

   double cmp_c0=0;
   double ref_c0=0;
   double dif_c0=0;

   double cmp_c1=0;
   double ref_c1=0;
   double dif_c1=0;

   double cmp_c2=0;
   double ref_c2=0;
   double dif_c2=0;

   const double* pw=NULL;
   double wav=0;
   double cmp_pos=0;
   double ref_pos=0;
   double dif_pos=0;

   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C0,col_comp);
   check(cmp_c0=cpl_propertylist_get_double(plist,key_name));
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C1,col_comp);
   cmp_c1=cpl_propertylist_get_double(plist,key_name);
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C2,col_comp);
   cmp_c2=cpl_propertylist_get_double(plist,key_name);

   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C0,col_ref);
   ref_c0=cpl_propertylist_get_double(plist,key_name);
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C1,col_ref);
   ref_c1=cpl_propertylist_get_double(plist,key_name);
   sprintf(key_name,"%s_%s",XSH_QC_TRACE_FIT_C2,col_ref);
   ref_c2=cpl_propertylist_get_double(plist,key_name);


   dif_c0=cmp_c0-ref_c0;
   dif_c1=cmp_c1-ref_c1;
   dif_c2=cmp_c2-ref_c2;


   pw=cpl_table_get_data_double_const(table,"WAVELENGTH");

   wav=pw[0];
   cmp_pos=cmp_c0+cmp_c1*wav+cmp_c2*wav*wav;
   ref_pos=ref_c0+ref_c1*wav+ref_c2*wav*wav;

   dif_pos=cmp_pos-ref_pos;


   cpl_propertylist_append_double(plist,XSH_QC_TRACE_FIT_DIFF_C0,dif_c0);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE_FIT_DIFF_C0,"order 0 fit coeff diff");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE_FIT_DIFF_C1,dif_c1);
   cpl_propertylist_set_comment(plist,XSH_QC_TRACE_FIT_DIFF_C1,"order 1 fit coeff diff");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE_FIT_DIFF_C1,dif_c2);
   cpl_propertylist_set_comment(plist,key_name,"order 2 fit coeff diff");

   cpl_propertylist_append_double(plist,XSH_QC_TRACE_FIT_DIFF_POS,dif_pos);
   cpl_propertylist_set_comment(plist,key_name,"fit trace diff pos");

 cleanup:
   return cpl_error_get_code();

}

/**
  @brief
    Trace object position in a cube
  @param frm_cube
    The frame whose frame need to be updated
  @param instrument
    The instrument setting structure
  @param suffix
    The product filename suffix
  @param rec_prefix
    The input recipe prefix string value
  @param win_min
    The win_min value allowed in the search
  @param win_max
    The win_max value allowed in the search
  @param hsize
    The half window size used in the object peack final search
  @param method
    The peack search method 0: Gaussian, 1: centroid
  @param compute_qc
    Switch to activate QC computation


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


cpl_frame* 
xsh_cube_qc_trace_window(cpl_frame* frm_cube,xsh_instrument* instrument,
                         const char* suffix,const char* rec_prefix,
                         const int win_min, const int win_max,
                         const int hsize, 
                         const int method,const int compute_qc)
{
   cpl_frame* result=NULL;
   cpl_table* table=NULL;
   cpl_image* data_ima=NULL;
   //cpl_image* errs_ima=NULL;
   cpl_imagelist* data_iml=NULL;
   cpl_imagelist* errs_iml=NULL;
   cpl_imagelist* swap1=NULL;
   cpl_imagelist* swap2=NULL;
   cpl_imagelist* data_swap=NULL;
   cpl_imagelist* errs_swap=NULL;
  
   const char* name=NULL;

   int k=0;
 
   int j=0;

   int naxis2=0;
   int naxis3=0;

    
   cpl_size mx=0;
   cpl_size my=0;
   double cx=0;
   //double cy=0;

   //double max=0;
   int llx=0;
   int urx=0;
  
   double* pcx1=NULL;
   double* pcx2=NULL;
   double* pcx3=NULL;
   double* pwav=NULL;
   double crval3=0;
   double cdelt3=0;
   cpl_propertylist* plist=NULL;
   char fname[256];
   char tag[256];

   check(name=cpl_frame_get_filename(frm_cube));

/* load data */
   check(data_iml=cpl_imagelist_load(name,CPL_TYPE_DOUBLE,0));
   plist=cpl_propertylist_load(name,0);
   crval3=xsh_pfits_get_crval3(plist);
   cdelt3=xsh_pfits_get_cdelt3(plist);

   swap1=cpl_imagelist_swap_axis_create(data_iml,CPL_SWAP_AXIS_XZ);
   xsh_free_imagelist(&data_iml);
   swap2=cpl_imagelist_swap_axis_create(swap1,CPL_SWAP_AXIS_YZ);
   xsh_free_imagelist(&swap1);
   data_swap=cpl_imagelist_swap_axis_create(swap2,CPL_SWAP_AXIS_XZ);
   xsh_free_imagelist(&swap2);

/* load errs */
   check(errs_iml=cpl_imagelist_load(name,CPL_TYPE_DOUBLE,0));

   swap1=cpl_imagelist_swap_axis_create(errs_iml,CPL_SWAP_AXIS_XZ);
   xsh_free_imagelist(&data_iml);
   swap2=cpl_imagelist_swap_axis_create(swap1,CPL_SWAP_AXIS_YZ);
   xsh_free_imagelist(&swap1);
   errs_swap=cpl_imagelist_swap_axis_create(swap2,CPL_SWAP_AXIS_XZ);
   xsh_free_imagelist(&swap2);

/* get sizes */
   check(naxis3=cpl_imagelist_get_size(data_swap));
   data_ima=cpl_imagelist_get(data_swap,0);

   naxis2=cpl_image_get_size_y(data_ima);
    //xsh_msg("size=%d",naxis3);
   table=cpl_table_new(naxis3);
   cpl_table_new_column(table,"WAVELENGTH",CPL_TYPE_DOUBLE);

   cpl_table_new_column(table,"POS_1",CPL_TYPE_DOUBLE);
   cpl_table_new_column(table,"POS_2",CPL_TYPE_DOUBLE);
   cpl_table_new_column(table,"POS_3",CPL_TYPE_DOUBLE);

   pwav=cpl_table_get_data_double(table,"WAVELENGTH");
   pcx1=cpl_table_get_data_double(table,"POS_1");
   pcx2=cpl_table_get_data_double(table,"POS_2");
   pcx3=cpl_table_get_data_double(table,"POS_3");

   cpl_table_fill_column_window_double(table,"WAVELENGTH",0,naxis3,0.);
   cpl_table_fill_column_window_double(table,"POS_1",0,naxis3,0.);
   cpl_table_fill_column_window_double(table,"POS_2",0,naxis3,0.);
   cpl_table_fill_column_window_double(table,"POS_3",0,naxis3,0.);
 

   for(k=0;k<naxis3;k++) {

      check(data_ima=cpl_imagelist_get(data_swap,k));
      //check(errs_ima=cpl_imagelist_get(data_swap,k));
      pwav[k]=crval3+cdelt3*k;

      for(j=1;j<=naxis2;j++) {
         check(cpl_image_get_maxpos_window(data_ima,
                                           win_min,j,win_max,j,&mx,&my));
         llx=(mx-hsize>win_min) ? mx-hsize:win_min;
         urx=(mx+hsize<win_max) ? mx+hsize:win_max;
         if(method == 0 ) {
            cx=xsh_image_fit_gaussian_max_pos_x_window(data_ima,llx,urx,j);
         } else {
            check(cx=cpl_image_get_centroid_x_window(data_ima,llx,j,urx,j));
            //check(max=cpl_image_get_max_window(data_ima,llx,j,urx,j));
         }
         //xsh_msg("raw=%d, max[%d,%d]=%g cx=%g cy=%g",k,mx,j,max,cx,cy);
         switch(j){
            case 1: pcx1[k]=cx;
            case 2: pcx2[k]=cx;
            case 3: pcx3[k]=cx;
         }
      }

   }

   /* for QC compute residuals */
   cpl_table_duplicate_column(table,"RES12",table,"POS_1");
   cpl_table_subtract_columns(table,"RES12","POS_2");

   cpl_table_duplicate_column(table,"RES32",table,"POS_3");
   cpl_table_subtract_columns(table,"RES32","POS_2");

   cpl_table_duplicate_column(table,"RES13",table,"POS_1");
   cpl_table_subtract_columns(table,"RES13","POS_3");

   xsh_cube_trace_fit(&table,"WAVELENGTH","POS_1","FPOS_1","T1",plist);
   xsh_cube_trace_fit(&table,"WAVELENGTH","POS_2","FPOS_2","T2",plist);
   xsh_cube_trace_fit(&table,"WAVELENGTH","POS_3","FPOS_3","T3",plist);

   xsh_cube_trace_diff(table,"T3","T2",plist);
   xsh_cube_trace_diff(table,"T1","T2",plist);

   if(compute_qc) {
      check(xsh_util_compute_qc_residuals(table, instrument,plist));
   }



   sprintf(tag,"%s_%s_TRACE_OBJ_%s",
           rec_prefix,suffix,xsh_instrument_arm_tostring( instrument));
    sprintf(fname,"%s.fits",tag);
    check(cpl_table_save(table,plist,NULL,fname,CPL_IO_DEFAULT));
    result=xsh_frame_product(fname,tag,CPL_FRAME_TYPE_TABLE, 
                            CPL_FRAME_GROUP_PRODUCT,CPL_FRAME_LEVEL_FINAL);

 
  cleanup:
   //xsh_msg("llx=%d urx=%d",llx,urx);
   xsh_free_table(&table);
   xsh_free_imagelist(&swap1);
   xsh_free_imagelist(&swap2);
   xsh_free_imagelist(&data_swap);
   xsh_free_imagelist(&errs_swap);
   xsh_free_imagelist(&data_iml);
   xsh_free_imagelist(&errs_iml);
   xsh_free_propertylist(&plist);

   return result;
}
/**
@brief merge imagelist via average
@param[in] data imagelist
@param[in] mask corresponding mask
@param[out] data_ima average image
@param[out] mask_ima corresponding mask
@param[in] mk index 
 */

cpl_error_code
xsh_iml_merge_avg(cpl_imagelist** data,
                  cpl_imagelist** mask,
                  const cpl_image* data_ima,
                  const cpl_image* mask_ima,
                  const int mk)
{
   cpl_image* data_tmp=NULL;
   cpl_image* mask_tmp=NULL;
   int* pmsk=NULL;
   double norm=0;

   int size=0;
   check(size=cpl_imagelist_get_size(*mask));
   if(mk<size) {
      check(data_tmp=cpl_imagelist_get(*data,mk));
      check(mask_tmp=cpl_imagelist_get(*mask,mk));
      check(pmsk=cpl_image_get_data_int(mask_tmp));

      check(norm=pmsk[1]+1);
      check(cpl_image_add(data_tmp,data_ima));
      check(cpl_image_divide_scalar(data_tmp,norm));
      check(cpl_image_add_scalar(mask_tmp,1));
      check(cpl_imagelist_set(*mask,cpl_image_duplicate(mask_ima),mk));
      check(cpl_imagelist_set(*data,cpl_image_duplicate(data_tmp),mk));

   } else {
      check(cpl_imagelist_set(*mask,cpl_image_duplicate(mask_ima),mk));
      check(cpl_imagelist_set(*data,cpl_image_duplicate(data_ima),mk));
   }

  cleanup:

   //xsh_free_image(&data_tmp);
   //xsh_free_image(&mask_tmp);

   return cpl_error_get_code();

}
/**
@brief merge imagelist via average
@param[in] data imagelist
@param[in] mask corresponding mask
@param[out] data_ima average image
@param[out] mask_ima corresponding mask
@param[in] mk index
 */

cpl_error_code
xsh_iml_merge_wgt(cpl_imagelist** data,
                  cpl_imagelist** errs,
                  cpl_imagelist** qual,
                  const cpl_image* flux_b,
                  const cpl_image* errs_b,
                  const cpl_image* qual_b,
                  const int mk,const int decode_bp)
{

   cpl_image* flux_a=NULL;
   cpl_image* errs_a=NULL;
   cpl_image* qual_a=NULL;
   //cpl_image* mask_tmp=NULL;

   cpl_image* flux_r=NULL;
   cpl_image* errs_r=NULL;
   cpl_image* qual_r=NULL;
   cpl_image* weight_a=NULL;
   cpl_image* weight_b=NULL;

   //double norm=0;

   int size=0;
   check(size=cpl_imagelist_get_size(*data));

   if(mk<size) {
      check(flux_a=cpl_imagelist_get(*data,mk));
      check(errs_a=cpl_imagelist_get(*errs,mk));
      check(qual_a=cpl_imagelist_get(*qual,mk));


      /*
       *  weight_a = 1.0 / (err_a * err_a);
       *  weight_b = 1.0 / (err_b * err_b);
       *  double tmp_val = 1.0/(weight_a+weight_b);
       *  flux_res = (weight_a*flux_a+weight_b*flux_b) * tmp_val;
       *  err_res =  sqrt(tmp_val);
       */
      weight_a = cpl_image_duplicate(errs_a);
      weight_b = cpl_image_duplicate(errs_b);

      cpl_image_power(weight_a,-2);
      cpl_image_power(weight_b,-2);

      cpl_image* tmp_ima=cpl_image_duplicate(weight_a);
      cpl_image_add(tmp_ima,weight_b);
      cpl_image_power(tmp_ima,-1);
      errs_r = cpl_image_duplicate(tmp_ima);
      cpl_image_power(errs_r,0.5);

      cpl_image_multiply(weight_a,flux_a);
      cpl_image_multiply(weight_b,flux_b);

      cpl_image_add(weight_a,weight_b);

      flux_r=cpl_image_duplicate(weight_a);

      cpl_image_multiply(flux_r,tmp_ima);

      qual_r = cpl_image_duplicate(qual_a);
      /* OR combine qualifiers */

      xsh_badpixelmap_image_coadd(&qual_r,qual_b,1);
      xsh_free_image(&weight_a);
      xsh_free_image(&weight_b);
      xsh_free_image(&tmp_ima);

      check(cpl_imagelist_set(*data,cpl_image_duplicate(flux_r),mk));
      check(cpl_imagelist_set(*errs,cpl_image_duplicate(errs_r),mk));
      check(cpl_imagelist_set(*qual,cpl_image_duplicate(qual_r),mk));

      xsh_free_image(&errs_r);
      xsh_free_image(&flux_r);
      xsh_free_image(&qual_r);
   } else {
       //xsh_msg("mk=%d size=%d",mk,size);
      check(cpl_imagelist_set(*data,cpl_image_duplicate(flux_b),mk));
      check(cpl_imagelist_set(*errs,cpl_image_duplicate(errs_b),mk));
      check(cpl_imagelist_set(*qual,cpl_image_duplicate(qual_b),mk));
   }

  cleanup:

   return cpl_error_get_code();

}
/*-------------------------------------------------------------------------*/
/**
  @brief	Flag blemishes in a flat image
  @param	flat_frame input image
  @param	instrument arm setting
  @return	output frame or NULL;

 */
/*--------------------------------------------------------------------------*/
cpl_error_code
xsh_image_mflat_detect_blemishes(cpl_frame* flat_frame,
			       xsh_instrument* instrument)
{

  cpl_image* diff=NULL;
  cpl_image* flat_smooth=NULL;
  cpl_array* val=NULL;
  cpl_matrix* mx=NULL;
  xsh_pre* mflat=NULL;

  int binx=0;
  int biny=0;
  int sx=0;
  int sy=0;
  int i=0;
  int j=0;
  int filter_width_x=7;  //7
  int filter_width_y=7;
  
  double kappa=40.;

  float* pima=NULL;
  int* pqual=NULL;

  int npixs=0;
  const char* filename;
  const char* tag;
  /* check input is valid */
  XSH_ASSURE_NOT_NULL_MSG(flat_frame, "NULL input flat ");

  filename=cpl_frame_get_filename(flat_frame);
  tag=cpl_frame_get_tag(flat_frame);

  check(mflat=xsh_pre_load(flat_frame,instrument));
  /* get image and bin sizes */
  sx=mflat->nx;
  sy=mflat->ny;
  binx=mflat->binx;
  biny=mflat->biny;
  npixs=sx*sy;

  /* 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(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);
    }
  }
  
  /* smooth master flat */
  check(diff=cpl_image_duplicate(mflat->data));
  check(flat_smooth=xsh_image_filter_median(mflat->data,mx));
  /* 
    check(cpl_image_save(flat_smooth,"flat_smooth.fits",
    CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
  */

  /* subtract smoothed data */
  check(cpl_image_subtract(diff,flat_smooth));

  /* 
    check(cpl_image_save(diff,"diff.fits",
    CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
  */

  check(cpl_image_divide(diff,mflat->errs));
  /*
  check(cpl_image_save(diff,"norm.fits",
    CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
  */
  check(pqual=cpl_image_get_data_int(mflat->qual));
  check(pima=cpl_image_get_data_float(diff));

  for(i=0;i<npixs;i++) {
    if(fabs(pima[i])>kappa) {
      pqual[i] |= QFLAG_OTHER_BAD_PIXEL;
    }
  }

  /* save mask to debug: NB if you leave it remember to clean memory */
  cpl_frame* frm=NULL;
  check(frm=xsh_pre_save(mflat,filename,tag,0));
  xsh_free_frame(&frm);
 

 cleanup:

  xsh_free_array(&val);
  xsh_free_image(&diff);
  xsh_free_image(&flat_smooth);
  xsh_free_matrix(&mx);
  xsh_pre_free(&mflat);
  return cpl_error_get_code();
}

/** 
 * Create an error image from an image list and a "valid pixels" mask 
 *
 * @param errs [OUTPUT] The errs image result  
 * @param list error images list to collapse
 * @param mode mode qualifier (median or mean stack combination)
 * 
 * @return Pointer to error image
 */
cpl_error_code 
xsh_collapse_errs(cpl_image * errs, cpl_imagelist * list,const int mode)
{
  int nx = 0, ny = 0, nimg = 0, i = 0;
  float **pdata = NULL;
  cpl_binary ** pbinary = NULL;
  float* errsdata = NULL;
  double mpi_2=0.5*M_PI;
  check(nimg = cpl_imagelist_get_size (list));
  assure(nimg > 0,CPL_ERROR_ILLEGAL_INPUT,"you must have image to collapse");

  /* create the array of pointers to errs data */
  pdata = cpl_malloc (nimg * sizeof (float *));
  assure (pdata != NULL, cpl_error_get_code (),
	  "Cant allocate memory for data pointers");
  /* create the array of pointers to errs binary */
  pbinary = cpl_malloc (nimg * sizeof (cpl_binary *));
  assure (pbinary != NULL, cpl_error_get_code (),
          "Cant allocate memory for binary pointers");

  /* Populate images pointer array */
  for (i = 0; i < nimg; i++) {
    check( pdata[i] = cpl_image_get_data_float(cpl_imagelist_get (list, i)));
    check( pbinary[i] = cpl_mask_get_data(cpl_image_get_bpm(
      cpl_imagelist_get(list, i))));
  }

  /* get size and from first image */
  check(nx = cpl_image_get_size_x (cpl_imagelist_get (list, 0)));
  check(ny = cpl_image_get_size_y (cpl_imagelist_get (list, 0)));
  check(errsdata = cpl_image_get_data_float(errs));

  /* Loop over all pixels */
  for (i = 0; i < nx * ny; i++){
    int count = 0;
    int k = 0;
    double errval = 0.0;
    /* loop over error images */
    for (count = 0, k = 0; k < nimg; k++) {
      /* check if good pixel */
      if ( ((pbinary[k])[i] == CPL_BINARY_0) ) {
	  errval += (pdata[k])[i] * (pdata[k])[i];
	  count++;
      }
    }
    /* convert variance to error */
    if (count > 1) {
      
     if (mode==1){
         /* mean */
	errsdata[i] = sqrt (errval)/((double)count);
      } else if (mode==0){
         /* median */
         if(count <=2 ) {
            errsdata[i] = sqrt (errval)/((double)count);
         } else {
            errsdata[i] = sqrt ( mpi_2*errval / ((double)(count*(count- 1.))) );
         }
     }
    } else if ( count == 1 ) {
       errsdata[i] = sqrt (errval);
    }
  }
  cleanup:
    cpl_free(pdata);
    cpl_free(pbinary);
    return cpl_error_get_code();
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Combine flat frames line adjusting illumination level to merge them smoothly
   @param    frm1 1st frame
   @param    frm2 2nd frame
   @param    otab order table
   @param    oref order where to merge
   @param    xrad x-radius size
   @param    xrad y-radius size
   @return   CPL_ERROR_NONE if everything is ok

   @doc

*/

cpl_image*
xsh_combine_flats(
    cpl_image* ima1_in,
    cpl_image* ima2_in,
    xsh_order_list* qth_list,
    xsh_order_list* d2_list,
    const int xrad,
    const int yrad)
{

  cpl_image* ima_comb=NULL;
  cpl_image* ima_mask=NULL;

  int sx=0;
  int sy=0;
  int j=0;
  int i=0;

  double* point_mask=NULL;

  double xpos=0;

  int xpos_min=0;
  int xpos_max=0;
  int xpos_cen=0;
  int ypos_cen=0;

  int oref_qth=7;
  int oref_d2=0;

  int llx=0;
  int lly=0;
  int urx=0;
  int ury=0;
  double dflux=0;
  double fflux=0;
  double scale=0;
  cpl_image* ima1=NULL;
  cpl_image* ima2=NULL;

  cpl_table        *ordertable            = NULL;
  cpl_propertylist *otab_header     = NULL;
  cpl_polynomial   *otab_traces       = NULL;

  ima1=cpl_image_cast(ima1_in,CPL_TYPE_DOUBLE);
  ima2=cpl_image_cast(ima2_in,CPL_TYPE_DOUBLE);
  xsh_msg("list size=%d ord_min=%d ord_max=%d",
      qth_list->size,qth_list->absorder_min,qth_list->absorder_max);
  /*
  cpl_image_save(ima1,"ima1_qth.fits", CPL_BPP_IEEE_FLOAT,NULL,
                   CPL_IO_DEFAULT);
  cpl_image_save(ima2,"ima2_d2.fits", CPL_BPP_IEEE_FLOAT,NULL,
                   CPL_IO_DEFAULT);
  */
  /*
for(i=0;i<qth_list->size;i++){
xsh_msg("i=%d abs order=%d rel order=%d",i,qth_list->list[i].absorder,qth_list->list[i].order);
y=(double)qth_list->list[i].starty;
x1=xsh_order_list_eval( qth_list, qth_list->list[i].cenpoly,y);
y=(double)qth_list->list[i].endy;
x2=xsh_order_list_eval( qth_list, qth_list->list[i].cenpoly,y);

xsh_msg("x1=%g x2=%g",x1,x2);
}
*/

  /*
for(i=0;i<qth_list->size;i++){
xsh_msg("i=%d abs order=%d rel order=%d",i,qth_list->list[i].absorder,qth_list->list[i].order);
llx=xsh_order_list_eval_int( qth_list, qth_list->list[i].cenpoly,qth_list->list[i].starty);
urx=xsh_order_list_eval_int( qth_list, qth_list->list[i].cenpoly,qth_list->list[i].endy);

xsh_msg("llx=%d urx=%d",llx,urx);
}
*/
  /* check size flat is same as size dflat */
  sx=cpl_image_get_size_x(ima1);
  sy=cpl_image_get_size_y(ima1);
  assure(sx==cpl_image_get_size_x(ima2),CPL_ERROR_ILLEGAL_INPUT,
      "illagal x size");
  assure(sy==cpl_image_get_size_y(ima2),CPL_ERROR_ILLEGAL_INPUT,
      "illagal y size");

  /* Do real job */
  /* get min x position of overlapping region: d2 trace */
  //ypos=cpl_polynomial_evaluate_2d(otab_traces,0,order_ref);
  llx=xsh_order_list_eval_int( d2_list, d2_list->list[oref_d2].edglopoly,d2_list->list[oref_d2].starty);
  //xpos+=cpl_polynomial_evaluate_2d(otab_traces,0,order_ref+1);
  urx=xsh_order_list_eval_int( d2_list, d2_list->list[oref_d2].edglopoly,d2_list->list[oref_d2].endy);
  xsh_msg("llx=%d urx=%d sx=%d sy=%d",llx,urx,sx,sy);
  xpos= ( llx < urx ) ? llx: urx;
  xpos_min=(int)xpos;

  /* get max x position of overlapping region: qth trace */
  //ypos=cpl_polynomial_evaluate_2d(otab_traces,(double)sx,order_ref);
  llx=xsh_order_list_eval_int( qth_list, qth_list->list[oref_qth].edguppoly, 0);
  //ypos+=cpl_polynomial_evaluate_2d(otab_traces,(double)sx,order_ref+1);
  urx=xsh_order_list_eval_int( qth_list, qth_list->list[oref_qth].edguppoly, sy);
  xsh_msg("llx=%d urx=%d sx=%d sy=%d",llx,urx,sx,sy);
  xpos= ( llx > urx ) ? llx: urx;
  xpos_max=(int)xpos;

  xsh_msg("xpos min=%d max=%d",xpos_min,xpos_max);
  ima_mask = cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
  point_mask=cpl_image_get_data_double(ima_mask);
  /* set right hand side part of mask to 1 */
  for(j=0;j<sy;j++) {
    for(i=xpos_max;i<sx;i++) {
      point_mask[j*sx+i]=1.;
    }
  }
  /*
  cpl_image_save(ima_mask,"ima_mask_ord1.fits", CPL_BPP_IEEE_FLOAT,NULL,
                   CPL_IO_DEFAULT);
  */
  /* in transition region (only) make the check */
  for(j=0;j<sy;j++) {

    for(i=xpos_min;i<xpos_max;i++) {

      /* Here the order trace pass through the order center
            but we want to have the trace in the inter order region
            x=(xd2_upp+xqth_low)/2; where yc1 and yc2 are the two position at
                           order center and order+1 center
       */
      //ypos= cpl_polynomial_evaluate_2d(otab_traces,xpos,order_ref);
      llx= xsh_order_list_eval_int( d2_list, d2_list->list[oref_d2].edglopoly, j);
      //ypos+=cpl_polynomial_evaluate_2d(otab_traces,xpos,order_ref+1);
      urx= xsh_order_list_eval_int( qth_list, qth_list->list[oref_qth].edguppoly,j);
      xpos=0.5*(llx+urx);

      if(i > xpos)  {
        //xsh_msg("pix[%d,%d]: llx=%d urx=%d xpos=%g",i,j,llx,urx,xpos);
        point_mask[j*sx+i] = 1.;
      }
    }
  }
  /*
   cpl_image_save(ima_mask,"ima_mask_ord2.fits", CPL_BPP_IEEE_FLOAT,NULL,
                  CPL_IO_DEFAULT);
  */

  /*determine ref flux on d2-flat (oref_d2) */
  ypos_cen=sy/2;
  lly=ypos_cen-yrad;
  ury=ypos_cen+yrad;

  //ypos= cpl_polynomial_evaluate_2d(otab_traces,(double)xpos_cen,order_ref+1);

  xpos = xsh_order_list_eval_int( d2_list, d2_list->list[oref_d2].cenpoly, ypos_cen);

  xpos_cen=(int)xpos;
  llx=xpos_cen-yrad;
  urx=xpos_cen+yrad;
  fflux=cpl_image_get_median_window(ima1,llx,lly,urx,ury);



  /*determine ref flux on qth-flat2 (oref_qth): on the same x-y pos! */
  //xpos = xsh_order_list_eval_int( qth_list, qth_list->list[oref_qth].cenpoly, ypos_cen);
  //ypos=cpl_polynomial_evaluate_2d(otab_traces,(double)xpos_cen,order_ref);
  //xpos_cen=(int)xpos;
  //llx=xpos_cen-xrad;
  //urx=xpos_cen+xrad;
  
  dflux=cpl_image_get_median_window(ima2,llx,lly,urx,ury);

  scale=fflux/dflux;

  xsh_msg("flux: n=%g d=%g s=%g",fflux,dflux,scale);

  /* combine images */
  ima_comb=cpl_image_duplicate(ima1);
  cpl_image_multiply(ima_comb,ima_mask);
  cpl_image_multiply_scalar(ima_mask,-1.);
  cpl_image_add_scalar(ima_mask,1.);
  cpl_image_multiply(ima2,ima_mask);
  cpl_image_multiply_scalar(ima2,scale);
  cpl_image_add(ima_comb,ima2);
  /*
   cpl_image_save(ima_comb,"ima_comb.fits", CPL_BPP_IEEE_FLOAT,NULL,
                  CPL_IO_DEFAULT);
  */
  cleanup:

  xsh_free_table(&ordertable);
  xsh_free_propertylist(&otab_header);
  xsh_free_polynomial(&otab_traces);
  xsh_free_image(&ima1);
  xsh_free_image(&ima2);
  xsh_free_image(&ima_mask);

  return ima_comb;
}


cpl_error_code  xsh_frame_image_save2ext(cpl_frame* frm,
					const char* name_o, const int ext_i, 
					 const int ext_o) {
  const char* name = NULL;
  cpl_image* ima = NULL;
  cpl_propertylist* plist = NULL;

  name = cpl_frame_get_filename(frm);
  ima = cpl_image_load(name, XSH_PRE_DATA_TYPE, 0, ext_i);

  if (ext_o == 0) {
    cpl_image_save(ima, name_o, XSH_PRE_DATA_BPP, plist, CPL_IO_DEFAULT);
  } else {
    cpl_image_save(ima, name_o, XSH_PRE_DATA_BPP, NULL, CPL_IO_EXTEND);
  }

  xsh_free_image(&ima);
  xsh_free_propertylist(&plist);
  return cpl_error_get_code();

}

cpl_error_code xsh_frame_image_add_double(cpl_frame* frm, const double value) {
  const char* name = NULL;
  name = cpl_frame_get_filename(frm);
  cpl_image* ima = NULL;
  cpl_propertylist* plist = NULL;

  name=cpl_frame_get_filename(frm);
  ima = cpl_image_load(name, XSH_PRE_DATA_TYPE, 0, 0);
  plist=cpl_propertylist_load(name,0);

  cpl_image_add_scalar(ima,value);
  cpl_image_save(ima, name, XSH_PRE_DATA_BPP, plist, CPL_IO_DEFAULT);

  xsh_free_image(&ima);
  xsh_free_propertylist(&plist);
  return cpl_error_get_code();

}

static cpl_error_code
xsh_key_scan_mult_by_fct(cpl_propertylist** plist,const char* kname,const int fct)
{

  int value=0;
  if(cpl_propertylist_has(*plist,kname) > 0) {
    xsh_get_property_value(*plist,kname,CPL_TYPE_INT,&value);
    if(value>1) {
      check(cpl_propertylist_set_int(*plist,kname,value*fct));
    }
  } else {
    if(value>1) {
      cpl_propertylist_append_int(*plist,kname,1);
    }
  }

 cleanup:
  return cpl_error_get_code();
}

static cpl_error_code
xsh_key_bin_div_by_fct(cpl_propertylist** plist,const char* kname,const int fct)
{

  int value=0;
  if(cpl_propertylist_has(*plist,kname) > 0) {
    xsh_get_property_value(*plist,kname,CPL_TYPE_INT,&value);
    if(value>1) {
      check(cpl_propertylist_set_int(*plist,kname,value/fct));
    }
  } else {
    if(fct>1) {
      cpl_propertylist_append_int(*plist,kname,1);
    }
  }

 cleanup:
  return cpl_error_get_code();
}


static cpl_error_code
xsh_plist_mult_by_fct(cpl_propertylist** plist,const int fctx,const int fcty)
{

  xsh_key_bin_div_by_fct(plist,XSH_WIN_BINX,fctx);
  xsh_key_bin_div_by_fct(plist,XSH_WIN_BINY,fcty);
  xsh_key_scan_mult_by_fct(plist,XSH_PRSCX,fctx);
  xsh_key_scan_mult_by_fct(plist,XSH_PRSCY,fcty);
  xsh_key_scan_mult_by_fct(plist,XSH_OVSCX,fctx);
  xsh_key_scan_mult_by_fct(plist,XSH_OVSCY,fcty);

  return cpl_error_get_code();
}







static cpl_image*
xsh_image_div_by_fct(const cpl_image* ima_dat,const int fctx,const int fcty)
{
  int sx=0;
  int sy=0;
  int nx=0;
  int ny=0;

  cpl_image* ima_datr=NULL;

  const float* pdat=NULL;
  float* pdatr=NULL;

  int i=0;
  int j=0;
  int k=0;
  int m=0;

  check(sx=cpl_image_get_size_x(ima_dat));
  check(sy=cpl_image_get_size_y(ima_dat));

  xsh_msg("org image size dat: %d %d",sx,sy);
  nx=sx/fctx;
  ny=sy/fcty;

  check(ima_datr=cpl_image_new(nx,ny,CPL_TYPE_FLOAT));
  xsh_msg("new image size dat: %d %d",nx,ny);
  check(pdat=cpl_image_get_data_float_const(ima_dat));
  check(pdatr=cpl_image_get_data_float(ima_datr));


  for (j = 0; j < ny; j++) {
    for (m = 0; m < fcty; m++) {
      for (i = 0; i < nx; i++) {
        for (k = 0; k < fctx; k++) {
          /*
           xsh_msg("j=%d m=%d i=%d k=%d index=%d int=%f",j,m,i,k,
           i*fctx+k+(j*fcty+m)*fctx*nx,pdat[i+j*nx]);
           */
          pdatr[i + j * nx] += pdat[i * fctx + k + (j * fcty + m) * fctx * nx];
        }
      }
    }
    /* HERE ONE SHOULD RE-SCALE */
    pdatr[i + j * nx] /= (fctx * fcty);

  }
  
 cleanup:
  return ima_datr;

}




static cpl_image*
xsh_image_mult_by_fct(const cpl_image* ima_dat,const int fctx,const int fcty)
{

  int nx=0;
  int ny=0;

  cpl_image* ima_datr=NULL;

  const float* pdat=NULL;
  float* pdatr=NULL;

  int i=0;
  int j=0;
  int k=0;
  int m=0;

  check(nx=cpl_image_get_size_x(ima_dat));
  check(ny=cpl_image_get_size_y(ima_dat));
       
  xsh_msg("org image size dat: %d %d",nx,ny);
  check(ima_datr=cpl_image_new(fctx*nx,fcty*ny,CPL_TYPE_FLOAT));
  xsh_msg("new image size dat: %d %d",fctx*nx,fcty*ny);

  check(pdat=cpl_image_get_data_float_const(ima_dat));
  check(pdatr=cpl_image_get_data_float(ima_datr));

  for(j=0;j<ny;j++) {
    for(m=0;m<fcty;m++) {
      for(i=0;i<nx;i++) {
	for(k=0;k<fctx;k++) {
               //xsh_msg("j=%d m=%d i=%d k=%d index=%d int=%f",j,m,i,k,
	       //       i*fctx+k+(j*fcty+m)*fctx*nx,pdat[i+j*nx]);
	  pdatr[i*fctx+k+(j*fcty+m)*fctx*nx]=pdat[i+j*nx];
	}
      }
    }
  }

 cleanup:
  return ima_datr;
}


cpl_frame*
xsh_frame_image_div_by_fct(cpl_frame* frm,const int fctx, const int fcty)
{

  const char* name=NULL;
  cpl_propertylist* plist=NULL;
  cpl_propertylist* hext=NULL;
  cpl_image* ima_dat=NULL;
  cpl_image* ima_datr=NULL;

  int next=0;

  int prscx=0;
  int prscy=0;
  int ovscx=0;
  int ovscy=0;
  int kk=0;
  cpl_frame* frm_cor=NULL;
  const char* tag=NULL;

  const char* basename=NULL;
  char new_name[256];

  check(name=cpl_frame_get_filename(frm));
  check(tag=cpl_frame_get_tag(frm));
  next=cpl_frame_get_nextensions(frm);
  check(plist=cpl_propertylist_load(name,0));
 
  check(prscx=xsh_pfits_get_prscx(plist));
  check(prscy=xsh_pfits_get_prscy(plist));
  check(ovscx=xsh_pfits_get_ovscx(plist));
  check(ovscy=xsh_pfits_get_ovscy(plist));
  xsh_msg("Prescan: %d,%d Overscan: %d,%d",prscx,prscy,ovscx,ovscy);

  xsh_plist_div_by_fct(&plist,fctx,fcty);

  check(basename=xsh_get_basename(name));
  sprintf(new_name,"fctx%d_fcty%d_%s",fctx,fcty,basename);
  xsh_msg("new_name=%s",new_name);

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

    check(ima_dat=cpl_image_load(name,CPL_TYPE_FLOAT,0,kk));
    check(hext=cpl_propertylist_load(name,kk));
    ima_datr=xsh_image_div_by_fct(ima_dat,fctx,fcty);

    if(kk==0) {
      check(cpl_image_save(ima_datr,new_name,XSH_PRE_DATA_BPP,plist,
			   CPL_IO_DEFAULT));
    } else if (kk==1) {
      check(cpl_image_save(ima_datr,new_name,XSH_PRE_ERRS_BPP,hext,
			   CPL_IO_EXTEND));
    } else if (kk==2) {
      check(cpl_image_save(ima_datr,new_name,XSH_PRE_QUAL_BPP,hext,
			   CPL_IO_EXTEND));
    }

    xsh_free_image(&ima_dat);
    xsh_free_image(&ima_datr);
    xsh_free_propertylist(&plist);
    xsh_free_propertylist(&hext);
  } /* end loop over extensions */
  frm_cor=cpl_frame_new();
  cpl_frame_set_filename(frm_cor,new_name);
  check(cpl_frame_set_tag(frm_cor,tag));
  cpl_frame_set_type(frm_cor,CPL_FRAME_TYPE_IMAGE);
  cpl_frame_set_group(frm_cor,CPL_FRAME_GROUP_CALIB);
  xsh_add_temporary_file(new_name);

 cleanup:

  xsh_free_image(&ima_dat);
  xsh_free_image(&ima_datr);
  xsh_free_propertylist(&plist);
  xsh_free_propertylist(&hext);

  return frm_cor;
}

cpl_frame* 
xsh_frame_image_mult_by_fct(cpl_frame* frm,const int fctx, const int fcty)
{

  const char* name=NULL;
  cpl_propertylist* plist=NULL;
  cpl_propertylist* hext=NULL;
  cpl_image* ima_dat=NULL;
  cpl_image* ima_datr=NULL;

  int next=0;

  int prscx=0;
  int prscy=0;
  int ovscx=0;
  int ovscy=0;
  int kk=0;
  cpl_frame* frm_cor=NULL;
  const char* tag=NULL;
  const char* basename=NULL;
  char new_name[256];

  check(name=cpl_frame_get_filename(frm));
  check(tag=cpl_frame_get_tag(frm));
  next=cpl_frame_get_nextensions(frm);
  check(plist=cpl_propertylist_load(name,0));

  check(prscx=xsh_pfits_get_prscx(plist));
  check(prscy=xsh_pfits_get_prscy(plist));
  check(ovscx=xsh_pfits_get_ovscx(plist));
  check(ovscy=xsh_pfits_get_ovscy(plist));

  xsh_msg("Prescan: %d,%d Overscan: %d,%d",prscx,prscy,ovscx,ovscy);
  check(basename=xsh_get_basename(name));
  sprintf(new_name,"fctx%d_fcty%d_%s",fctx,fcty,basename);
  xsh_msg("new_name=%s",new_name);

  xsh_plist_mult_by_fct(&plist,fctx,fcty);
  for(kk=0;kk<=next;kk++) {

    check(ima_dat=cpl_image_load(name,CPL_TYPE_FLOAT,0,kk));
    check(hext=cpl_propertylist_load(name,kk));
    ima_datr=xsh_image_mult_by_fct(ima_dat,fctx,fcty);
    if(kk==0) {
      check(cpl_image_save(ima_datr,new_name,XSH_PRE_DATA_BPP,plist,
			   CPL_IO_DEFAULT));
    } else if (kk==1) {
      check(cpl_image_save(ima_datr,new_name,XSH_PRE_ERRS_BPP,hext,
			   CPL_IO_EXTEND));
    } else if (kk==2) {
      check(cpl_image_save(ima_datr,new_name,XSH_PRE_QUAL_BPP,hext,
			   CPL_IO_EXTEND));
    }

    xsh_free_image(&ima_dat);
    xsh_free_image(&ima_datr);
    xsh_free_propertylist(&plist);
    xsh_free_propertylist(&hext);

  }

  frm_cor=cpl_frame_new();
  cpl_frame_set_filename(frm_cor,new_name);
  cpl_frame_set_tag(frm_cor,tag);
  cpl_frame_set_type(frm_cor,CPL_FRAME_TYPE_IMAGE);
  cpl_frame_set_group(frm_cor,CPL_FRAME_GROUP_CALIB);
  xsh_add_temporary_file(new_name);
cleanup:
  return frm_cor;

}
cpl_error_code xsh_image_cut_dichroic_uvb(cpl_frame* frame1d)
{

    cpl_propertylist* phead=NULL;
    cpl_propertylist* dhead=NULL;
    cpl_propertylist* ehead=NULL;
    cpl_propertylist* qhead=NULL;
    cpl_image* org_data_ima=NULL;
    cpl_image* cut_data_ima=NULL;
    cpl_image* org_errs_ima=NULL;
    cpl_image* cut_errs_ima=NULL;
    cpl_image* org_qual_ima=NULL;
    cpl_image* cut_qual_ima=NULL;

    const char* fname=NULL;
    char oname[128];
    int next=0;

    int i=0;
    int naxis1=0;
    int naxis2=0;
    int xcut=0;

    double crval1=0;
    double cdelt1=0;
    double wave_cut=XSH_UVB_DICHROIC_WAVE_CUT; /* 556 nm dichroic cut */
    double wave_min=0;
    double wave_max=0;
    char cmd[256];
    fname=cpl_frame_get_filename(frame1d);
    next=cpl_frame_get_nextensions(frame1d);
    phead = cpl_propertylist_load(fname, 0);

    xsh_msg("fname=%s",fname);
    check(org_data_ima=cpl_image_load( fname, XSH_PRE_DATA_TYPE, 0,0 ));
    check(naxis1=cpl_image_get_size_x(org_data_ima));
    check(naxis2=cpl_image_get_size_y(org_data_ima));
    xsh_free_image(&org_data_ima);

    crval1=xsh_pfits_get_crval1(phead);
    cdelt1=xsh_pfits_get_cdelt1(phead);

    wave_min = crval1;
    wave_max = wave_min + cdelt1*naxis1;
    cpl_ensure_code(wave_max > wave_cut, CPL_ERROR_ILLEGAL_INPUT);
    xcut = (int) ( (wave_cut-wave_min) / cdelt1 + 0.5 );
    cpl_ensure_code(xcut <= naxis1, CPL_ERROR_ILLEGAL_INPUT);

    if (xcut == naxis1) {
        return CPL_ERROR_NONE;
    }
    sprintf(oname,"tmp_%s",fname);
    /* loop over each frame extensions */
    for(i=0;i<next;i+=3) {

        org_data_ima=cpl_image_load( fname, XSH_PRE_DATA_TYPE, 0,i );
        org_errs_ima=cpl_image_load( fname, XSH_PRE_ERRS_TYPE, 0,i+1 );
        org_qual_ima=cpl_image_load( fname, XSH_PRE_QUAL_TYPE, 0,i+2 );
        dhead = cpl_propertylist_load(fname, i);
        ehead = cpl_propertylist_load(fname, i+1);
        qhead = cpl_propertylist_load(fname, i+2);
        if(i==0) {
             cut_data_ima=cpl_image_extract(org_data_ima,1,1,xcut,naxis2);
             cut_errs_ima=cpl_image_extract(org_errs_ima,1,1,xcut,naxis2);
             cut_qual_ima=cpl_image_extract(org_qual_ima,1,1,xcut,naxis2);

            cpl_image_save( cut_data_ima, oname, CPL_BPP_IEEE_FLOAT, phead,
                            CPL_IO_DEFAULT ) ;
            cpl_image_save( cut_errs_ima, oname, CPL_BPP_IEEE_FLOAT, ehead,
                            CPL_IO_EXTEND ) ;
            cpl_image_save( cut_qual_ima, oname, CPL_BPP_IEEE_FLOAT, qhead,
                            CPL_IO_EXTEND ) ;

            xsh_free_image(&cut_data_ima);
            xsh_free_image(&cut_errs_ima);
            xsh_free_image(&cut_qual_ima);


        } else {
            cpl_image_save( org_data_ima, oname, CPL_BPP_IEEE_FLOAT, dhead,
                            CPL_IO_EXTEND ) ;
            cpl_image_save( org_errs_ima, oname, CPL_BPP_IEEE_FLOAT, ehead,
                            CPL_IO_EXTEND ) ;
            cpl_image_save( org_qual_ima, oname, CPL_BPP_IEEE_FLOAT, qhead,
                            CPL_IO_EXTEND ) ;
        }

        xsh_free_image(&org_data_ima);
        xsh_free_image(&org_errs_ima);
        xsh_free_image(&org_qual_ima);
        xsh_free_propertylist(&dhead);
        xsh_free_propertylist(&ehead);
        xsh_free_propertylist(&qhead);

    }
    sprintf(cmd,"mv  %s %s",oname,fname);
    assure(system(cmd)==0,CPL_ERROR_UNSPECIFIED,"unable to mv file");
    //cpl_frame_set_filename(frame1d,oname);
    cleanup:
    xsh_free_propertylist(&phead);
    if(cpl_error_get_code() != CPL_ERROR_NONE) {
        xsh_print_rec_status(0);
    }
    return cpl_error_get_code();
}

/**@}*/
