/*
 * This file is part of the ESO SINFONI Pipeline
 * Copyright (C) 2004,2005 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, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA
 */
/*----------------------------------------------------------------------------

     File name    :       sinfo_new_psf.c
   Author       :    A. Modigliani
   Created on   :    Sep 17, 2003
   Description  :

 sinfo_new_psf.py does the image reconstruction of a set of
 sky-subtracted, flatfielded,
 bad pixel corrected and slope of the spectra aligned exposures of a bright
 star with continuum spectrum. The resulting image can be used to determine
 the PSF
 ---------------------------------------------------------------------------*/
#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

/*----------------------------------------------------------------------------
                                Includes
 ---------------------------------------------------------------------------*/
#define _GNU_SOURCE
#include <math.h>

#include <sinfo_cpl_size.h>

#include <irplib_utils.h>
#include <irplib_strehl.h>
#include "sinfo_new_psf.h"
#include "sinfo_pro_save.h"
#include "sinfo_hidden.h"
#include "sinfo_key_names.h"
#include "sinfo_psf_ini.h"
#include "sinfo_psf_ini_by_cpl.h"
#include "sinfo_utilities_scired.h"
#include "sinfo_hidden.h"
#include "sinfo_pfits.h"
#include "sinfo_functions.h"
#include "sinfo_error.h"
#include "sinfo_utils_wrappers.h"
#include "sinfo_globals.h"
//Used only for sinfo_propertylist_has
#include "sinfo_dfs.h"
/*----------------------------------------------------------------------------
                                Defines
 ---------------------------------------------------------------------------*/
//PSO
#define SINFO_MATH_PI   3.1415926535897932384626433832795028841971693993751058
#define SINFO_MATH_PI_2 1.5707963267948966192313216916397514420985846996875529
#define SINFO_MATH_PI_4 0.7853981633974483096156608458198757210492923498437765



#define SINFO_STREHL_M1                       8.0  //7.9
#define SINFO_STREHL_M2                       1.1  //1.33
#define SINFO_STREHL_BOX_SIZE                 64
#define SINFO_STREHL_WINDOW                   6
#define SINFO_PSF_SZ                          4
#define SINFO_RSTAR                           32//25
#define SINFO_BKG_R1                          32//25
#define SINFO_BKG_R2                          33//27
#define SINFO_STREHL_ERROR_COEFFICIENT    SINFO_MATH_PI * 0.007 / 0.0271
#ifndef SINFO_STREHL_RAD_CENTRAL
#define SINFO_STREHL_RAD_CENTRAL 5
#endif

//constants for perfect PSF generation
// Dimension of the support for generating the perfect PFS
#define SINFO_PSF_DIM   1024//256
#define SINFO_PSF_BLOCKS   63//11

#define SINFO_PSF_BIN    16 // Pixels over "pixel_size"
#define SINFO_PSF_NPOINT 10000// number of encircled energy sampling points
#define SINFO_BKG_BOX_SZ 8
/*----------------------------------------------------------------------------
                             Function Definitions
 ---------------------------------------------------------------------------*/
static cpl_error_code
sinfo_add_com_psf_qclog(const char* fname,cpl_table** qclog_tbl);


static cpl_error_code
sinfo_get_star_features(const cpl_image* im,
                        const int radius,
                        const int xpos,
                        const int ypos,
                        double* xc,
                        double* yc,
                        double* pick,
                        double* flux,
                        double* bkg);

static double
sinfo_find_min_of_four(const double n1,
                       const double n2,
                       const double n3,
                       const double n4);

static cpl_table*
sinfo_get_strehl_from_2images(cpl_image* ima1,
                              cpl_image* ima2,
                              cpl_frame* frm1,
                              cpl_frame* frm2);


static int
sinfo_get_strehl_input1(cpl_frame* frm1,
                        double* dispersion,
                        double* centralWave,
                        double* ws,
                        double* we,
                        double* pscale,
                        double* exptime,
                        double* strehl_star_rad,
                        double* strehl_bg_rmin,
                        double* strehl_bg_rmax);

static int
sinfo_get_strehl_input2(cpl_frame* frm1,cpl_frame* frm2,
                        double* dispersion,
                        double* centralWave,
                        double* ws,
                        double* we,
                        double* pscale1,
                        double* pscale2,
                        double* exptime1,
                        double* exptime2,
                        double* strehl_star_rad1,
                        double* strehl_star_rad2,
                        double* strehl_bg_rmin1,
                        double* strehl_bg_rmin2,
                        double* strehl_bg_rmax1,
                        double* strehl_bg_rmax2);


static void
sinfo_check_borders(cpl_size* val,const int max,const int thresh);

static void
sinfo_get_safe_box(int* llx,
                   int* lly,
                   int* urx,
                   int* ury,
                   const int xpos,
                   const int ypos,
                   const int box,
                   const int szx,
                   const int szy);

static int
sinfo_get_strehl_from_slice(cpl_imagelist* cube,
                            double disp,
                            double cWave,
                            double ws,
                            double we,
                            double pscale,
                            double strehl_star_radius,
                            double strehl_bg_r1,
                            double strehl_bg_r2,
                            double* strehl,
                            double* strehl_err);


static cpl_table*
sinfo_get_encircled_energy(cpl_frameset* sof,
                           cpl_image* img,
                           double* fwhm_x,
                           double* fwhm_y,
                           cpl_table** qclog);

static double
sinfo_get_strehl_from_ima(cpl_image* ima,
                          cpl_frame* frame);

static int
sinfo_get_strehl_from_image(cpl_image* img,
                            double ws,
                            double we,
                            double pscale,
                            double strehl_star_radius,
                            double strehl_bg_r1,
                            double strehl_bg_r2,
                            double* strehl,
                            double* strehl_err);



static cpl_table*
sinfo_get_strehl_from_cube(cpl_imagelist* cube,
                           char* name,
                           cpl_frame* frame);

static int
sinfo_get_frm12(cpl_frameset* sof,cpl_frame** frm1,cpl_frame** frm2);


/**@{*/
/**
 * @addtogroup sinfo_rec_jitter PSF data reduction
 *
 * TBD
 */


