/* $Id: naco_img_zpoint.c,v 1.99 2011-12-22 11:09:36 llundin Exp $
 *
 * This file is part of the NACO 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., 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA
 */

/*
 * $Author: llundin $
 * $Date: 2011-12-22 11:09:36 $
 * $Revision: 1.99 $
 * $Name: not supported by cvs2svn $
 */

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

/*-----------------------------------------------------------------------------
                                Includes
 -----------------------------------------------------------------------------*/

#include "naco_recipe.h"
#include "naco_strehl.h"

#include "irplib_strehl.h"
#include "irplib_wcs.h"
#include "irplib_stdstar.h"

#include <string.h>

/*-----------------------------------------------------------------------------
                            Defines
 -----------------------------------------------------------------------------*/

#define RECIPE_STRING "naco_img_zpoint"

/* @cond */
typedef enum _NACO_BAND_ {
    BAND_J,
    BAND_JS,
    BAND_JBLOCK,
    BAND_H,
    BAND_K,
    BAND_KS,
    BAND_L,
    BAND_M,
    BAND_LP,
    BAND_MP,
    BAND_Z,
    BAND_SZ,
    BAND_SH,
    BAND_SK,
    BAND_SL,
    BAND_UNKNOWN
} naco_band;
/* @endcond */

/*-----------------------------------------------------------------------------
                            Private Functions prototypes
 -----------------------------------------------------------------------------*/

static cpl_table * naco_img_zpoint_reduce(cpl_propertylist *,
                                          const irplib_framelist *,
                                          const cpl_parameterlist *,
                                          const char *, const char *,
                                          cpl_image **);

static cpl_error_code naco_img_zpoint_qc(cpl_propertylist *,
                                         cpl_propertylist *,
                                         const irplib_framelist *);

static cpl_error_code naco_img_zpoint_save(cpl_frameset *,
                                           const cpl_parameterlist *,
                                           const cpl_propertylist *,
                                           const cpl_propertylist *,
                                           const cpl_table *,
                                           const cpl_image *);

static cpl_error_code naco_img_zpoint_reduce_one(cpl_table *, cpl_vector *, int,
                                                 const cpl_image *,
                                                 const cpl_parameterlist *,
                                                 const char *, double, double,
                                                 double, double *, double *,
                                                 double *, double *, double *);

static double naco_img_zpoint_find_mag(cpl_propertylist *, double, double,
                                       const char *, const char *);

static cpl_table * naco_img_zpoint_load_std_star(const char *, double, double, double);

static cpl_error_code naco_img_zpoint_find_std_star(cpl_table *,
                                                    const char *[],
                                                    double, double,
                                                    const char *,
                                                    cpl_boolean,
                                                    int *);

static cpl_error_code naco_img_zpoint_qc_all(cpl_propertylist *,
                                             cpl_propertylist *,
                                             const irplib_framelist *);

static cpl_error_code naco_img_zpoint_check_im(cpl_image **, const cpl_image *,
                                               int, int, double, double,
                                               double, double, double);

static naco_band naco_get_bbfilter(const char *);

static const char * naco_std_band_name(naco_band);


NACO_RECIPE_DEFINE(naco_img_zpoint,
                   NACO_PARAM_STAR_R  |                        
                   NACO_PARAM_BG_RINT |                        
                   NACO_PARAM_BG_REXT |                        
                   NACO_PARAM_RA      |                        
                   NACO_PARAM_DEC     |                        
                   NACO_PARAM_PIXSCALE|                        
                   NACO_PARAM_MAGNITD |                        
                   NACO_PARAM_SX      |                        
                   NACO_PARAM_SY      |                        
                   NACO_PARAM_CHK_IMG,
                   "Zero point computation recipe",
                   RECIPE_STRING " -- Zero point recipe\n"                     
                   "The files listed in the Set Of Frames (sof-file) " 
                   "must be tagged:\n"
                   "NACO-raw-file.fits " NACO_IMG_ZPOINT_CHOP " or\n"           
                   "NACO-raw-file.fits " NACO_IMG_ZPOINT_JITTER ".\n"           
                   "NACO-Imaging-Standard-Star-Catalog.fits "
                    NACO_IMG_STD_CAT "\n"
                   "Optionally, a flat field frame may be inluded:\n"       
                   "NACO-flat-file.fits " NACO_CALIB_FLAT "\n");

/*-----------------------------------------------------------------------------
  Static variables
 -----------------------------------------------------------------------------*/

static struct {
    /* Inputs */
    double      ra;
    double      dec;
    double      magnitude;
    int         sx;
    int         sy;
    double      phot_star_radius;
    double      phot_bg_r1;
    double      phot_bg_r2;
    double      pscale;
    int         check_im;

} naco_img_zpoint_config;


/*----------------------------------------------------------------------------*/
/**
 * @defgroup naco_img_zpoint   Zero Point
 */
/*----------------------------------------------------------------------------*/

/*-----------------------------------------------------------------------------
                                Functions code
 -----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    The recipe data reduction part is implemented here 
  @param    framelist   the frames list
  @param    parlist     the parameters list
  @return   0 iff everything is ok
 */
