/* $Id: sinfo_dfs.c,v 1.44 2013/09/17 08:11:22 amodigli Exp $
 *
 * This file is part of the SINFONI Pipeline
 * Copyright (C) 2002,2003 European Southern Observatory
 *
 * This program 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, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

/*
 * $Author: amodigli $
 * $Date: 2013/09/17 08:11:22 $
 * $Revision: 1.44 $
 * $Name: sinfo-2_4_0 $
 */

#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif
/*----------------------------------------------------------------------------
  Macros
  ----------------------------------------------------------------------------*/


/*----------------------------------------------------------------------------
  Private to this module
  ----------------------------------------------------------------------------*/


/*-----------------------------------------------------------------------------
  Includes
  ----------------------------------------------------------------------------*/
#include "sinfo_dfs.h"
#include <cpl.h>
#include <math.h>
#include "sinfo_error.h"
#include "sinfo_utilities.h"
#include "sinfo_utils_wrappers.h"
#include "sinfo_msg.h"
#include "sinfo_globals.h"
#include "sinfo_pro_save.h"
#include "sinfo_skycor.h"
#include "sinfo_file_handling.h"
#include <unistd.h>
#include <stdio.h>
/**@{*/
/*---------------------------------------------------------------------------*/
/**
 * @defgroup sinfo_dfs  DFS related Utilities
 *
 * TBD
 */
/*---------------------------------------------------------------------------*/

/* defines */

#define FITS_MAGIC_SZ      6
#define SINFO_FIT_AMOEBA_NMAX 5000

/* function prototypes */
/*
  static int
  sinfo_stat_rectangle(cpl_image* img,
  const int kappa,
  const int nclip,
  double *mean,
  double *stdev);
*/
static void
sinfo_fit_amoeba_get_psum(int ndim, int mpts, double** p, double* psum);


static  double
sinfo_fit_amotry(double** p,
                 double y[],
                 double psum[],
                 int ndim,
                 double (*funk)(double[]),
                 int ihi,
                 double fac);


static double
get_chisq(int N, int D,
          int (*f)(const double x[], const double a[], double *result),
          const double *a,
          const double *x,
          const double *y,
          const double *sigma);

static int get_candidate(const double *a, const int ia[],
                         int M, int N, int D,
                         double lambda,
                         int    (*f)(const double x[], const double a[],
                                     double *result),
                         int (*dfda)(const double x[], const double a[],
                                     double result[]),
                         const double *x,
                         const double *y,
                         const double *sigma,
                         double *partials,
                         cpl_matrix *alpha,
                         cpl_matrix *beta,
                         double *a_da);



int
sinfo_frame_is_raw_dark(char * tag);

/**@{*/




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



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

   subset = cpl_frameset_new();

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

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



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


/**
   @brief   Kappa-sigma clip of vector values
   @param   vin      Input vector
   @param   kappa   Value of kappa
   @param   n       Number of iterations
   @param   method  Possible method:

   0: are rejected
   values ||val-mean|| > kappa*sigma

   1: are rejected
   values ||val-median|| > kappa*sigma

   @return  clipped vector
*/

cpl_vector*
sinfo_vector_clip(const cpl_vector* vinp,
                  const double kappa,
                  const int n,
                  const int method)
{
   cpl_vector* vout=NULL;
   cpl_vector* vtmp=NULL;
   int size=0;
   int j=0;
   register int i=0;

   double mean=0;
   double median=0;
   double stdev=0;
   double* pt=NULL;
   double* po=NULL;

   cknull(vinp,"Null input vector");
   check_nomsg(vout=cpl_vector_duplicate(vinp));
   check_nomsg(mean=cpl_vector_get_mean(vout));
   check_nomsg(median=cpl_vector_get_median_const(vout));
   check_nomsg(stdev=cpl_vector_get_stdev(vout));
   check_nomsg(pt=cpl_vector_get_data(vtmp));

   if(method == 0) {
      /*
         are rejected
         values ||val-mean|| > kappa*sigma
      */
      for(j=0;j<n;j++) {

         check_nomsg(cpl_vector_sort(vout,1));  /* sort by increasing data */
         check_nomsg(po=cpl_vector_get_data(vout));

         if( (size > 1) && (fabs(po[size-1]-mean) > kappa*stdev)) {

            size--;
            check_nomsg(vtmp=cpl_vector_new(size));
            check_nomsg(pt=cpl_vector_get_data(vtmp));
            for(i=0;i<size;i++) {
               pt[i]=po[i];
            }
            check_nomsg(cpl_vector_delete(vout));
            check_nomsg(vout=cpl_vector_duplicate(vtmp));
            check_nomsg(cpl_vector_delete(vtmp));

            check_nomsg(mean=cpl_vector_get_mean(vout));
            check_nomsg(stdev=cpl_vector_get_stdev(vout));

         }

      }

   } else {
      /*
         are rejected
         values ||val-median|| > kappa*sigma
      */


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

         check_nomsg(cpl_vector_sort(vout,1));  /* sort by increasing data */
         check_nomsg(po=cpl_vector_get_data(vout));

         if( (size > 1) && (fabs(po[size-1]-median) > kappa*stdev)) {

            size--;
            check_nomsg(vtmp=cpl_vector_new(size));
            check_nomsg(pt=cpl_vector_get_data(vtmp));
            for(i=0;i<size;i++) {
               pt[i]=po[i];
            }
            check_nomsg(cpl_vector_delete(vout));
            check_nomsg(vout=cpl_vector_duplicate(vtmp));
            check_nomsg(cpl_vector_delete(vtmp));

            check_nomsg(median=cpl_vector_get_median_const(vout));
            check_nomsg(stdev=cpl_vector_get_stdev(vout));

         }

      }




   }
   return vout;
  cleanup:
   return NULL;


}



/*----------------------------------------------------------------------------*/
/**
   @brief   Get new position in parameter space (L-M algorithm)
   @param   a       Current fit parameters.
   @param   ia      Non-NULL array defining with non-zero values which
   parameters participate in the fit.
   @param   M       Number of fit parameters
   @param   N       Number of positions
   @param   D       Dimension of x-positions
   @param   lambda  Lambda in L-M algorithm.
   @param   f       Function that evaluates the fit function.
   @param   dfda    Function that evaluates the partial derivaties
   of the fit function w.r.t. fit parameters.
   @param   x       The input positions (pointer to MxD matrix buffer).
   @param   y       The N values to fit.
   @param   sigma   A vector of size N containing the uncertainties of the
   y-values. If NULL, a constant uncertainty equal to 1 is
   assumed.
   @param   partials The partial derivatives (work space).
   @param   alpha   Alpha in L-M algorithm (work space).
   @param   beta    Beta in L-M algorithm (work space).
   @param   a_da    (output) Candidate position in parameter space.

   @return  0 iff okay.

   This function computes a potentially better set of parameters @em a + @em da,
   where @em da solves the equation @em alpha(@em lambda) * @em da = @em beta .

   Possible #_cpl_error_code_ set in this function:
   - CPL_ERROR_ILLEGAL_INPUT if the fit function or its derivative could
   not be evaluated.
   - CPL_ERROR_SINGULAR_MATRIX if @em alpha is singular.

*/
/*----------------------------------------------------------------------------*/
static int
get_candidate(const double *a, const int ia[],
              int M, int N, int D,
              double lambda,
              int    (*f)(const double x[], const double a[], double *result),
              int (*dfda)(const double x[], const double a[], double result[]),
              const double *x,
              const double *y,
              const double *sigma,
              double *partials,
              cpl_matrix *alpha,
              cpl_matrix *beta,
              double *a_da)
{
   int Mfit = 0;         /* Number of non-constant fit parameters */
   cpl_matrix *da;       /* Solution of   alpha * da = beta */
   double *alpha_data;
   double *beta_data;
   double *da_data;
   int i, imfit = 0;
   int j, jmfit = 0;
   int k = 0;

   /* For efficiency, don't check input in this static function */

   Mfit = cpl_matrix_get_nrow(alpha);

   alpha_data    = cpl_matrix_get_data(alpha);
   beta_data     = cpl_matrix_get_data(beta);

   /* Build alpha, beta:
    *
    *  alpha[i,j] = sum_{k=1,N} (sigma_k)^-2 * df/da_i * df/da_j  *
    *                           (1 + delta_ij lambda) ,
    *
    *   beta[i]   = sum_{k=1,N} (sigma_k)^-2 * ( y_k - f(x_k) ) * df/da_i
    *
    * where (i,j) loop over the non-constant parameters (0 to Mfit-1),
    * delta is Kronecker's delta, and all df/da are evaluated in x_k
    */

   cpl_matrix_fill(alpha, 0.0);
   cpl_matrix_fill(beta , 0.0);

   for (k = 0; k < N; k++)
   {
      double sm2 = 0.0;                /* (sigma_k)^-2 */
      double fx_k = 0.0;               /* f(x_k)       */
      const double *x_k = &(x[0+k*D]); /* x_k          */

      if (sigma == NULL)
      {
         sm2 = 1.0;
      }
      else
      {
         sm2 = 1.0 / (sigma[k] * sigma[k]);
      }

      /* Evaluate f(x_k) */
      cpl_ensure( f(x_k, a, &fx_k) == 0, CPL_ERROR_ILLEGAL_INPUT, -1);

      /* Evaluate (all) df/da (x_k) */
      cpl_ensure( dfda(x_k, a, partials) == 0,
                  CPL_ERROR_ILLEGAL_INPUT, -1);

      for (i = 0, imfit = 0; i < M; i++)
      {
         if (ia[i] != 0)
         {
            /* Beta */
            beta_data[imfit] +=
               sm2 * (y[k] - fx_k) * partials[i];

            /* Alpha is symmetrical, so compute
               only lower-left part */
            for (j = 0, jmfit = 0; j < i; j++)
            {
               if (ia[j] != 0)
               {
                  alpha_data[jmfit + imfit*Mfit] +=
                     sm2 * partials[i] *
                     partials[j];

                  jmfit += 1;
               }
            }

            /* Alpha, diagonal terms */
            j = i;
            jmfit = imfit;

            alpha_data[jmfit + imfit*Mfit] +=
               sm2 * partials[i] *
               partials[j] * (1 + lambda);

            imfit += 1;
         }
      }

      cpl_ensure( imfit == Mfit, CPL_ERROR_ILLEGAL_INPUT,-1);
   }

   /* Create upper-right part of alpha */
   for (i = 0, imfit = 0; i < M; i++) {
      if (ia[i] != 0) {
         for (j = i+1, jmfit = imfit+1; j < M; j++) {
            if (ia[j] != 0) {
               alpha_data[jmfit+imfit*Mfit] = alpha_data[imfit+jmfit*Mfit];
               jmfit += 1;
            }
         }
         cpl_ensure( jmfit == Mfit,CPL_ERROR_ILLEGAL_INPUT,-1 );
         imfit += 1;
      }
   }
   cpl_ensure( imfit == Mfit, CPL_ERROR_ILLEGAL_INPUT,-1);

   da = cpl_matrix_solve(alpha, beta);

   cpl_ensure(da != NULL, cpl_error_get_code(), -1);

   /* Create a+da vector by adding a and da */
   da_data   = cpl_matrix_get_data(da);

   for (i = 0, imfit = 0; i < M; i++)
   {
      if (ia[i] != 0)
      {
         a_da[i] = a[i] + da_data[0 + imfit*1];

         imfit += 1;
      }
      else
      {
         a_da[i] = a[i];
      }
   }

   cpl_ensure( imfit == Mfit ,CPL_ERROR_ILLEGAL_INPUT,-1);

   cpl_matrix_delete(da);

   return 0;
}

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


/*----------------------------------------------------------------------------*/
/**
   @brief   Compute chi square
   @param   N       Number of positions
   @param   D       Dimension of x-positions
   @param   f       Function that evaluates the fit function.
   @param   a       The fit parameters.
   @param   x       Where to evaluate the fit function (N x D matrix).
   @param   y       The N values to fit.
   @param   sigma   A vector of size N containing the uncertainties of the
   y-values. If NULL, a constant uncertainty equal to 1 is
   assumed.

   @return  chi square, or a negative number on error.

   This function calculates chi square defined as
   sum_i (y_i - f(x_i, a))^2/sigma_i^2

   Possible #_cpl_error_code_ set in this function:
   - CPL_ERROR_ILLEGAL_INPUT if the fit function could not be evaluated
*/
/*----------------------------------------------------------------------------*/

static double
get_chisq(int N, int D,
          int (*f)(const double x[], const double a[], double *result),
          const double *a,
          const double *x,
          const double *y,
          const double *sigma)
{
   double chi_sq;     /* Result */
   int i = 0;

   /* For efficiency, don't check input in this static function */
   chi_sq = 0.0;
   for (i = 0; i < N; i++)
   {
      double fx_i;
      double residual;                 /* Residual in units of uncertainty */
      const double *x_i = &(x[0+i*D]);

      /* Evaluate */
      cpl_ensure( f(x_i,
                    a,
                    &fx_i) == 0, CPL_ERROR_ILLEGAL_INPUT, -1.0);

      /* Accumulate */
      if (sigma == NULL)
      {
         residual = (fx_i - y[i]);
      }
      else
      {
         residual = (fx_i - y[i]) / sigma[i];
      }

      chi_sq += residual*residual;

   }

   return chi_sq;
}