/*----------------------------------------------------------------------------
   Function     :       sinfo_new_psf()
   In           :       ini_file: file name of according .ini file
   Out          :       integer (0 if it worked, -1 if it doesn't)
   Job          :

 sinfo_new_psf.py does the image reconstruction of a set of sky-subtracted,
 flatfielded,
 bad pixel corrected and slope of the spectra aligned exposures of a bright
 star with continuum spectrum. The resulting image can be used to determine
 the PSF

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

int
sinfo_new_psf (const char* plugin_id,
               cpl_parameterlist* config,
               cpl_frameset* sof, cpl_frameset* ref_set)
{

    cpl_imagelist* cube1=NULL;
    cpl_imagelist* cube2=NULL;
    cpl_image * med_img1=NULL ;
    cpl_image * med_img2=NULL ;

    cpl_table* ao_performance=NULL;
    cpl_table* enc_energy=NULL;

    cpl_frame* frm1=NULL;
    cpl_frame* frm2=NULL;

    cpl_table* qclog_tbl=NULL;
    cpl_frameset* stk=NULL;
    cpl_propertylist* plist =NULL;

    psf_config * cfg =NULL;

    int nsample=0;
    int i = 0;
    int status=0;



    int strehl_sw=0;
    int ilx1=0;
    int ily1=0;
    /*
  int ilx2=0;
  int ily2=0;
     */
    float cx1=0;
    float cy1=0;
    /*
  float cx2=0;
  float cy2=0;
     */

    double fwhm_x=0;
    double fwhm_y=0;
    double lam=0;
    double strehl=0;
    double strehl1=0;
    double strehl2=0;

    char fname1[MAX_NAME_SIZE];
    char fname2[MAX_NAME_SIZE];

    char key_name[MAX_NAME_SIZE];

    char obs_name1[MAX_NAME_SIZE];
    char hlamp_st='F';
    char shut2_st='F';
    cpl_table* tmp_tbl=NULL;


    /*
       -----------------------------------------------------------------
       1) parse the file names and parameters to the psf_config data
          structure cfg
       -----------------------------------------------------------------
     */

    sinfo_msg("Parsing cpl input");
    check_nomsg(stk=cpl_frameset_new());

    cknull(cfg = sinfo_parse_cpl_input_psf(sof,&stk),
           "error parsing cpl input");

    /* TODO the following generate a small leak of 72 bytes */
    strehl_sw=sinfo_get_strehl_type(sof);
    if(strehl_sw==0) {
        sinfo_msg("One target Strehl computation");
        if(sinfo_is_fits_file(cfg->inFrame) != 1) {
            sinfo_msg_error("Input file %s is not FITS",cfg->inFrame);
            goto cleanup;
        } else {
            strcpy(fname1,cfg->inFrame);
        }

        if(NULL != cpl_frameset_find(sof,PRO_COADD_PSF)) {
            frm1 = cpl_frameset_find(sof,PRO_COADD_PSF);
        } else if(NULL != cpl_frameset_find(sof,PRO_OBS_PSF)) {
            frm1 = cpl_frameset_find(sof,PRO_OBS_PSF);
        } else if(NULL != cpl_frameset_find(sof,PRO_COADD_STD)) {
            frm1 = cpl_frameset_find(sof,PRO_COADD_STD);
        } else if(NULL != cpl_frameset_find(sof,PRO_OBS_STD)) {
            frm1 = cpl_frameset_find(sof,PRO_OBS_STD);
        } else if(NULL != cpl_frameset_find(sof,PRO_COADD_OBJ)) {
            frm1 = cpl_frameset_find(sof,PRO_COADD_OBJ);
        } else if(NULL != cpl_frameset_find(sof,PRO_OBS_OBJ)) {
            frm1 = cpl_frameset_find(sof,PRO_OBS_OBJ);
        } else {
            sinfo_msg_error("Frame %s  or %s or %s  or %s or %s  or %s not found!",
                            PRO_COADD_PSF,PRO_OBS_PSF,
                            PRO_COADD_STD,PRO_OBS_STD,
                            PRO_COADD_OBJ,PRO_OBS_OBJ);
            goto cleanup;
        }

        sinfo_get_obsname(frm1,obs_name1);
        check_nomsg(hlamp_st=sinfo_get_keyvalue_bool(frm1,KEY_NAME_LAMP_HALO));
        check_nomsg(shut2_st=sinfo_get_keyvalue_bool(frm1,KEY_NAME_SHUT2_ST));


        check_nomsg(cube1 = cpl_imagelist_load(fname1,CPL_TYPE_FLOAT,0));
        cknull(med_img1=sinfo_new_median_cube(cube1),
               " could not do sinfo_medianCube()");

        check_nomsg(ilx1=cpl_image_get_size_x(med_img1));
        check_nomsg(ily1=cpl_image_get_size_y(med_img1));

        cx1 = ilx1 / 2. + 0.5;
        cy1 = ily1 / 2. + 0.5;

        cknull(ao_performance=sinfo_get_strehl_from_cube(cube1,fname1,frm1),
               "error computing strehl");
        strehl=sinfo_get_strehl_from_ima(med_img1,frm1);
        sinfo_free_imagelist(&cube1);
    } else {
        sinfo_msg("Two target Strehl computation");
        sinfo_get_frm12(sof,&frm1,&frm2);
        strcpy(fname1,cpl_frame_get_filename(frm1));
        strcpy(fname2,cpl_frame_get_filename(frm2));

        check_nomsg(cube1 = cpl_imagelist_load(fname1,CPL_TYPE_FLOAT,0));
        check_nomsg(cube2 = cpl_imagelist_load(fname2,CPL_TYPE_FLOAT,0));
        cknull(med_img1=sinfo_new_median_cube(cube1),"Computing median on cube");
        cknull(med_img2=sinfo_new_median_cube(cube2),"Computing median on cube");
        check_nomsg(cpl_image_save(med_img1,"med_img1.fits",CPL_BPP_IEEE_FLOAT,
                        NULL,CPL_IO_DEFAULT));
        check_nomsg(cpl_image_save(med_img2,"med_img2.fits",CPL_BPP_IEEE_FLOAT,
                        NULL,CPL_IO_DEFAULT));


        check_nomsg(ilx1=cpl_image_get_size_x(med_img1));
        check_nomsg(ily1=cpl_image_get_size_y(med_img1));
        /*
    check_nomsg(ilx2=cpl_image_get_size_x(med_img2));
    check_nomsg(ily2=cpl_image_get_size_y(med_img2));
         */
        cx1 = ilx1 / 2. + 0.5;
        cy1 = ily1 / 2. + 0.5;
        /*
    cx2 = ilx2 / 2. + 0.5;
    cy2 = ily2 / 2. + 0.5;
         */

        sinfo_free_imagelist(&cube1);
        sinfo_free_imagelist(&cube2);

        cknull(tmp_tbl=sinfo_get_strehl_from_2images(med_img1,med_img2,frm1,frm2),
               "Computing strehl");
        check_nomsg(strehl=cpl_table_get_double(tmp_tbl,"strehl",0,&status));
        sinfo_free_table(&tmp_tbl);
        strehl1=sinfo_get_strehl_from_ima(med_img1,frm1);
        sinfo_msg_debug("Strehl on 1st image=%f",strehl);
        strehl2=sinfo_get_strehl_from_ima(med_img2,frm2);
        sinfo_msg_debug("Strehl on 2nd image=%f",strehl);

        cknull_nomsg(qclog_tbl = sinfo_qclog_init());
        check_nomsg(sinfo_add_com_psf_qclog(fname1,&qclog_tbl));
        if(irplib_isnan(strehl1)) strehl1=-100.;
        ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL025",strehl1,
                        "STREHL 25 mas","%f"));
        ck0(sinfo_pro_save_ima(med_img1,ref_set,sof,PSF_MED_CUB_025_FILENAME,
                        PRO_MED_COADD_PSF,qclog_tbl,plugin_id,config),
            "cannot save ima %s", PSF_MED_CUB_100_FILENAME);
        sinfo_free_table(&qclog_tbl);


        cknull_nomsg(qclog_tbl = sinfo_qclog_init());
        check_nomsg(sinfo_add_com_psf_qclog(fname2,&qclog_tbl));
        if(irplib_isnan(strehl2)) strehl2=-100.;
        ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL100",strehl2,
                        "STREHL 100 mas","%f"));

        if(irplib_isnan(strehl)) strehl=-100.;

        ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL",strehl,
                        "STREHL from both pixel scale images","%f"));
        ck0(sinfo_pro_save_ima(med_img2,ref_set,sof,PSF_MED_CUB_100_FILENAME,
                        PRO_MED_COADD_PSF,qclog_tbl,plugin_id,config),
            "cannot save ima %s", PSF_MED_CUB_100_FILENAME);

        sinfo_free_table(&qclog_tbl);
        sinfo_free_image(&med_img2);

    }
    /* STREHL computation */

    check_nomsg(nsample=cpl_table_get_nrow(ao_performance));
    cknull_nomsg(qclog_tbl = sinfo_qclog_init());
    check_nomsg(sinfo_add_com_psf_qclog(fname1,&qclog_tbl));

    if(strehl_sw==0) {
        if(irplib_isnan(strehl)) strehl=-100.;

        ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL",strehl,
                        "STREHL from image","%f"));

    }

    check_nomsg(strehl=cpl_table_get_column_median(ao_performance,"strehl"));

    ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL MED",strehl,
                    "STREHL MEDIAN","%f"));

    check_nomsg(strehl=cpl_table_get_column_mean(ao_performance,"strehl"));

    ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL AVG",strehl,
                    "STREHL AVERAGE","%f"));
    /*
  strehl=sinfo_get_strehl_from_ima(med_img1,frm1);

  ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL AVG",strehl,
            "STREHL AVERAGE","%f"));
     */
    for(i=1;i<nsample;i++) {

        check_nomsg(strehl=cpl_table_get_double(ao_performance,"strehl",
                        i,&status));
        if(irplib_isnan(strehl)) strehl=-100.;

        snprintf(key_name,MAX_NAME_SIZE-1,"%s%d","QC STREHL",i);
        ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,key_name,strehl,"STREHL","%f"));

        check_nomsg(lam=cpl_table_get_double(ao_performance,"wavelength",
                        i,&status));
        snprintf(key_name,MAX_NAME_SIZE-1,"%s%d","QC LAMBDA",i);
        ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,key_name,lam,
                        "WAVELENGTH","%f"));

    }

    check_nomsg(strehl=cpl_table_get_column_median(ao_performance,
                    "strehl_error"));
    ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC STREHL MEDERR",strehl,
                    "STREHL ERROR MEDIAN","%f"));
    ck0_nomsg(sinfo_qclog_add_string(qclog_tbl,"OBS NAME",obs_name1,
                    "OB name","%s"));
    ck0_nomsg(sinfo_qclog_add_bool(qclog_tbl,PAF_NAME_LAMP_HALO,hlamp_st,
                    KEY_NAME_LAMP_HALO,"%d"));
    ck0_nomsg(sinfo_qclog_add_bool(qclog_tbl,PAF_NAME_SHUT2_ST,shut2_st,
                    KEY_NAME_SHUT2_ST,"%d"));

    ck0(sinfo_pro_save_tbl(ao_performance,ref_set,sof,
                    PSF_AO_PERFORMANCE_OUT_FILENAME,
                    PRO_AO_PERFORMANCE,qclog_tbl,plugin_id,config),
        "cannot save tbl %s", PSF_AO_PERFORMANCE_OUT_FILENAME);

    sinfo_free_table(&qclog_tbl);
    sinfo_free_table(&ao_performance);

    /* Encircled energy & FWHM computation */
    cknull_nomsg(qclog_tbl=sinfo_qclog_init());
    cknull(enc_energy=sinfo_get_encircled_energy(sof,
                    med_img1,
                    &fwhm_x,
                    &fwhm_y,
                    &qclog_tbl),
           "Computing encircled energy");

    ck0(sinfo_pro_save_tbl(enc_energy,ref_set,sof,PSF_ENC_ENERGY_OUT_FILENAME,
                    PRO_ENC_ENERGY,qclog_tbl,plugin_id,config),
        "cannot save tbl %s", PSF_ENC_ENERGY_OUT_FILENAME);

    sinfo_free_table(&qclog_tbl);
    sinfo_free_table(&enc_energy);

    /* QC log */
    cknull_nomsg(qclog_tbl = sinfo_qclog_init());
    ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC FWHMX",fwhm_x,
                    "QC FWHM X","%f"));
    ck0_nomsg(sinfo_qclog_add_double(qclog_tbl,"QC FWHMY",fwhm_y,
                    "QC FWHM Y","%f"));
    ck0_nomsg(sinfo_qclog_add_bool(qclog_tbl,PAF_NAME_LAMP_HALO,
                    hlamp_st,KEY_NAME_LAMP_HALO,"%d"));
    ck0_nomsg(sinfo_qclog_add_bool(qclog_tbl,PAF_NAME_SHUT2_ST,shut2_st,
                    KEY_NAME_SHUT2_ST,"%d"));

    ck0(sinfo_pro_save_ima(med_img1,ref_set,sof,cfg->outName,PRO_PSF,
                    qclog_tbl,plugin_id,config),
        "cannot save ima %s", cfg->outName);

    sinfo_free_table(&qclog_tbl);
    sinfo_new_set_wcs_image(med_img1,cfg->outName,cx1, cy1);
    sinfo_free_image(&med_img1);
    sinfo_free_frameset(&stk);
    sinfo_free_psf(&cfg);
    return 0;

    cleanup:

    sinfo_free_table(&qclog_tbl);
    sinfo_free_imagelist(&cube2);
    sinfo_free_imagelist(&cube1);
    sinfo_free_table(&enc_energy);
    sinfo_free_image(&med_img1);
    sinfo_free_table(&ao_performance);
    sinfo_free_propertylist(&plist) ;
    sinfo_free_psf(&cfg);
    sinfo_free_frameset(&stk);

    return -1 ;

}




static cpl_error_code
sinfo_add_com_psf_qclog(const char* fname,cpl_table** qclog_tbl)
{

    cpl_propertylist* plist=NULL;

    /* QC log */
    cknull(plist = cpl_propertylist_load(fname, 0),
           "getting header from reference ima frame %s",fname);

    if (sinfo_propertylist_has(plist, KEY_NAME_LOOP_STATE)) {
        sinfo_qclog_add_string(*qclog_tbl,KEY_NAME_LOOP_STATE,
                        cpl_propertylist_get_string(plist,KEY_NAME_LOOP_STATE),
                        KEY_HELP_LOOP_STATE,"%s");
    }



    if (sinfo_propertylist_has(plist, KEY_NAME_LOOP_LGS)) {
        sinfo_qclog_add_int(*qclog_tbl,KEY_NAME_LOOP_LGS,
                        cpl_propertylist_get_int(plist,KEY_NAME_LOOP_LGS),
                        KEY_HELP_LOOP_LGS,"%d");
    }


    if (sinfo_propertylist_has(plist, KEY_NAME_INS1_MODE)) {
        sinfo_qclog_add_string(*qclog_tbl,KEY_NAME_INS1_MODE,
                        cpl_propertylist_get_string(plist,KEY_NAME_INS1_MODE),
                        KEY_HELP_INS1_MODE,"%s");
    }


    cleanup:
    sinfo_free_propertylist(&plist);

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


}