/*----------------------------------------------------------------------------*/
static int naco_img_zpoint(cpl_frameset            * framelist,
                           const cpl_parameterlist * parlist)
{
    irplib_framelist* allframes = NULL;
    irplib_framelist* rawframes = NULL;
    cpl_propertylist* qclist    = cpl_propertylist_new();
    cpl_propertylist* paflist   = cpl_propertylist_new();
    const char      * flat;
    const char      * star_cat;
    cpl_table       * tab = NULL;
    cpl_image       * check_im = NULL;
    
    /* Retrieve input parameters */
    /* --ra */
    naco_img_zpoint_config.ra
        = naco_parameterlist_get_double(parlist, RECIPE_STRING, NACO_PARAM_RA);
    /* --dec */
    naco_img_zpoint_config.dec
        = naco_parameterlist_get_double(parlist, RECIPE_STRING, NACO_PARAM_DEC);
    /* --pscale */
    naco_img_zpoint_config.pscale
        = naco_parameterlist_get_double(parlist,RECIPE_STRING,NACO_PARAM_PIXSCALE);
    /* --mag */
    naco_img_zpoint_config.magnitude
        = naco_parameterlist_get_double(parlist, RECIPE_STRING,NACO_PARAM_MAGNITD);
    /* --sx */
    naco_img_zpoint_config.sx
        = naco_parameterlist_get_int(parlist, RECIPE_STRING, NACO_PARAM_SX);

    skip_if_lt(naco_img_zpoint_config.sx, 1,
               "for the size of the search window in X-direction [pixel]");

    /* --sy */
    naco_img_zpoint_config.sy
        = naco_parameterlist_get_int(parlist, RECIPE_STRING, NACO_PARAM_SY);

    skip_if_lt(naco_img_zpoint_config.sy, 1,
               "for the size of the search window in Y-direction [pixel]");

    /* --star_r */
    naco_img_zpoint_config.phot_star_radius
        = naco_parameterlist_get_double(parlist, RECIPE_STRING, NACO_PARAM_STAR_R);

    /* --bg_r1 */
    naco_img_zpoint_config.phot_bg_r1
        = naco_parameterlist_get_double(parlist, RECIPE_STRING,NACO_PARAM_BG_RINT);

    /* --bg_r2 */
    naco_img_zpoint_config.phot_bg_r2
        = naco_parameterlist_get_double(parlist, RECIPE_STRING,NACO_PARAM_BG_REXT);

    /* --check_im */
    naco_img_zpoint_config.check_im
        = naco_parameterlist_get_bool(parlist, RECIPE_STRING, NACO_PARAM_CHK_IMG);

    /* Identify the RAW and CALIB frames in the input frameset */
    skip_if (naco_dfs_set_groups(framelist));

    allframes = irplib_framelist_cast(framelist);
    skip_if(allframes == NULL);

    rawframes = irplib_framelist_extract_regexp(allframes,
                                                "^(" NACO_IMG_ZPOINT_JITTER
                                                "|"  NACO_IMG_ZPOINT_CHOP ")$",
                                                CPL_FALSE);
    skip_if(rawframes == NULL);
    irplib_framelist_empty(allframes);

    /* Standard star catalog */
    star_cat = irplib_frameset_find_file(framelist, NACO_IMG_STD_CAT);
    error_if (star_cat == NULL, CPL_ERROR_DATA_NOT_FOUND, "The input "
              "file(s) have no star catalog tagged %s", NACO_IMG_STD_CAT);

    /* Retrieve calibration data */
    flat = irplib_frameset_find_file(framelist, NACO_CALIB_FLAT);
    bug_if(0);
   
    skip_if( irplib_framelist_load_propertylist(rawframes, 0, 0, "^("
                                                IRPLIB_PFITS_REGEXP_RECAL "|"
                                                NACO_PFITS_REGEXP_ZPOINT "|"
                                                NACO_PFITS_REGEXP_ZPOINT_PAF "|"
                                                NACO_PFITS_REGEXP_ZPOINT_REF
                                                ")$", CPL_FALSE));

    skip_if(irplib_framelist_load_propertylist_all(rawframes, 0, "^("
                                                   NACO_PFITS_REGEXP_ZPOINT
                                                   ")$", CPL_FALSE));

    /* Compute the strehl/zpoint values */
    tab = naco_img_zpoint_reduce(qclist, rawframes, parlist, star_cat, flat,
                                 &check_im);
    skip_if (tab == NULL);

    skip_if(naco_img_zpoint_qc(qclist, paflist, rawframes));

    /* Reduce maximum number of pointers used */
    irplib_framelist_empty(rawframes);

    /* PRO.CATG */
    bug_if (cpl_propertylist_append_string(paflist, CPL_DFS_PRO_CATG,
                                           NACO_IMG_ZPOINT_RES));

    /* Save the products */
    skip_if (naco_img_zpoint_save(framelist, parlist, qclist, paflist, tab,
                                  check_im));

    end_skip;

    cpl_table_delete(tab);
    cpl_image_delete(check_im);
    irplib_framelist_delete(allframes);
    irplib_framelist_delete(rawframes);
    cpl_propertylist_delete(qclist);
    cpl_propertylist_delete(paflist);

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    The recipe data reduction part is implemented here 
  @param    qclist      List of QC parameters
  @param    rawframes   The list of raw frames
  @param    parlist     The recipe parameter list
  @param    star_cat    The name of the standard star catalog
  @param    flat        The flat field name or NULL
  @param    pcheck_im   Pointer to the produced check image or NULL
  @return   table with computed photometry or NULL on error
 */
/*----------------------------------------------------------------------------*/
static cpl_table * naco_img_zpoint_reduce(cpl_propertylist       * qclist,
                                          const irplib_framelist * rawframes,
                                          const cpl_parameterlist * parlist,
                                          const char             * star_cat,
                                          const char             * flat,
                                          cpl_image             ** pcheck_im)
{
    cpl_errorstate           prestate = cpl_errorstate_get();
    const cpl_propertylist * plist
        = irplib_framelist_get_propertylist_const(rawframes, 0);
    cpl_image              * flat_im = NULL;
    cpl_image              * rawimage = NULL;
    cpl_image              * imdiff = NULL;
    const char             * filter;
    const int                ndiff = 2 * irplib_framelist_get_size(rawframes)-2;
    double                   pos_x_cen = DBL_MAX; /* Avoid uninit warning */
    double                   pos_y_cen = DBL_MAX; /* Avoid uninit warning */
    cpl_apertures          * aperts = NULL;
    double                   psigmas[] = {20.0, 10.0, 8.0, 6.0, 5.0};
    const int                nsigmas = (int)(sizeof(psigmas)/sizeof(double));
    cpl_size                 isigma;
    cpl_vector             * sigmas = NULL;
    cpl_table              * out_tab = NULL;
    cpl_vector             * zpoints = NULL;
    cpl_stats              * fstats = NULL;
    double                   dit;
    double                   off_x0 = DBL_MAX; /* Avoid uninit warning */
    double                   off_y0 = DBL_MAX; /* Avoid uninit warning */
    double                   off_x  = DBL_MAX; /* Avoid uninit warning */
    double                   off_y  = DBL_MAX; /* Avoid uninit warning */
    double                   str_sum = 0.0;
    double                   str_err_sum = 0.0;
    double                   pe_sum = 0.0;
    double                   fl_sum = 0.0;
    double                   bg_no_sum = 0.0;
    double                   sqsum = 0.0;
    double                   avg_zp = 0.0;
    int                      nok_zp = 0;
    int                      nok_strehl = 0;
    cpl_error_code           code;
    int                      i;

    /* QC Parameters */
    double      zpointrms;
    double      strehl;
    double      strehl_err;
    double      strehl_rms;
    double      star_peak;
    double      star_flux;



    bug_if (0);
    bug_if (pcheck_im == NULL);
    bug_if (*pcheck_im != NULL);

    skip_if_lt(ndiff/2+1, 3, "raw frames");

    /* Get the filter name, DIT, RA, DEC and pixelscale */

    dit = naco_pfits_get_dit(plist);
    skip_if (dit <= 0.0);
    if (naco_img_zpoint_config.ra > 998.0)
        naco_img_zpoint_config.ra = naco_pfits_get_ra(plist);
    if (naco_img_zpoint_config.dec > 998.0) 
        naco_img_zpoint_config.dec = naco_pfits_get_dec(plist);
    skip_if(0);

    if (naco_img_zpoint_config.pscale <= 0.0) {
        naco_img_zpoint_config.pscale = naco_pfits_get_pixscale(plist);
        skip_if(naco_img_zpoint_config.pscale <= 0.0);
    }

    cpl_msg_info(cpl_func, "Using star at position: RA = %g ; DEC = %g", 
            naco_img_zpoint_config.ra, naco_img_zpoint_config.dec);
   
    filter = naco_pfits_get_filter(plist);
    skip_if(0);

    /* Get the standard star information from database */
    if (naco_img_zpoint_config.magnitude > IRPLIB_STDSTAR_LIMIT) {
        naco_img_zpoint_config.magnitude
            = naco_img_zpoint_find_mag(qclist,
                                       naco_img_zpoint_config.ra,
                                       naco_img_zpoint_config.dec,
                                       star_cat, filter);
        if (cpl_error_get_code()) {
            const cpl_propertylist * reflist
                = irplib_framelist_get_propertylist_const(rawframes, 0);
            const char * starname = naco_pfits_get_object(reflist);

            if (starname != NULL) {
                error_if (0, cpl_error_get_code(), "Star '%s' has "
                          "no magnitude for filter '%s' in catalogue '%s'",
                          starname, filter, star_cat);
            }
        }
    }
    cpl_msg_info(cpl_func, "Star magnitude with filter %s : %g", filter,
                 naco_img_zpoint_config.magnitude);
    bug_if(cpl_propertylist_append_double(qclist, "ESO QC STARMAG",
                                          naco_img_zpoint_config.magnitude));
    
    zpoints = cpl_vector_new(ndiff);
    out_tab = cpl_table_new(ndiff);
    cpl_table_new_column(out_tab, "POSX",       CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "POSY",       CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "ZPOINT",     CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "PEAK",       CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "FLUX",       CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "BGD_NOISE",  CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "STREHL",     CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "STREHL_ERR", CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "BGD",        CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "FWHMX",      CPL_TYPE_DOUBLE);
    cpl_table_new_column(out_tab, "FWHMY",      CPL_TYPE_DOUBLE);
    bug_if(0);

    /* Load the the flatfield if one is provided */
    if (flat != NULL) {
        flat_im = cpl_image_load(flat, CPL_TYPE_FLOAT, 0, 0);

        if (flat_im == NULL) {
            cpl_msg_error(cpl_func, "Could not load flat field %s", flat);
            skip_if(1);
        } else {
            fstats = cpl_stats_new_from_image(flat_im, CPL_STATS_ALL);
            if (cpl_stats_get_min(fstats) <= 0.0) {
                cpl_msg_warning(cpl_func, "Setting non-positive (down to %g) "
                                "flat field pixels to 1",
                                cpl_stats_get_min(fstats));
                bug_if(cpl_image_threshold(flat_im, 0.0, DBL_MAX, 1.0,
                                           DBL_MAX));
            }
        }
    }

    cpl_msg_info(cpl_func, "Loading the image from raw frame %d",1);
    rawimage = cpl_image_load(cpl_frame_get_filename(
                     irplib_framelist_get_const(rawframes, 0)),
                              CPL_TYPE_FLOAT, 0, 0);
    if (rawimage == NULL) {
        cpl_msg_error(cpl_func, "Could not load image from first raw frame"); 
        skip_if(1);
    }

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

        double pos_x, pos_y;
        double str, str_err, pe, fl, bg_no;


        bug_if(0);

        if (i == 0 || i % 2 == 1) {
            /* Get the offsets */

            off_x = naco_pfits_get_cumoffsetx(plist);
            off_y = naco_pfits_get_cumoffsety(plist);

            skip_if(0);

            if (i == 0) {
                off_x0 = off_x;
                off_y0 = off_y;
            }

            off_x -= off_x0;
            off_y -= off_y0;

            cpl_msg_info(cpl_func, "Offsets for difference image %d: (%g,%g)",
                         i, off_x, off_y);

            /* Update the plist to that of the next frame */
            if (i + 1 < ndiff)
                plist = irplib_framelist_get_propertylist_const(rawframes,
                                                                1 + (i+1)/2);
        }

        if (i % 2 == 0) {
            const char * filename = cpl_frame_get_filename(
                                  irplib_framelist_get_const(rawframes, 1+i/2));

            bug_if(0);

            cpl_image_delete(imdiff);
            imdiff = rawimage;

            cpl_msg_info(cpl_func, "Loading the image from raw frame %d",2+i/2);
            rawimage = cpl_image_load(filename, CPL_TYPE_FLOAT, 0, 0);
            if (rawimage == NULL) {
                cpl_msg_error(cpl_func, "Could not load image %d", 2+i/2); 
                skip_if(1);
            }
            bug_if(cpl_image_subtract(imdiff, rawimage));
            if (flat_im != NULL) skip_if(cpl_image_divide(imdiff, flat_im));
        } else {
            bug_if(cpl_image_multiply_scalar(imdiff, -1.0));
        }

        if (i == 0) {
            double    min_dist = DBL_MAX; /* Avoid (false) uninit warning */
            const int size_x = cpl_image_get_size_x(imdiff);
            const int size_y = cpl_image_get_size_y(imdiff);
            int       iap;

            /* Detect the central object in the first frame */
            cpl_msg_info(cpl_func, "Detecting a bright object in the first "
                         "difference image using %d sigma-levels ranging from "
                         "%g down to %g", nsigmas, psigmas[0],
                         psigmas[nsigmas-1]);
            sigmas = cpl_vector_wrap(nsigmas, psigmas);
           
            aperts = cpl_apertures_extract(imdiff, sigmas, &isigma);
            if (aperts == NULL || cpl_apertures_get_size(aperts) < 1) {
                cpl_msg_error(cpl_func, "Could not detect any bright object");
                skip_if(1);
            }
            for (iap=0; iap < cpl_apertures_get_size(aperts); iap++) {
                const double d_x
                    = cpl_apertures_get_centroid_x(aperts, iap+1) - size_x/2.0;
                const double d_y
                    = cpl_apertures_get_centroid_y(aperts, iap+1) - size_y/2.0;
                const double dist = d_x * d_x + d_y * d_y;
                if (iap == 0 || dist < min_dist) {
                    min_dist = dist;
                    pos_x_cen = d_x;
                    pos_y_cen = d_y;
                }
            }
            cpl_apertures_delete(aperts);
            aperts = NULL;
            bug_if(0);
            pos_x_cen += size_x/2.0;
            pos_y_cen += size_y/2.0;
            cpl_msg_info(cpl_func, "Detected a bright object at sigma=%g, at "
                         "position: %g %g", psigmas[isigma], pos_x_cen,
                         pos_y_cen);

        }

        pos_x = pos_x_cen + off_x;
        pos_y = pos_y_cen + off_y;

        if (i > 0) {
            /* Refine the positions */
            const double opos_x = pos_x;
            const double opos_y = pos_y;
            const int llx = (int)pos_x - naco_img_zpoint_config.sx;
            const int urx = (int)pos_x + naco_img_zpoint_config.sx;
            const int lly = (int)pos_y - naco_img_zpoint_config.sy;
            const int ury = (int)pos_y + naco_img_zpoint_config.sy;
            pos_x = cpl_image_get_centroid_x_window(imdiff, llx, lly, urx, ury);
            pos_y = cpl_image_get_centroid_y_window(imdiff, llx, lly, urx, ury);
            error_if (0, cpl_error_get_code(), "Could not refine the positions "
                      "of difference image %d", i+1);
            cpl_msg_info(cpl_func, "For difference image %d refined object "
                         "position (x,y): (%g,%g) -> (%g,%g)", i,
                         opos_x, opos_y, pos_x, pos_y);
        }

        bug_if(0);

        /* Create the check image if requested */
        if (naco_img_zpoint_config.check_im) {
            const double r1 = naco_img_zpoint_config.phot_star_radius
                /naco_img_zpoint_config.pscale;
            const double r2 = naco_img_zpoint_config.phot_bg_r1
                /naco_img_zpoint_config.pscale;
            const double r3 = naco_img_zpoint_config.phot_bg_r2
                /naco_img_zpoint_config.pscale;

            skip_if(naco_img_zpoint_check_im(pcheck_im, imdiff, i, ndiff,
                                             pos_x, pos_y, r1, r2, r3));
        }

        /* Compute the flux/strehl in the current image */
        code = naco_img_zpoint_reduce_one(out_tab, zpoints, i, imdiff,
                                          parlist, filter,
                                          pos_x, pos_y, dit,
                                          &str, &str_err, &pe, &fl, &bg_no);
        if (code) {
            cpl_msg_warning(cpl_func, "Strehl computation for difference image "
                            "%d at (x,y)=(%g,%g) failed:", i+1, pos_x, pos_y);
            cpl_errorstate_dump(prestate, CPL_FALSE,
                                cpl_errorstate_dump_one_warning);
            cpl_errorstate_set(prestate);
            continue;
        } else if (str <= 0.0 || str >= 1.0) {
            cpl_msg_info(cpl_func, "Excluding from statistics non-physical "
                         "Strehl ratio for difference image %d at (x,y)=(%g,%g)"
                         ": %g", i+1, pos_x, pos_y, str);
            continue;
        }

        /* Compute the averages of the results for the strehl */
        nok_strehl++;

        str_sum     += str;
        str_err_sum += str_err;
        bg_no_sum   += bg_no;
        pe_sum      += pe;
        fl_sum      += fl;
    }

    skip_if_lt(nok_strehl, 1, "valid strehl measurements");

    strehl     = str_sum     / (double)nok_strehl;
    strehl_err = str_err_sum / (double)nok_strehl;
    strehl_rms = bg_no_sum   / (double)nok_strehl;
    star_peak  = pe_sum      / (double)nok_strehl;
    star_flux  = fl_sum      / (double)nok_strehl;
    
    /* Compute the averages of the results for the zero point */
    cpl_vector_sort(zpoints, 1);
    /* Reject highest and lowest value */
    for (i=1; i < ndiff-1; i++) {
        const double zp = cpl_vector_get(zpoints, i);
        if (zp > 0.0) {
            avg_zp += zp;
            sqsum += zp * zp;
            nok_zp ++;
        }
    }
    cpl_vector_delete(zpoints);
    zpoints = NULL;

    skip_if_lt(nok_zp, 1, "valid zpoint measurements");

    avg_zp /= (double)nok_zp;
    sqsum  /= (double)nok_zp;
    zpointrms = sqsum - avg_zp * avg_zp;
    zpointrms = zpointrms > 0.0 ? sqrt(zpointrms) : 0.0;

    /* Print final results */
    cpl_msg_info(cpl_func, "***** FINAL RESULTS *****");
    cpl_msg_info(cpl_func, "Strehl :       %g", strehl);
    cpl_msg_info(cpl_func, "Strehl error : %g", strehl_err);
    cpl_msg_info(cpl_func, "Peak :         %g", star_peak);
    cpl_msg_info(cpl_func, "Flux :         %g", star_flux);
    cpl_msg_info(cpl_func, "Strehl RMS     %g", strehl_rms);
    cpl_msg_info(cpl_func, "Zero point :   %g", avg_zp);
    cpl_msg_info(cpl_func, "Zero p. RMS:   %g", zpointrms);

    cpl_propertylist_append_double(qclist, "ESO QC ZPOINT", avg_zp);
    cpl_propertylist_append_double(qclist, "ESO QC ZPOINTRMS", zpointrms);
    cpl_propertylist_append_double(qclist, "ESO QC STREHL", strehl);
    cpl_propertylist_append_double(qclist, "ESO QC STREHL ERROR", strehl_err);
    cpl_propertylist_append_double(qclist, "ESO QC STREHL RMS", strehl_rms);
    cpl_propertylist_append_double(qclist, "ESO QC STREHL PEAK", star_peak);
    cpl_propertylist_append_double(qclist, "ESO QC STREHL FLUX", star_flux);
    cpl_propertylist_append_string(qclist, "ESO QC FILTER OBS", filter);

    bug_if(0);

    end_skip;
    
    cpl_stats_delete(fstats);
    cpl_image_delete(rawimage);
    cpl_image_delete(imdiff);
    cpl_image_delete(flat_im);
    cpl_apertures_delete(aperts);
    cpl_vector_unwrap(sigmas);
    cpl_vector_delete(zpoints);

    if (cpl_error_get_code()) {
        cpl_image_delete(*pcheck_im);
        *pcheck_im = NULL;
        cpl_table_delete(out_tab);
        out_tab = NULL;
    }

    return out_tab;
}