#ifndef CPL_VECTOR_FIT_MAXITER
#define CPL_VECTOR_FIT_MAXITER 1000
#endif
/*----------------------------------------------------------------------------*/
/**
   @brief   Fit a function to a set of data
   @param   x        N x D matrix of the positions to fit.
   Each matrix row is a D-dimensional position.
   @param   sigma_x  Uncertainty (one sigma, gaussian errors assumed)
   assosiated with @em x. Taking into account the
   uncertainty of the independent variable is currently
   unsupported, and this parameter must therefore be set
   to NULL.
   @param   y        The N values to fit.
   @param   sigma_y  Vector of size N containing the uncertainties of
   the y-values. If this parameter is NULL, constant
   uncertainties are assumed.
   @param   a        Vector containing M fit parameters. Must contain
   a guess solution on input and contains the best
   fit parameters on output.
   @param   ia       Array of size M defining which fit parameters participate
   in the fit (non-zero) and which fit parameters are held
   constant (zero). At least one element must be non-zero.
   Alternatively, pass NULL to fit all parameters.
   @param   f        Function that evaluates the fit function
   at the position specified by the first argument (an array of
   size D) using the fit parameters specified by the second
   argument (an array of size M). The result must be output
   using the third parameter, and the function must return zero
   iff the evaluation succeded.
   @param   dfda     Function that evaluates the first order partial
   derivatives of the fit function with respect to the fit
   parameters at the position specified by the first argument
   (an array of size D) using the parameters specified by the
   second argument (an array of size M). The result must
   be output using the third parameter (array of size M), and
   the function must return zero iff the evaluation succeded.
   @param mse        If non-NULL, the mean squared error of the best fit is
   computed.
   @param red_chisq  If non-NULL, the reduced chi square of the best fit is
   computed. This requires @em sigma_y to be specified.
   @param covariance If non-NULL, the formal covariance matrix of the best
   fit parameters is computed (or NULL on error). On success
   the diagonal terms of the covariance matrix are guaranteed
   to be positive. However, terms that involve a constant
   parameter (as defined by the input array @em ia) are
   always set to zero. Computation of the covariacne matrix
   requires @em sigma_y to be specified.


   @return  CPL_ERROR_NONE iff OK.

   This function makes a minimum chi squared fit of the specified function
   to the specified data set using the Levenberg-Marquardt algorithm.

   Possible #_cpl_error_code_ set in this function:
   - CPL_ERROR_NULL_INPUT if an input pointer other than @em sigma_x, @em
   sigma_y, @em mse, @em red_chisq or @em covariance is NULL.
   - CPL_ERROR_ILLEGAL_INPUT if an input matrix/vector is empty, if @em ia
   contains only zero values, if N <= M and @em red_chisq is non-NULL,
   if any element of @em sigma_x or @em sigma_y is non-positive, or if
   evaluation of the fit function or its derivative failed.
   - CPL_ERROR_INCOMPATIBLE_INPUT if the dimensions of the input
   vectors/matrices do not match, or if chi square or covariance computation
   is requested and @em sigma_y is NULL.
   - CPL_ERROR_ILLEGAL_OUTPUT if memory allocation failed.
   - CPL_ERROR_CONTINUE if the Levenberg-Marquardt algorithm failed to converge.
   - CPL_ERROR_SINGULAR_MATRIX if the covariance matrix could not be computed.

*/
/*----------------------------------------------------------------------------*/
cpl_error_code
sinfo_fit_lm(const cpl_matrix *x,
             const cpl_matrix *sigma_x,
             const cpl_vector *y,
             const cpl_vector *sigma_y,
             cpl_vector *a,
             const int ia[],
             int    (*f)(const double x[],
                         const double a[],
                         double *result),
             int (*dfda)(const double x[],
                         const double a[],
                         double result[]),
             double *mse,
             double *red_chisq,
             cpl_matrix **covariance)
{
   const double *x_data     = NULL; /* Pointer to input data                  */
   const double *y_data     = NULL; /* Pointer to input data                  */
   const double *sigma_data = NULL; /* Pointer to input data                  */
   int N    = 0;                    /* Number of data points                  */
   int D    = 0;                    /* Dimension of x-points                  */
   int M    = 0;                    /* Number of fit parameters               */
   int Mfit = 0;                    /* Number of non-constant fit
                                       parameters                             */

   double lambda    = 0.0;          /* Lambda in L-M algorithm                */
   double MAXLAMBDA = 10e40;        /* Parameter to control the graceful exit
                                       if steepest descent unexpectedly fails */
   double chi_sq    = 0.0;          /* Current  chi^2                         */
   int count        = 0;            /* Number of successive small improvements
                                       in chi^2 */
   int iterations   = 0;

   cpl_matrix *alpha  = NULL;       /* The MxM ~curvature matrix used in L-M  */
   cpl_matrix *beta   = NULL;       /* Mx1 matrix = -.5 grad(chi^2)           */
   double *a_data     = NULL;       /* Parameters, a                          */
   double *a_da       = NULL;       /* Candidate position a+da                */
   double *part       = NULL;       /* The partial derivatives df/da          */
   int *ia_local      = NULL;       /* non-NULL version of ia                 */

   /* If covariance computation is requested, then either
    * return the covariance matrix or return NULL.
    */
   if (covariance != NULL) *covariance = NULL;

   /* Validate input */
   cpl_ensure_code(x       != NULL, CPL_ERROR_NULL_INPUT);
   cpl_ensure_code(sigma_x == NULL, CPL_ERROR_UNSUPPORTED_MODE);
   cpl_ensure_code(y       != NULL, CPL_ERROR_NULL_INPUT);
   cpl_ensure_code(a       != NULL, CPL_ERROR_NULL_INPUT);
   /* ia may be NULL */
   cpl_ensure_code(f       != NULL, CPL_ERROR_NULL_INPUT);
   cpl_ensure_code(dfda    != NULL, CPL_ERROR_NULL_INPUT);

   /* Chi^2 and covariance computations require sigmas to be known */
   cpl_ensure_code( sigma_y != NULL ||
                    (red_chisq == NULL && covariance == NULL),
                    CPL_ERROR_INCOMPATIBLE_INPUT);

   D = cpl_matrix_get_ncol(x);
   N = cpl_matrix_get_nrow(x);
   M = cpl_vector_get_size(a);
   cpl_ensure_code(N > 0 && D > 0 && M > 0, CPL_ERROR_ILLEGAL_INPUT);

   cpl_ensure_code( cpl_vector_get_size(y) == N,
                    CPL_ERROR_INCOMPATIBLE_INPUT);

   x_data = cpl_matrix_get_data_const(x);
   y_data = cpl_vector_get_data_const(y);
   a_data = cpl_vector_get_data(a);

   if (sigma_y != NULL)
   {
      cpl_ensure_code( cpl_vector_get_size(sigma_y) == N,
                       CPL_ERROR_INCOMPATIBLE_INPUT);
      /* Sigmas must be positive */
      cpl_ensure_code( cpl_vector_get_min (sigma_y) > 0,
                       CPL_ERROR_ILLEGAL_INPUT);
      sigma_data = cpl_vector_get_data_const(sigma_y);
   }

   ia_local = cpl_malloc(M * sizeof(int));
   cpl_ensure_code(ia_local != NULL, CPL_ERROR_ILLEGAL_OUTPUT);

   /* Count non-constant fit parameters, copy ia */
   if (ia != NULL)
   {
      int i;

      Mfit = 0;
      for (i = 0; i < M; i++)
      {
         ia_local[i] = ia[i];

         if (ia[i] != 0)
         {
            Mfit += 1;
         }
      }

      if (! (Mfit > 0))
      {
         cpl_free(ia_local);
         cpl_ensure_code( CPL_FALSE,
                          CPL_ERROR_ILLEGAL_INPUT);
      }
   }
   else
   {
      /* All parameters participate */
      int i;

      Mfit = M;

      for (i = 0; i < M; i++)
      {
         ia_local[i] = 1;
      }
   }

   /* To compute reduced chi^2, we need N > Mfit */
   if (! ( red_chisq == NULL || N > Mfit ) )
   {
      cpl_free(ia_local);
      cpl_ensure_code(
         CPL_FALSE,
         CPL_ERROR_ILLEGAL_INPUT);
   }

   /* Create alpha, beta, a_da, part  work space */
   alpha = cpl_matrix_new(Mfit, Mfit);
   if (alpha == NULL)
   {
      cpl_free(ia_local);
      cpl_ensure_code(
         CPL_FALSE,
         CPL_ERROR_ILLEGAL_OUTPUT);
   }

   beta = cpl_matrix_new(Mfit, 1);
   if (beta == NULL)
   {
      cpl_free(ia_local);
      cpl_matrix_delete(alpha);
      cpl_ensure_code(
         CPL_FALSE,
         CPL_ERROR_ILLEGAL_OUTPUT);
   }

   a_da = cpl_malloc(M * sizeof(double));
   if (a_da == NULL)
   {
      cpl_free(ia_local);
      cpl_matrix_delete(alpha);
      cpl_matrix_delete(beta);
      cpl_ensure_code(
         CPL_FALSE,
         CPL_ERROR_ILLEGAL_OUTPUT);
   }

   part = cpl_malloc(M * sizeof(double));
   if (part == NULL)
   {
      cpl_free(ia_local);
      cpl_matrix_delete(alpha);
      cpl_matrix_delete(beta);
      cpl_free(a_da);
      cpl_ensure_code(
         CPL_FALSE,
         CPL_ERROR_ILLEGAL_OUTPUT);
   }

   /* Initialize loop variables */
   lambda = 0.001;
   count = 0;
   iterations = 0;
   if( (chi_sq = get_chisq(N, D, f, a_data, x_data, y_data, sigma_data)) < 0)
   {
      cpl_free(ia_local);
      cpl_matrix_delete(alpha);
      cpl_matrix_delete(beta);
      cpl_free(a_da);
      cpl_free(part);
      cpl_ensure_code(
         CPL_FALSE,
         cpl_error_get_code());
   }

   /* uves_msg_debug("Initial chi^2 = %f", chi_sq); */

   /* Iterate until chi^2 didn't improve substantially many (say, 5)
      times in a row */
   while (count < 5 &&
          lambda < MAXLAMBDA &&
          iterations < CPL_VECTOR_FIT_MAXITER)
   {
      /* In each iteration lambda increases, or chi^2 decreases or
         count increases. Because chi^2 is bounded from below
         (and lambda and count from above), the loop will terminate */

      double chi_sq_candidate = 0.0;
      int returncode = 0;

      /* Get candidate position in parameter space = a+da,
       * where  alpha * da = beta .
       * Increase lambda until alpha is non-singular
       */

      while( (returncode = get_candidate(a_data, ia_local,
                                         M, N, D,
                                         lambda, f, dfda,
                                         x_data, y_data, sigma_data,
                                         part, alpha, beta, a_da)
                ) != 0
             && cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX
             && lambda < MAXLAMBDA)
      {
         /* uves_msg_debug("Singular matrix. lambda = %e", lambda); */
         cpl_error_reset();
         lambda *= 9.0;
      }

      /* Set error if lambda diverged */
      if ( !( lambda < MAXLAMBDA ) )
      {
         cpl_free(ia_local);
         cpl_matrix_delete(alpha);
         cpl_matrix_delete(beta);
         cpl_free(a_da);
         cpl_free(part);
         cpl_ensure_code(
            CPL_FALSE,
            CPL_ERROR_CONTINUE);
      }

      if (returncode != 0)
      {
         cpl_free(ia_local);
         cpl_matrix_delete(alpha);
         cpl_matrix_delete(beta);
         cpl_free(a_da);
         cpl_free(part);
         cpl_ensure_code(
            CPL_FALSE,
            cpl_error_get_code());
      }

      /* Get chi^2(a+da) */
      if ((chi_sq_candidate = get_chisq(N, D, f, a_da,
                                        x_data, y_data, sigma_data)) < 0)
      {
         cpl_free(ia_local);
         cpl_matrix_delete(alpha);
         cpl_matrix_delete(beta);
         cpl_free(a_da);
         cpl_free(part);
         cpl_ensure_code(
            CPL_FALSE,
            cpl_error_get_code());
      }

      /* uves_msg_debug("Chi^2 = %f  Candidate = %f  Lambda = %e",
         chi_sq, chi_sq_candidate, lambda);  */

      if (chi_sq_candidate > chi_sq)
      {
         /* Move towards steepest descent */
         lambda *= 9.0;
      }
      else
      {
         /* Move towards Newton's algorithm */
         lambda /= 10.0;

         /* Count the number of successive improvements in chi^2 of
            less than 0.01 relative */
         if ( chi_sq == 0 ||
              (chi_sq - chi_sq_candidate)/chi_sq < .01)
         {
            count += 1;
         }
         else
         {
            /* Chi^2 improved by a significant amount,
               reset counter */
            count = 0;
         }

         /* chi^2 improved, update a and chi^2 */
         {
            int i;
            for (i = 0; i < M; i++) a_data[i] = a_da[i];
         }
         chi_sq = chi_sq_candidate;
      }
      iterations++;
   }

   /* Set error if we didn't converge */
   if ( !( lambda < MAXLAMBDA && iterations < CPL_VECTOR_FIT_MAXITER ) )
   {
      cpl_free(ia_local);
      cpl_matrix_delete(alpha);
      cpl_matrix_delete(beta);
      cpl_free(a_da);
      cpl_free(part);
      cpl_ensure_code(
         CPL_FALSE,
         CPL_ERROR_CONTINUE);
   }

   /* Compute mse if requested */
   if (mse != NULL)
   {
      int i;

      *mse = 0.0;

      for(i = 0; i < N; i++)
      {
         double fx_i = 0.0;
         double residual = 0.0;

         /* Evaluate f(x_i) at the best fit parameters */
         if( f(&(x_data[i*D]),
               a_data,
               &fx_i) != 0)
         {
            cpl_free(ia_local);
            cpl_matrix_delete(alpha);
            cpl_matrix_delete(beta);
            cpl_free(a_da);
            cpl_free(part);
            cpl_ensure_code(
               CPL_FALSE,
               CPL_ERROR_ILLEGAL_INPUT);
         }

         residual = y_data[i] - fx_i;
         *mse += residual * residual;
      }
      *mse /= N;
   }

   /* Compute reduced chi^2 if requested */
   if (red_chisq != NULL)
   {
      /* We already know the optimal chi^2 (and that N > Mfit)*/
      *red_chisq = chi_sq / (N-Mfit);
   }

   /* Compute covariance matrix if requested
    * cov = alpha(lambda=0)^-1
    */
   if (covariance != NULL)
   {
      cpl_matrix *cov;

      if( get_candidate(a_data, ia_local,
                        M, N, D, 0.0, f, dfda,
                        x_data, y_data, sigma_data,
                        part, alpha, beta, a_da)
          != 0)
      {
         cpl_free(ia_local);
         cpl_matrix_delete(alpha);
         cpl_matrix_delete(beta);
         cpl_free(a_da);
         cpl_free(part);
         cpl_ensure_code(
            CPL_FALSE,
            cpl_error_get_code());
      }

      cov = cpl_matrix_invert_create(alpha);
      if (cov == NULL)
      {
         cpl_free(ia_local);
         cpl_matrix_delete(alpha);
         cpl_matrix_delete(beta);
         cpl_free(a_da);
         cpl_free(part);
         cpl_ensure_code(
            CPL_FALSE,
            cpl_error_get_code());
      }

      /* Make sure that variances are positive */
      {
         int i;
         for (i = 0; i < Mfit; i++)
         {
            if ( !(cpl_matrix_get(cov, i, i) > 0) )
            {
               cpl_free(ia_local);
               cpl_matrix_delete(alpha);
               cpl_matrix_delete(beta);
               cpl_free(a_da);
               cpl_free(part);
               cpl_matrix_delete(cov);
               *covariance = NULL;
               cpl_ensure_code(
                  CPL_FALSE,
                  CPL_ERROR_SINGULAR_MATRIX);
            }
         }
      }

      /* Expand covariance matrix from Mfit x Mfit
         to M x M. Set rows/columns corresponding to fixed
         parameters to zero */

      *covariance = cpl_matrix_new(M, M);
      if (*covariance == NULL)
      {
         cpl_free(ia_local);
         cpl_matrix_delete(alpha);
         cpl_matrix_delete(beta);
         cpl_free(a_da);
         cpl_free(part);
         cpl_matrix_delete(cov);
         cpl_ensure_code(
            CPL_FALSE,
            CPL_ERROR_ILLEGAL_OUTPUT);
      }

      {
         int j, jmfit;

         for (j = 0, jmfit = 0; j < M; j++)
            if (ia_local[j] != 0)
            {
               int i, imfit;

               for (i = 0, imfit = 0; i < M; i++)
                  if (ia_local[i] != 0)
                  {
                     cpl_matrix_set(*covariance, i, j,
                                    cpl_matrix_get(
                                       cov, imfit, jmfit));
                     imfit += 1;
                  }

               cpl_ensure( imfit == Mfit, CPL_ERROR_ILLEGAL_INPUT,-1);

               jmfit += 1;
            }

         cpl_ensure( jmfit == Mfit, CPL_ERROR_ILLEGAL_INPUT,-1 );
      }

      cpl_matrix_delete(cov);
   }

   cpl_free(ia_local);
   cpl_matrix_delete(alpha);
   cpl_matrix_delete(beta);
   cpl_free(a_da);
   cpl_free(part);

   return CPL_ERROR_NONE;
}















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