static int
sinfo_get_strehl_from_image(cpl_image* img,
                            double ws,
                            double we,
                            double pscale,
                            double strehl_star_radius,
                            double strehl_bg_r1,
                            double strehl_bg_r2,
                            double* strehl,
                            double* strehl_err)
{
    cpl_errorstate clean_state = cpl_errorstate_get();

    cpl_image* img_dup=NULL;

    double dlam=0.;
    double lam=0.;
    /*
  double max_ima_cx=0.;
  double max_ima_cy=0.;
     */
    double psf_peak=0.;
    double psf_flux=0.;
    double bkg_noise=0.;
    double star_bkg=0.;
    double star_peak=0.;
    double star_flux=0.;

    cpl_size max_ima_x=0;
    cpl_size max_ima_y=0;
    int wllx=0;
    int wlly=0;
    int wurx=0;
    int wury=0;
    int ima_szx=0;
    int ima_szy=0;


    lam = (double)0.5*(ws+we);
    dlam=we-ws;
    sinfo_msg_debug("ws=%f we=%f dl=%f",ws,we,dlam);
    check_nomsg(img_dup=cpl_image_duplicate(img));
    sinfo_clean_nan(&img_dup);
    check_nomsg(cpl_image_get_maxpos(img_dup,&max_ima_x,&max_ima_y));
    sinfo_free_image(&img_dup);

    check_nomsg(ima_szx=cpl_image_get_size_x(img));
    check_nomsg(ima_szy=cpl_image_get_size_y(img));
    sinfo_check_borders(&max_ima_x,ima_szx,SINFO_STREHL_WINDOW);
    sinfo_check_borders(&max_ima_y,ima_szy,SINFO_STREHL_WINDOW);
    sinfo_get_safe_box(&wllx,&wlly,&wurx,&wury,max_ima_x,max_ima_y,SINFO_PSF_SZ,
                       ima_szx,ima_szy);

    //cpl_image_get_maxpos_window(img,wllx,wlly,wurx,wury,&max_ima_x,&max_ima_y);
    /*
  check_nomsg(max_ima_cx=cpl_image_get_centroid_x_window(img,wllx,wlly,
                                                         wurx,wury));
  check_nomsg(max_ima_cy=cpl_image_get_centroid_y_window(img,wllx,wlly,
  wurx,wury));
     */

    if(CPL_ERROR_NONE != sinfo_strehl_compute_one(img,
                    SINFO_STREHL_M1,
                    SINFO_STREHL_M2,
                    lam,
                    dlam,
                    pscale,
                    max_ima_x,
                    max_ima_y,
                    strehl_star_radius,
                    strehl_bg_r1,
                    strehl_bg_r2,
                    SINFO_STREHL_BOX_SIZE,
                    strehl,
                    strehl_err,
                    &star_bkg,
                    &star_peak,
                    &star_flux,
                    &psf_peak,
                    &psf_flux,
                    &bkg_noise)) {


        *strehl=-1;
        *strehl_err=0;
        irplib_error_recover(clean_state,"Problem computing strehl");

    }

    return 0;

    cleanup:

    return -1;

}






static int
sinfo_get_strehl_from_slice(cpl_imagelist* cube,
                            double disp,
                            double cWave,
                            double ws,
                            double we,
                            double pscale,
                            double strehl_star_radius,
                            double strehl_bg_r1,
                            double strehl_bg_r2,
                            double* strehl,
                            double* strehl_err)
{


    cpl_errorstate clean_state = cpl_errorstate_get();


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

    double dlam=0.;
    double lam=0.;
    /*
  double max_ima_cx=0.;
  double max_ima_cy=0.;
     */
    double psf_peak=0.;
    double psf_flux=0.;
    double bkg_noise=0.;
    double star_bkg=0.;
    double star_peak=0.;
    double star_flux=0.;

    cpl_size max_ima_x=0;
    cpl_size max_ima_y=0;
    int wllx=0;
    int wlly=0;
    int wurx=0;
    int wury=0;
    int ima_szx=0;
    int ima_szy=0;


    lam = (double)0.5*(ws+we);
    dlam=we-ws;


    img=sinfo_new_average_cube_to_image_between_waves(cube,disp,cWave,ws,we);
    check_nomsg(img_dup=cpl_image_duplicate(img));
    sinfo_clean_nan(&img_dup);
    check_nomsg(cpl_image_get_maxpos(img_dup,&max_ima_x,&max_ima_y));
    check_nomsg(cpl_image_delete(img_dup));


    check_nomsg(ima_szx=cpl_image_get_size_x(img));
    check_nomsg(ima_szy=cpl_image_get_size_y(img));
    sinfo_check_borders(&max_ima_x,ima_szx,SINFO_STREHL_WINDOW);
    sinfo_check_borders(&max_ima_y,ima_szy,SINFO_STREHL_WINDOW);


    sinfo_get_safe_box(&wllx,&wlly,&wurx,&wury,max_ima_x,max_ima_y,SINFO_PSF_SZ,
                       ima_szx,ima_szy);

    /*
  cpl_image_get_maxpos_window(img,wllx,wlly,wurx,wury,&max_ima_x,&max_ima_y);
     */
    /*
  check_nomsg(max_ima_cx=cpl_image_get_centroid_x_window(img,wllx,wlly,
                                                         wurx,wury));



  check_nomsg(max_ima_cy=cpl_image_get_centroid_y_window(img,wllx,wlly,
                                                         wurx,wury));
     */

    cpl_image_reject_value(img,  CPL_VALUE_NAN);
    if(CPL_ERROR_NONE != irplib_strehl_compute(img,
                    SINFO_STREHL_M1,
                    SINFO_STREHL_M2,
                    lam,
                    dlam,
                    pscale,
                    SINFO_STREHL_BOX_SIZE,
                    max_ima_x,
                    max_ima_y,
                    strehl_star_radius,
                    strehl_bg_r1,
                    strehl_bg_r2,
                    NOISE_HSIZE,
                    NOISE_NSAMPLES,
                    strehl,
                    strehl_err,
                    &star_bkg,
                    &star_peak,
                    &star_flux,
                    &psf_peak,
                    &psf_flux,
                    &bkg_noise)) {


        *strehl=-1;
        *strehl_err=0;
        irplib_error_recover(clean_state,"Problem computing strehl");

    }

    /*
  cpl_msg_info(__func__,"stehl=%f err=%f star_bkg=%f star_peak=%f star_flux=%f",
     *strehl,*strehl_err,star_bkg,star_peak,star_flux);
  cpl_msg_info(__func__,"psf_peak=%f psf_flux=%f bkg_noise=%f",
                         psf_peak,psf_flux,bkg_noise);
     */
    sinfo_free_image(&img);


    return 0;

    cleanup:
    return -1;

}