/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    Create an image with subimages and circles around the star
  @param    self      Pointer to the produced check image or NULL
  @param    imdiff    Difference image
  @param    idiff     Index of the difference image to insert
  @param    nima      Number of difference images
  @param    pos_x     X-coordinate of object in difference image
  @param    pos_y     Y-coordinate of object in difference image
  @param    r1        First radius
  @param    r2        Second radius
  @param    r3        Third radius
  @return   0 iff everything is ok

  The function takes sub images of the input images centered around the
  specified position, and make a big images with the sub images next to
  each others. Circles are drawn around the first central position with
  three different radii (r1, r2, r3). 
 */
/*----------------------------------------------------------------------------*/
static cpl_error_code naco_img_zpoint_check_im(cpl_image          ** self,
                                               const cpl_image     * imdiff,
                                               int                   idiff,
                                               int                   nima,
                                               double                pos_x,
                                               double                pos_y,
                                               double                r1,
                                               double                r2,
                                               double                r3)
{
    const float * pin_ima = cpl_image_get_data_float_const(imdiff);
    float       * pout_ima;
    const int     in_nx = cpl_image_get_size_x(imdiff);
    const int     in_ny = cpl_image_get_size_y(imdiff);
    const int     box_sz = 2 * (int)r3 + 1;
    const int     nx = box_sz * nima;
    const int     ny = box_sz;
    /* Get the sub image position */
    const int     llx = (int)(pos_x - r3);
    const int     lly = (int)(pos_y - r3);
    int           i, j;


    bug_if(0);

    bug_if(self == NULL);

    skip_if (r1 > r2);
    skip_if (r2 >= r3);

    if (idiff == 0) {
        bug_if(*self != NULL);

        cpl_msg_info(cpl_func, "Creating %d X %d X %d check-image",
                     nima, box_sz, box_sz);

        /* Create the output image */
        *self = cpl_image_new(nx, ny, CPL_TYPE_FLOAT);
    }

    pout_ima = cpl_image_get_data_float(*self);

    bug_if(0);

    for (j=0; j < box_sz; j++) {
        if (j + lly < 0 || j + lly >= in_ny) continue;
        for (i=0; i < box_sz; i++) {
            if (i + llx >= 0 && i + llx < in_nx) {
                const int in_pos = llx + i + (lly+j) * in_nx;
                const int out_pos = (box_sz * idiff) + i + j * nx;

                bug_if ( in_pos < 0 ||  in_pos >= in_nx*in_ny);
                bug_if (out_pos < 0 || out_pos >=    nx*   ny);

                pout_ima[out_pos] = pin_ima[in_pos];
            }
        }
    }

    if (idiff == 0) {
        /* Draw the two circles */
        const double sqr1 = sqrt(r1*r1);
        const double sqr2 = sqrt(r2*r2);
        const double sqr3 = sqrt(r3*r3);
        for (j=0; j < box_sz; j++) {
            const int jdist = j - box_sz/2;
            for (i=0; i < box_sz; i++) {
                const int idist = i - box_sz/2;
                const double dist
                    = sqrt((double)(idist * idist + jdist * jdist));
                if (fabs(dist-sqr1) < 0.5 ||
                    fabs(dist-sqr2) < 0.5 ||
                    fabs(dist-sqr3) < 0.5) pout_ima[i + j * nx] = 10000;
            }
        }
    }

    end_skip;

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    Reduce one image
  @param    zptab        Table to be filled with zero point information
  @param    zpoints      Vector with an element to be set to zero point
  @param    idiff        Index of row element to modify
  @param    self         The input image
  @param    parlist      The recipe parameter list
  @param    filter       The filter
  @param    pos_x        The object x position
  @param    pos_y        The object y position
  @param    dit          The DIT
  @param    pstrehl      The computed strehl
  @param    pstrehl_err  The computed strehl error
  @param    pstar_peak   The computed star peak
  @param    pstar_flux   The computed star flux
  @param    pbg_noise    The background noise   
  @return   0 iff everything is ok

 */
/*----------------------------------------------------------------------------*/
static
cpl_error_code naco_img_zpoint_reduce_one(cpl_table       * zptab,
                                          cpl_vector      * zpoints,
                                          int               idiff,
                                          const cpl_image * self,
                                          const cpl_parameterlist * parlist,
                                          const char      * filter,
                                          double            pos_x,
                                          double            pos_y,
                                          double            dit,
                                          double          * pstrehl,
                                          double          * pstrehl_err,
                                          double          * pstar_peak,
                                          double          * pstar_flux,
                                          double          * pbg_noise)
{
    cpl_errorstate cleanstate = cpl_errorstate_get();
    double zeropoint, background;
    double r, r1, r2;
    double lam, dlam;
    double star_bg, psf_peak, psf_flux;
    double fwhm_x, fwhm_y;


    bug_if(pstar_flux == NULL);
    bug_if(filter     == NULL);

    /* Compute the photometry */
    r = naco_img_zpoint_config.phot_star_radius/naco_img_zpoint_config.pscale;
    r1 = naco_img_zpoint_config.phot_bg_r1/naco_img_zpoint_config.pscale;
    r2 = naco_img_zpoint_config.phot_bg_r2/naco_img_zpoint_config.pscale;
    background = irplib_strehl_ring_background(self, pos_x, pos_y, r1, r2,
            IRPLIB_BG_METHOD_AVER_REJ);
    skip_if(0);
    *pstar_flux = irplib_strehl_disk_flux(self, pos_x, pos_y, r, background);
    skip_if(0);

    /* Get lam and dlam from the filter name for the Strehl computation */
    irplib_check(naco_get_filter_infos(filter, &lam, &dlam),
                 "Cannot get filter infos [%s]", filter);
    
    /* Compute the strehl */
    irplib_check(naco_strehl_compute(self, parlist, RECIPE_STRING, lam, dlam,
                                     pos_x, pos_y,
                                     naco_img_zpoint_config.pscale,
                                     pstrehl, pstrehl_err, &star_bg,
                                     pstar_peak, pstar_flux,
                                     &psf_peak, &psf_flux, pbg_noise),
                 "Could not compute the Strehl ratio. r=%g <= r1=%g < r2=%g",
                 r, r1, r2);

    /* FWHM_X / FWHM_Y */
    if (cpl_image_get_fwhm(self, (int)pos_x, (int)pos_y, &fwhm_x, &fwhm_y)) {
        irplib_error_recover(cleanstate, "Could not compute FWHM for image %d:",
                          idiff+1);
        fwhm_x = fwhm_y = 0.0;
    } else {
        if (fwhm_x <= 0.0) {
            cpl_msg_warning(cpl_func, "Could not compute FWHM in x for image "
                            "%d:", idiff+1);
            fwhm_x = 0.0;
        }
        if (fwhm_y <= 0.0) {
            cpl_msg_warning(cpl_func, "Could not compute FWHM in y for image "
                            "%d:", idiff+1);
            fwhm_y = 0.0;
        }
    }

    zeropoint = naco_img_zpoint_config.magnitude + 2.5 * log10(*pstar_flux/dit);

    cpl_msg_info(cpl_func, "Strehl :       %g", *pstrehl);
    cpl_msg_info(cpl_func, "Strehl error : %g", *pstrehl_err);
    cpl_msg_info(cpl_func, "Peak :         %g", *pstar_peak);
    cpl_msg_info(cpl_func, "Flux :         %g", *pstar_flux);
    cpl_msg_info(cpl_func, "Background :   %g", background);
    cpl_msg_info(cpl_func, "Bg noise :     %g", *pbg_noise);
    cpl_msg_info(cpl_func, "Zero point :   %g", zeropoint);
    cpl_msg_info(cpl_func, "FWHM in x :    %g", fwhm_x);
    cpl_msg_info(cpl_func, "FWHM in y :    %g", fwhm_y);

    /* Save the results in the vectors */
    cpl_vector_set(zpoints, idiff, zeropoint);
    cpl_table_set_double(zptab, "POSX",       idiff, pos_x);
    cpl_table_set_double(zptab, "POSY",       idiff, pos_y);
    cpl_table_set_double(zptab, "ZPOINT",     idiff, zeropoint);
    cpl_table_set_double(zptab, "PEAK",       idiff, *pstar_peak);
    cpl_table_set_double(zptab, "FLUX",       idiff, *pstar_flux);
    cpl_table_set_double(zptab, "BGD_NOISE",  idiff, *pbg_noise);
    cpl_table_set_double(zptab, "STREHL",     idiff, *pstrehl);
    cpl_table_set_double(zptab, "STREHL_ERR", idiff, *pstrehl_err);
    cpl_table_set_double(zptab, "BGD",        idiff, background);
    cpl_table_set_double(zptab, "FWHMX",      idiff, fwhm_x);
    cpl_table_set_double(zptab, "FWHMY",      idiff, fwhm_y);

    bug_if(0);

    end_skip;

    if (cpl_error_get_code())
        cpl_msg_error(cpl_func, "Cannot reduce the image %d", idiff+1);

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    Get the standard star magnitude
  @param    qclist  List of QC parameters
  @param    ra      The Right Ascension
  @param    dec     The Declination
  @param    star_cat    The name of the standard star catalog
  @param    filter  The filter name
  @return   The star magnitude, or undefined on error
 */
/*----------------------------------------------------------------------------*/
static double naco_img_zpoint_find_mag(cpl_propertylist * qclist,
                                       double             ra,
                                       double             dec,
                                       const char       * star_cat,
                                       const char       * filter)
{
    cpl_error_code       error;
    const char         * star_name;
    const char         * star_type;
    const char         * cat_name;
    int                  istar;
    double               star_mag = 0.0;
    naco_band            band;
    const char         * bandname = NULL;
    cpl_table          * stdstars = NULL;
    const char * sw_cat[] = {"LCO-Palomar", "LCO-Palomar-NICMOS-Red-Stars", 
                             "ESO-VanDerBliek", "UKIRT-Extended",
                             "UKIRT-Fundamental", "SAAO-Carter", NULL};
    const char * lw_cat[] = {"ESO-VanDerBliek", "UKIRT-Standards",
                             "UKIRT-LM", NULL};

    bug_if (filter == NULL);

    cpl_msg_info(cpl_func, "Get the star magnitude with filter: %s", filter);

    band = naco_get_bbfilter(filter); /* Get the band */

    skip_if(0);

    /* Get the nearby standard stars */ 
    stdstars = naco_img_zpoint_load_std_star(star_cat, ra, dec, /* degrees */
                                             (IRPLIB_STDSTAR_MAXDIST)/60.0);

    skip_if(stdstars == NULL);
    skip_if(cpl_table_get_nrow(stdstars) == 0);

    istar = -1;

    switch (band) {
        /* SW mode */
    case BAND_J:
    case BAND_H:
    case BAND_K:
    case BAND_KS: 

        bandname = naco_std_band_name(band);

        error = naco_img_zpoint_find_std_star(stdstars, sw_cat, ra, dec,
                                              bandname, CPL_FALSE, &istar);

        if (error) break;
        if (istar >= 0) break;


        /* Special case: swap K and Ks if needed */
        if (band == BAND_K) {
            bandname = naco_std_band_name(BAND_KS);

            cpl_msg_info(cpl_func, "Retrying with alternative band: %s",
                         bandname);

            error = naco_img_zpoint_find_std_star(stdstars, sw_cat, ra, dec,
                                                  bandname, CPL_TRUE, &istar);

        } else if (band == BAND_KS) {
            bandname = naco_std_band_name(BAND_K);

            cpl_msg_info(cpl_func, "Retrying with alternative band: %s",
                         bandname);

            error = naco_img_zpoint_find_std_star(stdstars, sw_cat, ra, dec,
                                                  bandname, CPL_TRUE, &istar);
        }
        break;

        /* LW mode  */
    case BAND_L:
    case BAND_M:
    case BAND_LP:
    case BAND_MP:

        bandname = naco_std_band_name(band);

        error = naco_img_zpoint_find_std_star(stdstars, lw_cat, ra, dec,
                                              bandname, CPL_FALSE, &istar);

        if (error) break;
        if (istar < 0) {
            naco_band other = BAND_UNKNOWN;

            switch(band) {
            case BAND_L:
                other = BAND_LP;
                break;
            case BAND_M:
                other = BAND_MP;
                break;
            case BAND_LP:
                other = BAND_L;
                break;
            case BAND_MP:
                other = BAND_M;
                break;
            default:
                bug_if (1);
            }

            bandname = naco_std_band_name(other);

            cpl_msg_info(cpl_func, "Retrying with alternative band: %s",
                         bandname);

            error = naco_img_zpoint_find_std_star(stdstars, lw_cat, ra, dec,
                                                  bandname, CPL_TRUE, &istar);
        }
        break;
    default:
        skip_if(1);
    }

    error_if (error || istar < 0, CPL_ERROR_DATA_NOT_FOUND, "Star magnitude "
              "for filter '%s' not found in catalog(s) at (RA,DEC)=(%g,%g)"
              " with tolerance=%g (degrees)", filter, ra, dec,
              IRPLIB_STDSTAR_MAXDIST/60.0);

    star_mag  = cpl_table_get_double(stdstars, bandname, istar, NULL);
    star_name = cpl_table_get_string(stdstars, IRPLIB_STDSTAR_STAR_COL, istar);
    star_type = cpl_table_get_string(stdstars, IRPLIB_STDSTAR_TYPE_COL, istar);
    cat_name  = cpl_table_get_string(stdstars, "CAT_NAME",              istar);


    /* Store results */
    bug_if(cpl_propertylist_append_string(qclist, "ESO QC STDNAME",
                                          star_name));
    bug_if(cpl_propertylist_append_string(qclist, "ESO QC CATNAME",
                                          cat_name));
    bug_if(cpl_propertylist_append_string(qclist, "ESO QC SPECTYPE",
                                          star_type));

    cpl_msg_info(cpl_func, "Found standard star '%s' of type '%s' with "
                 "magnitude %g for filter %s from catalog '%s'",
                 star_name, star_type, star_mag, bandname, cat_name);

    end_skip;

    cpl_table_delete(stdstars);

    return star_mag;
}


/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief  Search a sequence of catalogs for a standard star
  @param  self       Table of stars close enough to (ra, dec)
  @param  cat        The array of catalog names
  @param  ra         The Right Ascension
  @param  dec        The Declination
  @param  band       The band name
  @param  retry      CPL_TRUE, iff this call is a retry with the same table
  @param  pistar     On success, the index of the star in the table, or negative
  @return 0 iff OK
  @note If none of the specified catalogs match the entire table is searched

  When retry is false all table rows are assumed to be selected (which is the
  case for a newly created table).
  When retry is true all table rows are assumed to be unselected (which is the
  case when a previous call with the table did not find a star).

  The only change to the table is the selection state.

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code naco_img_zpoint_find_std_star(cpl_table * self,
                                                    const char * cat[],
                                                    double ra, double dec,
                                                    const char * bandname,
                                                    cpl_boolean retry,
                                                    int * pistar)
{

    double min_dist = IRPLIB_STDSTAR_MAXDIST / 60.0; /* Maximum */
    int nsel;

    bug_if (pistar   == NULL);
    *pistar = -1;

    bug_if (self     == NULL);
    bug_if (bandname == NULL);

    nsel = (retry 
            ? cpl_table_or_selected_double
            : cpl_table_and_selected_double)(self, bandname,
                                             CPL_LESS_THAN,
                                             IRPLIB_STDSTAR_LIMIT);

    if (nsel == 0) {
        cpl_msg_info(cpl_func, "None of the standard star catalog(s) have "
                     "a star with a known magnitude for band %s within a "
                     "distance of tol=%g [degrees] from (RA,DEC)=(%g,%g)",
                     bandname, min_dist, ra, dec);
    } else {

        /* At this point we are sure to find a star, if not in the specified
           list of catalogs, then when searching them all */

        const int nrows = cpl_table_get_nrow(self);
        int ibest = -1;
        int i;

        int icat;

        bug_if (cat == NULL);

        for (icat = 0; cat[icat] != NULL; icat++) {

            char * regexp = cpl_sprintf("^%s$", cat[icat]);

            cpl_msg_info(cpl_func, "Trying %s", cat[icat]);

            nsel = cpl_table_and_selected_string(self, "CAT_NAME",
                                                 CPL_EQUAL_TO, regexp);
            cpl_free(regexp);

            if (nsel > 0) break;

            /* No stars found in this catalog, reset to try next */
            nsel = cpl_table_or_selected_double(self, bandname,
                                                CPL_LESS_THAN,
                                                IRPLIB_STDSTAR_LIMIT);
            bug_if(nsel == 0);
        }

        bug_if (nsel == 0);

        /* Compute distances to the selected rows */

        for (i=0; i < nrows; i++) {
            if (cpl_table_is_selected(self, i)) {
                /* The row is selected - compute the distance */
                const double distance
                    = irplib_wcs_great_circle_dist(ra, dec,
                    cpl_table_get_double(self, IRPLIB_STDSTAR_RA_COL, i, NULL),
                    cpl_table_get_double(self, IRPLIB_STDSTAR_DEC_COL, i,NULL));

                if (distance < min_dist) {
                    min_dist = distance;
                    ibest = i;
                }
            }
        }

        bug_if (ibest < 0);

        cpl_msg_info(cpl_func, "Found %d star(s) with known magnitude in band "
                     "%s - selected one with distance %g", nsel, bandname,
                     min_dist);

        *pistar = ibest;
    }

    end_skip;

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    Append the QC parameters to the propertylist
  @param    qclist    List of QC parameters
  @param    paflist   List of PAF parameters
  @param    rawframes List of rawframes and their propertylists
  @return   0 iff everything is ok
 */
/*----------------------------------------------------------------------------*/
static cpl_error_code naco_img_zpoint_qc(cpl_propertylist       * qclist,
                                         cpl_propertylist       * paflist,
                                         const irplib_framelist * rawframes)
{

    cpl_errorstate cleanstate = cpl_errorstate_get();
    const cpl_propertylist * reflist
        = irplib_framelist_get_propertylist_const(rawframes, 0);

    const char       * sval;


    bug_if(0);

    /* Copy the keywords for the paf file */
    bug_if(cpl_propertylist_copy_property_regexp(paflist, reflist, "^("
                                                 NACO_PFITS_REGEXP_ZPOINT_PAF
                                                 ")$", 0));

    /* Add QC parameters */

    sval = naco_pfits_get_opti3_name(reflist);
    if (sval == NULL)
        naco_error_reset("Could not get FITS key:");
    else
        bug_if(cpl_propertylist_append_string(qclist, "ESO QC FILTER NDENS",
                                               sval));
    sval = naco_pfits_get_opti4_name(reflist);
    if (sval == NULL)
        naco_error_reset("Could not get FITS key:");
    else
        bug_if(cpl_propertylist_append_string(qclist, "ESO QC FILTER POL",
                                               sval));

    skip_if (naco_img_zpoint_qc_all(qclist, paflist, rawframes));

    bug_if(cpl_propertylist_append(paflist, qclist));

    bug_if(cpl_propertylist_copy_property_regexp(qclist, reflist, "^("
                                                 IRPLIB_PFITS_REGEXP_RECAL 
                                                 ")$", 0));

    bug_if (irplib_pfits_set_airmass(qclist, rawframes));
    bug_if(cpl_propertylist_append_double(qclist, "ESO QC AIRMASS", 
                                          irplib_pfits_get_double(qclist,
                                                                  "AIRMASS")));

    end_skip;

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/** 
  @internal
  @brief    Save the recipe product on disk
  @param    set         the input frame set
  @param    parlist     the input parameters list
  @param    qclist      List of QC parameters
  @param    paflist     List of properties from reference frame
  @param    tab         the table to save
  @param    check_im    the check image or NULL
  @return   0 iff everything is ok
 */ 
/*----------------------------------------------------------------------------*/
static cpl_error_code naco_img_zpoint_save(cpl_frameset            * set,
                                           const cpl_parameterlist * parlist,
                                           const cpl_propertylist  * qclist,
                                           const cpl_propertylist  * paflist,
                                           const cpl_table         * tab,
                                           const cpl_image         * check_im)
{

    bug_if(0);

    /* Write the zpoint table  */
    skip_if (irplib_dfs_save_table(set, parlist, set, tab, NULL, RECIPE_STRING,
                               NACO_IMG_ZPOINT_RES, qclist, NULL, naco_pipe_id,
                               RECIPE_STRING CPL_DFS_FITS));


    /* Write the check image */
    if (check_im)
        skip_if (irplib_dfs_save_image(set, parlist, set, check_im,
                                   CPL_BPP_IEEE_FLOAT, RECIPE_STRING,
                                   NACO_IMG_ZPOINT_CHECK, qclist, NULL,
                                   naco_pipe_id,
                                   RECIPE_STRING "_check" CPL_DFS_FITS));

    skip_if (cpl_dfs_save_paf("NACO", RECIPE_STRING, paflist,
                             RECIPE_STRING CPL_DFS_PAF));

    end_skip;

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/** 
    @internal
    @brief    Compute the median of the values of a key in several frames
    @param    qclist    List of QC parameters
    @param    paflist   List of QC parameters
    @param    rawframes List of rawframes and their propertylists
    @return   0 iff everything is ok
*/ 
/*----------------------------------------------------------------------------*/
static cpl_error_code naco_img_zpoint_qc_all(cpl_propertylist * qclist,
                                             cpl_propertylist * paflist,
                                             const irplib_framelist * rawframes)
{
    const int    nframes  = irplib_framelist_get_size(rawframes);
    cpl_vector * ec_vec   = cpl_vector_new(nframes);
    cpl_vector * flux_vec = cpl_vector_new(nframes);
    cpl_vector * l0_vec   = cpl_vector_new(nframes);
    cpl_vector * t0_vec   = cpl_vector_new(nframes);
    cpl_vector * r0_vec   = cpl_vector_new(nframes);
    cpl_vector * hum_vec  = cpl_vector_new(nframes);
    double       ec, flux, l0, t0, r0, hum;
    int          i;


    bug_if(0);

    bug_if(nframes <= 0);

    for (i = 0; i < nframes; i++) {
        const cpl_propertylist * plist
            = irplib_framelist_get_propertylist_const(rawframes, i);

        bug_if(0);

        skip_if(cpl_vector_set(ec_vec,   i, naco_pfits_get_ecmean(plist)));
        skip_if(cpl_vector_set(flux_vec, i, naco_pfits_get_fluxmean(plist)));
        skip_if(cpl_vector_set(t0_vec,   i, naco_pfits_get_t0mean(plist)));
        skip_if(cpl_vector_set(l0_vec,   i, naco_pfits_get_l0mean(plist)));
        skip_if(cpl_vector_set(r0_vec,   i, naco_pfits_get_r0mean(plist)));
        skip_if(cpl_vector_set(hum_vec,  i,
                               naco_pfits_get_humidity_level(plist)));

    }

    bug_if(0);

    ec   = cpl_vector_get_median(ec_vec);   /* vector-permute */
    flux = cpl_vector_get_median(flux_vec); /* vector-permute */
    l0   = cpl_vector_get_median(l0_vec);   /* vector-permute */
    t0   = cpl_vector_get_median(t0_vec);   /* vector-permute */
    r0   = cpl_vector_get_median(r0_vec);   /* vector-permute */
    hum  = cpl_vector_get_mean(hum_vec);
    bug_if(0);

    cpl_propertylist_append_double(qclist, "ESO QC AMBI RHUM AVG", hum);
    cpl_propertylist_append_double(paflist, 
                                   "ESO AOS RTC DET DST L0MEAN", l0);
    cpl_propertylist_append_double(paflist, 
                                   "ESO AOS RTC DET DST T0MEAN", t0);
    cpl_propertylist_append_double(paflist, 
                                   "ESO AOS RTC DET DST R0MEAN", r0);
    cpl_propertylist_append_double(paflist, 
                                   "ESO AOS RTC DET DST ECMEAN", ec);
    cpl_propertylist_append_double(paflist, 
                                   "ESO AOS RTC DET DST FLUXMEAN", flux);
    bug_if(0);


    end_skip;

    cpl_vector_delete(ec_vec);
    cpl_vector_delete(flux_vec);
    cpl_vector_delete(r0_vec);
    cpl_vector_delete(t0_vec);
    cpl_vector_delete(l0_vec);
    cpl_vector_delete(hum_vec);

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    Get the broad band filter
  @param    filter  The filter name
  @return   The broadband filter id, or BAND_UNKNOWN on error
 */
/*----------------------------------------------------------------------------*/
static naco_band naco_get_bbfilter(const char * filter)
{
    naco_band self = BAND_UNKNOWN;


    bug_if (filter == NULL);

    if (!strcmp(filter, "J"))             self = BAND_J;
    else if (!strcmp(filter, "Jc"))       self = BAND_J;
    else if (!strcmp(filter, "H"))        self = BAND_H;
    else if (!strcmp(filter, "K"))        self = BAND_K;
    else if (!strcmp(filter, "Ks"))       self = BAND_KS;
    else if (!strcmp(filter, "L"))        self = BAND_L;
    else if (!strcmp(filter, "L_prime"))  self = BAND_LP;
    else if (!strcmp(filter, "M_prime"))  self = BAND_MP;
    else if (!strcmp(filter, "NB_1.04"))  self = BAND_J;
    else if (!strcmp(filter, "NB_1.08"))  self = BAND_J;
    else if (!strcmp(filter, "NB_1.09"))  self = BAND_J;
    else if (!strcmp(filter, "NB_1.24"))  self = BAND_J;
    else if (!strcmp(filter, "NB_1.26"))  self = BAND_J;
    else if (!strcmp(filter, "NB_1.28"))  self = BAND_J;
    else if (!strcmp(filter, "NB_1.64"))  self = BAND_H;
    else if (!strcmp(filter, "NB_1.75"))  self = BAND_H;
    else if (!strcmp(filter, "NB_3.74"))  self = BAND_L;
    else if (!strcmp(filter, "IB_2.00"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.03"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.06"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.09"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.12"))  self = BAND_K;
    else if (!strcmp(filter, "NB_2.12"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.15"))  self = BAND_K;
    else if (!strcmp(filter, "NB_2.17"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.18"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.21"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.24"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.27"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.30"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.33"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.36"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.39"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.42"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.45"))  self = BAND_K;
    else if (!strcmp(filter, "IB_2.48"))  self = BAND_K;
    else if (!strcmp(filter, "NB_4.05"))  self = BAND_M;
        /* As per email 2009-10-13 from epompei@eso.org */
    else if (!strcmp(filter, "IB_4.05"))  self = BAND_M;
    else if (!strcmp(filter, "SJ"))       self = BAND_UNKNOWN;
    else if (!strcmp(filter, "SH"))       self = BAND_UNKNOWN;
    else if (!strcmp(filter, "SK"))       self = BAND_UNKNOWN;

    error_if (self == BAND_UNKNOWN, CPL_ERROR_UNSUPPORTED_MODE, "No broad-"
              "band could be associated with the filter: %s", filter);

    end_skip;

    return self;
}


/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    Load the standard stars within the given tolerance
  @param    star_cat  The name of the standard star catalog
  @param    ra        The RA  [degree]
  @param    dec       The DEC [degree]
  @param    tol       The tolerance [degree]
  @return   A (possibly empty) table of the stars or NULL on error
  @note The table must be deallocated using cpl_table_delete()
 */
/*----------------------------------------------------------------------------*/
static cpl_table * naco_img_zpoint_load_std_star(const char * star_cat,
                                                 double ra, double dec,
                                                 double tol)
{

    cpl_table    * self = cpl_table_load(star_cat, 1, 0);
    const double * pra
        = cpl_table_get_data_double_const(self, IRPLIB_STDSTAR_RA_COL);
    const double * pdec
        = cpl_table_get_data_double_const(self, IRPLIB_STDSTAR_DEC_COL);
    const int      nrow = cpl_table_get_nrow(self);
    int i;

    skip_if(self == NULL);
    bug_if(star_cat == NULL);
    skip_if(pra == NULL);
    skip_if(pdec == NULL);
    skip_if(tol < 0.0);

    bug_if(cpl_table_unselect_all(self));

    for (i = 0; i < nrow; i++) {
        const double deci = pdec[i];

        if (deci > dec + tol || 
            deci < dec - tol || 
            irplib_wcs_great_circle_dist(ra, dec, pra[i], deci) > tol) {

            bug_if(cpl_table_select_row(self, i));

        }
    }

    if (cpl_table_count_selected(self) == nrow) {
        double mindist = DBL_MAX; /* Avoid uninit warning */
        int    idist   = 0;       /* Avoid uninit warning */

        for (i = 0; i < nrow; i++) {
            const double dist
                = irplib_wcs_great_circle_dist(ra, dec, pra[i], pdec[i]);

            if (i == 0 || dist < mindist) {
                idist = i;
                mindist = dist;
            }
        }

        (void)cpl_error_set_message_macro(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                                          __FILE__, __LINE__,  "Catalog '%s' "
                                          "star %d of %d at (RA,DEC)=(%g,%g) "
                                          "is closest to target at "
                                          "(RA,DEC)=(%g,%g) with a too large "
                                          "distance of %g [degrees] > %g",
                                          star_cat, 1+idist, nrow, pra[idist],
                                          pdec[idist], ra, dec, mindist, tol);
    }

    bug_if(cpl_table_erase_selected(self));

    cpl_msg_info(cpl_func, "Loaded %d of %d stars from '%s' which are within "
                 "%g degrees from (RA,DEC)=(%g,%g)",
                 (int)cpl_table_get_nrow(self), nrow, star_cat, tol, ra, dec);
    if (cpl_msg_get_level() <= CPL_MSG_DEBUG) {
        cpl_table_dump(self, 0, cpl_table_get_nrow(self), stdout);
    }

    end_skip;

    return self;

}

/*-------------------------------------------------------------------------*/
/**
  @internal
  @brief    Return a band name
  @param    band    a BB
  @return   1 pointer to a static band name.
 */
/*--------------------------------------------------------------------------*/
static const char * naco_std_band_name(naco_band band)
{
    switch (band) {
        case BAND_J:        return "J"; 
        case BAND_JS:       return "Js";
        case BAND_JBLOCK:   return "J+Block";
        case BAND_H:        return "H";
        case BAND_K:        return "K";
        case BAND_KS:       return "Ks";
        case BAND_L:        return "L";
        case BAND_M:        return "M";
        case BAND_LP:       return "Lp";
        case BAND_MP:       return "Mp";
        case BAND_Z:        return "Z";
        case BAND_SZ:       return "SZ";
        case BAND_SH:       return "SH";
        case BAND_SK:       return "SK";
        case BAND_SL:       return "SL";
        default:            return "Unknown";
    } 
}