/**
   @name        sinfo_fit_amoeba_get_psum
   @memo        computes sum of p values
   @param        ndim vector's dimension
   @param        mpts No of points
   @param        p matrix of size [1...ndim+1][1...ndim]
   @param        psum result
   @return    void

*/

static void
sinfo_fit_amoeba_get_psum(int ndim, int mpts, double** p, double* psum)
{
   int i=0;
   int j=0;
   double sum=0;
   for (j=0;j<ndim;j++) {
      for (sum=0.0,i=0;i<mpts;i++) {
         sum += p[i][j];
      }
      psum[j]=sum;
   }

}


#define SINFO_FIT_AMOEBA_SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;}



/**
   @name        sinfo_fit_amoeba
   @memo        Imp-lements amoeba function for multidimensional minimizzation
   @param        p matrix of size [1...ndim+1][1...ndim]
   @param        y vector[1...ndim+1]
   @param        psum
   @param        ndim vector's dimension
   @param        funk function to be minimized
   @param        ihi
   @param        fac
   @return    int 0, 1, or -1
   @doc
   Multidimensional minimizzation of the function funk(x) where x[1..ndim] is
   a vector in ndim dimensions, by the downhill simplex method of Nedler and
   Mead. The matrix p[1..ndim+1][1..ndim] is input. Its ndim+1 rows are
   ndim-dimensional vectors which are the vertices of the starting simplex.
   Also input is the vector y[1..ndim+1], whose components must be
   pre-initialized to the values of funk avaluated at the ndim+1 vertices (rows)
   of p; and ftol the fractional convergence tolerance to be achieved in the
   function value (N.B.). On output, p and y will have been reset to ndim+1 new
   points all within ftol of a minimum function value, and nfunc gives the
   number of functions taken.

*/


void
sinfo_fit_amoeba(
   double**p,
   double y[],
   int ndim,
   double ftol,
   double (*funk)(double[]),
   int* nfunk)
{


   int i=0;
   int ihi=0;
   int ilo=0;
   int inhi=0;
   int j=0;
   int mpts=ndim+1;
   double rtol=0;
   double swap=0;
   double ysave=0;
   double ytry=0;
   cpl_vector* sum=NULL;
   double* psum=NULL;

   sum=cpl_vector_new(ndim);
   psum=cpl_vector_get_data(sum);
   *nfunk=0;

   sinfo_fit_amoeba_get_psum(ndim,mpts,p,psum);

   for(;;) {
      ilo=0;
      /*
        First we must determine which point is the highest (worst),
        next-highest, and lowest (best), by looping over the points
        in the simplex
      */
      ihi=y[0]>y[1] ? (inhi=1,0) : (inhi=0,1);

      for (i=0;i< mpts;i++) {
         if (y[i] <= y[ilo]) ilo=i;
         if (y[i] > y[ihi]) {
            inhi=ihi;
            ihi=i;
         } else if (y[i] > y[inhi] && i != ihi) inhi=i;
      }
      rtol=2.0*fabs(y[ihi]-y[ilo])/(fabs(y[ihi])+fabs(y[ilo]));

      /*
        compute the fractional range from highest to lowest and return if
        satisfactory
      */
      if(rtol < ftol) { // if returning, but best point and value is in slot 1
         SINFO_FIT_AMOEBA_SWAP(y[0],y[ilo]);
         for (i=0;i<ndim;i++) SINFO_FIT_AMOEBA_SWAP(p[1][i],p[ilo][i]);
         break;
      }
      if (*nfunk >= SINFO_FIT_AMOEBA_NMAX) {
         sinfo_msg_error("NMAX exceeded");
         SINFO_FIT_AMOEBA_SWAP(y[0],y[ilo]);
         for (i=0;i<ndim;i++) SINFO_FIT_AMOEBA_SWAP(p[1][i],p[ilo][i]);
         for (i=0;i<ndim;i++) {
            sinfo_msg("p[1][i]=%g p[ilo][i]=%g ilo=%d",p[1][i],p[ilo][i],ilo);
         }
         assure(*nfunk >= SINFO_FIT_AMOEBA_NMAX,CPL_ERROR_UNSPECIFIED,
                "NMAX exceeded");
         break;

      }
      *nfunk +=2;
      /*
        Begin a new iteration. First extrapolate by a Factor -1 through the face
        of the simplex across the high point, i.e. reflect the simplex from the
        high point
      */
      ytry=sinfo_fit_amotry(p,y,psum,ndim,funk,ihi,-1.0);
      if(ytry <= y[ilo]) {
         /*
            Gives a result better than the best point, so try an additional
            extrapolation by a factor 2
         */
         ytry=sinfo_fit_amotry(p,y,psum,ndim,funk,ihi,2.0);
      } else if (ytry >= y[inhi]) {

         /*
           The reflected point is worse than the second highest, so look for an
           intermediate lower point, i.e. do a one-dimensional contraction
         */
         ysave=y[ihi];
         ytry=sinfo_fit_amotry(p,y,psum,ndim,funk,ihi,0.5);
         if(ytry >= ysave) {
            /*
               Can't seem to get rid of that high point.
               Better contract around the lowest (best) point
            */
            for(i=0;i<mpts;i++) {
               if(i != ilo) {
                  for( j=0;j<ndim;j++) {
                     p[i][j]=psum[j]=0.5*(p[i][j]+p[ilo][j]);
                  }
                  y[i]=(*funk)(psum);
               }
            }
            *nfunk += ndim; /* Keep track of function evaluations */
            sinfo_fit_amoeba_get_psum(ndim,mpts,p,psum);/* Recomputes psum */
         }
      } else {
         --(*nfunk);
         /* Go back for the test of doneness and the next iteration */
      }
   }
  cleanup:
   cpl_vector_delete(sum);
}


static  double
sinfo_fit_amotry(double** p, double y[], double psum[], int ndim,
                 double (*funk)(double[]),int ihi, double fac)
{
   int j;
   double fac1=0;
   double fac2=0;
   double ytry=0;
   cpl_vector * vtry=NULL;
   double *ptry=NULL;

   vtry=cpl_vector_new(ndim);
   ptry=cpl_vector_get_data(vtry);

   fac1=(1.0-fac)/ndim;
   fac2=fac1-fac;

   for (j=0;j<ndim;j++) {
      ptry[j]=psum[j]*fac1-p[ihi][j]*fac2;
   }
   ytry=(*funk)(ptry);
   if (ytry < y[ihi]) {
      y[ihi]=ytry;
      for (j=0;j<ndim;j++) {
         psum[j] += ptry[j]-p[ihi][j];
         p[ihi][j]=ptry[j];
      }
   }
   sinfo_free_my_vector(&vtry);
   return ytry;
}

/*-------------------------------------------------------------------------*/
/*-------------------------------------------------------------------------*/
/**
   @name        sinfo_vector_dindgen
   @memo        Fill a vector with values from 0 to vector_size-1
   @param    v vector to be filled
   @return    int 0, -1
   @doc

   Returns in case of succes -1 else.
*/
/*--------------------------------------------------------------------------*/

int sinfo_vector_dindgen(cpl_vector** v)
{

   int sz=0;
   int i=0;

   cknull(*v,"Null input vector");
   check(sz=cpl_vector_get_size(*v),"Getting size of a vector");

   for(i=0;i<sz;i++) {
      cpl_vector_set(*v,i,(double)i);
   }

   return 0;
  cleanup:
   return -1;

}

/*-------------------------------------------------------------------------*/
/**
   @name        sinfo_is_fits_file
   @memo        returns 1 if file is in FITS format, 0 else
   @param    filename name of the file to check
   @return    int 0, 1, or -1
   @doc

   Returns 1 if the file name corresponds to a valid FITS file. Returns
   0 else. If the file does not exist, returns -1.
*/
/*--------------------------------------------------------------------------*/

int sinfo_is_fits_file(const char *filename)
{
   FILE    *fp ;
   char    *magic ;
   int        isfits ;

   if ((fp = fopen(filename, "r"))==NULL) {
      sinfo_msg_error("cannot open file [%s]", filename) ;
      return -1 ;
   }

   magic = cpl_calloc(FITS_MAGIC_SZ+1, sizeof(char)) ;
   (void)fread(magic, 1, FITS_MAGIC_SZ, fp) ;
   (void)fclose(fp) ;
   magic[FITS_MAGIC_SZ] = (char)0 ;
   if (strstr(magic, "SIMPLE")!=NULL)
      isfits = 1 ;
   else
      isfits = 0 ;
   cpl_free(magic) ;
   return isfits ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Extracts raw frames
   @param    set     The input frameset
   @return   CPL_ERROR_NONE iff ok
*/
/*---------------------------------------------------------------------------*/
cpl_error_code
sinfo_table_correl(cpl_table * t1, cpl_table* t2, cpl_table* range,double* xcor)
{

   double wsr=0;
   double wer=0;
   int nr=0;
   int i=0;
   int status=0;
   int nrows=0;
   double mean=0;
   double prod=0;

   cpl_table* tmp_t1=NULL;
   cpl_table* tmp_t2=NULL;

   check_nomsg(nr=cpl_table_get_nrow(range));
   for(i=0;i<nr;i++) {
      wsr=cpl_table_get_double(range,"WSTART",i,&status);
      wer=cpl_table_get_double(range,"WEND",i,&status);
      cpl_table_and_selected_double(t1,"WAVE",CPL_NOT_LESS_THAN,wsr);
      cpl_table_and_selected_double(t1,"WAVE",CPL_NOT_GREATER_THAN,wer);
      tmp_t1=cpl_table_extract_selected(t1);
      cpl_table_and_selected_double(t2,"WAVE",CPL_NOT_LESS_THAN,wsr);
      cpl_table_and_selected_double(t2,"WAVE",CPL_NOT_GREATER_THAN,wer);
      tmp_t2=cpl_table_extract_selected(t2);
      cpl_table_duplicate_column(tmp_t1,"INT1",tmp_t1,"INT");
      cpl_table_duplicate_column(tmp_t1,"INT2",tmp_t2,"INT");
      cpl_table_multiply_columns(tmp_t1,"INT1","INT2");
      mean=cpl_table_get_column_mean(tmp_t1,"INT1");
      nrows=cpl_table_get_nrow(tmp_t1);
      prod=mean*nrows;
      *xcor+=prod;
   }

  cleanup:
   return cpl_error_get_code();
}
/**
   @brief    Extracts raw frames
   @param    set     The input frameset
   @return   CPL_ERROR_NONE iff ok
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
sinfo_frameset_merge(cpl_frameset * set1, cpl_frameset* set2)
{

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

   passure(set1 != NULL, "Wrong input set");

   check_nomsg(frm_tmp = cpl_frameset_get_first(set2));
   while (frm_tmp != NULL)
   {
      frm_dup=cpl_frame_duplicate(frm_tmp);
      cpl_frameset_insert(set1,frm_dup);
      frm_tmp = cpl_frameset_get_next(set2);
   }

  cleanup:
   return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Extracts frames of a given type
   @param    set     The input frameset
   @param    ext     The output frameset
   @param    type    The frame type
   @return   CPL_ERROR_NONE iff ok
*/
/*----------------------------------------------------------------------------*/

cpl_error_code
sinfo_extract_frames_group_type(const cpl_frameset * set,
                                cpl_frameset** ext,
                                cpl_frame_group type)
{
   const cpl_frame* frm_tmp=NULL;
   cpl_frame* frm_dup=NULL;
   cpl_frame_group g;

   check_nomsg(*ext = cpl_frameset_new());
   check_nomsg(frm_tmp = cpl_frameset_get_first_const(set));
   while (frm_tmp != NULL)
   {
      g=cpl_frame_get_group(frm_tmp);
      if(g == type) {
         frm_dup=cpl_frame_duplicate(frm_tmp);
         cpl_frameset_insert(*ext,frm_dup);
         sinfo_msg_debug("group %d insert file %s ",
                         type,cpl_frame_get_filename(frm_dup));
      }
      frm_tmp = cpl_frameset_get_next_const(set);
   }

  cleanup:
   return cpl_error_get_code();
}




/**
   @brief    Get what object shift
   @param    iml imagelist
   @param    n   imagelist sequence
   @param    qclog_tbl qclog table
   @return   0 if standard 0 if pixel scale changes in input Strehl data
*/



int
sinfo_get_pupil_shift(cpl_imagelist* iml,const int n,cpl_table** qclog_tbl)
{
   cpl_size max_ima_x=0;
   cpl_size max_ima_y=0;
   int nx=0;
   int ny=0;

   double xshift=0;
   double yshift=0;

   double max_ima_cx=0;
   double max_ima_cy=0;

   cpl_image* img=NULL;
   cpl_image* img_dup=NULL;

   char key_name[FILE_NAME_SZ];

   img=cpl_imagelist_collapse_median_create(iml);
   nx=cpl_image_get_size_x(img);
   ny=cpl_image_get_size_y(img);

   img_dup=cpl_image_duplicate(img);
   sinfo_clean_nan(&img_dup);
   cpl_image_get_maxpos(img_dup,&max_ima_x,&max_ima_y);
   max_ima_cx=cpl_image_get_centroid_x_window(img_dup,1,1,nx,ny);
   max_ima_cy=cpl_image_get_centroid_y_window(img_dup,1,1,nx,ny);

   cpl_image_delete(img_dup);


   xshift=max_ima_cx-(double)nx/2;
   yshift=max_ima_cy-(double)ny/2;

   snprintf(key_name,sizeof(key_name),"%s%d%s","QC PUPIL",n," SHIFTX");
   sinfo_qclog_add_double(*qclog_tbl,key_name,xshift,
                          "X shift centroid - center image","%f");

   snprintf(key_name,sizeof(key_name),"%s%d%s","QC PUPIL",n," SHIFTY");
   sinfo_qclog_add_double(*qclog_tbl,key_name,yshift,
                          "Y shift centroid - center image","%f");
   cpl_image_delete(img);

   return 0;
}



/**
   @brief    Get what kind of Strehl data one has
   @param    sof    input set of frames
   @return   0 if standard 0 if pixel scale changes in input Strehl data
*/

int sinfo_get_strehl_type(cpl_frameset* sof)
{
   int strehl_sw=0;
   int nobs=0;
   int i=0;
   cpl_frameset* obs=NULL;

   cpl_frame* frame=NULL;
   float* pix_scale=NULL;
   cpl_propertylist* plist=NULL;

   obs = cpl_frameset_new();

   sinfo_contains_frames_kind(sof,obs,PRO_OBS_PSF);

   nobs=cpl_frameset_get_size(obs);
   if (nobs < 1) {
      sinfo_contains_frames_kind(sof,obs,PRO_OBS_STD);
      nobs=cpl_frameset_get_size(obs);
   }

   nobs=cpl_frameset_get_size(obs);

   if (nobs < 1) {
      return 0;
   } else {
      pix_scale=cpl_calloc(nobs,sizeof(float));
      for(i=0;i<nobs;i++) {
         frame=cpl_frameset_get_frame(obs,i);
         plist=cpl_propertylist_load(cpl_frame_get_filename(frame),0);
         pix_scale[i]=sinfo_pfits_get_pixscale(plist);
         cpl_propertylist_delete(plist);
      }
      if(sinfo_pix_scale_isnot_const(pix_scale,nobs)) {
         strehl_sw=1;
      }
      cpl_free(pix_scale);
   }
   cpl_frameset_delete(obs);

   return strehl_sw;

}



/**
   @brief    Set central wave as a function of band
   @param    band    input band
   @return   central wavelength
*/

double sinfo_get_wave_cent(const char* band)
{
   double lam=0.;
   if (strcmp(band,"H+K") == 0) {
      lam=1.950;
   } else if (strcmp(band,"K") == 0) {
      lam=2.175;
   } else if (strcmp(band,"J") == 0) {
      lam=1.225;
   } else if (strcmp(band,"H") == 0) {
      lam=1.675;
   }
   return lam;

}



/**
   @brief    Check if pixel scale changes
   @param    pix_scale    input pixel scale
   @param    n            input array index
   @return   1 if changes 0 else
*/


int sinfo_pix_scale_isnot_const(float* pix_scale, const int n) {
   int i=0;
   float eps=0.0001;
   float ref=pix_scale[0];

   for(i=1;i<n;i++) {
      if(fabs(pix_scale[i]-ref) > eps) return 1;
   }
   return 0;
}


/**
   @brief    Get pixel scale string
   @param    ps      input pixel scale
   @return   pixel scale
*/


const char* sinfo_get_pix_scale(float ps) {

   const char* key_value;
   float eps=0.0001;

   if(fabs(ps - 0.025) < eps) {
      key_value="0.025";
   }
   else if (fabs(ps - 0.1) < eps) {
      key_value="0.1";
   }
   else if (fabs(ps - 0.25) < eps) {
      key_value="0.25";
   }
   else if (fabs(ps - 1.0) < eps) {
      key_value="pupil";
   } else {
      sinfo_msg_error("ps=%f. Failed to set pixel scale",ps);
      return NULL;
   }

   return key_value;
}


/**
   @brief    Get clean mean and stdev of an image over a window
   @param    img input image
   @param    llx input lower left x image's window coordinate
   @param    lly input lower left y image's window coordinate
   @param    urx input upper right y image's window coordinate
   @param    ury input upper right y image's window coordinate
   @param    kappa  input kappa of kappa-sigma clip
   @param    nclip input max no of kappa-sigma clip iterations
   @param    clean_mean output upper right y image's window coordinate
   @param    clean_stdev output upper right y image's window coordinate
   @return   pixel scale
*/


int  sinfo_get_clean_mean_window(cpl_image* img,
                                 int llx, int lly, int urx, int ury,
                                 const int kappa, const int nclip,
                                 double* local_clean_mean,
                                 double* clean_stdev)
{

   double mean=0;
   double stdev=0;
   double threshold=0;
   double lo_cut=0;
   double hi_cut=0;
   cpl_mask* mask=NULL;
   cpl_image* tmp=NULL;
   cpl_stats* stats=NULL;
   int i=0;

   tmp=cpl_image_extract(img,llx,lly,urx,ury);
   cpl_image_accept_all(tmp);
   for(i=0;i<nclip;i++) {


      cpl_stats_delete(stats);
      stats = cpl_stats_new_from_image(tmp, CPL_STATS_MEAN | CPL_STATS_STDEV);
      mean = cpl_stats_get_mean(stats);
      stdev = cpl_stats_get_stdev(stats);

      threshold=kappa*stdev;
      lo_cut=mean-threshold;
      hi_cut=mean+threshold;
      cpl_image_accept_all(tmp);
      mask=cpl_mask_threshold_image_create(tmp,lo_cut,hi_cut);

      cpl_mask_not(mask);
      cpl_image_reject_from_mask(tmp,mask);
      cpl_mask_delete(mask);


   }
   *local_clean_mean=mean;
   *clean_stdev=stdev;
   cpl_image_delete(tmp);
   cpl_stats_delete(stats);


   return 0;


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

/**
   @brief    Remove NANs from an image
   @param    im input image
   @return   0 after successful operation
*/

int
sinfo_clean_nan(cpl_image** im)
{
   int i=0;
   int j=0;
   int nx=0;
   int ny=0;
   float* data=NULL;

   nx=cpl_image_get_size_x(*im);
   ny=cpl_image_get_size_y(*im);
   data=cpl_image_get_data_float(*im);

   for(j=0;j<ny;j++) {
      for(i=0;i<nx;i++) {
         if(isnan(data[j*nx+i]) != 0) {
            data[j*nx+i] = 0;
         }
      }
   }
   return 0;
}

/**
   @brief    Add standard DFS keys to FITS header
   @param    plist input propertylist
   @param    pro_catg input poduct category
   @param    file_name input file name
   @param    out_name product name
   @return   none
*/

void
sinfo_add_pro_fits_key(cpl_propertylist * plist,
                       char* pro_catg,
                       char* file_name,
                       char* out_name)
{

   char* date=NULL;
   date     = sinfo_get_datetime_iso8601() ;

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_PIPEFILE, out_name) ;
   cpl_propertylist_set_comment(plist, KEY_NAME_PIPEFILE,KEY_HELP_PIPEFILE) ;

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_DID, KEY_VALUE_HPRO_DID) ;
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_DID,KEY_HELP_HPRO_DID) ;

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_TYPE, "REDUCED") ;
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_TYPE, KEY_HELP_HPRO_TYPE) ;

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_CATG, pro_catg) ;
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_CATG,  KEY_HELP_HPRO_CATG);

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_STATUS, "OK") ;
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_STATUS,KEY_HELP_HPRO_CATG);

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_DATE, date) ;
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_DATE, KEY_HELP_HPRO_DATE);

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_RECID, file_name) ;
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_RECID,KEY_HELP_HPRO_RECID);

   cpl_propertylist_insert_after_string(plist, "EXPTIME",
                                        KEY_NAME_HPRO_DRSID, PACKAGE_VERSION);
   cpl_propertylist_set_comment(plist, KEY_NAME_HPRO_DRSID,KEY_HELP_HPRO_DRSID);


}
/*---------------------------------------------------------------------------*/
/**
   @brief    Comparison function to identify different input frames
   @param    frame1  first frame
   @param    frame2  second frame
   @return   0 if frame1!=frame2, 1 if frame1==frame2, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int  sinfo_compare_tags(
   const cpl_frame   *   frame1,
   const cpl_frame   *   frame2)
{
   char            *   v1 ;
   char            *   v2 ;

   /* Test entries */
   if (frame1==NULL || frame2==NULL) return -1 ;

   /* Get the tags */
   if ((v1 = (char*)cpl_frame_get_tag(frame1)) == NULL) return -1 ;
   if ((v2 = (char*)cpl_frame_get_tag(frame2)) == NULL) return -1 ;

   /* Compare the tags */
   if (strcmp(v1, v2)) return 0 ;
   else return 1 ;
}