cpl_table* sinfo_get_encircled_energy(cpl_frameset* sof,
                                      cpl_image* img,
                                      double* fwhm_x,
                                      double* fwhm_y,
                                      cpl_table** qclog_tbl)
{

    cpl_errorstate clean_state = cpl_errorstate_get();

    cpl_image* img_dup=NULL;
    cpl_size max_ima_x=0;
    cpl_size max_ima_y=0;
    int wllx=0;
    int wlly=0;
    int wurx=0;
    int wury=0;
    const double d_mirror = 8.;
    const double factor = 180/PI_NUMB*3600.;
    /*
  double max_ima_cx=0;
  double max_ima_cy=0;
     */
    double norm=0.;
    double xc=0.;
    double yc=0.;
    double sx=0.;
    double sy=0.;

    double flux=0;
    double flux_max=1;
    double pix_scale=0;
    double lam=0.;
    double pscale=0.;
    int dr_difr=0;

    double r=0.;
    double bkg=0.;
    int i=0;
    int ni=0;
    int ir_difr=0;
    int dr=0;
    int rmin=0;

    char band[MAX_NAME_SIZE];
    char spat_res[MAX_NAME_SIZE];

    cpl_table* enc_energy=NULL;
    cpl_frame* frame=NULL;

    int ima_szx=0;
    int ima_szy=0;



    if(NULL != cpl_frameset_find(sof,PRO_COADD_PSF)) {
        frame = cpl_frameset_find(sof,PRO_COADD_PSF);
    } else if(NULL != cpl_frameset_find(sof,PRO_OBS_PSF)) {
        frame = cpl_frameset_find(sof,PRO_OBS_PSF);
    } else if(NULL != cpl_frameset_find(sof,PRO_COADD_STD)) {
        frame = cpl_frameset_find(sof,PRO_COADD_STD);
    } else if(NULL != cpl_frameset_find(sof,PRO_OBS_STD)) {
        frame = cpl_frameset_find(sof,PRO_OBS_STD);
    } else if(NULL != cpl_frameset_find(sof,PRO_COADD_OBJ)) {
        frame = cpl_frameset_find(sof,PRO_COADD_OBJ);
    } else if(NULL != cpl_frameset_find(sof,PRO_OBS_OBJ)) {
        frame = cpl_frameset_find(sof,PRO_OBS_OBJ);
    } else {
        sinfo_msg_error("Frame %s  or %s or  %s  or %s or %s  or %s not found!",
                        PRO_COADD_PSF,PRO_OBS_PSF,
                        PRO_COADD_STD, PRO_OBS_STD,
                        PRO_COADD_OBJ, PRO_OBS_OBJ);
        return NULL;
    }

    sinfo_get_spatial_res(frame,spat_res);
    sinfo_get_band(frame,band);
    pix_scale=atof(spat_res);
    lam=sinfo_get_wave_cent(band);
    /* factor 2 due to change of detector to 2K */
    pscale=0.5*pix_scale;



    dr_difr=factor*1.22*lam*1.e-6/d_mirror/pscale;
    ir_difr=floor(dr_difr+0.5);
    if (pix_scale==0.025) {
        ni=10;
        rmin=ir_difr;
        dr=rmin;
    } else {
        ni=15;
        sinfo_msg_warning("Reset diffraction limit");
        ir_difr=10;
        rmin=1;
        dr=2;
    }

    sinfo_msg("Diffraction limit: %d",ir_difr);

    check_nomsg(img_dup=cpl_image_duplicate(img));
    sinfo_clean_nan(&img_dup);
    check_nomsg(cpl_image_get_maxpos(img_dup,&max_ima_x,&max_ima_y));
    sinfo_free_image(&img_dup);



    check_nomsg(ima_szx=cpl_image_get_size_x(img));
    check_nomsg(ima_szy=cpl_image_get_size_y(img));
    sinfo_check_borders(&max_ima_x,ima_szx,SINFO_STREHL_WINDOW);
    sinfo_check_borders(&max_ima_y,ima_szy,SINFO_STREHL_WINDOW);
    sinfo_get_safe_box(&wllx,&wlly,&wurx,&wury,max_ima_x,max_ima_y,SINFO_PSF_SZ,
                       ima_szx,ima_szy);
    /*
  check_nomsg(max_ima_cx=cpl_image_get_centroid_x_window(img,wllx,wlly,
                                                         wurx,wury));
  check_nomsg(max_ima_cy=cpl_image_get_centroid_y_window(img,wllx,wlly,
                                                         wurx,wury));
     */

    cpl_image_save(img, "bad_image_psf_c.fits",CPL_BPP_IEEE_DOUBLE, NULL, CPL_IO_CREATE);
    sinfo_msg("@@@@ sinfo_get_encircled_energy() max_ima_x[%" CPL_SIZE_FORMAT "] max_ima_y[%" CPL_SIZE_FORMAT "] psf_sz[%d]", max_ima_x,
              max_ima_y,
              SINFO_PSF_SZ);

    if(CPL_ERROR_NONE != cpl_image_fit_gaussian(img,max_ima_x,max_ima_y,
                    SINFO_PSF_SZ,
                    &norm,&xc,&yc,&sx,&sy,
                    fwhm_x,fwhm_y)) {


        irplib_error_recover(clean_state,"Gaussian fit failed");

    }

    check_nomsg(enc_energy = cpl_table_new(ni));
    check_nomsg(cpl_table_new_column(enc_energy,"r_pix", CPL_TYPE_INT));
    check_nomsg(cpl_table_new_column(enc_energy,"r_mas", CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(enc_energy,"r_dif", CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(enc_energy,"abs_energy" , CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(enc_energy,"rel_energy" , CPL_TYPE_DOUBLE));

    /* encircled energy computation */
    check_nomsg(bkg=irplib_strehl_ring_background(img,max_ima_x,max_ima_y,
                    SINFO_BKG_R1,SINFO_BKG_R2,IRPLIB_BG_METHOD_AVER_REJ)) ;
    r=rmin+(ni-1)*dr;
    cpl_image_reject_value(img,  CPL_VALUE_NAN);
    check_nomsg(flux_max=irplib_strehl_disk_flux(img,max_ima_x,max_ima_y,r,bkg));
    r=rmin;

    for(i=0; i<ni; i++)
    {
        check_nomsg(flux=irplib_strehl_disk_flux(img,max_ima_x,max_ima_y,r,bkg));

        check_nomsg(cpl_table_set_int(enc_energy,"r_pix",i,r));
        check_nomsg(cpl_table_set_double(enc_energy,"r_mas",i,r*pscale));
        check_nomsg(cpl_table_set_double(enc_energy,"r_dif",i,r/ir_difr));
        if(!isnan(flux)) {
            check_nomsg(cpl_table_set_double(enc_energy,"abs_energy",i,flux));
        } else {
            check_nomsg(cpl_table_set_double(enc_energy,"abs_energy",i,-999));
        }
        r+=dr;
    }
    /* Because flux may be NAN we compute flux_max in two stages */
    flux_max=cpl_table_get_column_max(enc_energy,"abs_energy");

    r=rmin;
    for(i=0; i<ni; i++)
    {
        check_nomsg(flux=irplib_strehl_disk_flux(img,max_ima_x,max_ima_y,r,bkg));
        if(!isnan(flux)) {
            check_nomsg(cpl_table_set_double(enc_energy,"rel_energy",i,flux/flux_max));
        } else {
            check_nomsg(cpl_table_set_double(enc_energy,"rel_energy",i,1));
        }
        r+=dr;
    }

    //sinfo_msg("max ima=%d %d\n",max_ima_x,max_ima_y);
    //sinfo_msg("centroid ima=%f %f\n",max_ima_cx,max_ima_cy);
    //sinfo_msg("gauss info=%f %f %f %f %f %f %f\n",
    //                         norm,xc,yc,sx,sy,*fwhm_x,*fwhm_y);


    check_nomsg(flux=irplib_strehl_disk_flux(img,max_ima_x,max_ima_y,
                    ir_difr,bkg));
    double enc_en=-999;
    if(!isnan(flux) && !isnan(flux_max)) {
        enc_en=flux/flux_max;
    }
    ck0_nomsg(sinfo_qclog_add_double(*qclog_tbl,"QC ENC CORE",
                    enc_en,
                    "Encircled energy within PSF core","%f"));
    return enc_energy;

    cleanup:
    sinfo_free_image(&img_dup);

    return NULL;
}


static cpl_table* sinfo_get_strehl_from_cube(cpl_imagelist* cube,
                                             char* name,
                                             cpl_frame* frame)
{
    cpl_table* strehl_tbl=NULL;

    double dispersion=0.;
    double centralWave=0.;
    /* double wrange=0; */
    double wstart=0;
    double wstep=0;
    double wend=0;
    double ws=0;
    double we=0;
    double pix_scale=0;
    double lam=0;
    /* double dlam=0; */
    double pscale = 0;

    double strehl_star_radius=0;
    double strehl_bg_r1=0;
    double strehl_bg_r2=0;
    double strehl=0;
    double strehl_err=0;
    char spat_res[MAX_NAME_SIZE];
    cpl_propertylist* plist=NULL;

    /* int naxis3=0; */
    int nsample=0;
    int i=0;


    sinfo_get_spatial_res(frame,spat_res);
    pix_scale=atof(spat_res);
    sinfo_msg("Camera pixel scale=%f",pix_scale);
    /* factor 2 due to change of detector to 2K */
    pscale=0.5*pix_scale;

    strehl_star_radius=SINFO_BKG_R1*pscale;
    strehl_bg_r1=SINFO_BKG_R1*pscale;
    strehl_bg_r2=SINFO_BKG_R2*pscale;

    plist=cpl_propertylist_load(name,0);
    dispersion=sinfo_pfits_get_cdelt3(plist);
    centralWave=sinfo_pfits_get_crval3(plist);
    /* naxis3=sinfo_pfits_get_naxis3(plist); */
    sinfo_free_propertylist(&plist);
    /* wrange=dispersion*naxis3; */

    wstart = centralWave - (float) (cpl_imagelist_get_size(cube) / 2)*
                    dispersion+dispersion;
    wend  =wstart + dispersion * cpl_imagelist_get_size(cube);
    wstep=0.025;
    /*
   note:
    -wstep as we do not hit the borders where the
    sinfo_gaussian fit has a problem
     */
    nsample=(int)((wend-wstart-wstep)/wstep);
    check_nomsg(strehl_tbl = cpl_table_new(nsample));
    check_nomsg(cpl_table_new_column(strehl_tbl,"wavelength",CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(strehl_tbl,"strehl",CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(strehl_tbl,"strehl_error",CPL_TYPE_DOUBLE));


    for(i=1;i<nsample;i++) {

        ws=wstart+wstep*i;
        we=ws+wstep;

        lam = (double)0.5*(ws+we);
        /* dlam=wstep; */

        check(sinfo_get_strehl_from_slice(cube,
                        dispersion,
                        centralWave,
                        ws,
                        we,
                        pscale,
                        strehl_star_radius,
                        strehl_bg_r1,
                        strehl_bg_r2,
                        &strehl,
                        &strehl_err),"Error computing strehl");


        if((isnan(lam) ==0) &&
                        (isnan(lam) ==0) &&
                        (isnan(lam) ==0)) {
            check_nomsg(cpl_table_set_double(strehl_tbl,"wavelength",i,lam));
            check_nomsg(cpl_table_set_double(strehl_tbl,"strehl",i,strehl));
            check_nomsg(cpl_table_set_double(strehl_tbl,"strehl_error",i,
                            strehl_err));

        }
    }

    return strehl_tbl;

    cleanup:
    return NULL;


}


static double
sinfo_get_strehl_from_ima(cpl_image* ima,
                          cpl_frame* frame)
{

    double dispersion=0.;
    double centralWave=0.;
    double wstart=0;
    double wend=0;
    double pscale = 0;

    double strehl_star_radius=0;
    double strehl_bg_r1=0;
    double strehl_bg_r2=0;
    double strehl=0;
    double strehl_err=0;
    double exptime=0;



    ck0_nomsg(sinfo_get_strehl_input1(frame,&dispersion,&centralWave,
                    &wstart,&wend,&pscale,&exptime,
                    &strehl_star_radius,&strehl_bg_r1,
                    &strehl_bg_r2));


    check(sinfo_get_strehl_from_image(ima,
                    wstart,
                    wend,
                    pscale,
                    strehl_star_radius,
                    strehl_bg_r1,
                    strehl_bg_r2,
                    &strehl,
                    &strehl_err),"Computing Strehl");





    cleanup:
    return strehl;


}

static int
sinfo_get_frm12(cpl_frameset* sof,cpl_frame** frm1,cpl_frame** frm2){

    cpl_frameset* obs=NULL;
    int nobs=0;
    float eps=0.0001;
    float* pix_scale=NULL;
    int i=0;
    cpl_frame* frame=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) {
        sinfo_contains_frames_kind(sof,obs,PRO_OBS_OBJ);
        nobs=cpl_frameset_get_size(obs);
    }

    nobs=cpl_frameset_get_size(obs);

    if (nobs < 1) {
        return -1;
    } else {
        pix_scale=cpl_calloc(nobs,sizeof(float));
        for(i=0;i<nobs;i++) {
            frame=cpl_frameset_get_frame(obs,i);
            pix_scale[i]=sinfo_pfits_get_pixelscale(
                            (char*)cpl_frame_get_filename(frame));
            if(fabs(pix_scale[i]-0.025)< eps) {
                *frm1=cpl_frame_duplicate(frame);
            } else if (fabs(pix_scale[i]-0.1) <eps) {
                *frm2=cpl_frame_duplicate(frame);
            } else {
                sinfo_msg_error("No proper frame found for strehl computation");
                return -1;
            }
        }
    }
    cpl_free(pix_scale);
    cpl_frameset_delete(obs);

    return 0;

}




static int
sinfo_get_strehl_input1(cpl_frame* frm,
                        double* dispersion,
                        double* centralWave,
                        double* wstart,
                        double* wend,
                        double* pscale,
                        double* exptime,
                        double* strehl_star_rad,
                        double* strehl_bg_rmin,
                        double* strehl_bg_rmax)

{

    cpl_propertylist* plist=NULL;
    char res[MAX_NAME_SIZE];
    double pix_scale=0;
    double wrange=0;
    char fname[MAX_NAME_SIZE];
    int naxis3=0;

    sinfo_get_spatial_res(frm,res);
    pix_scale=atof(res);

    /* factor 2 due to change of detector to 2K
     *pscale=0.5*pix_scale;
     */


    *pscale=pix_scale;

    *strehl_star_rad=SINFO_RSTAR*(*pscale);
    *strehl_bg_rmin=SINFO_BKG_R1*(*pscale);
    *strehl_bg_rmax=SINFO_BKG_R2*(*pscale);

    strcpy(fname,cpl_frame_get_filename(frm));
    check_nomsg(plist=cpl_propertylist_load(fname,0));
    check_nomsg(*dispersion=sinfo_pfits_get_cdelt3(plist));
    *centralWave=sinfo_pfits_get_crval3(plist);
    check_nomsg(naxis3=sinfo_pfits_get_naxis3(plist));
    *exptime=sinfo_pfits_get_exp_time(plist);
    sinfo_free_propertylist(&plist);

    wrange=(*dispersion)*naxis3;

    *wstart = *centralWave - (wrange / 2) +(*dispersion);
    *wend   = *wstart + wrange;


    cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        return -1;
    } else {
        return 0;
    }

}


static int
sinfo_get_strehl_input2(cpl_frame* frm1,
                        cpl_frame* frm2,
                        double* dispersion,
                        double* centralWave,
                        double* wstart,
                        double* wend,
                        double* pscale1,
                        double* pscale2,
                        double* exptime1,
                        double* exptime2,
                        double* strehl_star_rad1,
                        double* strehl_star_rad2,
                        double* strehl_bg_rmin1,
                        double* strehl_bg_rmin2,
                        double* strehl_bg_rmax1,
                        double* strehl_bg_rmax2)

{

    cpl_propertylist* plist=NULL;
    char res1[MAX_NAME_SIZE];
    char res2[MAX_NAME_SIZE];
    double pix_scale1=0;
    double pix_scale2=0;
    double wrange=0;
    char fname1[MAX_NAME_SIZE];
    char fname2[MAX_NAME_SIZE];
    int naxis3=0;

    sinfo_get_spatial_res(frm1,res1);
    sinfo_get_spatial_res(frm2,res2);
    pix_scale1=atof(res1);
    pix_scale2=atof(res2);
    /* factor 2 due to change of detector to 2K
     *pscale1=0.5*pix_scale1;
     *pscale2=0.5*pix_scale2;
     */

    *pscale1=pix_scale1;
    *pscale2=pix_scale2;


    *strehl_star_rad1=SINFO_RSTAR*(*pscale1);
    *strehl_bg_rmin1=SINFO_BKG_R1*(*pscale1);
    *strehl_bg_rmax1=SINFO_BKG_R2*(*pscale1);

    *strehl_star_rad2=SINFO_RSTAR*(*pscale2);
    *strehl_bg_rmin2=SINFO_BKG_R1*(*pscale2);
    *strehl_bg_rmax2=SINFO_BKG_R2*(*pscale2);

    strcpy(fname1,cpl_frame_get_filename(frm1));
    check_nomsg(plist=cpl_propertylist_load(fname1,0));
    check_nomsg(*dispersion=sinfo_pfits_get_cdelt3(plist));
    *centralWave=sinfo_pfits_get_crval3(plist);
    check_nomsg(naxis3=sinfo_pfits_get_naxis3(plist));
    *exptime1=sinfo_pfits_get_exp_time(plist);
    sinfo_free_propertylist(&plist);
    strcpy(fname2,cpl_frame_get_filename(frm2));


    check_nomsg(plist=cpl_propertylist_load(fname2,0));
    *exptime2=sinfo_pfits_get_exp_time(plist);
    sinfo_free_propertylist(&plist);



    wrange=(*dispersion)*naxis3;

    *wstart = *centralWave - (wrange / 2) +(*dispersion);
    *wend   = *wstart + wrange;


    cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        return -1;
    } else {
        return 0;
    }

}



static cpl_table*
sinfo_get_strehl_from_2images(cpl_image* ima1,
                              cpl_image* ima2,
                              cpl_frame* frm1,
                              cpl_frame* frm2)
{

    cpl_table* strehl_tbl=NULL;


    double dispersion=0.;
    double centralWave=0.;
    double wstart=0;
    double wstep=0;
    double wend=0;
    double lam=0;
    double dlam=0;
    double pscale1 = 0;
    double pscale2 = 0;

    double strehl_star_rad1=0;
    double strehl_star_rad2=0;
    double strehl_bg_rmin1=0;
    double strehl_bg_rmin2=0;
    double strehl_bg_rmax1=0;
    double strehl_bg_rmax2=0;
    double strehl=0;
    double strehl_err=0;

    int nsample=1;
    double exptime1=0;
    double exptime2=0;
    cpl_image* img_dup=NULL;

    cpl_size max_ima1_x=0;
    cpl_size max_ima1_y=0;

    cpl_size max_ima2_x=0;


    cpl_size max_ima2_y=0;
    double star_bkg=0;
    double star_peak=0;
    double star_flux=0;

    double psf_peak=0;
    double psf_flux=0;
    double bkg_noise=0;

    cpl_errorstate clean_state = cpl_errorstate_get();

    ck0_nomsg(sinfo_get_strehl_input2(frm1,frm2,&dispersion, &centralWave,
                    &wstart,&wend,&pscale1,&pscale2,
                    &exptime1,&exptime2,
                    &strehl_star_rad1,&strehl_star_rad2,
                    &strehl_bg_rmin1,&strehl_bg_rmin2,
                    &strehl_bg_rmax1,&strehl_bg_rmax2));





    check_nomsg(img_dup=cpl_image_duplicate(ima1));
    sinfo_clean_nan(&img_dup);
    check_nomsg(cpl_image_get_maxpos(img_dup,&max_ima1_x,&max_ima1_y));
    sinfo_free_image(&img_dup);


    check_nomsg(img_dup=cpl_image_duplicate(ima2));
    sinfo_clean_nan(&img_dup);
    check_nomsg(cpl_image_get_maxpos(img_dup,&max_ima2_x,&max_ima2_y));
    sinfo_free_image(&img_dup);

    /*
     note:
     -wstep as we do not hit the borders where the
     sinfo_gaussian fit has a problem
     */



    check_nomsg(strehl_tbl = cpl_table_new(nsample));
    check_nomsg(cpl_table_new_column(strehl_tbl,"wavelength",CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(strehl_tbl,"strehl",CPL_TYPE_DOUBLE));
    check_nomsg(cpl_table_new_column(strehl_tbl,"strehl_error",CPL_TYPE_DOUBLE));
    wstep  = wend-wstart;



    lam = (double)0.5*(wstart+wend);
    dlam=wstep;
    sinfo_msg("lambda=%f dlambda=%f",lam,dlam);
    sinfo_msg("wstart=%f wend=%f",wstart,wend);
    sinfo_msg("wstep=%f",wstep);


    if(CPL_ERROR_NONE != sinfo_strehl_compute_two(ima1,ima2,
                    SINFO_STREHL_M1,SINFO_STREHL_M2,
                    lam,
                    pscale1,pscale2,
                    exptime1,exptime2,
                    max_ima1_x,max_ima1_y,
                    max_ima2_x,max_ima2_y,
                    strehl_star_rad1,
                    strehl_bg_rmin1,
                    strehl_bg_rmax1,
                    &strehl,&strehl_err,&star_bkg,
                    &star_peak,&star_flux,
                    &psf_peak,&psf_flux,&bkg_noise))
    {

        strehl=-1;
        strehl_err=0;
        irplib_error_recover(clean_state,
                             "Problem computing strehl, set it to -1");

    }


    if((isnan(lam) ==0) &&
                    (isnan(lam) ==0) &&
                    (isnan(lam) ==0)) {
        check_nomsg(cpl_table_set_double(strehl_tbl,"wavelength",0,lam));
        check_nomsg(cpl_table_set_double(strehl_tbl,"strehl",0,strehl));
        check_nomsg(cpl_table_set_double(strehl_tbl,"strehl_error",
                        0,strehl_err));

    }



    return strehl_tbl;
    cleanup:


    return NULL;
}



/*---------------------------------------------------------------------------*/
/**
  @brief    Compute the strehl ratio in an image
  @param    im1            Image with pixel-type float (pick computation)
  @param    im2            Image with pixel-type float (flux,bkg computation)
  @param    m1             Diameter of the M1 mirror [m]
  @param    m2             Diameter of the M2 mirror [m]
  @param    lam            Central wavelength [micron]
  @param    dlam           Filter bandwidth [micron]
  @param    pscale1        Positive pixel scale (of image for pick comput.)
  @param    pscale2        Positive pixel scale (of image for flux,bkg comput.)
  @param    exptime1       Exposure time (of image for pick comput.)
  @param    exptime2       Exposure time (of image for flux,bkg comput.)
  @param    size           Size of image to be used for internal PSF
  @param    xpos1          The x position of the ring center
  @param    ypos1          The y position of the ring center
  @param    xpos2          The x position of the ring center
  @param    ypos2          The y position of the ring center
  @param    r1             The Star Radius, r1 > 0
  @param    r2             The Internal Radius, r2 > 0
  @param    r3             The External Radius, r3 > r2
  @param    noise_box_sz   Pass -1 for default values
  @param    noise_nsamples Pass -1 for default values
  @param    strehl         Pointer to the Strehl Error (positive on success)
  @param    strehl_err     Pointer to the Strehl Error (non-negative on success)
  @param    star_bkg        Pointer to the Star Background
  @param    star_peak      Pointer to the Star Peak (positive on success)
  @param    star_flux      Pointer to the Star Flux (positive on success)
  @param    psf_peak       Pointer to the PSF Peak (positive on success)
  @param    psf_flux       Pointer to the PSF Flux (1 on success)
  @param    bg_noise       Pointer to the Background Noise
  @return   0 iff ok
  @note     The output is undefined on error. On success the Strehl Ratio may
            exceed 1 (e.g. 1.7).
 */
/*---------------------------------------------------------------------------*/
#define irplib_assure_code cpl_ensure_code
int sinfo_strehl_compute_two(
                const cpl_image *   im1,
                const cpl_image *   im2,
                double              m1,
                double              m2,
                double              lam,
                double              pscale1,
                double              pscale2,
                double              exptime1,
                double              exptime2,
                int                 xpos1,
                int                 ypos1,
                int                 xpos2,
                int                 ypos2,
                double              r1,
                double              r2,
                double              r3,
                double          *   strehl,
                double          *   strehl_err,
                double          *   star_bkg,
                double          *   star_peak,
                double          *   star_flux,
                double          *   psf_peak,
                double          *   psf_flux,
                double          *   bg_noise)
{
    double psf_peak1=0;
    double psf_peak2=0;
    /*
    double psf_flux1=0;
    double psf_flux2=0;
     */
    double star_bkg1=0;
    double star_bkg2=0;
    double star_flux1=0;
    double star_flux2=0;
    double star_peak1=0;
    double star_peak2=0;

    const double   window_size = 5.0 ;
    //double         star_radius;
    //double         max_radius ;
    double       ring[4];

    double prat=pscale2/pscale1;
    double prat2=prat*prat;
    double trat=exptime1/exptime2;
    double frat=sinfo_scale_flux(pscale1,pscale2,exptime1,exptime2);
    double xc=0;
    double yc=0;
    /*
    int sx=0;
    int sy=0;
     */
    int d=16;
    cpl_errorstate initial_errorstate = cpl_errorstate_get();


    /* Test inputs */
    irplib_assure_code(im1 != NULL,         CPL_ERROR_NULL_INPUT);
    irplib_assure_code(im2 != NULL,         CPL_ERROR_NULL_INPUT);
    irplib_assure_code(strehl != NULL,     CPL_ERROR_NULL_INPUT);
    irplib_assure_code(strehl_err != NULL, CPL_ERROR_NULL_INPUT);
    irplib_assure_code(star_bkg != NULL,    CPL_ERROR_NULL_INPUT);
    irplib_assure_code(star_peak != NULL,  CPL_ERROR_NULL_INPUT);
    irplib_assure_code(star_flux != NULL,  CPL_ERROR_NULL_INPUT);
    irplib_assure_code(psf_peak != NULL,   CPL_ERROR_NULL_INPUT);
    irplib_assure_code(psf_flux != NULL,   CPL_ERROR_NULL_INPUT);

    irplib_assure_code(pscale1 > 0.0,      CPL_ERROR_ILLEGAL_INPUT);
    irplib_assure_code(pscale2 > 0.0,      CPL_ERROR_ILLEGAL_INPUT);

    irplib_assure_code(xpos1-window_size > 0, CPL_ERROR_ACCESS_OUT_OF_RANGE);
    irplib_assure_code(ypos1-window_size > 0, CPL_ERROR_ACCESS_OUT_OF_RANGE);
    irplib_assure_code(xpos2-window_size > 0, CPL_ERROR_ACCESS_OUT_OF_RANGE);
    irplib_assure_code(ypos2-window_size > 0, CPL_ERROR_ACCESS_OUT_OF_RANGE);

    irplib_assure_code(xpos1+window_size <= cpl_image_get_size_x(im1),
                       CPL_ERROR_ACCESS_OUT_OF_RANGE);
    irplib_assure_code(ypos1+window_size <= cpl_image_get_size_y(im1),
                       CPL_ERROR_ACCESS_OUT_OF_RANGE);

    irplib_assure_code(xpos2+window_size <= cpl_image_get_size_x(im2),
                       CPL_ERROR_ACCESS_OUT_OF_RANGE);
    irplib_assure_code(ypos2+window_size <= cpl_image_get_size_y(im2),
                       CPL_ERROR_ACCESS_OUT_OF_RANGE);

    irplib_assure_code(r1 > 0.0,      CPL_ERROR_ILLEGAL_INPUT);
    irplib_assure_code(r2 > 0.0,      CPL_ERROR_ILLEGAL_INPUT);
    irplib_assure_code(r3 > r2,       CPL_ERROR_ILLEGAL_INPUT);

    /* Computing a Strehl ratio is a story between an ideal PSF */
    /* and a candidate image supposed to approximate this ideal PSF. */

    /* Generate first appropriate PSF to find max peak: same pscale as
       the one of the image where we compute the flux */

    /*
    sx=cpl_image_get_size_x(im1);
    sy=cpl_image_get_size_y(im1);
     */

    /* psf_flux1 = 1.0; // The psf flux, cpl_image_get_flux(psf), is always 1 */
    /* psf_flux2 = 1.0; // The psf flux, cpl_image_get_flux(psf), is always 1 */
    *psf_flux=1.0;
    ring[0] = xpos2;
    ring[1] = ypos2;
    ring[2] = r2/pscale2;
    ring[3] = r3/pscale2;

    sinfo_msg_debug("star_pos=%d %d %d %d",xpos1,ypos1,xpos2,ypos2);
    sinfo_msg_debug("star_ring=%f %f %f %f",ring[0],ring[1],ring[2],ring[3]);

    /* Compute star_radius in pixels */
    //star_radius = r1/pscale2;

    /* Find the peak value on the central part of the candidate image */


    /* Find the peak value on the central part of the candidate image */
    //max_radius = window_size < star_radius ? window_size : star_radius;

    check_nomsg(sinfo_get_star_features(im1,d,xpos1,ypos1,&xc,&yc,
                    &star_peak1,&star_flux1,&star_bkg1));


    *star_peak=star_peak1;

    check_nomsg(sinfo_compute_psf(m1,m2/m1,lam*1.e-6,pscale1,xc,yc,1.,
                    &psf_peak1));

    check_nomsg(sinfo_get_star_features(im2,d,xpos2,ypos2,&xc,&yc,
                    &star_peak2,&star_flux2,&star_bkg2));

    *star_flux=star_flux2;
    *star_bkg=star_bkg2;

    check_nomsg(sinfo_compute_psf(m1,m2/m1,lam*1.e-6,pscale2,xc,yc,1.,
                    &psf_peak2));




    sinfo_msg_debug("p1=%g p2=%g",*star_peak,star_peak2);
    sinfo_msg_debug("corr peak: p1=%g p2=%g",*star_peak,star_peak2/frat);
    sinfo_msg_debug("corr bkg: bkg1=%g bkg2=%g",star_bkg1/frat,*star_bkg);
    sinfo_msg_debug("rel diff: %g",
                    fabs(star_peak2/frat- *star_peak)/(star_peak2/frat));



    sinfo_msg_debug("Rescaled star_flux1=%g star_flux2=%g",
                    star_flux1*trat,*star_flux);

    //Check that flux value as measured on im1 and on 1m2 are close one
    //to another. Note that flux1, measured on im1, need to be rescaled
    //by exposure time to match to flux2=star_flux
    if ( fabs((star_flux1*frat-*star_flux)/(*star_flux)) > 0.25) {
        sinfo_msg_debug("Star flux rel diff: %g",
                        fabs((star_flux1*frat-*star_flux)/(*star_flux)));
    }

    //Check that pick value as measured on im1 and on 1m2 are close one
    //to another. Note that peak2, measured on im2, need to be rescaled
    //by exposure time and pixel scale to match to peak1=star_peak
    if ( fabs(star_peak2-star_peak1*frat)/(star_peak2) > 0.25) {
        sinfo_msg_debug("Star pick rel diff: %g",
                        fabs(star_peak2-star_peak1*frat)/(star_peak2));
    }
    sinfo_msg_debug("ak1 star peak=%g",*star_peak);
    irplib_assure_code(*star_peak > 0.0,      CPL_ERROR_ILLEGAL_OUTPUT);
    *star_peak=star_peak1;

    *star_bkg=star_bkg2;
    *star_flux=star_flux2;

    sinfo_msg_debug("ak2");

    //psf1 = irplib_strehl_generate_psf(m1, m2, lam, dlam, pscale1, size*4);
    //psf_peak1 = cpl_image_get_max(psf1) ;



    /* Compute Strehl */
    //*strehl = (*star_peak *prat2/trat/ *star_flux) / (*psf_peak / *psf_flux);
    *strehl = (*star_peak/(*star_flux*trat)) / (psf_peak1 );
    //*strehl = (*star_peak/(*star_flux)) / (psf_peak1 / *psf_flux) ;
    sinfo_msg_debug("peak=%g flux1=%f flux2=%f flux=%f cflux=%g "
                    "fct=%g psf_peak=%g",
                    *star_peak,star_flux1,star_flux2,*star_flux,
                    *star_flux/frat*prat2,prat2/frat,psf_peak1);
    sinfo_msg_debug("=======strehl=%g",*strehl);
    /*
    if (*strehl > 1)
        cpl_msg_warning(cpl_func, "Extreme Strehl-ratio=%g, star_peak=%g, "
                        "star_flux=%g, psf_peak=%g, psf_flux=%g", *strehl,
     *star_peak, *star_flux, *psf_peak, *psf_flux);


    // Compute Strehl error
    if (cpl_flux_get_noise_ring(im2, ring, noise_box_sz, noise_nsamples,
                                bg_noise, NULL) == CPL_ERROR_NONE) {
     *strehl_err = SINFO_STREHL_ERROR_COEFFICIENT * (*bg_noise) * pscale2 *
            star_radius * star_radius / *star_flux;
        irplib_assure_code(*strehl_err >= 0.0,       CPL_ERROR_ILLEGAL_OUTPUT);
    } else {
      sinfo_msg_warning("Problem computing noise");
    }
     */
    *bg_noise=0;

    cleanup:


    if (!cpl_errorstate_is_equal(initial_errorstate)) {
        /* Dump the error history since recipe execution start.
           At this point the recipe cannot recover from the error */
        cpl_errorstate_dump(initial_errorstate, CPL_FALSE, NULL);
    }

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

}




static cpl_error_code
sinfo_get_star_features(const cpl_image* im,
                        const int radius,
                        const int xpos,
                        const int ypos,
                        double* xc,
                        double* yc,
                        double* peak,
                        double* flux,
                        double* bkg)
{
    int sx=0;
    int sy=0;
    int ixm=0;
    int iym=0;
    int llx=0;
    int lly=0;
    int urx=0;
    int ury=0;
    int dim_new=0;
    double kappa=2;
    double xm=0;
    double ym=0;
    double bkg_stdev=0;
    int bkg_sx=SINFO_BKG_BOX_SZ;
    int bkg_sy=SINFO_BKG_BOX_SZ;

    cpl_bivector* iqe=NULL;
    double* piqe=NULL;
    cpl_image* im_new=NULL;

    sx=cpl_image_get_size_x(im);
    sy=cpl_image_get_size_y(im);

    sinfo_msg_debug("star_radius=%d",radius);
    //We find the image centroid
    if(NULL != (iqe=cpl_image_iqe(im,sx/2-radius,sy/2-radius,
                    sx/2+radius,sy/2+radius))) {


        piqe=cpl_bivector_get_x_data(iqe);
        //*star_peak=piqe[5];
        xm=piqe[0];
        ym=piqe[1];
        //Extract a square sub-image of minimal size not to hit the image borders
        //centered on the previous image centroid
        sinfo_msg_debug("Max ima: %g %g",xm,ym);
        sinfo_msg_debug("Find min of: %g %g %g %g",xm,sx-xm,ym,sy-ym);
        ixm=floor(xm);
        iym=floor(ym);
        sinfo_msg_debug("ixm=%d iym=%d",ixm,iym);
        dim_new=floor(sinfo_find_min_of_four(xm,sx-xm,ym,sy-ym));
        sinfo_msg_debug("dim_new=%d",dim_new);
        llx=(ixm-dim_new > 1) ? ixm-dim_new : 1;
        lly=(iym-dim_new > 1) ? iym-dim_new : 1;
        urx=(ixm+dim_new < sx) ? ixm+dim_new : sx;
        ury=(iym+dim_new < sy) ? iym+dim_new : sy;
        sinfo_msg_debug("llx=%d lly=%d urx=%d ury=%d",llx,lly,urx,ury);
        check_nomsg(im_new=cpl_image_extract(im,llx,lly,urx,ury));

        //compute the background of this last image
        check_nomsg(sinfo_get_bkg_4corners(im_new,bkg_sx,bkg_sy,bkg,&bkg_stdev));



        sinfo_free_bivector(&iqe);

        //Determine the image pick on the new coordinate system
        iqe=cpl_image_iqe(im_new,dim_new-radius,dim_new-radius,
                        dim_new+radius,dim_new+radius);
        piqe=cpl_bivector_get_x_data(iqe);
        sinfo_msg_debug("xc=%g yc=%g",piqe[0],piqe[1]);
        *xc=piqe[0]-dim_new-1;
        *yc=piqe[1]-dim_new-1;


        sinfo_msg_debug("xc=%g yc=%g",*xc,*yc);
        //*peak=piqe[5];
        *peak=cpl_image_get_max_window(im_new,dim_new-radius,dim_new-radius,
                        dim_new+radius,dim_new+radius);

        sinfo_get_flux_above_bkg(im_new,kappa,bkg_stdev,flux);
        *peak -= (*bkg);
        sinfo_msg_debug("star peak=%g bkg=%g",*peak,*bkg);


        sinfo_free_bivector(&iqe);


    } else {
        sinfo_msg_warning("IQE fit failed");
        cpl_error_reset();
        sinfo_msg_debug("xc=%d yc=%d radius=%d",xpos,ypos,radius);
        *xc=xpos-sx/2;
        *yc=ypos-sy/2;
        sinfo_msg_debug("xc=%g yc=%g",*xc,*yc);
        check_nomsg(sinfo_get_bkg_4corners(im,bkg_sx,bkg_sy,bkg,&bkg_stdev));
        check_nomsg(sinfo_get_safe_box(&llx, &lly, &urx, &ury, xpos,ypos,radius,
                        64,64));
        check_nomsg(*peak=cpl_image_get_max_window(im,llx,lly,urx,ury)-(*bkg));
        sinfo_get_flux_above_bkg(im,kappa,bkg_stdev,flux);
        sinfo_msg_debug("star peak=%g bkg=%g",*peak,*bkg);


    }



    cleanup:
    sinfo_free_image(&im_new);
    sinfo_free_bivector(&iqe);




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

}






/*----------------------------------------------------------------------------*/
/**
  @brief    Compute the strehl ratio in an image
  @param    im             Image with pixel-type float
  @param    m1             Diameter of the M1 mirror [m]
  @param    m2             Diameter of the M2 mirror [m]
  @param    lam            Central wavelength [micron]
  @param    dlam           Filter bandwidth [micron]
  @param    pscale         Positive pixel scale
  @param    size           Size of image to be used for internal PSF
  @param    xpos           The x position of the ring center
  @param    ypos           The y position of the ring center
  @param    r1             The Star Radius, r1 > 0
  @param    r2             The Internal Radius, r2 > 0
  @param    r3             The External Radius, r3 > r2
  @param    strehl         Pointer to the Strehl Error (positive on success)
  @param    strehl_err     Pointer to the Strehl Error (non-negative on success)
  @param    star_bkg        Pointer to the Star Background
  @param    star_peak      Pointer to the Star Peak (positive on success)
  @param    star_flux      Pointer to the Star Flux (positive on success)
  @param    psf_peak       Pointer to the PSF Peak (positive on success)
  @param    psf_flux       Pointer to the PSF Flux (1 on success)
  @param    bg_noise       Pointer to the Background Noise
  @return   0 iff ok
  @note     The output is undefined on error. On success the Strehl Ratio may
            exceed 1.
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
sinfo_strehl_compute_one(const cpl_image *   im,
                         double              m1,
                         double              m2,
                         double              lam,
                         double              dlam,
                         double              pscale,
                         int                 xpos,
                         int                 ypos,
                         double              r1,
                         double              r2,
                         double              r3,
                         int                 size,
                         double          *   strehl,
                         double          *   strehl_err,
                         double          *   star_bkg,
                         double          *   star_peak,
                         double          *   star_flux,
                         double          *   psf_peak,
                         double          *   psf_flux,
                         double          *   bg_noise)
{
    cpl_image  * psf;
    /* double       star_radius; */

    /* FIXME: Arbitrary choice of image border */
    const double window_size = (double)(SINFO_STREHL_RAD_CENTRAL);

    /* Determined empirically by C. Lidman for Strehl error computation */
    //Commented as not used
    //const double strehl_error_coefficient = SINFO_MATH_PI * 0.007 / 0.0271;

    /* double       ring[4]; */

    cpl_bivector* iqe1=NULL;
    double xc=0;
    double yc=0;
    int d=16;



    /* Check compile-time constant */
    cpl_ensure_code(window_size > 0.0,  CPL_ERROR_ILLEGAL_INPUT);

    /* Test inputs */
    cpl_ensure_code(im != NULL,         CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(strehl != NULL,     CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(strehl_err != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(star_bkg != NULL,    CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(star_peak != NULL,  CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(star_flux != NULL,  CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(psf_peak != NULL,   CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(psf_flux != NULL,   CPL_ERROR_NULL_INPUT);

    cpl_ensure_code(pscale > 0.0,      CPL_ERROR_ILLEGAL_INPUT);


    cpl_ensure_code(r1 > 0.0,      CPL_ERROR_ILLEGAL_INPUT);
    cpl_ensure_code(r2 > 0.0,      CPL_ERROR_ILLEGAL_INPUT);

    cpl_ensure_code(r3 > r2,       CPL_ERROR_ILLEGAL_INPUT);


    /* Computing a Strehl ratio is a story between an ideal PSF */
    check_nomsg(sinfo_compute_psf(m1,m2/m1,lam*1.e-6,pscale,xc,yc,
                    1.,psf_peak));
    /* and a candidate image supposed to approximate this ideal PSF. */

    /* Generate first appropriate PSF to find max peak */

    psf = irplib_strehl_generate_psf(m1, m2, lam, dlam, pscale, size);
    cpl_ensure_code(psf != NULL,      CPL_ERROR_ILLEGAL_OUTPUT);

    /* Compute flux in PSF and find max peak */
    *psf_peak = cpl_image_get_max(psf);

    cpl_image_delete(psf);




    cpl_ensure( *psf_peak > 0.0, CPL_ERROR_ILLEGAL_OUTPUT,CPL_ERROR_ILLEGAL_OUTPUT); /* The ideal PSF has a positive maximum */
    *psf_flux = 1.0; /* The psf flux, cpl_image_get_flux(psf), is always 1 */


    /* Compute star_radius in pixels */
    /*star_radius = r1/pscale; */


    check_nomsg(sinfo_get_star_features(im,d,xpos,ypos,&xc,&yc,
                    star_peak,star_flux,star_bkg));


    check_nomsg(sinfo_compute_psf(m1,m2/m1,lam*1.e-6,pscale,xc,yc,1.,psf_peak));



    *star_peak -= *star_bkg;


    cpl_ensure_code(*star_peak > 0.0,      CPL_ERROR_ILLEGAL_OUTPUT);


    /* Compute Strehl */
    /* (StarPeak / StarFlux) / (PsfPeak / PsfFlux) */
    sinfo_msg_debug("Star flux=%g", *star_flux);
    sinfo_msg_debug("Star peak=%g", *star_peak);
    sinfo_msg_debug("PSF  flux=%g", *psf_flux);
    sinfo_msg_debug("PSF  peak=%g", *psf_peak);

    *strehl = (*star_peak * *psf_flux ) / ( *star_flux * *psf_peak);



    if (*strehl > 1)
        cpl_msg_warning(cpl_func, "Extreme Strehl-ratio=%g, star_peak=%g, "
                        "star_flux=%g, psf_peak=%g, psf_flux=%g", *strehl,
                        *star_peak, *star_flux, *psf_peak, *psf_flux);

    /* Compute Strehl error */
    /*
    ring[0] = xpos;
    ring[1] = ypos;
    ring[2] = r2/pscale;
    ring[3] = r3/pscale;
     */
    /*
     *strehl_err = strehl_error_coefficient * (*bg_noise) * pscale *
        star_radius * star_radius / *star_flux;

    // This check should not be able to fail, but just to be sure
    cpl_ensure_code(*strehl_err >= 0.0,       CPL_ERROR_ILLEGAL_OUTPUT);
     */
    *bg_noise=0;


    cleanup:
    sinfo_free_bivector(&iqe1);
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        return cpl_error_get_code();
    } else {
        return CPL_ERROR_NONE;
    }


}



static void
sinfo_check_borders(cpl_size* val,const int max,const int thresh)
{

    *val = ((*val-thresh) > 0) ? *val : thresh;
    *val = ((*val+thresh) < max) ? *val : max-thresh-1;
    return;
}

static void
sinfo_get_safe_box(int* llx,
                   int* lly,
                   int* urx,
                   int* ury,
                   const int xpos,
                   const int ypos,
                   const int box,
                   const int szx,
                   const int szy)

{
    *llx= ((xpos-box)>0)   ? (xpos-box) : 1;
    *lly= ((ypos-box)>0)   ? (ypos-box) : 1;
    *urx= ((xpos+box)<szx) ? (xpos+box) : szx-1 ;
    *ury= ((ypos+box)<szy) ? (ypos+box) : szy-1 ;

    return;
}





/*---------------------------------------------------------------------------*/
/**
 * @brief  Computes bkg from image
 * @param  img      input image
 * @param  bkg_sx   x size bkg corner window
 * @param  bkg_sy   y size bkg corner window
 * @param  bkg      background value
 * @param  std      std deviation value of background image 
 * @return background value as median of pixels in 4 image's corners
 */
/*---------------------------------------------------------------------------*/
cpl_error_code
sinfo_get_bkg_4corners(const cpl_image *img,
                       const int bkg_sx,
                       const int bkg_sy,
                       double* bkg,
                       double* std)
{

    int sx=0;
    int sy=0;
    cpl_image* img_bkg=NULL;
    *bkg=0;

    cknull(img,"NULL input image!");
    check_nomsg(sx=cpl_image_get_size_x(img));
    check_nomsg(sy=cpl_image_get_size_y(img));

    check_nomsg(img_bkg=cpl_image_new(2*bkg_sx,2*bkg_sy,CPL_TYPE_FLOAT));
    cpl_image* img_ext;
    img_ext=cpl_image_extract(img,1,1,bkg_sx,bkg_sy);
    check_nomsg(cpl_image_copy(img_bkg,img_ext,1,1));
    sinfo_free_image(&img_ext);

    img_ext=cpl_image_extract(img,sx-bkg_sx,1, sx,bkg_sy);
    check_nomsg(cpl_image_copy(img_bkg,img_ext,bkg_sx+1,1));
    sinfo_free_image(&img_ext);

    img_ext=cpl_image_extract(img,1,sy-bkg_sy,bkg_sx,sy);
    check_nomsg(cpl_image_copy(img_bkg,img_ext,1,bkg_sy+1));
    sinfo_free_image(&img_ext);

    img_ext=cpl_image_extract(img,sx-bkg_sx,sy-bkg_sy,sx,sy);
    check_nomsg(cpl_image_copy(img_bkg,img_ext,bkg_sx+1,bkg_sy+1));
    sinfo_free_image(&img_ext);

    check_nomsg(*bkg=cpl_image_get_median(img_bkg));
    check_nomsg(*std=cpl_image_get_stdev(img_bkg));
    sinfo_msg_debug("sky bkg: %f",*bkg);
    sinfo_msg_debug("sky stdev: %f",*std);


    cleanup:
    sinfo_free_image(&img_bkg);

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


}

/**
 * @brief computes theoretical PSF compuatation
 * @param  dia      telescope diameter [m]
 * @param  occ      telescope occulter size [% (of dia)]
 * @param  lambda   wavelength [m]
 * @param  psize    pixel size ["]
 * @param  cx psf x offset     [pix]
 * @param  cy psf y offset     [pix]
 * @param  anamorph anamorphysm (y/x)
 * @param  psf_peak theoretical PFS peak
 * @return error status
 */
/*---------------------------------------------------------------------------*/
cpl_error_code
sinfo_compute_psf(const double dia,
                  const double occ,
                  const double lambda,
                  const double psize,
                  const double cx,
                  const double cy,
                  const double anamorph,
                  double* psf_peak)
{

    int bin=SINFO_PSF_BIN;
    int npoints=SINFO_PSF_NPOINT;

    int dim=SINFO_PSF_DIM;
    int blocks=SINFO_PSF_BLOCKS;
    int sx=dim;
    int sy=dim;


    int i=0;
    int j=0;
    double k=0;

    int ii=0;
    int jj=0;
    int start=0;

    double nyquist=lambda/dia/2.*206265/psize*bin;
    double cor=0.;
    double v0=0;
    double ll[npoints];
    double part[npoints];
    double ee;
    double dll=0;
    double tot1=0;
    double tot2=0;


    double fct=0;

    double* pxx=NULL;
    double* pyy=NULL;
    double* prr=NULL;
    double* ppsf0=NULL;

    double* pcor=NULL;
    double* pairy=NULL;
    /* double* pw=NULL; */

    cpl_image* img_xx=NULL;
    cpl_image* img_yy=NULL;
    cpl_image* img_rr=NULL;
    cpl_image* img_rrcor=NULL;
    cpl_image* img_airy=NULL;
    cpl_image* img_w=NULL;
    cpl_image* img_psf0=NULL;



    sinfo_msg_debug("lambda=%g",lambda);
    sinfo_msg_debug("dia=%f",dia);
    sinfo_msg_debug("psize=%f",psize);
    sinfo_msg_debug("bin=%d",bin);
    sinfo_msg_debug("nyquist=%f",nyquist);

    check_nomsg(img_xx=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE));
    img_yy=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
    img_rr=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
    //img_rrcor=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);

    pxx=cpl_image_get_data_double(img_xx);
    pyy=cpl_image_get_data_double(img_yy);
    prr=cpl_image_get_data_double(img_rr);

    for(j=0;j<sy;j++) {
        for(i=0;i<sx;i++) {
            //xz plane increasing along y
            pxx[j*sx+i]=(i-sx/2-cx*bin)/nyquist*SINFO_MATH_PI/2;
            //yz plane increasing along x
            pyy[j*sx+i]=(j-sy/2-cy*bin)/nyquist*SINFO_MATH_PI/2*anamorph;

            //combinex xyz surface
            prr[j*sx+i]=sqrt(pxx[j*sx+i]*pxx[j*sx+i]+pyy[j*sx+i]*pyy[j*sx+i]);
        }
    }

    /*
  check_nomsg(cpl_image_save(img_xx,"out_xx.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

  check_nomsg(cpl_image_save(img_yy,"out_yy.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

  check_nomsg(cpl_image_save(img_rr,"out_rr.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

     */

    //img_rrcor=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);

    cor=1./(1.-occ*occ);
    cor*=cor;

    img_rrcor=cpl_image_duplicate(img_rr);
    cpl_image_multiply_scalar(img_rrcor,cor);
    pcor=cpl_image_get_data_double(img_rrcor);

    /*
  check_nomsg(cpl_image_save(img_rrcor,"out_rrcor.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));
     */

    img_airy=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
    pairy=cpl_image_get_data_double(img_airy);


    if (occ == 0.0) {

        for(j=0;j<sx;j++) {
            for(i=0;i<sy;i++) {
                fct=(2.*j1(prr[j*sx+i])/prr[j*sx+i]);
                pairy[j*sx+i]=fct*fct;

            }
        }

    } else {
        for(j=0;j<sy;j++) {
            for(i=0;i<sx;i++) {

                fct=(2.*j1(prr[j*sx+i])/prr[j*sx+i]-occ*occ*2.*j1(pcor[j*sx+i])/pcor[j*sx+i]);
                pairy[j*sx+i]=cor*fct*fct;

            }
        }
    }

    /*
  check_nomsg(cpl_image_save(img_airy,"out_airy.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

     */

    //To remove an expected NAN value at the PSF centre we re-set PSF(centre)=1
    img_w=cpl_image_duplicate(img_airy);
    /* pw=cpl_image_get_data_double(img_w); */
    pairy=cpl_image_get_data_double(img_airy);

    for(j=0;j<sy;j++) {
        for(i=0;i<sx;i++) {
            if(!irplib_isnan(pairy[i+j*sx]) && (pairy[i+j*sx] ==0)) {
                pairy[i+j*sx]=1.;
                sinfo_msg_debug("====> %f",pairy[i+j*sx]);
            }
        }
    }
    pairy[sx/2+sy/2*sx]=1.;

    sinfo_msg_debug("total-airy=%f",cpl_image_get_flux(img_airy));

    /*
  check_nomsg(cpl_image_save(img_airy,"out_airy1.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

     */


    // Computation of EE


    v0=prr[0+dim/4-1];
    sinfo_msg_debug("v0=%12.10g",v0);
    for(i=0;i<npoints;i++) {
        ll[i]=(double)i/npoints*v0;
    }
    dll=ll[1]-ll[0];
    cor=1./(1.-occ*occ);

    for(i=0;i<npoints;i++) {
        part[i]=2.*j1(ll[i])/ll[i];
    }
    part[0]=1.0;

    tot1=0.;
    for(i=0;i<npoints;i++) {
        tot1+=j1(occ*ll[i])*part[i]*dll;
    }
    sinfo_msg_debug("tot=%10.8f",tot1);


    sinfo_msg_debug("cor=%10.8f",cor);

    ee=(1.-j0(v0)*j0(v0));

    sinfo_msg_debug("(1-j0(v0)*j0(v0))=%10.8f",ee);


    ee-=(j1(v0))*(j1(v0));
    sinfo_msg_debug("j1^2=%10.8f",(j1(v0))*(j1(v0)));
    sinfo_msg_debug("ee=%10.8f",ee);

    sinfo_msg_debug("factor=%10.8f",
                    occ*occ*(1-j0(occ*v0)*j0(occ*v0)-j1(occ*v0)*j1(occ*v0)));


    ee+=occ*occ*(1-j0(occ*v0)*j0(occ*v0)-j1(occ*v0)*j1(occ*v0));
    sinfo_msg_debug("ee=%10.8f",ee);

    ee-=2.*occ*tot1;
    sinfo_msg_debug("ee=%10.8f",ee);

    ee*=cor;
    sinfo_msg_debug("ee=%10.8f",ee);


    tot1=0;
    pairy=cpl_image_get_data_double(img_airy);
    prr=cpl_image_get_data_double(img_rr);
    for(j=0;j<sy;j++) {
        for(i=0;i<sx;i++) {
            if(!irplib_isnan(pairy[i+j*sx]) && (prr[i+j*sx] <v0)) {
                tot1+=pairy[i+j*sx]*ee;
                //sinfo_msg_debug("tot=%f",tot1);

            }
        }
    }

    sinfo_msg_debug("tot=%10.8f",tot1);
    cpl_image_divide_scalar(img_airy,tot1);

    /*
  check_nomsg(cpl_image_save(img_airy,"out_airy2.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

     */


    // Computation of maximum

    sinfo_msg_debug("dim=%d blocks=%d,bin=%d",dim,blocks,bin);
    start=(dim/2-1)-(blocks/2*bin-1)-bin/2;
    sinfo_msg_debug("start=%d",start);

    img_psf0=cpl_image_new(blocks,blocks,CPL_TYPE_DOUBLE);
    ppsf0=cpl_image_get_data_double(img_psf0);
    tot1=0.;
    tot2=0.;

    for(j=0;j<blocks;j++) {
        for(i=0;i<blocks;i++) {
            tot1=0;
            for(jj=start+j*bin;jj<start+(j+1)*bin-1;jj++){
                for(ii=start+i*bin;ii<start+(i+1)*bin-1;ii++){
                    if(!irplib_isnan(pairy[ii+jj*sx])) {
                        tot1+=pairy[ii+jj*sx];
                    }
                }
            }
            ppsf0[i+j*blocks]=tot1;
            tot2+=tot1;
        }
    }

    cpl_image_divide_scalar(img_psf0,tot2);
    /*
  check_nomsg(cpl_image_save(img_psf0,"out_psf0.fits", CPL_BPP_IEEE_DOUBLE,
			     NULL,CPL_IO_DEFAULT));

     */
    k=180.*3600./SINFO_MATH_PI;
    sinfo_msg_debug("k=%f",k);
    sinfo_msg_debug("radius of first zero: 1.22*lambda/d*k:=%f",
                    1.22*lambda/dia*k);
    sinfo_msg_debug("tot: %f",tot2);
    sinfo_msg_debug("max: %f",cpl_image_get_max(img_psf0)*tot2);
    sinfo_msg_debug("max/tot: %f",cpl_image_get_max(img_psf0));
    *psf_peak=cpl_image_get_max(img_psf0);

    sinfo_msg_debug("d=%g ob=%g w=%g ps=%g cx=%g cy=%g a=%g peak=%10.8g",
                    dia,occ,lambda,psize,cx,cy,anamorph,*psf_peak);



    cleanup:
    sinfo_free_image(&img_w);
    sinfo_free_image(&img_psf0);
    sinfo_free_image(&img_xx);
    sinfo_free_image(&img_yy);
    sinfo_free_image(&img_rr);
    sinfo_free_image(&img_rrcor);
    sinfo_free_image(&img_airy);


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

}


cpl_error_code
sinfo_get_flux_above_bkg(const cpl_image* img,
                         const float kappa,
                         const float std,
                         double* f)
{

    const float* pimg=NULL;
    int sx=0;
    int sy=0;
    int i=0;
    int j=0;
    int k=0;
    float tot=0;

    cpl_image* timg=NULL;
    double sky_bkg=0;
    double sky_std=0;

    timg=cpl_image_duplicate(img);
    cpl_image_subtract_scalar(timg,std);
    check_nomsg(sinfo_get_bkg_4corners(timg,SINFO_BKG_BOX_SZ,SINFO_BKG_BOX_SZ,
                    &sky_bkg,&sky_std));

    check_nomsg(pimg=cpl_image_get_data_float_const(timg));

    sx=cpl_image_get_size_x(img);
    sy=cpl_image_get_size_y(img);

    for(j=0;j<sy;j++) {
        for(i=0;i<sx;i++) {
            if(!irplib_isnan(pimg[i+j*sx]) &&
                            (pimg[i+j*sx]>(sky_bkg+kappa*sky_std))) {
                tot+=(double)pimg[i+j*sx];
                k++;
            }
        }
    }

    *f=(double)(tot-k*sky_bkg);

    cleanup:
    sinfo_free_image(&timg);

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

}



/*
cpl_error_code
sinfo_get_centroid(const cpl_image* img,
                   const int d,
                   const double xc,
                   const double yc,
                   double* xcen,
                   double* ycen,
                   double* xfwhm,
                   double* yfwhm,
                   double* angle)
{

  cpl_bivector* q=NULL;
  int sx=0;
  int sy=0;
  double* pq=NULL;
  double peak=0;
  double bkg=0;

  check_nomsg(sx=cpl_image_get_size_x(img));
  check_nomsg(sy=cpl_image_get_size_y(img));

  check_nomsg(q=cpl_image_iqe(img,sx/2-d,sy/2-d,sx/2+d,sy/2+d));
  pq=cpl_bivector_get_data(q);

 *xcen=pq[0];
 *ycen=pq[1];
 *xfwhm=pq[2];
 *yfwhm=pq[3];
 *angle=pq[4];
  peak=pq[5];
  bkg=pq[6];


 cleanup:

  sinfo_free_bivector(&q);

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

}
 */



static double
sinfo_find_min_of_four(const double n1,
                       const double n2,
                       const double n3,
                       const double n4)
{
    double min=0;
    min = (n1 < n2) ? n1 : n2;
    min = (min < n3) ? min : n3;
    min = (min < n4) ? min : n4;
    return min;
}

double
sinfo_scale_flux(const double p1,
                 const double p2,
                 const double t1,
                 const double t2)
{

    return (p2/p1)*(p2/p1)*(t2/t1);

}


/**@}*/