/**
   @brief    Extracts raw pinhole frames
   @param    sof input frameset
   @param    raw output frameset
   @return   0 if success
*/


int sinfo_extract_raw_pinhole_frames(cpl_frameset * sof, cpl_frameset** raw)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_frame_is_pinhole_lamp(tag) == 1) {
               cpl_frameset_insert(*raw,frame);
            }
         }
      }
   }
   return 0;
}


int sinfo_get_ins_set(char* band,int* ins_set){

   if (strcmp(band,"H") == 0) {
      *ins_set = 0;
   }
   else if (strcmp(band,"H+K") == 0) {
      *ins_set = 1;
   }
   else if (strcmp(band,"K") == 0) {
      *ins_set = 2;
   }
   else if (strcmp(band,"J") == 0) {
      *ins_set = 3;
   }
   return 0;


}
int sinfo_extract_raw_frames(cpl_frameset * sof, cpl_frameset** raw)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_frame_is_raw(tag) == 1) {
               cpl_frameset_insert(*raw,frame);
            }
         }
      }
   }
   return 0;
}

int sinfo_remove_qc_frames(cpl_frameset* sof,cpl_frameset** raw)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   int nsof=0;
   int i=0;

   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      /* sinfo_msg("name=%s",name); */
      if(sinfo_is_fits_file(name) == 1) {
         /* sinfo_msg("\t exist "); */
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            /* sinfo_msg("\t tag %s\n ",tag); */
            if(strstr(tag,"QC") != NULL) {
               /* sinfo_msg("remove frame %s\n",name); */
               cpl_frameset_erase(*raw,tag);
            }
         }
      } else {
         /* sinfo_msg("remove frame\n"); */
         cpl_frameset_erase_frame(*raw,frame);
      }
   }
   return 0;

}


int sinfo_contains_frames_kind(cpl_frameset * sof,
                               cpl_frameset* raw,
                               const char*         type)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;

   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
     frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            /* sinfo_msg("name=%s tag=%s type=%s\n",name,tag,type); */
            if(strstr(tag,type) != NULL) {
               /* sinfo_msg("Match name=%s tag=%s type=%s\n",name,tag,type); */
               frame_dup = cpl_frame_duplicate(frame);
               cpl_frameset_insert(raw,frame_dup);
               /* sinfo_msg("inserted\n"); */
            }
         }
      }
   }
   return 0;
}




int sinfo_is_fibres_on_off(cpl_frameset * sof,
                           cpl_frameset* raw)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;

   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            /* sinfo_msg("name=%s tag=%s type=%s\n",name,tag,type); */
            if( strcmp(tag,PRO_FIBRE_NS_STACKED ) == 0) {
               /* sinfo_msg("Match name=%s tag=%s type=%s\n",name,tag); */
               frame_dup = cpl_frame_duplicate(frame);
               cpl_frameset_insert(raw,frame_dup);
               /* sinfo_msg("inserted\n"); */
            }
         }
      }
   }
   return 0;
}


int sinfo_contains_frames_type(cpl_frameset * sof,
                               cpl_frameset** raw,
                               const char*          type)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(strstr(tag,type) != NULL) {
               /* sinfo_msg("name=%s tag=%s type=%s\n",name,tag,type); */
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(*raw,frame_dup);
            }
         }
      }
   }
   return 0;
}

int sinfo_extract_raw_frames_type2(cpl_frameset * sof,
                                   cpl_frameset** raw,
                                   const char*          type)
{

   cpl_frame* frame=NULL;
   cpl_frame* frame_dup   = NULL;
   frame = cpl_frameset_find(sof,type);
   while(frame) {
      frame_dup=cpl_frame_duplicate(frame);
      cpl_frameset_insert(*raw,frame_dup);
      frame = cpl_frameset_find(sof,NULL);
   }
   return 0;

}


int sinfo_extract_raw_frames_type1(cpl_frameset * sof,
                                   cpl_frameset* raw,
                                   const char*          type)
{

   cpl_frame* frame=NULL;
   cpl_frame* frame_dup   = NULL;
   frame = cpl_frameset_find(sof,type);
   while(frame) {
      frame_dup=cpl_frame_duplicate(frame);
      cpl_frameset_insert(raw,frame_dup);
      frame = cpl_frameset_find(sof,NULL);
   }
   return 0;

}

int sinfo_extract_raw_frames_type(cpl_frameset * sof,
                                  cpl_frameset** raw,
                                  const char*          type)
{
   char tag[FILE_NAME_SZ];
   char name[FILE_NAME_SZ];
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      strcpy(name, cpl_frame_get_filename(frame));
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            strcpy(tag,cpl_frame_get_tag(frame));
            if(strcmp(tag,type) == 0) {
               /* sinfo_msg("name=%s tag=%s type=%s\n",name,tag,type); */
               frame_dup=cpl_frame_duplicate(frame);

               cpl_frameset_insert(*raw,frame_dup);
            }
         }
      }
   }
   return 0;
}

int sinfo_extract_frames_type(cpl_frameset * sof,
                              cpl_frameset * raw,
                              const char*          type)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) == 1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(strcmp(tag,type) == 0) {
               /* sinfo_msg("name=%s tag=%s type=%s\n",name,tag,type); */
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(raw,frame_dup);
            }
         }
      }
   }
   return 0;
}


int sinfo_extract_obj_frames(cpl_frameset * sof, cpl_frameset* obj)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;

   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_tag_is_obj(tag) == 1) {
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(obj,frame_dup);
            }
         }
      }
   }

   return 0;
}


int sinfo_extract_obj_products(cpl_frameset * sof, cpl_frameset* obj)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;

   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_tag_is_objpro(tag) == 1) {
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(obj,frame_dup);
            }
         }
      }
   }

   return 0;
}

int sinfo_extract_on_frames(cpl_frameset * sof, cpl_frameset* on)
{
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;

   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      if(sinfo_frame_is_on(frame) ==1) {
         frame_dup=cpl_frame_duplicate(frame);
         cpl_frameset_insert(on,frame_dup);
      }
   }

   return 0;
}

int sinfo_extract_sky_frames(cpl_frameset * sof, cpl_frameset* sky)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_tag_is_sky(tag) == 1) {
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(sky,frame_dup);
            }
         }
      }
   }

   return 0;
}



int sinfo_extract_off_frames(cpl_frameset * sof, cpl_frameset* off)
{
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      if(sinfo_frame_is_on(frame)) {
         frame_dup=cpl_frame_duplicate(frame);
         cpl_frameset_insert(off,frame_dup);
      }
   }

   return 0;
}

int sinfo_extract_mst_frames(cpl_frameset * sof, cpl_frameset* cdb)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;

   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_frame_is_cdb(tag) == 1) {
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(cdb,frame_dup);
            }
         }
      }
   }

   return 0;
}

cpl_frameset* sinfo_frameset_join(cpl_frameset* fs1,cpl_frameset* fs2) {

   cpl_frameset* join=NULL;
   cpl_frame* frm=NULL;
   cpl_frame* frm_dup=NULL;
   int i=0;
   int n=0;

   join=cpl_frameset_new();

   n=cpl_frameset_get_size(fs1);
   for(i=0;i<n; i++) {
      frm=cpl_frameset_get_frame(fs1,i);
      frm_dup= cpl_frame_duplicate(frm);
      cpl_frameset_insert(join,frm_dup);
   }

   n=cpl_frameset_get_size(fs2);
   for(i=0;i<n; i++) {
      frm=cpl_frameset_get_frame(fs2,i);
      frm_dup= cpl_frame_duplicate(frm);
      cpl_frameset_insert(join,frm_dup);
   }


   return join;

}


int sinfo_extract_stk_frames(cpl_frameset * sof,
                             cpl_frameset* res)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;

   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_frame_is_stk(tag) == 1) {
               frame_dup=cpl_frame_duplicate(frame);
               cpl_frameset_insert(res,frame_dup);
            }
         }
      }
   }

   return 0;
}


int
sinfo_extract_preoptic_frames(cpl_frameset * sof,
                              cpl_frameset** res,
                              const char* val)
{
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;
   int nsof=0;
   int i=0;

   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         if(sinfo_frame_is_preoptic(frame,val) == 1) {
            frame_dup=cpl_frame_duplicate(frame);
            cpl_frameset_insert(*res,frame_dup);
         }
      }
   }

   return 0;
}

int sinfo_extract_raw_stack_frames(cpl_frameset * sof, cpl_frameset** pro)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   cpl_frame* frame_dup   = NULL;

   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);

   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            /* sinfo_msg("tag=%s\n",tag); */
            if(sinfo_frame_is_raw_stack(tag) == 1) {
               frame_dup   = cpl_frame_duplicate(frame);
               cpl_frameset_insert(*pro,frame_dup);
            }
         }
      }
   }

   return 0;
}


int sinfo_extract_raw_slit_frames(cpl_frameset * sof, cpl_frameset** pro)
{
   char* tag=NULL;
   char* name=NULL;
   cpl_frame* frame   = NULL;
   int nsof=0;
   int i=0;
   nsof = cpl_frameset_get_size(sof);
   for (i=0 ; i<nsof ; i++) {
      frame = cpl_frameset_get_frame(sof,i);
      name= (char*) cpl_frame_get_filename(frame);
      if(sinfo_is_fits_file(name) ==1) {
         /* to go on the file must exist */
         if(cpl_frame_get_tag(frame) != NULL) {
            /* If the frame has a tag we process it. Else it is an object */
            tag= (char*) cpl_frame_get_tag(frame);
            if(sinfo_frame_is_slit_lamp(tag) == 1) {
               cpl_frameset_insert(*pro,frame);
            }
         }
      }
   }

   return 0;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfo_frame_is_raw
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_frame_is_raw(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_LINEARITY_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_DARK)) return 1 ;
   if (!strcmp(tag, RAW_PINHOLE_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_SLIT_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_FLAT_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_NS)) return 1 ;
   if (!strcmp(tag, RAW_FLAT_NS)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_EW)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_NS)) return 1 ;
   if (!strcmp(tag, RAW_FLAT_SKY)) return 1 ;
   if (!strcmp(tag, RAW_FLUX_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_PSF_CALIBRATOR)) return 1 ;
   if (!strcmp(tag, RAW_FOCUS)) return 1 ;

   if (!strcmp(tag, RAW_STD)) return 1 ;
   if (!strcmp(tag, RAW_STD_STAR)) return 1 ;
   if (!strcmp(tag, RAW_STD_STAR_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_STD)) return 1 ;
   if (!strcmp(tag, RAW_SKY_OH)) return 1 ;
   if (!strcmp(tag, RAW_SKY_PSF_CALIBRATOR)) return 1 ;

   if (!strcmp(tag, RAW_PUPIL_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_JITTER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_JITTER)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_NODDING)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_SKYSPIDER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_NODDING)) return 1 ;

   if (!strcmp(tag, RAW_FLAT_LAMP_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_LAMP_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_STD_STAR_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_NODDING_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_SKYSPIDER_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_NODDING_DITHER)) return 1 ;


   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfo_frame_is_raw
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_frame_is_raw_stack(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;


   if (!strcmp(tag, PRO_SKY_DUMMY)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_LAMP_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_NS)) return 1 ;
   if (!strcmp(tag, RAW_WAVE_NS_DITHER)) return 1 ;

   if (!strcmp(tag, RAW_FLUX_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_NS)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_EW)) return 1 ;

   if (!strcmp(tag, RAW_PSF_CALIBRATOR)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_PSF)) return 1 ;
   if (!strcmp(tag, RAW_FIBRE_DARK)) return 1 ;

   if (!strcmp(tag, RAW_FOCUS)) return 1 ;

   if (!strcmp(tag, RAW_PUPIL_LAMP)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_JITTER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_JITTER)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_NODDING)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_SKYSPIDER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_NODDING)) return 1 ;

   if (!strcmp(tag, RAW_OBJECT_NODDING_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_OBJECT_SKYSPIDER_DITHER)) return 1 ;
   if (!strcmp(tag, RAW_SKY_NODDING_DITHER)) return 1 ;


   if (!strcmp(tag, RAW_IMAGE_PRE_OBJECT)) return 1 ;
   if (!strcmp(tag, RAW_IMAGE_PRE_SKY)) return 1 ;
   if (!strcmp(tag, RAW_STD)) return 1 ;
   if (!strcmp(tag, RAW_SKY_STD)) return 1 ;
   if (!strcmp(tag, RAW_SKY_OH)) return 1 ;
   if (!strcmp(tag, RAW_SKY_PSF_CALIBRATOR)) return 1 ;
   if (!strcmp(tag, RAW_STD_STAR)) return 1 ;
   if (!strcmp(tag, RAW_SKY)) return 1 ;

   return 0 ;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfo_frame_is_raw
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_frame_is_raw_dark(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_DARK)) return 1 ;

   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfo_frame_is_raw
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_frame_is_slit_lamp(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_SLIT_LAMP)) return 1 ;

   return 0 ;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfo_frame_is_raw
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_frame_is_pinhole_lamp(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_PINHOLE_LAMP)) return 1 ;

   return 0 ;
}


int sinfo_frame_is_cdb(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;
   /* For the moment not checked the following:

   PRO_STACKED
   PRO_SLIT_ON
   PRO_FLUX_LAMP_STACKED
   PRO_WAVE_LAMP_STACKED
   PRO_PSF_CALIBRATOR_STACKED
   PRO_FOCUS_STACKED
   PRO_OBJECT_NODDING_STACKED
   PRO_OBJECT_SKYSPIDER_STACKED
   PRO_SKY_NODDING_STACKED
   PRO_STD_NODDING_STACKED
   PRO_MASK_CUBE
   PRO_PSF
   TMP_FOCUS
   TMP_FOCUS_ON
   TMP_FOCUS_OFF
   PRO_FOCUS
   PRO_FOCUS_GAUSS
   PRO_SPECTRA
   PRO_CUBE
   PRO_CUBE_COLL
   PRO_SLOPEX
   PRO_SLOPEY
   PRO_MASK_CUBE
   PRO_OBJ_CUBE
   PRO_BP_COEFF
   */

   if (!strcmp(tag, REF_LINE_ARC)) return 1 ;
   if (!strcmp(tag, REF_LINE_OH)) return 1 ;
   if (!strcmp(tag, PRO_BP_MAP)) return 1 ;
   if (!strcmp(tag, PRO_BP_MAP_HP)) return 1 ;
   if (!strcmp(tag, PRO_BP_MAP_DI)) return 1 ;
   if (!strcmp(tag, PRO_BP_MAP_NO)) return 1 ;
   if (!strcmp(tag, PRO_BP_MAP_NL)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_BP_MAP)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_DARK)) return 1 ;
   if (!strcmp(tag, PRO_SLOPE)) return 1 ;
   if (!strcmp(tag, PRO_DISTORTION)) return 1 ;
   if (!strcmp(tag, PRO_SLITLETS_DISTANCE)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP1)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP2)) return 1 ;
   if (!strcmp(tag, PRO_SLIT_POS)) return 1 ;
   if (!strcmp(tag, PRO_SLIT_POS_GUESS)) return 1 ;
   if (!strcmp(tag, PRO_WAVE_PAR_LIST)) return 1 ;
   if (!strcmp(tag, PRO_WAVE_COEF_SLIT)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_LAMP_SPEC)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_TWIFLAT)) return 1 ;
   if (!strcmp(tag, PRO_COEFF_LIST)) return 1 ;
   if (!strcmp(tag, PRO_INDEX_LIST)) return 1 ;
   if (!strcmp(tag, PRO_HALO_SPECT)) return 1 ;
   if (!strcmp(tag, PRO_FIRST_COL)) return 1 ;
   if (!strcmp(tag, PRO_FOCUS)) return 1 ;
   if (!strcmp(tag, PRO_WAVE_MAP)) return 1 ;
   if (!strcmp(tag, PRO_REF_ATM_REF_CORR)) return 1 ;

   return 0;

}




int sinfo_frame_is_stk(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;
   /* For the moment not checked the following: */


   if (!strcmp(tag, PRO_SKY_STACKED_DUMMY)) return 1 ;
   if (!strcmp(tag, PRO_STACK_SKY_DIST)) return 1 ;
   if (!strcmp(tag, PRO_STACK_MFLAT_DIST)) return 1 ;
   if (!strcmp(tag, PRO_PSF_CALIBRATOR_STACKED)) return 1 ;


   return 0;

}

int
sinfo_propertylist_has(cpl_propertylist* plist,
                       const char* key) {

   return cpl_propertylist_has(plist,key);

}

int sinfo_frame_is_preoptic(cpl_frame* frame,const char* val)
{

   char* file=NULL;
   char popt[FILE_NAME_SZ];
   cpl_propertylist* plist=NULL;


   file = cpl_strdup(cpl_frame_get_filename(frame)) ;
   if ((cpl_error_code)((plist = cpl_propertylist_load(file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",file);
      cpl_propertylist_delete(plist) ;
      cpl_free(file);
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_PREOPTICS)) {
      strcpy(popt,cpl_propertylist_get_string(plist, KEY_NAME_PREOPTICS));
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_PREOPTICS);
      cpl_free(file);
      return -1;
   }
   cpl_propertylist_delete(plist) ;
   cpl_free(file);

   if (strstr(val,popt) != NULL) return 1 ;


   return 0;

}


int sinfo_get_preoptic(const char* file, const char* val)
{

   cpl_propertylist* plist=NULL;


   if ((cpl_error_code)((plist = cpl_propertylist_load(file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",file);
      cpl_propertylist_delete(plist) ;
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_PREOPTICS)) {
      strcpy((char*)val,cpl_propertylist_get_string(plist, KEY_NAME_PREOPTICS));
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_PREOPTICS);
      return -1;
   }
   cpl_propertylist_delete(plist) ;

   return 0;

}

/*
  static int
  sinfo_stat_rectangle(cpl_image* img,
  const int kappa,
  const int nclip,
  double *mean,
  double *stdev)
  {

  double sum=0;
  double sum2=0;
  double noise=0;

  double* pim=NULL;
  int i=0;
  int j=0;
  int kk=0;
  int sx=0;
  int sy=0;

  *mean=0;
  pim=cpl_image_get_data(img);
  kk=0;
  for(i=0;i<sx*sy;i++) {
  *mean+=pim[i];
  }
  *mean/=(sx*sy);

  for(i=0;i<sx*sy;i++) {
  sum+=(pim[i]-*mean)*(pim[i]-*mean);
  }
  noise=sqrt(sum/(sx*sy));


  //clean a bit the bad pixels
  for(j=0;j<nclip;j++) {
  sum=0;
  sum2=0;
  kk=0;
  for(i=0;i<sx*sy;i++) {
  if(fabs(pim[i]-*mean)<kappa*noise) {

  sum  +=(pim[i]-*mean)*(pim[i]-*mean);
  sum2 += pim[i];
  kk+=1;
  }
  noise=sqrt(sum/kk);
  *mean=sum2/kk;

  }

  }
  *stdev=noise;

  return 0;

  }
*/

cpl_table* sinfo_compute_gain(cpl_frameset* son, cpl_frameset* sof)
{


   cpl_frame*    frm=NULL;

   cpl_image* img_on1=NULL;
   cpl_image* img_on2=NULL;
   cpl_image* img_on_dif=NULL;
   cpl_image* img_on_sub=NULL;


   cpl_image* img_of1=NULL;
   cpl_image* img_of2=NULL;
   cpl_image* img_of_dif=NULL;
   cpl_image* img_of_sub=NULL;

   cpl_table* res_tbl=NULL;
   cpl_vector* dit_on=NULL;
   cpl_vector* dit_of=NULL;
   cpl_vector* exptime_on=NULL;
   cpl_vector* exptime_of=NULL;
   cpl_propertylist* plist=NULL;

   int non=0;
   int nof=0;
   int nfr=0;
   double avg_on1=0;
   double avg_on2=0;
   double avg_of1=0;
   double avg_of2=0;
   double std=0;

   double sig_on_dif=0;
   double sig_of_dif=0;
   char* name=NULL;
   int i=0;
   int m=0;

   int llx=270;
   int lly=1000;
   int urx=320;
   int ury=1050;
   int zone[4];
   double gain=0;
   double dit_ref=0;
   double dit_tmp=0;
   double exptime_ref=0;
   double exptime_tmp=0;
   int kappa=5;
   int nclip=25;
   double centre=0;

   non = cpl_frameset_get_size(son);
   nof = cpl_frameset_get_size(sof);
   nfr = (non <= nof) ? non : nof;

   dit_on=cpl_vector_new(nfr);
   dit_of=cpl_vector_new(nfr);
   exptime_on=cpl_vector_new(nfr);
   exptime_of=cpl_vector_new(nfr);

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

      frm=cpl_frameset_get_frame(son,i);
      name=(char*)cpl_frame_get_filename(frm);
      plist=cpl_propertylist_load(name,0);
      dit_ref=sinfo_pfits_get_dit(plist);
      exptime_ref=(double)sinfo_pfits_get_exp_time(plist);
      cpl_propertylist_delete(plist);
      cpl_vector_set(dit_on,i,dit_ref);
      cpl_vector_set(exptime_on,i,exptime_ref);

      frm=cpl_frameset_get_frame(sof,i);
      name=(char*)cpl_frame_get_filename(frm);
      plist=cpl_propertylist_load(name,0);
      dit_ref=sinfo_pfits_get_dit(plist);
      exptime_ref=(double)sinfo_pfits_get_exp_time(plist);
      cpl_propertylist_delete(plist);
      cpl_vector_set(dit_of,i,dit_ref);
      cpl_vector_set(exptime_of,i,exptime_ref);

   }



   zone[0]=270;
   zone[1]=1030;
   zone[2]=310;
   zone[3]=1060;



   zone[0]=20;
   zone[1]=2028;
   zone[2]=20;
   zone[3]=2028;



   check_nomsg(res_tbl=cpl_table_new(nfr));
   cpl_table_new_column(res_tbl,"adu", CPL_TYPE_DOUBLE);
   cpl_table_new_column(res_tbl,"gain", CPL_TYPE_DOUBLE);

   for(i=0;i<nfr;i++) {
      frm=cpl_frameset_get_frame(son,i);
      name=(char*)cpl_frame_get_filename(frm);
      img_on1=cpl_image_load(name,CPL_TYPE_DOUBLE,0,0);

      frm=cpl_frameset_get_frame(sof,i);
      name=(char*)cpl_frame_get_filename(frm);
      img_of1=cpl_image_load(name,CPL_TYPE_DOUBLE,0,0);


      dit_ref=cpl_vector_get(dit_on,i);
      exptime_ref=cpl_vector_get(exptime_on,i);


      for(m=0;m<nfr; m++) {
         if(m != i) {
            frm=cpl_frameset_get_frame(son,m);
            name=(char*)cpl_frame_get_filename(frm);
            dit_tmp=cpl_vector_get(dit_on,m);
            exptime_tmp=cpl_vector_get(exptime_on,m);
            if(dit_tmp == dit_ref && exptime_tmp == exptime_ref) {
               /* sinfo_msg("m=%d i=%d\n",m,i); */
               img_on2=cpl_image_load(name,CPL_TYPE_DOUBLE,0,0);
               frm=cpl_frameset_get_frame(sof,m);
               name=(char*)cpl_frame_get_filename(frm);
               img_of2=cpl_image_load(name,CPL_TYPE_DOUBLE,0,0);

               img_on_dif=cpl_image_subtract_create(img_on1,img_on2);
               img_of_dif=cpl_image_subtract_create(img_of1,img_of2);

               img_on_sub=cpl_image_extract(img_on_dif,llx,lly,urx,ury);
               img_of_sub=cpl_image_extract(img_of_dif,llx,lly,urx,ury);

               sinfo_get_clean_mean_window(img_on1,llx,lly,urx,ury,kappa,
                                           nclip,&avg_on1,&std);
               sinfo_get_clean_mean_window(img_on2,llx,lly,urx,ury,kappa,
                                           nclip,&avg_on2,&std);
               sinfo_get_clean_mean_window(img_of1,llx,lly,urx,ury,kappa,
                                           nclip,&avg_of1,&std);
               sinfo_get_clean_mean_window(img_of2,llx,lly,urx,ury,kappa,
                                           nclip,&avg_of2,&std);
               /*
                 cpl_image_save(img_on_sub,"ima_on_sub.fits",
                                CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT);
                 cpl_image_save(img_of_sub,"ima_of_sub.fits",
                                CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT);
               */
               /*
               //worse accuracy
               sinfo_stat_rectangle(img_on_dif,kappa,nclip,
                                    &centre,&sig_on_dif);
               sinfo_stat_rectangle(img_of_dif,kappa,nclip,
                                    &centre,&sig_of_dif);
               */


               //better accuracy
               sinfo_get_clean_mean_window(img_on_dif,llx,lly,urx,ury,kappa,
                                           nclip,&centre,&sig_on_dif);
               sinfo_get_clean_mean_window(img_of_dif,llx,lly,urx,ury,kappa,
                                           nclip,&centre,&sig_of_dif);
               /**
                //medium accuracy
                ck0(sinfo_image_estimate_noise(img_on_sub,1,
                                               &centre,&sig_on_dif),
                                               "computing noise");
                ck0(sinfo_image_estimate_noise(img_of_sub,1,
                                               &centre,&sig_of_dif),
                                               "computing noise");


                cpl_flux_get_noise_window(img_on_dif,zone,2,100,
                                          &sig_on_dif,NULL);
                cpl_flux_get_noise_window(img_of_dif,zone,2,100,
                                          &sig_of_dif,NULL);
                sinfo_msg("noise=%g %g",sig_on_dif,sig_of_dif);
               */
               cpl_image_delete(img_on2);
               cpl_image_delete(img_of2);
               cpl_image_delete(img_on_dif);
               cpl_image_delete(img_of_dif);
               cpl_image_delete(img_on_sub);
               cpl_image_delete(img_of_sub);

               gain=((avg_on1+avg_on2)-(avg_of1+avg_of2))/
                  ((sig_on_dif*sig_on_dif)-(sig_of_dif*sig_of_dif));

               cpl_table_set_double(res_tbl,"gain",m,gain);
               cpl_table_set_double(res_tbl,"adu",m,
                                    ((avg_on1+avg_on2)/2-(avg_of1+avg_of2)/2));
               /* sinfo_msg("gain=%f ADU=%f\n",gain,
                  (avg_on1+avg_on2)/2-(avg_of1+avg_of2)/2);
                  sinfo_msg("g=%f avg_on1=%f avg_on2=%f",gain,avg_on1,avg_on2);
                 sinfo_msg("avg_of1=%f avg_of2=%f sig_on_dif=%f sig_of_dif=%f",
                  avg_of1,avg_of2,sig_on_dif,sig_of_dif);
               */

            }
         }
      }
      cpl_image_delete(img_on1);
      cpl_image_delete(img_of1);
   }


   /*
     sinfo_get_clean_mean_window(img_on_dif,llx,lly,urx,ury,kappa,
     nclip,&avg,&sig_on_dif);
     sinfo_get_clean_mean_window(img_of_dif,llx,lly,urx,ury,kappa,
     nclip,&avg,&sig_of_dif);
   */

   cpl_vector_delete(dit_on);
   cpl_vector_delete(dit_of);
   cpl_vector_delete(exptime_on);
   cpl_vector_delete(exptime_of);

   return res_tbl;

  cleanup:
   return NULL;

}


/*-------------------------------------------------------------------------*/
/**
   @name        sinfo_image_estimate_noise
   @memo        Estimate image noise
   @param    obj_frm input object frame
   @param    centre  output centre of object's intensity histogram
   @param    noise   output noise
   @return    int
   if success: 0
   else -1

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

int
sinfo_image_estimate_noise(cpl_image* img,
                           const int noise_fit,
                           double* centre,
                           double* noise)
{

   int nbins=0;

   int xsz=0;
   int ysz=0;
   int n=0;
   int i=0;
   int r=0;

   int ndist=0;
   double min_fct=HISTO_DIST_TEMPC_MIN_FCT;
   double max_fct=HISTO_DIST_TEMPC_MAX_FCT;
   double avg_d=0;
   double std_d=0;
   double hmin=0;
   double hmax=0;
   double kappa=3;

   double* pdata=NULL;
   double* disth=NULL;
   double* distx=NULL;

   double peak=0;
   double tempc=0;
   double value=0;
   double x0=0;
   double sigma=0;
   double area=0;
   double offset=0;
   //double mse=0;
   //double chired=0;

   cpl_table* data_tbl=NULL;
   cpl_table* histo=NULL;
   cpl_table* dist=NULL;
   cpl_table* min_xi=NULL;
   cpl_table* tmp_tbl1=NULL;
   cpl_table* tmp_tbl2=NULL;
   cpl_vector* vx=NULL;
   cpl_vector* vy=NULL;
   cpl_vector* sx=NULL;
   cpl_vector* sy=NULL;

   // Get Object relevant information
   check_nomsg(xsz=cpl_image_get_size_x(img));
   check_nomsg(ysz=cpl_image_get_size_y(img));
   n=xsz*ysz;
   nbins=sqrt(n);
   check_nomsg(data_tbl=cpl_table_new(n));
   check_nomsg(cpl_table_new_column(data_tbl,"DATA",CPL_TYPE_DOUBLE));

   check_nomsg(pdata=cpl_image_get_data(img));
   for(i=0;i<n;i++) {
      if(!isnan(pdata[i])) {
         cpl_table_set_double(data_tbl,"DATA",r,pdata[i]);
         r++;
      }
   }

   check_nomsg(cpl_table_erase_invalid(data_tbl));
   check_nomsg(avg_d=cpl_table_get_column_mean(data_tbl,"DATA"));
   check_nomsg(std_d=cpl_table_get_column_stdev(data_tbl,"DATA"));

   cpl_table_save(data_tbl, NULL, NULL, "out_data.fits", CPL_IO_DEFAULT);

   hmin=avg_d-kappa*std_d;
   hmax=avg_d+kappa*std_d;
   //sinfo_msg("mean=%g stdv=%g",avg_d,std_d);
   //sinfo_msg("hmin=%g hmax=%g",hmin,hmax);
   //sinfo_msg("Computes histogram");
   ck0(sinfo_histogram(data_tbl,nbins,hmin,hmax,&histo),"building histogram");

   value=(double)(hmax-hmin)/nbins/2.;
   //sinfo_msg("value=%10.8f",value);
   //cpl_table_save(histo, NULL, NULL, "out_pippo.fits", CPL_IO_DEFAULT0);

   check_nomsg(peak=cpl_table_get_column_max(histo,"HY"));
   //sinfo_msg("peak=%f",peak);
   sinfo_free_table(&tmp_tbl1);

   check_nomsg(tmp_tbl1=sinfo_extract_table_rows(histo,"HY",CPL_EQUAL_TO,peak));

   //cpl_table_save(tmp_tbl1, NULL, NULL, "out_tmp_tbl1.fits", CPL_IO_DEFAULT);


   check_nomsg(*centre=cpl_table_get_column_mean(tmp_tbl1,"HL"));
   //sinfo_msg("Background level=%f",*centre);

   sinfo_free_table(&tmp_tbl1);
   check_nomsg(tmp_tbl1=sinfo_extract_table_rows(histo,"HY",
                                                 CPL_GREATER_THAN,
                                                 peak/HISTO_Y_CUT));
   sinfo_free_table(&tmp_tbl2);
   check_nomsg(tmp_tbl2=sinfo_extract_table_rows(tmp_tbl1,"HY",
                                                 CPL_LESS_THAN,peak));
   sinfo_free_table(&tmp_tbl1);

   check_nomsg(tempc=*centre-cpl_table_get_column_min(tmp_tbl2,"HL"));
   //sinfo_msg("min HX %f",cpl_table_get_column_min(tmp_tbl2,"HL"));
   sinfo_free_table(&tmp_tbl2);
   //sinfo_msg("Tempc=%f",tempc);
   check_nomsg(dist=sinfo_where_tab_min_max(histo,"HL",
                                            CPL_GREATER_THAN,
                                            *centre-min_fct*tempc,
                                            CPL_NOT_GREATER_THAN,
                                            *centre+max_fct*tempc));

   offset=cpl_table_get_column_min(histo,"HY");
   sinfo_free_table(&histo);


   check_nomsg(ndist=cpl_table_get_nrow(dist));
   check_nomsg(cpl_table_cast_column(dist,"HY","HYdouble",CPL_TYPE_DOUBLE));
   check_nomsg(disth=cpl_table_get_data_double(dist,"HYdouble"));
   check_nomsg(distx=cpl_table_get_data_double(dist,"HL"));
   cpl_table_save(dist, NULL, NULL, "out_dist.fits", CPL_IO_DEFAULT);

   //TODO
   //gaussfit(distx,disty,dista,nterms=3);
   //*noise=dista[2];
   *noise=tempc/2;
   /* THIS DOES NOT WORK */
   //sinfo_msg("FWHM/2=%f",*noise);

   if(noise_fit == 1) {
      check_nomsg(vy=cpl_vector_wrap(ndist,disth));
      check_nomsg(vx=cpl_vector_wrap(ndist,distx));
      check_nomsg(sx=cpl_vector_new(ndist));
      check_nomsg(cpl_vector_fill(sx,1.));
      check_nomsg(sy=cpl_vector_duplicate(sx));
      x0=*centre;
      sigma=tempc/2;

      if(CPL_ERROR_NONE != cpl_vector_fit_gaussian(vx,NULL,
                                                   vy,NULL,
                                                   CPL_FIT_ALL,
                                                   &x0,&sigma,&area,&offset,
                                                   NULL,NULL,NULL)) {
         cpl_error_reset();
      }
      //sinfo_msg("Gauss fit parameters:"
      //          "x0=%f sigma=%f area=%f offset=%f mse=%f chired=%f",
      //           x0,sigma,area,offset,mse,chired);
      //sinfo_msg("Background level=%f",*centre);
      //sinfo_msg("Noise=%f",sigma);
      *noise=sigma;
      sinfo_unwrap_vector(&vx);
      sinfo_unwrap_vector(&vy);
      sinfo_free_my_vector(&sx);
      sinfo_free_my_vector(&sy);
   }
   sinfo_free_table(&dist);

   return 0;

  cleanup:
   sinfo_free_table(&min_xi);
   sinfo_free_table(&tmp_tbl1);
   sinfo_free_table(&tmp_tbl2);
   sinfo_free_table(&histo);
   sinfo_free_table(&dist);
   sinfo_free_table(&data_tbl);
   sinfo_free_my_vector(&sx);
   sinfo_free_my_vector(&sy);
   sinfo_unwrap_vector(&vx);
   sinfo_unwrap_vector(&vy);

   return -1;

}





cpl_table* sinfo_compute_linearity(cpl_frameset* son, cpl_frameset* sof)
{

   cpl_frame*    frm=NULL;

   int* status=0;
   int non=0;
   int nof=0;
   int nfr=0;
   int i=0;
   double med_on=0;
   double avg_on=0;
   double med_of=0;
   double avg_of=0;
   double med_dit=0;
   double avg_dit=0;

   double med=0;
   double avg=0;

   char* name=NULL;
   cpl_image* img=NULL;
   cpl_vector* vec_adl=NULL;
   cpl_vector* vec_dit=NULL;
   cpl_vector* vec_avg=NULL;
   cpl_vector* vec_med=NULL;
   cpl_vector* vec_avg_dit=NULL;
   cpl_vector* vec_med_dit=NULL;
   cpl_propertylist* plist=NULL;

   double dit=0;
   cpl_table* lin_tbl=NULL;


   non = cpl_frameset_get_size(son);
   nof = cpl_frameset_get_size(sof);
   nfr = (non <= nof) ? non : nof;

   lin_tbl=cpl_table_new(nfr);
   cpl_table_new_column(lin_tbl,"med", CPL_TYPE_DOUBLE);
   cpl_table_new_column(lin_tbl,"avg", CPL_TYPE_DOUBLE);
   cpl_table_new_column(lin_tbl,"med_dit", CPL_TYPE_DOUBLE);
   cpl_table_new_column(lin_tbl,"avg_dit", CPL_TYPE_DOUBLE);
   cpl_table_new_column(lin_tbl,"dit", CPL_TYPE_DOUBLE);
   vec_med=cpl_vector_new(nfr);
   vec_avg=cpl_vector_new(nfr);
   vec_med_dit=cpl_vector_new(nfr);
   vec_avg_dit=cpl_vector_new(nfr);
   vec_dit=cpl_vector_new(nfr);
   vec_adl=cpl_vector_new(nfr);

   for(i=0;i<nfr;i++) {
      frm=cpl_frameset_get_frame(son,i);
      name=(char*)cpl_frame_get_filename(frm);
      img=cpl_image_load(name,CPL_TYPE_FLOAT,0,0);
      med_on=cpl_image_get_median(img);
      avg_on=cpl_image_get_mean(img);
      cpl_image_delete(img);

      frm=cpl_frameset_get_frame(sof,i);
      name=(char*)cpl_frame_get_filename(frm);
      img=cpl_image_load(name,CPL_TYPE_FLOAT,0,0);
      med_of=cpl_image_get_median(img);
      avg_of=cpl_image_get_mean(img);
      cpl_image_delete(img);

      med=med_on-med_of;
      avg=avg_on-avg_of;
      plist=cpl_propertylist_load(name,0);
      dit=(double)sinfo_pfits_get_dit(plist);
      cpl_propertylist_delete(plist);
      avg_dit=avg/dit;
      med_dit=med/dit;

      cpl_vector_set(vec_dit,i,dit);
      cpl_vector_set(vec_avg,i,avg);
      cpl_vector_set(vec_med,i,med);
      cpl_vector_set(vec_avg_dit,i,avg_dit);
      cpl_vector_set(vec_med_dit,i,med_dit);

      cpl_table_set_double(lin_tbl,"dit",i,dit);
      cpl_table_set_double(lin_tbl,"med",i,med);
      cpl_table_set_double(lin_tbl,"avg",i,avg);
      cpl_table_set_double(lin_tbl,"med_dit",i,med_dit);
      cpl_table_set_double(lin_tbl,"avg_dit",i,avg_dit);

   }
   cpl_table_new_column(lin_tbl,"adl", CPL_TYPE_DOUBLE);
   med_dit=cpl_vector_get_mean(vec_med_dit);
   avg_dit=cpl_vector_get_mean(vec_avg_dit);

   for(i=0;i<nfr;i++) {
      dit = cpl_table_get_double(lin_tbl,"dit",i,status);
      cpl_vector_set(vec_adl,i,dit*med_dit);
      cpl_table_set_double(lin_tbl,"adl",i,dit*med_dit);
   }

   cpl_vector_delete(vec_dit);
   cpl_vector_delete(vec_adl);
   cpl_vector_delete(vec_avg);
   cpl_vector_delete(vec_med);
   cpl_vector_delete(vec_avg_dit);
   cpl_vector_delete(vec_med_dit);


   return lin_tbl;

}

/*--------------------------------------------------------------------*/
/**
   @brief    The recipe data reduction ('ron' part) is implemented here
   @param    framelist   the frames list of the current set
   @param    set         the complete frames set
   @return   0 if ok, -1 in error case
*/
/*--------------------------------------------------------------------*/
int
sinfo_get_ron(cpl_frameset    *   framelist,
              const int ron_xmin,
              const int ron_xmax,
              const int ron_ymin,
              const int ron_ymax,
              const int ron_hsize,
              const int ron_nsamp,
              double** ron)
{
   cpl_imagelist   *   iset =NULL;
   cpl_image       *   tmp_im =NULL;
   cpl_size                 zone[4] ;
   double              rms  =0;
   double              ndit =0;
   cpl_frame       *   frame =NULL;
   int                 i;
   cpl_propertylist* plist=NULL;

   /* Test entries */

   if (framelist == NULL) return -1 ;

   /* Load the current set */
   if ((iset = sinfo_new_frameset_to_iset(framelist)) == NULL) {
      sinfo_msg_error( "Cannot load the data") ;
      return -1 ;
   }

   /* Initialise */
   zone[0]=ron_xmin;
   zone[1]=ron_xmax;
   zone[2]=ron_ymin;
   zone[3]=ron_ymax;

   /* Loop on all pairs */
   for (i=0 ; i<cpl_imagelist_get_size(iset)-1 ; i++) {

      /* Compute the current subtracted image */
      if ((tmp_im=cpl_image_subtract_create(cpl_imagelist_get(iset,i),
                                            cpl_imagelist_get(iset, i+1)))
          == NULL) {
         sinfo_msg_error( "Cannot subtract the images") ;
         sinfo_free_imagelist(&iset) ;
         return -1 ;
      }

      /* Compute the read-out noise */
      if (cpl_flux_get_noise_window(tmp_im, zone, ron_hsize,
                                    ron_nsamp, &rms, NULL) != CPL_ERROR_NONE) {
         sinfo_msg_error( "Cannot compute the RON") ;
         sinfo_free_image(&tmp_im) ;
         sinfo_free_imagelist(&iset) ;
         return -1 ;
      }
      sinfo_free_image(&tmp_im) ;
      /* Normalise the RON with NDIT */
      frame = cpl_frameset_get_frame(framelist, i) ;
      cknull_nomsg(plist=cpl_propertylist_load(cpl_frame_get_filename(frame),
                                               0));
      ndit=sinfo_pfits_get_ndit(plist);
      sinfo_free_propertylist(&plist);

      (*ron)[i] = rms * sqrt(ndit/2.0) ;

   }

   /* Free and return */
   sinfo_free_imagelist(&iset) ;
   return 0 ;

  cleanup:
   sinfo_free_image(&tmp_im);
   sinfo_free_imagelist(&iset);
   sinfo_free_propertylist(&plist);
   return -1;

}



/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_img_combine
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_stack_get_pro_tag(char * tag_in, char* tag_out)
{
   /* Test entries */
   if (tag_in == NULL) return -1 ;
   /* here for the moment we set the same PRO ID as a non stacked frame */
   if (strcmp(tag_in,RAW_WAVE_LAMP_DITHER) == 0 ) {
      strcpy(tag_out,PRO_WAVE_LAMP_STACKED);
      return 0 ;
   }


   if (strcmp(tag_in,RAW_WAVE_LAMP) == 0 ) {
      strcpy(tag_out,PRO_WAVE_LAMP_STACKED);
      return 0 ;
   }

   if (strcmp(tag_in,RAW_WAVE_NS_DITHER) == 0 ) {
      strcpy(tag_out,PRO_WAVE_NS_STACKED);
      return 0 ;
   }


   if (strcmp(tag_in,RAW_WAVE_NS) == 0 ) {
      strcpy(tag_out,PRO_WAVE_NS_STACKED);
      return 0 ;
   }


   if (strcmp(tag_in,RAW_FIBRE_LAMP) == 0 ) {
      strcpy(tag_out,PRO_FIBRE_LAMP_STACKED);
      return 0 ;
   }

   if (strcmp(tag_in,RAW_FIBRE_EW) == 0 ) {
      strcpy(tag_out,PRO_FIBRE_EW_STACKED);
      return 0 ;
   }

   if (strcmp(tag_in,RAW_FIBRE_NS) == 0 ) {
      strcpy(tag_out,PRO_FIBRE_NS_STACKED);
      return 0 ;
   }


   if (strcmp(tag_in,PRO_FIBRE_NS_STACKED_ON) == 0 ) {
      strcpy(tag_out,PRO_FIBRE_NS_STACKED);
      return 0 ;
   }

   if (strcmp(tag_in,PRO_FIBRE_NS_STACKED) == 0 ) {
      strcpy(tag_out,PRO_FIBRE_NS_STACKED_DIST);
      return 0 ;
   }


   if (strcmp(tag_in,RAW_SLIT_LAMP) == 0 ) {
      strcpy(tag_out,PRO_SLIT_LAMP_STACKED);
      return 0 ;
   }


   if (strstr(tag_in, "FLUX") != NULL ) {
      strcpy(tag_out,PRO_FLUX_LAMP_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, "PSF") != NULL ) {
      strcpy(tag_out,PRO_PSF_CALIBRATOR_STACKED);
      return 0 ;
   }


   if (strstr(tag_in, "FOCUS") != NULL ) {
      strcpy(tag_out,PRO_FOCUS_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, "OBJECT_NODDING") != NULL ) {
      strcpy(tag_out,PRO_OBJECT_NODDING_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, "SKY_NODDING") != NULL ) {
      strcpy(tag_out,PRO_SKY_NODDING_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, "STD_NODDING") != NULL ) {
      strcpy(tag_out,PRO_STD_NODDING_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, "OBJECT_SKYSPIDER") != NULL ) {
      strcpy(tag_out,PRO_OBJECT_SKYSPIDER_STACKED);
      return 0 ;
   }


   if (strstr(tag_in, RAW_STD) != NULL ) {
      strcpy(tag_out,PRO_STD_STACKED);
      return 0 ;
   }


   if (strstr(tag_in, RAW_SKY_STD) != NULL ) {
      strcpy(tag_out,PRO_SKY_STD_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, RAW_SKY_OH) != NULL ) {
      strcpy(tag_out,PRO_SKY_OH_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, RAW_SKY_PSF_CALIBRATOR) != NULL ) {
      strcpy(tag_out,PRO_SKY_PSF_CALIBRATOR_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, RAW_STD_STAR) != NULL ) {
      strcpy(tag_out,PRO_STD_STAR_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, RAW_STD_STAR) != NULL ) {
      strcpy(tag_out,PRO_STD_STAR_DITHER_STACKED);
      return 0 ;
   }

   if (strstr(tag_in, RAW_SKY) != NULL ) {
      strcpy(tag_out,PRO_SKY_STACKED);
      return 0 ;
   }


   return 1 ;
}


int sinfo_is_dark(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_DARK)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_DARK)) return 1 ;
   return 0 ;
}

int sinfo_is_flat_bp(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_LINEARITY_LAMP)) return 1 ;
   return 0 ;
}

int sinfo_is_flat_lindet(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, RAW_LINEARITY_LAMP)) return 1 ;
   return 0 ;
}


int sinfo_blank2dot(const char * in, char* ou)
{
   int len=0;
   int i=0;

   strcpy(ou,in);
   len = strlen(in);
   for (i=0;i<len;i++)
   {
      if (in[i] == ' ') {
         ou[i] =  '.';
      }
   }
   return 0;
}


int sinfo_is_sky_flat(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;
   if (!strcmp(tag, RAW_FLAT_SKY)) return 1 ;
   return 0 ;
}



int sinfo_is_master_flat(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP1)) return 1 ;
   return 0 ;
}

int sinfo_is_master_flat_dither(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP2)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_stack(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (strstr(tag, PRO_STACKED) != NULL) return 1 ;
   return 0 ;
}

int sinfo_is_mflat(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP1)) return 1 ;
   if (!strcmp(tag, PRO_MASTER_FLAT_LAMP2)) return 1 ;
   return 0 ;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_psf_calibrator_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_PSF_CALIBRATOR_STACKED)) return 1 ;
   return 0 ;
}
/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_focus_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_FOCUS_STACKED)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_lamp_wave_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_WAVE_LAMP_STACKED)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_lamp_flux_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_FLUX_LAMP_STACKED)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_object_nodding_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_OBJECT_NODDING_STACKED)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_object_skyspider_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_OBJECT_SKYSPIDER_STACKED)) return 1 ;
   return 0 ;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_sky_nodding_stacked(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_SKY_NODDING_STACKED)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_wavemap(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_WAVE_MAP)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_halosp(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_HALO_SPECT)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_distlist(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_SLITLETS_DISTANCE)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_slitpos(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_SLIT_POS)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the input raw frames for sinfoni_util_inputs
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_firstcol(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_FIRST_COL)) return 1 ;
   return 0 ;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Define the bad pixel map
   @param    tag     The candidate DO_CATG
   @return   0 for no, 1 for yes, -1 in error case
*/
/*---------------------------------------------------------------------------*/
int sinfo_is_bpmap(char * tag)
{
   /* Test entries */
   if (tag == NULL) return -1 ;

   if (!strcmp(tag, PRO_BP_MAP)) return 1 ;
   return 0 ;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    ref_file      product status
   @param    set_id        instrument setting id
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_get_band(cpl_frame * ref_frame,char * band)
{

   char* ref_file=NULL;
   cpl_propertylist* plist=NULL;

   ref_file = cpl_strdup(cpl_frame_get_filename(ref_frame)) ;
   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_FILT_NAME)) {
      strcpy(band, cpl_propertylist_get_string(plist, KEY_NAME_FILT_NAME));
      /* sinfo_msg("%s value is %s", KEY_NAME_FILT_NAME, band); */

   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_FILT_NAME);
      return -1;
   }

   cpl_free(ref_file);
   cpl_propertylist_delete(plist);
   return 0;
}




/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    ref_file      product status
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_get_obsname(cpl_frame * ref_frame, const char* obs_name)
{

   char* ref_file=NULL;
   cpl_propertylist* plist=NULL;

   ref_file = cpl_strdup(cpl_frame_get_filename(ref_frame)) ;
   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_OBS_NAME)) {
      strcpy((char*)obs_name, cpl_propertylist_get_string(plist,
                                                          KEY_NAME_OBS_NAME));
      /* sinfo_msg("%s value is %s", KEY_NAME_OBS_NAME, obs_name); */

   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_OBS_NAME);
      return -1;
   }

   cpl_free(ref_file);
   cpl_propertylist_delete(plist);
   return 0;
}





/*---------------------------------------------------------------------------*/
/**
   @brief    Get keywords value from SINFONI FITS header
   @param    ref_frame   input frame
   @param    key_name    keyword name
   @return   key_value if ok, -1 otherwise

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

int sinfo_get_keyvalue_int(cpl_frame * ref_frame, const char* key_name)
{

   char* ref_file=NULL;
   cpl_propertylist* plist=NULL;
   int result=0;

   ref_file = cpl_strdup(cpl_frame_get_filename(ref_frame)) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      return -1;
   }


   if (sinfo_propertylist_has(plist, key_name)) {
      result=cpl_propertylist_get_int(plist,key_name);
   } else {
      sinfo_msg_warning("keyword %s does not exist",key_name);
      return -1;
   }

   cpl_free(ref_file);
   cpl_propertylist_delete(plist);

   return result;
}



/*---------------------------------------------------------------------------*/
/**
   @brief    Get keywords value from SINFONI FITS header
   @param    ref_frame   input frame
   @param    key_name    keyword name
   @return   key_value if ok, -1 otherwise

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

float sinfo_get_keyvalue_float(cpl_frame * ref_frame, const char* key_name)
{

   char* ref_file=NULL;
   cpl_propertylist* plist=NULL;
   float result=0;

   ref_file = cpl_strdup(cpl_frame_get_filename(ref_frame)) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      return -1;
   }


   if (sinfo_propertylist_has(plist, key_name)) {
      result=cpl_propertylist_get_float(plist,key_name);
   } else {
      sinfo_msg_warning("keyword %s does not exist",key_name);
      return -1;
   }

   cpl_free(ref_file);
   cpl_propertylist_delete(plist);

   return result;
}


/*---------------------------------------------------------------------------*/
/**
   @brief    Get keywords value from SINFONI FITS header
   @param    ref_frame   input frame
   @param    key_name    keyword name
   @return   key_value if ok, -1 otherwise

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

char sinfo_get_keyvalue_bool(cpl_frame * ref_frame, const char* key_name)
{

   char* ref_file=NULL;
   cpl_propertylist* plist=NULL;
   int res_val=0;

   ref_file = cpl_strdup(cpl_frame_get_filename(ref_frame)) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      return '0';
   }


   if (sinfo_propertylist_has(plist, key_name)) {
      res_val=cpl_propertylist_get_bool(plist,key_name);
   } else {
      sinfo_msg_warning("keyword %s does not exist",key_name);
      return '0';
   }

   cpl_free(ref_file);
   cpl_propertylist_delete(plist);
   if(res_val == 1) {
      return 'T';
   } else {
      return 'F';
   }
}




/*---------------------------------------------------------------------------*/
/**
   @brief    Get keywords value from SINFONI FITS header
   @param    ref_frame   input frame
   @param    key_name    keyword name
   @return   key_value if ok, -1 otherwise

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

const char*
sinfo_get_keyvalue_string(cpl_frame * ref_frame, const char* key_name)
{

   char* ref_file=NULL;
   cpl_propertylist* plist=NULL;
   const char* result=NULL;

   ref_file = cpl_strdup(cpl_frame_get_filename(ref_frame)) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      return FALSE;
   }


   if (sinfo_propertylist_has(plist, key_name)) {
      result=cpl_propertylist_get_string(plist,key_name);
   } else {
      sinfo_msg_warning("keyword %s does not exist",key_name);
      return NULL;
   }

   cpl_free(ref_file);
   cpl_propertylist_delete(plist);

   return result;
}



double sinfo_get_mjd_obs(cpl_frame * frame)
{
   cpl_propertylist* plist=NULL;
   const char* file=NULL;

   double mjd_obs=0.;
   file = cpl_frame_get_filename(frame) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",file);
      sinfo_free_propertylist(&plist) ;
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_MJD_OBS)) {
      mjd_obs=cpl_propertylist_get_double(plist, KEY_NAME_MJD_OBS);
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_MJD_OBS);
      sinfo_free_propertylist(&plist) ;
      return -1;
   }
   sinfo_free_propertylist(&plist) ;

   return mjd_obs;

}




double sinfo_get_cumoffsetx(cpl_frame * frame)
{
   cpl_propertylist* plist=NULL;
   char* file=NULL;

   double result=0.;
   file = cpl_strdup( cpl_frame_get_filename(frame)) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",file);
      cpl_propertylist_delete(plist) ;
      cpl_free(file);
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_CUMOFFX)) {
      result=cpl_propertylist_get_double(plist, KEY_NAME_CUMOFFX);
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_CUMOFFX);
      cpl_propertylist_delete(plist) ;
      return -1;
   }
   cpl_propertylist_delete(plist) ;
   cpl_free(file);

   return result;

}




double sinfo_get_cumoffsety(cpl_frame * frame)
{
   cpl_propertylist* plist=NULL;
   char* file=NULL;

   double result=0.;
   file = cpl_strdup( cpl_frame_get_filename(frame)) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",file);
      cpl_propertylist_delete(plist) ;
      cpl_free(file);
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_CUMOFFY)) {
      result=cpl_propertylist_get_double(plist, KEY_NAME_CUMOFFY);
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_CUMOFFY);
      cpl_propertylist_delete(plist) ;
      return -1;
   }
   cpl_propertylist_delete(plist) ;
   cpl_free(file);

   return result;

}

int sinfo_frame_is_dither(cpl_frame * frame)
{

   char file[256];
   char band[FILE_NAME_SZ];


   cpl_propertylist* plist=NULL;
   int grat_encoder=0;
   int dith_status=1;
   int len=0;


   cknull(frame,"Null input frame. Exit!");

   cknull_nomsg(strcpy(file,cpl_frame_get_filename(frame)));
   len= strlen(file);

   if(len<1) goto cleanup;
   if(sinfo_file_exists(file)==0) goto cleanup;
   //file = cpl_strdup(cpl_frame_get_filename(frame)) ;
   cknull(plist = cpl_propertylist_load(file, 0),
      "getting header from reference frame %s",file);

   if (sinfo_propertylist_has(plist, KEY_NAME_FILT_NAME)) {
      strcpy(band,cpl_propertylist_get_string(plist, KEY_NAME_FILT_NAME));
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_FILT_NAME);
      sinfo_free_propertylist(&plist) ;
      return -1;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_GRAT_ENC)) {
      grat_encoder = cpl_propertylist_get_int(plist, KEY_NAME_GRAT_ENC);
   } else {
      sinfo_msg_error("keyword %s does not exist",KEY_NAME_GRAT_ENC);
      sinfo_free_propertylist(&plist) ;
      return -1;
   }

   sinfo_free_propertylist(&plist) ;

   if (strcmp(band,"H") == 0) {
      if( abs(grat_encoder - GRAT_VAL2_H) <= GRAT_VAL_TOL ) {
         dith_status = 0;
      } else {
         dith_status = 0;
      }
   }
   else if (strcmp(band,"H+K") == 0) {
      if( abs(grat_encoder - GRAT_VAL2_HK) <= GRAT_VAL_TOL ) {
         dith_status = 0;
      } else {
         dith_status = 0;
      }
   }
   else if (strcmp(band,"K") == 0) {
      if( abs(grat_encoder - GRAT_VAL2_K) <= GRAT_VAL_TOL ) {
         dith_status = 0;
      } else {
         dith_status = 0;
      }
   }
   else if (strcmp(band,"J") == 0) {
      if( abs(grat_encoder - GRAT_VAL2_J) <= GRAT_VAL_TOL ) {
         dith_status = 0;
      } else {
         dith_status = 0;
      }
   }
 cleanup:

   sinfo_free_propertylist(&plist) ;
   if(cpl_error_get_code() != CPL_ERROR_NONE) {
     return -1;
   } else {
     return dith_status;
   }
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    ref_file      product status
   @param    spat_res      spatial resolution
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_get_spatial_res(cpl_frame * ref_frame, char * spat_res)
{

   const char* ref_file;
   cpl_propertylist* plist=NULL;

   ref_file=cpl_frame_get_filename(ref_frame) ;
   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      sinfo_free_propertylist(&plist) ;
      return -1 ;

   }

   if (sinfo_propertylist_has(plist, KEY_NAME_PREOPTICS)) {
      strcpy(spat_res,cpl_propertylist_get_string(plist, KEY_NAME_PREOPTICS));
      /* sinfo_msg("%s value is %s", KEY_NAME_PREOPTICS, spat_res); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_PREOPTICS);
      sinfo_free_propertylist(&plist);
      return -1;
   }
   sinfo_free_propertylist(&plist);
   return 0;

}

/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    ref_file      product status
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_frame_is_sky(cpl_frame * ref_frame)
{

   char  dpr_type[FILE_NAME_SZ];
   char* ref_file=NULL;
   const char* sval=NULL;

   int result=0;
   cpl_propertylist* plist=NULL;

   sval = cpl_frame_get_filename(ref_frame) ;
   ref_file = cpl_strdup(sval) ;

   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file, 0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      cpl_propertylist_delete(plist) ;
      cpl_free(ref_file);
      return -1 ;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_DPR_TYPE)) {
      strcpy(dpr_type,cpl_propertylist_get_string(plist, KEY_NAME_DPR_TYPE));
      /* sinfo_msg("%s value is %d", KEY_NAME_DPR_TYPE, dpr_type); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_DPR_TYPE);
      cpl_propertylist_delete(plist) ;
      cpl_free(ref_file);
      return -1;
   }
   cpl_propertylist_delete(plist);
   if(strstr(dpr_type,RAW_SKY) != NULL) {
      result=1;
   }
   cpl_free(ref_file);

   return result;

}


/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    tag     product status
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_tag_is_sky(char * tag)
{

   int result=0;

   if(
      (strcmp(tag,RAW_SKY) == 0)         ||
      (strcmp(tag,RAW_IMAGE_PRE_SKY) == 0)         ||
      (strcmp(tag,RAW_SKY_NODDING) == 0) ||
      (strcmp(tag,RAW_SKY_JITTER) == 0) ||
      (strcmp(tag,RAW_SKY_STD) == 0)     ||
      (strcmp(tag,RAW_FIBRE_DARK) == 0) ||
      (strcmp(tag,RAW_SKY_OH) == 0)      ||
      (strcmp(tag,RAW_SKY_PSF_CALIBRATOR) == 0)
      ) {
      result=1;
   }

   return result;

}


/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    tag     product status
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_tag_is_obj(char * tag)
{

   int result=0;

   if(
      (strcmp(tag,RAW_PUPIL_LAMP) == 0) ||
      (strcmp(tag,RAW_OBJECT) == 0)         ||
      (strcmp(tag,RAW_IMAGE_PRE_OBJECT) == 0)         ||
      (strcmp(tag,RAW_OBJECT_NODDING) == 0) ||
      (strcmp(tag,RAW_OBJECT_JITTER) == 0) ||
      (strcmp(tag,RAW_PSF_CALIBRATOR) == 0) ||
      (strcmp(tag,RAW_FIBRE_PSF) == 0) ||
      (strcmp(tag,RAW_STD) == 0)            ||
      (strcmp(tag,RAW_STD_STAR) == 0)

      ) {
      result=1;
   }

   return result;

}

/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    tag     product status
   @return   0 if ok, -1 otherwise

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_tag_is_objpro(char * tag)
{

   int result=0;

   if(
      (strcmp(tag,PRO_COADD_OBJ) == 0) ||
      (strcmp(tag,PRO_COADD_PSF) == 0) ||
      (strcmp(tag,PRO_COADD_STD) == 0) ||
      (strcmp(tag,PRO_OBS_OBJ) == 0) ||
      (strcmp(tag,PRO_OBS_PSF) == 0) ||
      (strcmp(tag,PRO_OBS_STD) == 0) ||
      (strcmp(tag,PRO_PSF_CALIBRATOR_STACKED) == 0) ||
      (strcmp(tag,PRO_SKY_PSF_CALIBRATOR_STACKED) == 0) ||
      (strcmp(tag,PRO_STD_STACKED) == 0) ||
      (strcmp(tag,PRO_SKY_STD_STACKED) == 0) ||
      (strcmp(tag,PRO_OBJECT_NODDING_STACKED) == 0) ||
      (strcmp(tag,PRO_SKY_NODDING_STACKED) == 0)
      ) {
      result=1;
   }

   return result;

}


/*---------------------------------------------------------------------------*/
/**
   @brief    Add PRO* keywords to a SINFONI FITS header
   @param    ref_file      product status
   @return   1 if on 0 if off if ok, -1 if unknown

   DFS only. See the DICB dictionaries to have details on the keywords.
*/
/*---------------------------------------------------------------------------*/

int sinfo_frame_is_on(cpl_frame * ref_frame)
{

   char ref_file[FILE_NAME_SZ];
   char dpr_type[FILE_NAME_SZ];
   int lamp_Xe=0;
   int lamp_Kr=0;
   int lamp_Ne=0;
   int lamp_Ar=0;
   int lamp_Halo=0;
   int len=0;
   int result=0;
   cpl_propertylist* plist=NULL;
   const char* filename=NULL;
   cknull(ref_frame,"Null input frame. Exit!");

   cknull_nomsg(filename=cpl_frame_get_filename(ref_frame));
   len= strlen(filename);
   if(len<1) goto cleanup;

   check_nomsg(strcpy(ref_file, filename)) ;
   if ((cpl_error_code)((plist = cpl_propertylist_load(ref_file,0)) == NULL)) {
      sinfo_msg_error( "getting header from reference frame %s",ref_file);
      sinfo_free_propertylist(&plist) ;
      return -1 ;
   }

/*-----------------------------------------------------------------------
  in J  Argon (4)
  in H Xenon and Argon (1+4)
  in K Neon (3)
  in H+K Xenon (1)
  -------------------------------------------------------------------------*/
   if (sinfo_propertylist_has(plist, KEY_NAME_DPR_TYPE)) {
      strcpy(dpr_type,cpl_propertylist_get_string(plist, KEY_NAME_DPR_TYPE));
      /* sinfo_msg("%s value is %s", KEY_NAME_DPR_TYPE, dpr_type); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_DPR_TYPE);
      sinfo_free_propertylist(&plist);
      return -1;
   }

   /*
     In order to use the frame tag to identify frames we have to add this line
     strcpy(dpr_type,cpl_frame_get_tag(ref_frame));

   */

   if(strstr(dpr_type,"STD") != NULL) {
      result = 1;
      sinfo_free_propertylist(&plist);
      return result;
   }

   if(strstr(dpr_type,"PSF") != NULL) {
      result = 1;
      sinfo_free_propertylist(&plist);
      return result;
   }

   if(strstr(dpr_type,"SKY") != NULL) {
      result = 0;
      sinfo_free_propertylist(&plist);
      return result;
   }


   if(strstr(dpr_type,"OBJECT") != NULL) {
      result = 1;
      sinfo_free_propertylist(&plist);
      return result;
   }
   /*
     if(strstr(dpr_type,"PUPIL") != NULL) {
     result = 1;
     cpl_propertylist_delete(plist);
     return result;
     }
   */

   if (sinfo_propertylist_has(plist, KEY_NAME_LAMP_XE)) {
      lamp_Xe=cpl_propertylist_get_bool(plist, KEY_NAME_LAMP_XE);
      /* sinfo_msg("%s value is %d", KEY_NAME_LAMP_XE, lamp_Xe); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_LAMP_XE);
      sinfo_free_propertylist(&plist);
      return -1;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_LAMP_KR)) {
      lamp_Kr=cpl_propertylist_get_bool(plist, KEY_NAME_LAMP_KR);
      /* sinfo_msg("%s value is %d", KEY_NAME_LAMP_KR, lamp_Kr); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_LAMP_KR);
      sinfo_free_propertylist(&plist);
      return -1;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_LAMP_NE)) {
      lamp_Ne=cpl_propertylist_get_bool(plist, KEY_NAME_LAMP_NE);
      /* sinfo_msg("%s value is %d", KEY_NAME_LAMP_NE, lamp_Ne); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_LAMP_NE);
      sinfo_free_propertylist(&plist);
      return -1;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_LAMP_AR)) {
      lamp_Ar=cpl_propertylist_get_bool(plist, KEY_NAME_LAMP_AR);
      /* sinfo_msg("%s value is %d", KEY_NAME_LAMP_AR, lamp_Ar); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_LAMP_AR);
      sinfo_free_propertylist(&plist);
      return -1;
   }

   if (sinfo_propertylist_has(plist, KEY_NAME_LAMP_HALO)) {
      lamp_Halo=cpl_propertylist_get_bool(plist, KEY_NAME_LAMP_HALO);
      /* sinfo_msg("%s value is %d", KEY_NAME_LAMP_HALO, lamp_Halo); */
   } else {
      sinfo_msg_warning("keyword %s does not exist",KEY_NAME_LAMP_HALO);
      sinfo_free_propertylist(&plist);
      return -1;
   }




   if(lamp_Xe) {
      result=1;
   }

   if(lamp_Kr) {
      result=1;
   }

   if(lamp_Ne) {
      result=1;
   }

   if(lamp_Ar) {
      result=1;
   }


   if(lamp_Halo) {
      result=1;
   }

  cleanup:
   sinfo_free_propertylist(&plist);
   return result;


}



int
sinfo_pfits_add_qc(cpl_propertylist       *   plist,
                   qc_log          *   qclog)
{
   char            key_name[80] ;
   char            key_value[80] ;

   int             i =0;

   /* Test entries */
   if (plist == NULL) return -1 ;

   /* Parameter Name:    PIPEFILE */
   /* we add ESO prefix to FITS keywords" */
   for(i=0;i<qclog[0].n;i++) {
      strcpy(key_name,"ESO ");
      strcat(key_name,qclog[i].name);
      if(strcmp(qclog[i].type,"string") == 0) {
         snprintf(key_value,sizeof(key_value)-1,"%s",qclog[i].s_val);
         cpl_propertylist_append_string(plist, key_name,key_value) ;
         cpl_propertylist_set_comment(plist, key_name,qclog[i].comm) ;

      } else if(strcmp(qclog[i].type,"bool") == 0) {
         snprintf(key_value,sizeof(key_value),"%i",(int)qclog[i].n_val);
         cpl_propertylist_append_bool(plist, key_name,(int)qclog[i].n_val) ;
         cpl_propertylist_set_comment(plist, key_name,qclog[i].comm) ;
      } else if(strcmp(qclog[i].type,"int") == 0) {
         snprintf(key_value,sizeof(key_value),"%i",(int)qclog[i].n_val);
         cpl_propertylist_append_int(plist, key_name,(int)qclog[i].n_val) ;
         cpl_propertylist_set_comment(plist, key_name,qclog[i].comm) ;
      } else if(strcmp(qclog[i].type,"float") == 0) {
         snprintf(key_value,sizeof(key_value),"%f",(float)qclog[i].n_val);
         cpl_propertylist_append_float(plist, key_name,(float)qclog[i].n_val) ;
         cpl_propertylist_set_comment(plist, key_name,qclog[i].comm) ;
      } else if(strcmp(qclog[i].type,"double") == 0) {
         snprintf(key_value,sizeof(key_value),"%f",qclog[i].n_val);
         cpl_propertylist_append_double(plist, key_name,qclog[i].n_val) ;
         cpl_propertylist_set_comment(plist, key_name,qclog[i].comm) ;
      }

   }

   return 0 ;
}



