/* $Id: visir_spectro.c,v 1.254 2013-09-24 10:46:00 jtaylor Exp $
 *
 * This file is part of the VISIR 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: jtaylor $
 * $Date: 2013-09-24 10:46:00 $
 * $Revision: 1.254 $
 * $Name: not supported by cvs2svn $
 */

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

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

#include "irplib_wavecal.h"

#include "visir_spectro.h"

#include "visir_utils.h"
#include "visir_pfits.h"
#include "visir_inputs.h"
#include "visir_parameter.h"
#include "visir_spc_distortion.h"

#include "irplib_framelist.h"

#include <cpl.h>

#include <string.h>
#include <math.h>
#include <float.h>
#include <assert.h>

/*----------------------------------------------------------------------------*/
/**
 * @defgroup visir_spectro   Functions for VISIR specific spectroscopy 
 *
 * TBD
 */
/*----------------------------------------------------------------------------*/

/*-----------------------------------------------------------------------------
                            Private structs
 -----------------------------------------------------------------------------*/

typedef struct {
    cpl_size             cost;    /* May be incremented for cost counting */
    cpl_size             xcost;   /* Ditto (can exclude failed fills) */
    cpl_size             ulines;  /* May be set to number of lines used */

    double               temp;   /* Temperature of dominant black-body (M1) */
    const cpl_vector   * vsymm;  /* Symmetric convolution vector from slit
                                    width, FWHM of transfer function and
                                    truncation width */

    const cpl_bivector * lines;  /* Sky spectrum, with
                                    increasing X-vector elements */
    const cpl_bivector * tqeff;  /* Spectrum of detector quantum efficiency with
                                    increasing X-vector elements */
} visir_spectrum_model;

/*-----------------------------------------------------------------------------
                            Private Function Prototypes
 -----------------------------------------------------------------------------*/


static cpl_error_code
visir_polynomial_shift_1d_from_correlation(cpl_polynomial *,
                                           const cpl_vector *,
                                           irplib_base_spectrum_model *,
                                           cpl_error_code (*)
                                           (cpl_vector *,
                                            const cpl_polynomial *,
                                            irplib_base_spectrum_model *),
                                           int, int, cpl_boolean,
                                           double *, double *);

static cpl_error_code visir_spectro_refine(cpl_polynomial *,
                                           const cpl_vector *,
                                           visir_spectrum_model *,
                                           const cpl_polynomial *,
                                           int, cpl_boolean, visir_spc_resol,
                                           double *, cpl_boolean *, double *);

static cpl_error_code visir_spectro_fill(cpl_vector *, const cpl_polynomial *,
                                         irplib_base_spectrum_model *);

static cpl_bivector * visir_spc_extract(cpl_image *, cpl_propertylist *,
                                        cpl_image **, int, int);

static cpl_error_code visir_spc_emission(cpl_bivector *, const cpl_vector *,
                                         const cpl_bivector *,
                                         const cpl_bivector *,
                                         const cpl_vector *, double);

static cpl_polynomial * visir_spc_phys_disp(int, double, visir_spc_resol, int,
                                            int);
static cpl_polynomial * visir_spc_phys_lrp(void);
static double visir_spc_get_dispersion(const cpl_polynomial *, double);
static cpl_error_code visir_vector_convolve_symm(cpl_vector *,
                                                 const cpl_vector *);
static cpl_vector * cpl_spc_convolve_init(int, double, double, int);

static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist *,
                                                int, double,
                                                cpl_boolean, double,
                                                const cpl_polynomial *,
                                                const cpl_polynomial *);

static cpl_error_code visir_spectro_qclist_obs(cpl_propertylist *,
                                               double, double);

static const double N_upper = 13.4e-6; /* Upper limit of N-band */
static const double whechelle = 35.8/2; /* Half the echelle width */

#ifndef VISIR_XC_LEN
#define VISIR_XC_LEN 50
#endif
#ifndef VISIR_XC_SUBSEARCH
#define VISIR_XC_SUBSEARCH 100
#endif

#ifndef VISIR_SPECTRO_SIGMA
#define VISIR_SPECTRO_SIGMA 3.0
#endif

/**@{*/

/*-----------------------------------------------------------------------------
                                Function code
 -----------------------------------------------------------------------------*/


cpl_error_code
visir_spc_extract_order(cpl_image ** order,
                        cpl_image ** comorder,
                        const cpl_image * combined,
                        const cpl_image * imhcycle,
                        const double wlen,
                        const visir_spc_config * pconfig,
                        const cpl_boolean do_ech,
                        int is_aqu)
{
    int icol1, icol2;
    int jcol1, jcol2;

    jcol1 = visir_parameterlist_get_int(pconfig->parlist, pconfig->recipename,
                                        VISIR_PARAM_REJLEFT);
    jcol2 = visir_parameterlist_get_int(pconfig->parlist, pconfig->recipename,
                                        VISIR_PARAM_REJRIGHT);


    if (do_ech) {
        skip_if (visir_spc_echelle_limit(&icol1, &icol2, wlen,
                                         pconfig->orderoffset,
                                         1, cpl_image_get_size_y(combined),
                                         is_aqu));
    } else {
        icol1 = 1;
        icol2 = cpl_image_get_size_x(imhcycle);
    }

    if (do_ech) {
        if (jcol1 != 0) {
            cpl_msg_info(cpl_func, "Ignoring %d leftmost columns from %d to %d",
                         jcol1, icol1, icol1 + jcol1);
            icol1 += jcol1;
        }
        if (jcol2 != 0) {
            cpl_msg_info(cpl_func, "Ignoring %d rightmost columns from %d to %d",
                         jcol2, icol2 - jcol2, icol2);
            icol2 -= jcol2;
        }
    } else {
        if (jcol1 != 0) {
            cpl_msg_info(cpl_func, "Ignoring %d leftmost columns", jcol1);
            icol1 += jcol1;
        }
        if (jcol2 != 0) {
            cpl_msg_info(cpl_func, "Ignoring %d rightmost columns", jcol2);
            icol2 -= jcol2;
        }
    }

    if (icol1 != 1 || icol2 != cpl_image_get_size_x(imhcycle)) {
        *order = visir_spc_column_extract(imhcycle, icol1, icol2,
                                          pconfig->plot);
        skip_if (0);

        *comorder = visir_spc_column_extract(combined, icol1, icol2,
                                             pconfig->plot);
        skip_if (0);

    } else {
        *order = cpl_image_duplicate(imhcycle);
        *comorder = cpl_image_duplicate(combined);
    }

    end_skip;

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Get Central Wavelength, Resolution and Slit width from a frameset
  @param    rawframes The list of VISIR observation frames
  @param    pwlen     The central wavelength [m]
  @param    pslitw    The slit width [pixel]
  @param    ptemp     The (optional) telescope (M1) temperature [Kelvin]
  @param    pfwhm     The spectral FWHM [pixel]
  @param    is_aqu         Whether working on aquarius detector
  @return   The resolution or 0 (VISIR_SPC_R_ERR) on error

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT
  - CPL_ERROR_ILLEGAL_INPUT

 */
/*----------------------------------------------------------------------------*/
visir_spc_resol visir_spc_get_res_wl(const irplib_framelist * rawframes,
                                     double * pwlen, double * pslitw,
                                     double * ptemp, double * pfwhm,
                                     int is_aqu)
{
    cpl_errorstate cleanstate = cpl_errorstate_get();
     /* Avoid (false) uninit warning */
    visir_spc_resol    resol = VISIR_SPC_R_ERR;
    char               ptmp[IRPLIB_FITS_STRLEN+1];
    double             wl, spx, pfov = 0.127; /* Avoid (false) uninit warning */
    double             sl = 0.0; /* Avoid (false) uninit warning */
    cpl_boolean        need_temp = ptemp != NULL;
    int                n;

    /* Check entries */
    cpl_ensure(rawframes != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
    cpl_ensure(pwlen     != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
    cpl_ensure(pslitw    != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
    cpl_ensure(pfwhm     != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);

    n = irplib_framelist_get_size(rawframes);

    cpl_ensure(n > 0, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);

     /* Allow 1 micron difference */
    skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_PIXSPACE,
                                      CPL_TYPE_DOUBLE, CPL_TRUE, 1e-6));

    /* The actual value depends on the age of the file :-( */
    skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_SLITWIDTH,
                                      CPL_TYPE_DOUBLE, CPL_FALSE, 0.0));

    skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_RESOL,
                                      CPL_TYPE_STRING, CPL_TRUE, 0.0));

    skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_SLITNAME,
                                      CPL_TYPE_STRING, CPL_TRUE, 0.0));

    for (int i = 0; i < n; i++) {
        const cpl_propertylist * plist;
        const char * filename =
            cpl_frame_get_filename(irplib_framelist_get_const(rawframes, i));
        const char * pfits;
        double wl_tmp, sl_tmp, spx_tmp, pfov_tmp;


        cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
                      VISIR_SPC_R_ERR);

        cpl_ensure(filename != NULL, CPL_ERROR_DATA_NOT_FOUND,
                      VISIR_SPC_R_ERR);

        plist = irplib_framelist_get_propertylist_const(rawframes, i);

        cpl_ensure(plist != NULL, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);

        wl_tmp = visir_pfits_get_wlen(plist);
        if (wl_tmp <= 0.0 || !cpl_errorstate_is_equal(cleanstate)) {
            irplib_error_recover(cleanstate, "Missing or invalid FITS card");
            wl_tmp = VISIR_SPC_LRP_CWLEN;
        }
        pfits = visir_pfits_get_resol(plist);
        if (pfits == NULL || !cpl_errorstate_is_equal(cleanstate)) {
            irplib_error_recover(cleanstate, "Missing or invalid FITS card");
            pfits = VISIR_SPC_LRP_NAME;
        }
        sl_tmp = visir_pfits_get_slitwidth(plist);
        spx_tmp = visir_pfits_get_pixspace(plist);

        /* FIXME: catch error 0.127, NULL, 0.127, ... */
        {
            pfov_tmp = visir_pfits_get_pixscale(plist);
            if (pfov_tmp <= 0.) {
                cpl_errorstate_set(cleanstate);
                cpl_msg_warning(cpl_func, VISIR_PFITS_STRING_PIXSCALE
                                " not set, falling back to 0.127");
                pfov_tmp = 0.127;
            }
        }
        
        cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
                      VISIR_SPC_R_ERR);

        if (i == 0) {
            
            visir_optmod ins_settings;

            sl = sl_tmp;
            spx = spx_tmp;
            wl = wl_tmp;
            pfov = pfov_tmp;

            /* Divide the slit width with the
               Spectral PFOV = 0.127 Arcseconds/pixel */
            *pslitw = sl / pfov; /* Convert Slit width from Arcseconds to pixel */

            *pwlen = wl * 1e-6; /* Convert from micron to m */

            strncpy(ptmp, pfits, IRPLIB_FITS_STRLEN);
            ptmp[IRPLIB_FITS_STRLEN] = '\0';

            cpl_msg_info(cpl_func, "RESOL [" VISIR_SPC_LRP_NAME "|LR|MR|HRS|HRG]"
                         " and WLEN [m] (%d frames): %s %g", n, ptmp, *pwlen);

            if (spx <= 0) {
                cpl_msg_error(cpl_func,"Pixel Spacing (%g) in %s is non-"
                              "positive", spx, filename);
                cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
            }

            if (*pslitw <= 0) {
                cpl_msg_error(cpl_func,"Slit Width (%g) in %s is non-positive",
                              sl, filename);
                cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
            }

            cpl_msg_info(cpl_func, "Slit Width [pixel] and Pixel Spacing [m]: "
                         "%g %g", *pslitw, spx);

            if (!strcmp(VISIR_SPC_LRP_NAME, ptmp)) {
                resol = VISIR_SPC_R_LRP;
            } else if (!strcmp("LR", ptmp)) {
                resol = VISIR_SPC_R_LR;
            } else if (!strcmp("MR", ptmp)) {
                resol = VISIR_SPC_R_MR;
            } else if (!strcmp("HRS", ptmp)) {
                resol = VISIR_SPC_R_HR;
            } else if (!strcmp("HRG", ptmp)) {
                resol = VISIR_SPC_R_GHR;
            } else {
                cpl_msg_error(cpl_func,"Unsupported resolution (%s) in %s",
                              ptmp, filename);
                cpl_ensure(0, CPL_ERROR_UNSUPPORTED_MODE, VISIR_SPC_R_ERR);
            }

            if (resol != VISIR_SPC_R_LRP) {
                /* Allow 1 nm difference */
                skip_if(irplib_framelist_contains(rawframes,
                                                  VISIR_PFITS_DOUBLE_WLEN,
                                                  CPL_TYPE_DOUBLE, CPL_TRUE,
                                                  1e-3));
            }

            if (visir_spc_optmod_init(resol, *pwlen, &ins_settings, is_aqu)) {
                cpl_msg_error(cpl_func, "Resolution %s does not support "
                              "Central Wavelength [m]: %g", ptmp, *pwlen);
                cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
            }

            cpl_msg_info(cpl_func, "The %s-Spectral Resolution at %gm: %g",
                         ptmp, *pwlen,
                         visir_spc_optmod_resolution(&ins_settings));
            cpl_msg_info(cpl_func, "The %s-Linear Dispersion at %gm [pixel/m]: "
                         "%g", ptmp, *pwlen,
                         visir_spc_optmod_dispersion(&ins_settings));

            *pfwhm  = *pwlen * visir_spc_optmod_dispersion(&ins_settings)
                / visir_spc_optmod_resolution(&ins_settings);

            cpl_msg_info(cpl_func, "The %s-FWHM at %gm [pixel]: %g",
                         ptmp, *pwlen, *pfwhm);
        } else {
            if (fabs(sl-sl_tmp) > 1e-3) { /* Allow 1 micron difference */
                cpl_msg_error(cpl_func, "Inconsistent slit width (%g <=>"
                              " %g) in %s (%d of %d)",
                              sl, sl_tmp, filename, i+1, n);
                cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
            }
            if (fabs(pfov-pfov_tmp) > 1e-4) { /* Allow 1 micron difference */
                cpl_msg_error(cpl_func, "Inconsistent pfov (%g <=>"
                              " %g) in %s (%d of %d)",
                              pfov, pfov_tmp, filename, i+1, n);
                cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
            }
        }
        if (need_temp) {
            /* Temperature [Celcius] not yet found */
            const double temp = visir_pfits_get_temp(plist);
            if (cpl_error_get_code()) {
                visir_error_reset("Could not get FITS key");
            } else if ((-20 < temp) && (temp < 60)) {
                /* Only accept a non-extreme temperature */
                need_temp = CPL_FALSE;
                *ptemp = temp;
            }
        }

    }

    if (need_temp) {
        cpl_msg_warning(cpl_func, "No FITS-files specify the M1 temperature, "
                     "using default");
        *ptemp = 10; /* Default is 10 Celcius */
    }


    if (ptemp != NULL) {
        *ptemp += 273.15; /* Convert to Kelvin */
        cpl_msg_info(cpl_func, "The M1 temperature [Kelvin]: %g", *ptemp);
    }

    end_skip;

    return resol;

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Resample a vector according to the source and boundaries
  @param    self     Preallocated vector to hold resampled result
  @param    xbounds  Boundary points
  @param    source   Bivector with the source of the resampling
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.
  @note The length of xbounds must be one higher than that of the result.

  Internally, a copy of the source is resampled to the boundary-points.
  The resampled value specified by two boundary points is the weighted average
  of the values at the boundary points and the source points in between.

  If a value is to be sampled from an interval outside of that covered by the
  source the function fails (no extrapolation allowed).

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_vector_resample(cpl_vector * self, 
                                     const cpl_vector * xbounds,
                                     const cpl_bivector * source)
{

    const cpl_vector * xsource  = cpl_bivector_get_x_const(source);
    const cpl_vector * ysource  = cpl_bivector_get_y_const(source);

    const double     * pxsource = cpl_vector_get_data_const(xsource);
    const double     * pysource = cpl_vector_get_data_const(ysource);
    const double     * pxbounds = cpl_vector_get_data_const(xbounds);


    cpl_vector   * ybounds  = cpl_vector_new(cpl_vector_get_size(xbounds));
    IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual)
    cpl_bivector * boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,
                                                        ybounds);
    IRPLIB_DIAG_PRAGMA_POP
    double       * pybounds = cpl_vector_get_data(ybounds);

    double       * pself  = cpl_vector_get_data(self);
    const int      npix   = cpl_vector_get_size(self);
    int i;
    int itt;


    cpl_ensure_code(cpl_bivector_get_size(boundary) == npix + 1,
                        CPL_ERROR_ILLEGAL_INPUT);

    skip_if (0);

    itt = cpl_vector_find(xsource, pxbounds[0]);

    skip_if (0);

    skip_if (cpl_bivector_interpolate_linear(boundary, source));

    /* At this point itt most likely points to element just below
       pxbounds[0] */
    while (pxsource[itt] < pxbounds[0]) itt++;

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

        /* The i'th value is the weighted average of the two interpolated
           values at the boundaries and the source values in between */

        double xlow  = pxbounds[i];
        double x     = pxsource[itt];

        if (x > pxbounds[i+1]) x = pxbounds[i+1];
        /* Contribution from interpolated value at lower boundary */
        pself[i] = pybounds[i] * (x - xlow);

        /* Contribution from table values in between boundaries */
        while (pxsource[itt] < pxbounds[i+1]) {
            const double xprev = x;
            x = pxsource[itt+1];
            if (x > pxbounds[i+1]) x = pxbounds[i+1];
            pself[i] += pysource[itt] * (x - xlow);
            xlow = xprev;
            itt++;
        }

        /* Contribution from interpolated value at upper boundary */
        pself[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);

        /* Compute average by dividing integral by length of sampling interval
           (the factor 2 comes from the contributions) */
        pself[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);

    }


    end_skip;

    cpl_vector_delete(ybounds);
    cpl_bivector_unwrap_vectors(boundary);

    return cpl_error_get_code();
}



/*----------------------------------------------------------------------------*/
/**
  @brief    The Spectrum Extraction and Wavelength Calibration
  @param    combined       Spectroscopic image
  @param    hcycle         Half-cycle image - with atmospheric lines
  @param    wlen           Central wavelength
  @param    slitw          The slit width
  @param    temp           The telescope (M1) temperature [Kelvin]
  @param    fwhm           The spectral FWHM [pixel]
  @param    resol          Resolution
  @param    ioffset        HRG order offset (0 for main)
  @param    spc_cal_lines  File with emission lines
  @param    spc_cal_qeff   File with detector quantum efficiency
  @param    pspc_table     Table with output fields
  @param    pweight2d      2D weights image to be created or NULL on error
  @param    qclist         QC Properties are appended to this list
  @param    doplot         Plotting level (zero for none)
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

  The cross-correlation is undefined in case of an error.

  The table *pspc_table must be deallocated with cpl_table_delete().

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_spc_extract_wcal(const cpl_image * combined,
                                      const cpl_image * hcycle,
                                      double wlen, double slitw,
                                      double temp, double fwhm,
                                      visir_spc_resol resol,
                                      int ioffset,
                                      const char * spc_cal_lines,
                                      const char * spc_cal_qeff,
                                      cpl_table ** pspc_table,
                                      cpl_image ** pweight2d,
                                      cpl_propertylist * qclist,
                                      int doplot, int bkgcorrect,
                                      int is_aqu)
{

    /* Both spectrum and error */
    cpl_bivector  * spc_n_err = NULL;
    cpl_image     * flipped   = NULL;
    const int       npix = cpl_image_get_size_y(combined);


    cpl_ensure_code(pweight2d != NULL, CPL_ERROR_NULL_INPUT);

    *pweight2d = NULL;

    cpl_ensure_code(npix > 0, CPL_ERROR_ILLEGAL_INPUT);
    error_if(npix != cpl_image_get_size_y(hcycle), CPL_ERROR_ILLEGAL_INPUT,
             "Sky frame does not have same size as the object frame."
             " %d vs %d pixels", (int)cpl_image_get_size_y(hcycle), npix);


    skip_if (0);

    skip_if (visir_spc_wavecal(hcycle, qclist, wlen, slitw, temp, fwhm, resol,
                               ioffset, spc_cal_lines, spc_cal_qeff,
                               pspc_table, doplot, is_aqu));

    /* Convert the combined image */
    flipped = cpl_image_cast(combined, CPL_TYPE_DOUBLE);
    skip_if (0);

    /* Extract spectrum with error from the combined image */
    /* FIXME: Move inside */
    spc_n_err = visir_spc_extract(flipped, qclist, pweight2d,
                                  doplot, bkgcorrect);
    skip_if (0);

    cpl_image_delete(flipped);
    flipped = NULL;

    skip_if (*pspc_table == NULL);

    skip_if (cpl_table_new_column(*pspc_table, "SPC_EXTRACTED", CPL_TYPE_DOUBLE));
    skip_if (cpl_table_new_column(*pspc_table, "SPC_ERROR", CPL_TYPE_DOUBLE));

    skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_EXTRACTED", "ADU/s"));
    skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_ERROR", "ADU/s"));

    skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_EXTRACTED", 
                                        cpl_bivector_get_x_data(spc_n_err)));
    skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_ERROR", 
                                        cpl_bivector_get_y_data(spc_n_err)));

    if (doplot) {
        visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
                         "t 'Extracted Spectrum' w linespoints",
                         "", *pspc_table, "WLEN", "SPC_EXTRACTED");
        visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
                         "t 'Error on Extracted Spectrum' w linespoints",
                         "", *pspc_table, "WLEN", "SPC_ERROR");
    }

    end_skip;

    cpl_image_delete(flipped);
    cpl_bivector_delete(spc_n_err);

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    The Wavelength Calibration
  @param    hcycle         Half-cycle spectroscopic image of the atmosphere
  @param    qclist         QC Properties are appended to this list
  @param    wlen           Central wavelength
  @param    slitw          The slit width
  @param    temp           The telescope (M1) temperature [Kelvin]
  @param    fwhm           The spectral FWHM [pixel]
  @param    resol          Resolution
  @param    ioffset        HRG order offset (0 for main)
  @param    linefile       File with emission lines
  @param    qefffile       File with detector quantum efficiency
  @param    pspc_table     Table with output fields
  @param    doplot         Plotting level (zero for none)
  @param    is_aqu         Whether working on aquarius data
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

  The cross-correlation is undefined in case of an error.

  The number of rows in the output table equals the number of rows in the
  spectroscopic image, ie. the number of pixels in the spectral direction.

  The table *pspc_table must be deallocated with cpl_table_delete().

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_spc_wavecal(const cpl_image * hcycle,
                                 cpl_propertylist * qclist,
                                 double wlen, double slitw,
                                 double temp, double fwhm,
                                 visir_spc_resol resol,
                                 int ioffset,
                                 const char * linefile,
                                 const char * qefffile,
                                 cpl_table ** pspc_table, int doplot,
                                 int is_aqu)
{

    /* Dispersion relation from physical model */
    cpl_polynomial * phdisp = NULL;
    /* Dispersion relation corrected by cross-correlation */
    cpl_polynomial * xcdisp = NULL;

    visir_spectrum_model mymodel;
    cpl_vector   * wlvals  = NULL;
    cpl_vector   * spmodel = NULL;

    cpl_bivector * emission = NULL;
    cpl_vector   * boundary = NULL;

    cpl_bivector * temiss = NULL;
    cpl_bivector * tqeff  = NULL;

    cpl_image    * corrected = NULL;

    cpl_image    * xc_image  = NULL;
    cpl_vector   * xc_vector = NULL;

    cpl_vector   * vsymm     = NULL;
    cpl_vector   * vxc       = NULL;

    const int      npix = cpl_image_get_size_y(hcycle);
#if 0
    double         xc0;
#endif
    double         qcxc = -1.0, qcsubdelta = 0.; /* avoid false unint warning */
    double         hc_min;
    const cpl_size i0 = 0;
    const cpl_size i1 = 1;
    cpl_boolean    didshift = CPL_FALSE;


    cpl_ensure_code(!cpl_error_get_code(), cpl_error_get_code());
    cpl_ensure_code(pspc_table, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(npix > 0,   CPL_ERROR_ILLEGAL_INPUT);


    /* Make sure the corrected image is of type double */
    corrected = cpl_image_cast(hcycle, CPL_TYPE_DOUBLE);
    skip_if (0);

    hc_min = cpl_image_get_min(corrected);
    skip_if (0);
    cpl_msg_info(cpl_func,"Half-cycle image [%d X %d] has minimum intensity: %g",
                 (int)cpl_image_get_size_x(hcycle), npix, hc_min);
    if (hc_min < 0) {
        cpl_msg_warning(cpl_func, "Thresholding negative intensities in half-"
                        "cycle image: %g", hc_min);
        skip_if (cpl_image_threshold(corrected, 0.0, DBL_MAX, 0.0, DBL_MAX));
    } else if (hc_min > 0) {
        skip_if (cpl_image_subtract_scalar(corrected, hc_min));
    }      

    xc_image = cpl_image_duplicate(corrected);

    /* Average the spatial dimension - into a cpl_vector */
    cpl_image_delete(corrected);
    corrected = cpl_image_collapse_create(xc_image, 1);
    cpl_image_delete(xc_image);
    xc_image = corrected;
    corrected = NULL;

    skip_if(cpl_image_divide_scalar(xc_image, npix));

    xc_vector = cpl_vector_wrap(npix, cpl_image_get_data(xc_image));

    skip_if (0);

#ifdef VISIR_SPC_LRP
    phdisp = visir_spc_phys_lrp();
    cpl_msg_info(cpl_func, "Central Dispersion (physical model) [pixel/m]: %g",
                 1.0/visir_spc_get_dispersion(phdisp, npix/2.0 + 0.5));
    cpl_msg_info(cpl_func, "Central Wavelength (physical model) [m]: %g",
                 cpl_polynomial_eval_1d(phdisp, npix/2.0 + 0.5, NULL));
    cpl_msg_info(cpl_func, "First Wavelength (physical model) [m]: %g",
                 cpl_polynomial_eval_1d(phdisp, 1.0, NULL));
    cpl_msg_info(cpl_func, "Last Wavelength (physical model) [m]: %g",
                 cpl_polynomial_eval_1d(phdisp, 1024, NULL));
    cpl_polynomial_dump(phdisp, stdout);
    cpl_polynomial_delete(phdisp);
#endif

    phdisp = visir_spc_phys_disp(npix, wlen, resol, ioffset, is_aqu);
    skip_if (0);

    if (cpl_polynomial_get_degree(phdisp) == 2) {
        const cpl_size i2 = 2;
        cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
                     " %gmum + ipix * %gmum/pixel + ipix^2 * (%g)mum/pixel^2 "
                     "[ipix = 1, 2, ..., %d]",
                     cpl_polynomial_get_coeff(phdisp, &i0) * 1e6,
                     cpl_polynomial_get_coeff(phdisp, &i1) * 1e6,
                     cpl_polynomial_get_coeff(phdisp, &i2) * 1e6,
                     npix);
    }
    else {
        cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
                     " %gmum + ipix * %gmum/pixel [ipix = 1, 2, ..., %d]",
                     cpl_polynomial_get_coeff(phdisp, &i0) * 1e6,
                     cpl_polynomial_get_coeff(phdisp, &i1) * 1e6, npix);
    }

    temiss = visir_bivector_load_fits(linefile, "Wavelength", "Emission", 1);
    any_if ("Could not load file with Emission Lines");

    tqeff  = visir_bivector_load_fits(qefffile, "Wavelength", "Efficiency",
                                      npix > 256 ? 2 : 1);
    any_if("Could not load file with Quantum-Efficiencies");

    if (doplot) {
        visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t '"
                            "Quantum Efficiency' w linespoints", "", tqeff);
    }

    vsymm = cpl_spc_convolve_init(npix, slitw, fwhm, doplot);

    skip_if (vsymm == NULL);

    vxc = cpl_vector_new(1);
    xcdisp = cpl_polynomial_new(1);

    mymodel.lines = temiss;
    mymodel.tqeff = tqeff;
    mymodel.vsymm = vsymm;
    mymodel.temp  = temp;
    mymodel.ulines = 0;
    mymodel.cost = 0;
    mymodel.xcost = 0;

    skip_if(visir_spectro_refine(xcdisp, xc_vector, &mymodel, phdisp,
                                 VISIR_XC_LEN, doplot, resol,
                                 &qcxc, &didshift, &qcsubdelta));

    if (didshift) {
        if (fabs(qcsubdelta) >= VISIR_XC_LEN) {
            cpl_msg_warning(cpl_func, "Cross-correlation (%g pixel shift): %g",
                            qcsubdelta, qcxc);
        } else {
            cpl_msg_info(cpl_func,"Cross-correlation (%g pixel shift): %g",
                         qcsubdelta, qcxc);
        }
    }

    cpl_msg_info(cpl_func, "Dispersion polynomial from cross-correlation: "
                 "%gm + ipix * %gm/pixel [ipix = 1, 2, ..., %d]",
                 cpl_polynomial_get_coeff(xcdisp, &i0),
                 cpl_polynomial_get_coeff(xcdisp, &i1), npix);

    cpl_msg_info(cpl_func, "New Central Wavelength [m]: %g",
                 cpl_polynomial_eval_1d(xcdisp, 0.5*npix+0.5, NULL));

    *pspc_table = cpl_table_new(npix);
    skip_if (0);

    /* Generate the new wavelengths based on the cross-correlation shift */
    wlvals = cpl_vector_new(npix);
    bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(wlvals),
                                  "WLEN"));

    skip_if (cpl_vector_fill_polynomial(wlvals, xcdisp, 1.0, 1.0));

    /*  Dump the unshifted model spectrum to the table */
    spmodel = cpl_vector_new(npix);
    bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
                                  "SPC_MODEL_PH"));
    skip_if (visir_spectro_fill(spmodel, phdisp,
                                (irplib_base_spectrum_model*)&mymodel));

    /* - and the wavelength calibrated model spectrum */
    (void)cpl_vector_unwrap(spmodel);
    spmodel = cpl_vector_new(npix);
    bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
                                  "SPC_MODEL_XC"));

    skip_if (visir_spectro_fill(spmodel, xcdisp,
                                (irplib_base_spectrum_model*)&mymodel));

    bug_if (cpl_table_wrap_double(*pspc_table,
                                  cpl_image_get_data_double(xc_image),
                                  "SPC_SKY"));
    (void)cpl_image_unwrap(xc_image);
    xc_image = NULL;

    /* Get the emissivity (range 0 to 1) for the calibrated wavelengths */
    (void)cpl_vector_unwrap(spmodel);
    spmodel = cpl_vector_new(npix);
    bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
                                  "SPC_EMISSIVITY"));

    boundary = cpl_vector_new(npix + 1);
    skip_if (cpl_vector_fill_polynomial(boundary, xcdisp, 0.5, 1.0));
    skip_if (visir_vector_resample(spmodel, boundary, temiss));

    bug_if (cpl_table_set_column_unit(*pspc_table, "WLEN", "m"));
    bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_PH",
                                       "J*radian/m^3/s"));
    bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_XC",
                                       "J*radian/m^3/s"));
    bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_SKY", "ADU/s"));

    /* If the spectrum goes into N-band the sky spectrum may have variable
       atmospheric features, that are not in the model used for the model
       spectrum. This can cause the wavelength calibration to yield completely
       wrong results */
    if (resol != VISIR_SPC_R_LRP && cpl_vector_get(wlvals, 0) < N_upper &&
        N_upper < cpl_vector_get(wlvals, npix-1))
        cpl_msg_warning(cpl_func, "Spectrum goes above N-band (%gm). Wavelength"
                        " Calibration may be entirely inaccurate", N_upper);

    bug_if(visir_spectro_qclist_wcal(qclist, npix, qcxc, didshift, qcsubdelta,
                                     phdisp, xcdisp));

    if (doplot) {
        cpl_bivector * plot = cpl_bivector_wrap_vectors(wlvals, xc_vector);

        visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t 'Spec"
                            "trum from Half-cycle' w linespoints", "", plot);
        cpl_bivector_unwrap_vectors(plot);

        visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
                          "t 'Calibrated Model Spectrum' w linespoints",
                          "", *pspc_table, "WLEN", "SPC_MODEL_XC");

        /* The unshifted model spectrum */
        visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
                          "t 'Physical Model Spectrum' w linespoints",
                          "", *pspc_table, "WLEN", "SPC_MODEL_PH");

        if (resol != VISIR_SPC_R_LRP) {

            /* Create an model spectrum of twice the npix length */
            emission = cpl_bivector_new(2 * npix);

            cpl_vector_delete(boundary);
            boundary = cpl_vector_new(2 * npix + 1);

            cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
                                       phdisp, -0.5*npix, 1);
            cpl_vector_fill_polynomial(boundary, phdisp, -0.5*(npix+1), 1);

            /* Get the emission at those wavelengths */
            visir_spc_emission(emission, boundary, temiss, tqeff, vsymm, temp);
            cpl_vector_delete(boundary);
            boundary = NULL;

            visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
                                "t 'Extended Model Spectrum' w linespoints",
                                "", emission);
        }
    }

    end_skip;

    (void)cpl_vector_unwrap(wlvals);
    (void)cpl_vector_unwrap(spmodel);
    cpl_polynomial_delete(phdisp);
    cpl_polynomial_delete(xcdisp);
    cpl_image_delete(xc_image);
    cpl_vector_delete(vsymm);
    cpl_image_delete(corrected);
    cpl_bivector_delete(temiss);
    cpl_bivector_delete(tqeff);
    cpl_vector_delete(boundary);
    cpl_bivector_delete(emission);
    (void)cpl_vector_unwrap(xc_vector);
    cpl_vector_delete(vxc);

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Find the column bounds on one order from a HR Grism Echelle
  @param    pcol1          First column of the requested order
  @param    pcol2          Last  column of the requested order
  @param    wlen           Central wavelength
  @param    ioffset        Which one of the HRG orders to extract (0 for main)
  @param    icolmin        Lower bound on the column to be extracted (f.ex. 1)
  @param    icolmax        Upper bound on the column to be extracted (f.ex. 256)
  @param    is_aqu         Whether working on aquarius detector
  @return   CPL_ERROR_NONE, or the relevant CPL-error code.

  As there are at most 5 orders in one echelle image ioffset may never exceed
  the range -4 to 4. Additionally, the main order + ioffset must be in the range
  1 through 18.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_spc_echelle_limit(int * pcol1, int * pcol2, double wlen,
                                       int ioffset, int icolmin, int icolmax,
                                       int is_aqu)
{

    visir_optmod ins_settings;
    double echpos;
    double wleni;   /* The central wavelength at order offset ioffset */
    int order;
    int error;


    cpl_ensure_code(wlen > 0,              CPL_ERROR_ILLEGAL_INPUT);
    cpl_ensure_code(pcol1,                 CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pcol2,                 CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(icolmin > 0,           CPL_ERROR_ILLEGAL_INPUT);
    cpl_ensure_code(icolmax >= icolmin,    CPL_ERROR_ILLEGAL_INPUT);
    /* There are up to 5 spectra in the imaage */
    cpl_ensure_code(ioffset >= -4,         CPL_ERROR_ILLEGAL_INPUT);
    cpl_ensure_code(ioffset <=  4,         CPL_ERROR_ILLEGAL_INPUT);

    error = visir_spc_optmod_init(VISIR_SPC_R_GHR, wlen, &ins_settings, is_aqu);
    if (error) {
        cpl_msg_error(cpl_func, "HRG Optical model initialization (%p) failed: %d "
                      "(%g)", (void*)&ins_settings, error, wlen);
        cpl_ensure_code(0, CPL_ERROR_ILLEGAL_INPUT);
    }
    order = ioffset + visir_spc_optmod_get_echelle_order(&ins_settings);

    /* There are 18 echelle orders */
    cpl_ensure_code(order >   0,           CPL_ERROR_ILLEGAL_INPUT);
    cpl_ensure_code(order <= 18,           CPL_ERROR_ILLEGAL_INPUT);

    wleni = visir_spc_optmod_echelle(&ins_settings, wlen, ioffset  );

    echpos = visir_spc_optmod_cross_dispersion(&ins_settings, wleni);
    if (echpos <= whechelle || echpos >= icolmax-whechelle) {
        cpl_msg_error(cpl_func, "Echelle (%d) location out of range [%d;%d]: %g",
                      order, icolmin, icolmax, echpos);
        cpl_ensure_code(0, CPL_ERROR_DATA_NOT_FOUND);
    }

    *pcol1 = ceil(echpos - whechelle); /* Round up */
    *pcol2 = echpos + whechelle; /* Round down */

    if (*pcol1 < icolmin) *pcol1 = icolmin;
    if (*pcol2 > icolmax) *pcol2 = icolmax;

    cpl_msg_info(cpl_func, "Echelle order %d at col %g [%d; %d]", order, echpos,
                 *pcol1, *pcol2);

    return cpl_error_get_code();

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Extract columns from a (spectroscopic) image
  @param    self           (spectroscopic) image
  @param    icol1          Leftmost column, 1 to keep all
  @param    icol2          Rightmost column, ncol (256) to keep all
  @param    doplot         Plotting level (zero for none)
  @return   extracted image or NULL on error.

  With doplot == 0 this call is equivalent to
  cpl_image_extract(self, icol1, 1, icol2, cpl_image_get_size_x(self)).

 */
/*----------------------------------------------------------------------------*/
cpl_image * visir_spc_column_extract(const cpl_image * self, int icol1,
                                     int icol2, int doplot)
{

    cpl_image  * band    = NULL;
    cpl_image  * spatial = NULL;
    const int nrow = cpl_image_get_size_y(self);
    const int ncol = cpl_image_get_size_x(self);

    cpl_ensure(self != NULL,   CPL_ERROR_NULL_INPUT,    NULL);
    cpl_ensure(icol1 > 0,      CPL_ERROR_ILLEGAL_INPUT, NULL);
    cpl_ensure(icol2 >= icol1, CPL_ERROR_ILLEGAL_INPUT, NULL);

    cpl_ensure(ncol >= icol2,  CPL_ERROR_ILLEGAL_INPUT, NULL);

    band = cpl_image_extract(self, icol1, 1, icol2, nrow);
    skip_if (0);

    if (doplot > 0) {
        visir_image_plot("", "t 'The full-width image'", "", self);

        if (doplot > 1) {
            /* Average the spectral dimension */
            spatial = cpl_image_collapse_create(self, 0);
            skip_if (0);
            skip_if (cpl_image_divide_scalar(spatial, nrow));

            visir_image_row_plot("set grid;", "t 'Spectral direction "
                                 "collapsed' w linespoints", "",
                                 spatial, 1, 1, 1);
        }
    }

    end_skip;

    cpl_image_delete(spatial);
    if (cpl_error_get_code() && band != NULL) {
        cpl_image_delete(band);
        band = NULL;
    }

    return band;

}


/*----------------------------------------------------------------------------*/
/**
  @brief    Append the QC parameters to the propertylists
  @param    qclist      List of QC parameters
  @param    paflist     (Empty) list to be filled with PAF parameters
  @param    drop_wcs    True iff WCS is to be dropped
  @param    rawframes   List of rawframes and their propertylists
  @param    regcopy     Regexp of properties to copy from reference frame
  @param    regcopypaf  Regexp of properties to copy to paf from reference frame
  @note     It is a bug in the pipeline if this functions fails
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_spectro_qc(cpl_propertylist * qclist,
                                cpl_propertylist * paflist,
                                cpl_boolean        drop_wcs,
                                const irplib_framelist * rawframes,
                                const char * regcopy,
                                const char * regcopypaf)
{

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

    bug_if (0);

    bug_if (visir_qc_append_capa(qclist, rawframes));

    if (regcopy != NULL)
        bug_if (cpl_propertylist_copy_property_regexp(qclist, reflist,
                                                      regcopy, 0));

    if (regcopypaf != NULL)
        bug_if (cpl_propertylist_copy_property_regexp(paflist, reflist,
                                                      regcopypaf, 0));

    bug_if (cpl_propertylist_append(paflist, qclist));

    if (drop_wcs) {
        cpl_propertylist * pcopy = cpl_propertylist_new();
        const cpl_error_code error
            = cpl_propertylist_copy_property_regexp(pcopy, reflist, "^("
                                                    IRPLIB_PFITS_WCS_REGEXP
                                                    ")$", 0);
        if (!error && cpl_propertylist_get_size(pcopy) > 0) {
            cpl_msg_warning(cpl_func, "Combined image will have no WCS "
                            "coordinates");
        }
        cpl_propertylist_delete(pcopy);
        bug_if(0);
    } else {
        bug_if(cpl_propertylist_copy_property_regexp(qclist, reflist, "^("
                                                     IRPLIB_PFITS_WCS_REGEXP
                                                     ")$", 0));
    }

    end_skip;

    return cpl_error_get_code();

}


/**@}*/


/*----------------------------------------------------------------------------*/
/**
  @brief    Append the wcal QC parameters to the supplied list
  @param    self      The list of properties to be extended
  @param    npix      Number of columns in spectroscopic image
  @param    xc        Cross-correlation factor
  @param    didshift  subdelta is defined iff didshift is TRUE
  @param    subdelta  Pixel shift (sub pixel precision)
  @param    phdisp    Dispersion relation from physical model
  @param    xcdisp    Dispersion relation corrected by cross-correlation
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist * self,
                                                int npix, double xc,
                                                cpl_boolean didshift,
                                                double subdelta,
                                                const cpl_polynomial * phdisp,
                                                const cpl_polynomial * xcdisp)
{

    const cpl_size phdegree = cpl_polynomial_get_degree(phdisp);
    const cpl_size xcdegree = cpl_polynomial_get_degree(xcdisp);

    const double phdisp0  = cpl_polynomial_eval_1d(phdisp, 1.0, NULL);
    const double xcdisp0  = cpl_polynomial_eval_1d(xcdisp, 1.0, NULL);

    const double xcwlen   = cpl_polynomial_eval_1d(xcdisp, 0.5*(double)npix+0.5,
                                                   NULL);
    const double phcdisp = visir_spc_get_dispersion(phdisp, npix/2.0 + 0.5);
    const double xccdisp = visir_spc_get_dispersion(xcdisp, npix/2.0 + 0.5);
    cpl_size i;


    bug_if (0);
    skip_if (phdegree < 1);
    skip_if (xcdegree < 1);

    cpl_msg_info(cpl_func, "Central Dispersion (physical model) [m/pixel]: %g",
                 phcdisp);
    cpl_msg_info(cpl_func, "Central Dispersion (calibrated) [m/pixel]: %g",
                 xccdisp);

    bug_if (cpl_propertylist_append_double(self, "ESO QC XC",       xc));

    if (didshift)
        bug_if (cpl_propertylist_append_double(self, "ESO QC XCSHIFT", 
                                               subdelta));;

    bug_if (cpl_propertylist_append_int(self,    "ESO QC PHDEGREE", phdegree));
    bug_if (cpl_propertylist_append_double(self, "ESO QC PHDISPX0", phdisp0));
    for (i = 1; i <= phdegree; i++) {
        const double coeff = cpl_polynomial_get_coeff(phdisp, &i);
        char * label = cpl_sprintf("ESO QC PHDISPX%d", (int)i);

        bug_if (cpl_propertylist_append_double(self, label, coeff));
        cpl_free(label);
    }

    bug_if (cpl_propertylist_append_double(self, "ESO QC XCWLEN",   xcwlen));

    bug_if (cpl_propertylist_append_int(self,    "ESO QC XCDEGREE", xcdegree));
    bug_if (cpl_propertylist_append_double(self, "ESO QC XCDISPX0", xcdisp0));

    for (i = 1; i <= xcdegree; i++) {
        const double coeff = cpl_polynomial_get_coeff(xcdisp, &i);
        char * label = cpl_sprintf("ESO QC XCDISPX%d", (int)i);

        bug_if (cpl_propertylist_append_double(self, label, coeff));
        cpl_free(label);
    }

    end_skip;

    return cpl_error_get_code();

}



/*----------------------------------------------------------------------------*/
/**
  @brief    Append the spec-obs QC parameters to the supplied list
  @param    self      The list of properties to be extended
  @param    npix      Number of columns in spectroscopic image
  @param    xc        Cross-correlation factor
  @param    subdelta  Pixel shift (sub pixel precision)
  @param    phdisp    Dispersion relation from physical model
  @param    xcdisp    Dispersion relation corrected by cross-correlation
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_spectro_qclist_obs(cpl_propertylist * self,
                                               double xfwhm, double xcentro)
{


    bug_if (0);

    bug_if (cpl_propertylist_append_double(self, "ESO QC XFWHM",    xfwhm));
    bug_if (cpl_propertylist_append_double(self, "ESO QC XCENTROI", xcentro));

    end_skip;

    return cpl_error_get_code();

}


/*----------------------------------------------------------------------------*/
/**
  @brief    Convolve a vector with a symmetric vector
  @param    self   Preallocated vector to be convolved in place
  @param    vsymm  Vector with symmetric convolution function
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.
  @note The length of vsymm must be smaller than that of self.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT
 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_vector_convolve_symm(cpl_vector * self,
                                                 const cpl_vector * vsymm)
{

    const int      npix = cpl_vector_get_size(self);
    const int      ihwidth = cpl_vector_get_size(vsymm) - 1;
    cpl_vector   * raw     = cpl_vector_duplicate(self);
    double       * pself= cpl_vector_get_data(self);
    double       * praw    = cpl_vector_get_data(raw);
    const double * psymm  = cpl_vector_get_data_const(vsymm);

    int i, j;


    skip_if (0);

    /* The convolution does not support this */
    skip_if (ihwidth >= npix);

    /* Convolve with the symmetric function */
    for (i = 0; i < ihwidth; i++) {
        pself[i] = praw[i] * psymm[0];
        for (j = 1; j <= ihwidth; j++) {
            const int k = i-j < 0 ? 0 : i-j;
            pself[i] += (praw[k]+praw[i+j]) * psymm[j];
        }

    }

    for (i = ihwidth; i < npix-ihwidth; i++) {
        pself[i] = praw[i] * psymm[0];
        for (j = 1; j <= ihwidth; j++)
            pself[i] += (praw[i-j]+praw[i+j]) * psymm[j];

    }
    for (i = npix-ihwidth; i < npix; i++) {
        pself[i] = praw[i] * psymm[0];
        for (j = 1; j <= ihwidth; j++) {
            const int k = i+j > npix-1 ? npix - 1 : i+j;
            pself[i] += (praw[k]+praw[i-j]) * psymm[j];
        }

    }

    end_skip;

    cpl_vector_delete(raw);

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Flip (if needed) the spectral dimension of a VISIR 2D-spectro image
  @param    image   The image
  @param    wlen    Central wavelength (used only in HR/HRG mode)
  @param    resol   Resolution
  @param    dtype   Raw data type (aquarius modes or drs modes)
  @return   Flipped spectro image or NULL on error

  The returned cpl_image is of type double.
  It must be deallocated using cpl_image_delete().

  In LR and MR the image is flipped.
  In HR the image is flipped iff it is A-side.
  In LR Prism mode it is rotated 90 degrees clock wise

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT

 */
/*----------------------------------------------------------------------------*/
cpl_image * visir_spc_flip(const cpl_image * image, double wlen,
                           visir_spc_resol resol, visir_data_type dtype)
{
    cpl_image  * flipped = cpl_image_cast(image, CPL_TYPE_DOUBLE);
    visir_optmod ins_settings;


    skip_if (0);

    if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
        visir_spc_optmod_init(resol, wlen, &ins_settings,
                              visir_data_is_aqu(dtype))) {
        visir_error_set(CPL_ERROR_ILLEGAL_INPUT);
        skip_if (1);
    }

    /* The dispersion relation goes from the top of the image to the bottom
       - except aquarius , where the detector is rotated 90 degrees
       - except using the B-side (in high resolution) */
    if (visir_data_is_aqu(dtype)) {
        skip_if (cpl_image_turn(flipped, 1));
        if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
                 visir_spc_optmod_side_is_A(&ins_settings) == 0) {
            skip_if (cpl_image_flip(flipped, 0));
        }
    }

    else if ((resol != VISIR_SPC_R_HR && resol != VISIR_SPC_R_GHR) ||
        visir_spc_optmod_side_is_A(&ins_settings) > 0) {

        cpl_msg_info(cpl_func, "Flipping image");

        skip_if (cpl_image_flip(flipped, 0));
    }

    end_skip;

    if (cpl_error_get_code() && flipped) {
        cpl_image_delete(flipped);
        flipped = NULL;
    }

    return flipped;

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Compute a dispersion relation based on the physical model
  @param    npix       The number of rows in the VISIR image
  @param    wlen       Central wavelength
  @param    resol      Resolution
  @param    ioffset    HRG order offset (0 for main)
  @param    is_aqu         Whether working on aquarius detector
  @return   phdisp or NULL on error.

  The returned cpl_polynomial must be deallocated with cpl_polynomial_delete().

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT
  - CPL_ERROR_ILLEGAL_INPUT
 */
/*----------------------------------------------------------------------------*/
static cpl_polynomial * visir_spc_phys_disp(int npix, double wlen,
                                            visir_spc_resol resol, int ioffset,
                                            int is_aqu)
{

    cpl_polynomial * phdisp = NULL;
    visir_optmod     ins_settings;

    double dwl;
    double wlen0;
    double wlen1;
    double disp;
    const cpl_size i1 = 1;
    const cpl_size i0 = 0;


    cpl_ensure(resol,    CPL_ERROR_ILLEGAL_INPUT, NULL);
    cpl_ensure(wlen > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
    cpl_ensure(npix > 1, CPL_ERROR_ILLEGAL_INPUT, NULL);

    /* Initialize instrument-specific settings
        - the resolution is not needed hereafter
       visir_spc_optmod_init() does itself not use the CPL-error system
          because it is also used in a non-CPL scope */

    cpl_ensure(!visir_spc_optmod_init(resol, wlen, &ins_settings, is_aqu),
               CPL_ERROR_ILLEGAL_INPUT, NULL);

    /* Get wavelength range (and corresponding central-wavelength)
       visir_spc_optmod_wlen() does not use the CPL-error system
         because it is also used in a non-CPL scope */
    dwl = visir_spc_optmod_wlen(&ins_settings, &wlen0, &wlen1);

    cpl_ensure(dwl >= 0, CPL_ERROR_ILLEGAL_INPUT, NULL);

    /* Central-wavelength residual on Scan-Angle determination */
    dwl -= wlen;
    /* Warn if the residual exceeds twice the machine-precision */
    if (fabs(dwl) > 2*wlen*DBL_EPSILON) cpl_msg_warning(cpl_func, "Too large res"
        "idual in Scan-Angle determination [meps]: %g", dwl/DBL_EPSILON/wlen);

    if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
        !visir_spc_optmod_side_is_A(&ins_settings)) {
        const double swap = wlen1;
        wlen1 = wlen0;
        wlen0 = swap;
    }
    cpl_ensure(wlen1 > wlen0, CPL_ERROR_ILLEGAL_INPUT, NULL);

    if (resol == VISIR_SPC_R_LRP) {
        phdisp = visir_spc_phys_lrp();
    } else {
        /* Construct the 1st degree dispersion relation
           based on the physical model */
        phdisp = cpl_polynomial_new(1);

        /* The dispersion */
        disp = (wlen1-wlen0)/(npix-1);

        skip_if (0);

        skip_if (cpl_polynomial_set_coeff(phdisp, &i1, disp));

        skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0-disp));
    }

    if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
        !visir_spc_optmod_side_is_A(&ins_settings)) {
        cpl_msg_info(cpl_func,"HR B-side WLMin, WLMax, Disp: %g %g %g", wlen0,
                     wlen1, cpl_polynomial_get_coeff(phdisp, &i1));
    } else {
        cpl_msg_info(cpl_func,"WLMin, WLMax, Disp: %g %g %g", wlen0, wlen1,
                     cpl_polynomial_get_coeff(phdisp, &i1));
    }

    if (resol == VISIR_SPC_R_GHR && ioffset != 0) {
        /* Another HRG Echelle order is requested
           - shift the 1st degree polynomial */
        const double dispi = visir_spc_optmod_echelle(&ins_settings,
                                cpl_polynomial_get_coeff(phdisp, &i1), ioffset);
        const double wlen0i= visir_spc_optmod_echelle(&ins_settings,
                                cpl_polynomial_get_coeff(phdisp, &i0), ioffset);

        skip_if (cpl_polynomial_set_coeff(phdisp, &i1, dispi));

        skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0i));

        cpl_msg_info(cpl_func, "WLc relative error(%d): %g", ioffset,
                     (wlen0i - cpl_polynomial_eval_1d(phdisp, 1, NULL))/wlen0i);
    }


    end_skip;

    if (cpl_error_get_code() && phdisp != NULL) {
        cpl_polynomial_delete(phdisp);
        phdisp = NULL;
    }

    return phdisp;

}


/*----------------------------------------------------------------------------*/
/**
  @brief    Load a bivector from two columns of a fits-table
  @param    file   File with FITS-table
  @param    labelx The label of the column to put in x-vector
  @param    labely The label of the column to put in y-vector
  @param    extnum The extension number to load from
  @return   A bivector or NULL on error.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT

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

cpl_bivector * visir_bivector_load_fits(const char * file,
                                        const char * labelx,
                                        const char * labely,
                                        int          extnum)
{

    cpl_bivector     * result = NULL;
    cpl_table        * table  = NULL;
    cpl_propertylist * extlist = NULL;
    cpl_vector       * xwrapper;
    cpl_vector       * ywrapper;
    char             * sext = NULL;
    double           * prowx;
    double           * prowy;
    int                next;
    int                nlines;


    bug_if (extnum < 1);

    next = cpl_fits_count_extensions(file);
    any_if("Could not load FITS table from (extension %d in) file: %s",
           extnum, file ? file : "<NULL>");

    skip_if_lt(next, extnum, "extensions in file: %s", file);

    table = cpl_table_load(file, extnum, 0);
    any_if ("Could not load FITS table from extension %d of %d in file: %s",
            extnum, next, file ? file : "<NULL>");

    extlist = cpl_propertylist_load_regexp(file, extnum, "EXTNAME", 0);
    if (cpl_propertylist_has(extlist, "EXTNAME")) {
        const char * extname = cpl_propertylist_get_string(extlist, "EXTNAME");
        sext = cpl_sprintf(" (EXTNAME=%s)", extname);
    }

    nlines = cpl_table_get_nrow(table);
    skip_if_lt(nlines, 2, "rows in table from extension %d%s of %d "
               "in %s", extnum, sext, next, file);
    
    prowx = cpl_table_get_data_double(table, labelx);
    any_if("Table from extension %d%s of %d in %s has no column %s",
           extnum, sext, next, file, labelx);

    prowy = cpl_table_get_data_double(table, labely);
    any_if("Table from extension %d%s of %d in %s has no column %s",
           extnum, sext, next, file, labely);

    xwrapper = cpl_vector_wrap(nlines, prowx);
    ywrapper = cpl_vector_wrap(nlines, prowy);

    result = cpl_bivector_wrap_vectors(xwrapper, ywrapper);
    cpl_table_unwrap(table, labelx);
    cpl_table_unwrap(table, labely);

    cpl_msg_info(cpl_func, "Read %d rows from extension %d%s of %d "
                 "in %s [%g;%g]", nlines, extnum, sext, next, file,
                 cpl_vector_get(xwrapper, 0),
                 cpl_vector_get(ywrapper, nlines-1));

    end_skip;

    cpl_free(sext);
    cpl_table_delete(table);
    cpl_propertylist_delete(extlist);

    if (result && cpl_error_get_code()) {
        cpl_bivector_delete(result);
        result = NULL;
    }

    return result;

}


/*----------------------------------------------------------------------------*/
/**
  @brief    Construct the expected emission at the given wavelengths
  @param    emission  Bivector with the wavelengths in the x-vector
  @param    boundary  Vector with the wavelengths boundaries
  @param    temiss    Bivector with the atmospheric emission 
  @param    tqeff     Bivector with detector quantum efficiency
  @param    vsymm     Vector with symmetric convolution function
  @param    temp      The telescope (M1) temperature [Kelvin]
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

  The length of boundary must be one higher than that of emission.

  The result is stored in the y-vector of emission, while the x-vector with
  the wavelengths is unmodified.

  The expected emission is an model spectrum used to cross-correlate
  against an actual observed spectrum. The expected emission is a super-
  position of two black-body emissions, one contribution from the atmosphere
  (multiplied by the emissivity of the atmosphere), the second from the
  telescope itself (multiplied by its own emissivity).

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_spc_emission(cpl_bivector       * emission,
                                         const cpl_vector   * boundary,
                                         const cpl_bivector * temiss,
                                         const cpl_bivector * tqeff,
                                         const cpl_vector   * vsymm,
                                         double temp)
{
    cpl_bivector * tqeffi   = NULL;
    cpl_vector   * planck   = NULL;
    const int      npix = cpl_bivector_get_size(emission);


    bug_if(emission == NULL);
    bug_if(boundary == NULL);
    bug_if(temiss   == NULL);
    bug_if(tqeff    == NULL);

    /* npix is currently 256 */
    skip_if(npix <= 1);

    skip_if(cpl_vector_get_size(boundary) != npix + 1);

    planck = cpl_vector_new(npix);
    skip_if (0);

    /* The atmospheric emission is assumed to be equivalent to that of
       a Black Body at 253 K */
    cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
                              cpl_bivector_get_x(emission),
                              CPL_UNIT_LENGTH, 253);

    skip_if (visir_vector_resample(cpl_bivector_get_y(emission),
                                      boundary, temiss));

    /* Convolve to reflect the instrument resolution */
    skip_if (visir_vector_convolve_symm(cpl_bivector_get_y(emission),
                                            vsymm));

    skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission), planck));

    /* The telescope emission is assumed to be equivalent to that of
       a Black Body */
    cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
                              cpl_bivector_get_x(emission),
                              CPL_UNIT_LENGTH, temp);

    /* The telescope emissivity is assumed to be uniform at 0.12 */
    skip_if (cpl_vector_multiply_scalar(planck, 0.12));

    /* Add the telescope emission to the atmospheric */
    skip_if (cpl_vector_add(cpl_bivector_get_y(emission), planck));

    /* Multiply by the detector quantum efficiency */
    tqeffi = cpl_bivector_duplicate(emission);
    skip_if (cpl_bivector_interpolate_linear(tqeffi, tqeff));

    skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission),
                                 cpl_bivector_get_y(tqeffi)));

    end_skip;

    cpl_bivector_delete(tqeffi);
    cpl_vector_delete(planck);

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Initialize Right Half of a Symmetric convolution function
  @param    maxlen The maximum width that the convolution may have
  @param    slitw  The slit width [pixel]
  @param    fwhm   The spectral FWHM [pixel]
  @param    doplot Plotting level (zero for none)
  @return   Right Half of (symmetric) convolution vector

  The convolution function is the right half of the convolution of a Gaussian
  with sigma =  fwhm / (2 * sqrt(2*log(2)))
  and a top-hat with a width equal to the slit width.
  Since this function is symmetric only the central, maximum value and the
  right half is returned. The length of the resulting vector is the maximum of
  1 + 5 * sigma + slitw/2 and maxlen/2 (to protect against extreme smoothings),
  meaning that the ratio between the last, smallest elements and the first,
  largest element is less than 5e-5.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT

 */
/*----------------------------------------------------------------------------*/
static cpl_vector * cpl_spc_convolve_init(int maxlen, double slitw,
                                          double fwhm, int doplot)
{

    const double sigma  = fwhm * CPL_MATH_SIG_FWHM;
    const int ihtophat  = (int)slitw/2;
    const int gausshlen = 1 + 5 * sigma + ihtophat < maxlen/2
        ? 1 + 5 * sigma + ihtophat : maxlen/2 - 1;
    /* convolen must be at least twice the gausshlen */
    const int convolen  = 1 + 10 * sigma + 8*ihtophat;
    cpl_vector * self = cpl_vector_new(gausshlen);
    cpl_vector * tophat = cpl_vector_new(convolen);
    int i;

    /* Easiest way to fill with a Gaussian is via a CPL image */
    cpl_image  * iself = cpl_image_wrap_double(gausshlen, 1,
                                               cpl_vector_get_data(self));


    skip_if (0);

    skip_if( slitw <= 0.0);
    skip_if( fwhm  <= 0.0);
    skip_if( convolen < 2 * gausshlen); /* This would indicate a bug */

    /* Place the top point of the Gaussian on left-most pixel */
    skip_if (cpl_image_fill_gaussian(iself, 1.0, 1.0, CPL_MATH_SQRT2PI,
                                     sigma, 1.0));

    if (doplot > 2) visir_vector_plot("set grid;", "t 'Right Half of Gaussian' "
                                      "w linespoints", "", self);
    
    /* The number of non-zero elements is 1+2*ihtophat */
    skip_if( cpl_vector_fill(tophat, 0.0));

    for (i = convolen/2-ihtophat; i < 1+convolen/2+ihtophat; i++)
        skip_if (cpl_vector_set(tophat, i, 1.0/(1.0+2.0*ihtophat)));

    /* Convolve the Top-hat with the Gaussian */
    skip_if (visir_vector_convolve_symm(tophat, self));

    if (doplot > 2) visir_vector_plot("set grid;","t 'Full Width Convolution' "
                                      "w linespoints", "", tophat);
    
    /* Overwrite the Gaussian with the Right Half of the convolution of the
       Top-hat + Gausssian */
#if 1
    memcpy(cpl_vector_get_data(self),
           cpl_vector_get_data(tophat) + convolen/2,
           sizeof(double)*gausshlen);
#else
    /* Equivalent, but slower */
    for (i = 0 ; i < gausshlen; i++)
        skip_if (cpl_vector_set(self, i, cpl_vector_get(tophat,
                                                          i + convolen/2)));
#endif

    skip_if (0);

    cpl_msg_info(cpl_func, "Convolving Model Spectrum, Gauss-sigma=%g, "
                 "Tophat-width=%d, Truncation-Error=%g with width=%d", sigma,
                 1+2*ihtophat,
                 cpl_vector_get(self,gausshlen-1)/cpl_vector_get(self,0),
                 2*gausshlen-1);

    if (doplot > 1) visir_vector_plot("set grid;","t 'Right Half of Convolution"
                                      "' w linespoints", "", self);

    end_skip;

    cpl_vector_delete(tophat);
    cpl_image_unwrap(iself);

    if (cpl_error_get_code()) {
        cpl_vector_delete(self);
        self = NULL;
    }

    return self;

}


static cpl_error_code
fit_gaussians(const cpl_image * flipped, const cpl_vector * error,
              cpl_size icollo, cpl_size icolhi,
              cpl_propertylist * qclist)
{
    cpl_size nrow = cpl_image_get_size_y(flipped);
    cpl_size ncol = cpl_image_get_size_x(flipped);
    icollo = CX_MAX(1, icollo);
    icolhi = CX_MIN(ncol, icolhi);
    cpl_errorstate cleanstate = cpl_errorstate_get();
    double sigs[nrow];
    double sigs_err = 0.;
    double peaks[nrow];
    double peaks_err = 0.;
    size_t nmeas = 0;
    for (cpl_size row = 0; row < nrow; row++) {
        const cpl_binary * dmask = cpl_image_get_bpm_const(flipped) ?
            cpl_mask_get_data_const(cpl_image_get_bpm_const(flipped)) : NULL;
        const double *dflipped = cpl_image_get_data_double_const(flipped);
        double * dx = cpl_malloc(ncol * sizeof(*dx));
        double * dy = cpl_malloc(ncol * sizeof(*dy));
        double * dye = cpl_malloc(ncol * sizeof(*dye));
        cpl_vector * x;
        cpl_vector * y;
        cpl_vector * ye;
        size_t n = 0;
        for (cpl_size i = icollo; i <= icolhi; i++) {
            if (dmask == NULL || !dmask[row * ncol + i]) {
                dx[n] = i;
                dy[n] = dflipped[row * ncol + (i - 1)];
                dye[n] = cpl_vector_get(error, (i - 1));
                n++;
            }
        }
        if (n > 0) {
            x = cpl_vector_wrap(n, dx);
            y = cpl_vector_wrap(n, dy);
            ye = cpl_vector_wrap(n, dye);
            double x0, sigma, sigma_err, peak, peak_err;
            fit_1d_gauss(x, y, ye, &x0, NULL, &peak, &peak_err, &sigma, &sigma_err);
            if (cpl_error_get_code() != CPL_ERROR_NONE) {
                cpl_msg_debug(cpl_func, "FIT row %lld failed", row);
                cpl_errorstate_set(cleanstate);
            }
            else {
                sigs[nmeas] = sigma;
                peaks[nmeas] = peak;
                sigs_err += sigma * sigma;
                peaks_err += peak * peak;
                nmeas++;
                cpl_msg_debug(cpl_func, "FIT row %lld x %g sig %g +- %g "
                              "peak %g +- %g",
                              row, x0, sigma, sigma_err, peak, peak_err);
            }
            cpl_vector_delete(x);
            cpl_vector_delete(y);
            cpl_vector_delete(ye);
        }
        else {
            cpl_free(dx);
            cpl_free(dy);
            cpl_free(dye);
        }
    }
    cpl_vector * sigv = cpl_vector_wrap(nmeas, sigs);
    cpl_vector * peakv = cpl_vector_wrap(nmeas, peaks);
    double medsigma = cpl_vector_get_median(sigv);
    double medsigma_err = sqrt(sigs_err) * sqrt(CPL_MATH_PI_2) / nmeas;
    double medpeak = cpl_vector_get_median(peakv);
    double medpeak_err = sqrt(peaks_err) * sqrt(CPL_MATH_PI_2) / nmeas;
    cpl_msg_info(cpl_func, "Median FWHM of spectrum: %g +- %g, Peak %g +- %g",
                 medsigma, medsigma_err, medpeak, medpeak_err);
    cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT FWHM",
                                   medsigma * 2.355);
    cpl_propertylist_set_comment(qclist, "ESO QC GAUSSFIT FWHM", "[pix]");
    cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT FWHM_ERR",
                                   medsigma_err * 2.355);
    cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT PEAK", medpeak);
    cpl_propertylist_set_comment(qclist, "ESO QC GAUSSFIT PEAK", "[adu/s]");
    cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT PEAK_ERR",
                                   medpeak_err);
    cpl_vector_unwrap(sigv);
    cpl_vector_unwrap(peakv);

    return cpl_error_get_code();
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief add background error (PIPE-6744)
 *
 * @param flipped input 2d spectrum, wavelength in y
 * @param qclist  qc property list, QC BACKGD SIGMA gets added
 */
/* ---------------------------------------------------------------------------*/
static cpl_error_code
add_qc_background_sigma(const cpl_image * flipped, cpl_propertylist * qclist)
{
    cpl_size lly, ury;
    /* use approximate good wavelength range */
    if (cpl_image_get_size_y(flipped) > VISIR_AQU_APPROX_WLEN13) {
        lly = VISIR_AQU_APPROX_WLEN8;
        ury = VISIR_AQU_APPROX_WLEN13;
    }
    else {
        lly = 1;
        ury = cpl_image_get_size_y(flipped);
    }

    cpl_image * cutimg =
        cpl_image_extract(flipped, 1, lly, cpl_image_get_size_x(flipped), ury);

    /* clip to remove signal */
    double bkgmad, bkgmed;
    bkgmed = cpl_image_get_mad(cutimg, &bkgmad);
    for (size_t i = 0; i < 3; i++) {
        cpl_mask * rej =
            cpl_mask_threshold_image_create(cutimg,
                                    bkgmed - bkgmad * CPL_MATH_STD_MAD * 3,
                                    bkgmed + bkgmad * CPL_MATH_STD_MAD * 3);
        cpl_mask_not(rej);
        cpl_image_reject_from_mask(cutimg, rej);
        cpl_mask_delete(rej);
        bkgmed = cpl_image_get_mad(cutimg, &bkgmad);
    }

    cpl_propertylist_append_double(qclist, "ESO QC BACKGD SIGMA",
                                   bkgmad * CPL_MATH_STD_MAD);
    cpl_propertylist_set_comment(qclist, "ESO QC BACKGD SIGMA",
                                 "[adu/s] background corrected");
    cpl_image_delete(cutimg);

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @brief   Extract the 1D-spectrum from a combined VISIR 2D-spectroscopic image
  @param   flipped   Combined, converted, (flipped mean-corrected) spectro image
  @param   qclist    QC Properties are appended to this list
  @param   pweight2d 2D weights image to be created or NULL on error
  @param   doplot    Plotting level (zero for none)
  @return  The 1D-spectrum and its error as a cpl_bivector or NULL on error

  The returned cpl_bivector consists of the spectrum and its error. It must be
  deallocated using cpl_bivector_delete().

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_ILLEGAL_INPUT
  - CPL_ERROR_NULL_INPUT

 */
/*----------------------------------------------------------------------------*/
static cpl_bivector * visir_spc_extract(cpl_image * flipped,
                                        cpl_propertylist * qclist,
                                        cpl_image ** pweight2d,
                                        int doplot, int bkgcorrect)
{
    const int       ncol    = cpl_image_get_size_x(flipped);
    const int       npix    = cpl_image_get_size_y(flipped);

    cpl_bivector * result   = NULL;
    cpl_vector   * spectrum = NULL;
    cpl_vector   * error    = NULL;
    cpl_vector   * col      = NULL;

    cpl_image  * spatial  = NULL;
    cpl_image  * iweight  = NULL;
    cpl_vector * row      = NULL;
    cpl_image  * imrow    = NULL;

    double     * pweight  = NULL;

    cpl_apertures  * objects  = NULL;
    cpl_mask   * binary    = NULL;
    cpl_image  * locnoise  = NULL;

    double       xfwhm;   /* FWHM of brightest object */
    double       xcentro; /* X-Centroid of brightest object */

    int i, j;
    int is_rejected;

    const double sigma = VISIR_SPECTRO_SIGMA; /* Assume signal at this level */
    double sp_median;
    double stdev2d, min, max, yfwhm;
    double weight_2norm;
    /* Position of the widest signal region */
    cpl_size ifwhm, jfwhm;
    int mspix;
    /* Low and High pixel of the widest signal-less region */
    int ilnoise, ihnoise;
    const int is_echelle = ncol <= 2 * (whechelle + 1);


    cpl_ensure(pweight2d != NULL, CPL_ERROR_NULL_INPUT, NULL);

    cpl_ensure(sigma > 0.0, CPL_ERROR_UNSUPPORTED_MODE, NULL);

    *pweight2d = NULL;

    skip_if(add_qc_background_sigma(flipped, qclist));

    /* Compute spatial weights:
       mean-subtract each row and average + normalize */

    if (bkgcorrect) {
        cpl_image * imean = cpl_image_duplicate(flipped);
        for (int h = 0; h < cpl_image_get_size_y(flipped); h++) {
            cpl_vector * n = cpl_vector_new_from_image_row(flipped, h+1);
            double mean = cpl_vector_get_median(n);
            cpl_vector_delete(n);
            for (int g = 0; g < cpl_image_get_size_x(flipped); g++) {
                cpl_image_set(imean, g+1, h + 1, mean);
            }
        }
        cpl_image_subtract(flipped, imean);
        cpl_image_delete(imean);
    }

    if (!is_echelle) {
        /* All but HR Grism has a negative signal equal to the positive
           i.e. the mean is zero */
        /* FIXME: Not true for large offsets (or very extended objects) */
        cpl_msg_info(cpl_func, "Combined image has mean: %g",
                     cpl_image_get_mean(flipped));

        col = cpl_vector_new(npix);
        skip_if (0);

        /* Subtract the mean from each row/wavelength */
        pweight = cpl_image_get_data_double(flipped);
        for (j=0; j < npix; j++, pweight += ncol) {
            double mean;

            imrow = cpl_image_wrap_double(1, ncol, pweight);
            skip_if (0);

            mean = cpl_image_get_mean(imrow);
            skip_if (0);

            skip_if (cpl_vector_set(col, j, mean));

            skip_if (cpl_image_subtract_scalar(imrow, mean));

            (void)cpl_image_unwrap(imrow);
            imrow = NULL;

        }

        if (doplot > 1) visir_vector_plot("set grid;","t 'Estimated Background'"
                                          " w linespoints", "", col);
        cpl_vector_delete(col);
        col = NULL;
    }

    /* The st.dev. of the noise */
    stdev2d = visir_img_phot_sigma_clip(flipped)/sqrt(npix);
    skip_if (0);

    cpl_msg_info(cpl_func, "St.Dev. on noise in 2D-combined image: %g",
                 stdev2d);

    /* Average the spectral dimension */
    spatial = cpl_image_collapse_create(flipped, 0);
    skip_if (0);
    skip_if (cpl_image_divide_scalar(spatial, npix));

    iweight = cpl_image_duplicate(spatial);

    /* Reject noise from spatial */
    sp_median = cpl_image_get_median(spatial);
    binary = cpl_mask_threshold_image_create(spatial, sp_median - sigma * stdev2d,
                                             sp_median + sigma * stdev2d);

    if (cpl_mask_count(binary) == ncol) {
        (void)cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                                    "%d spatial weights too noisy. sigma=%g. "
                                    "stdev2d=%g. Spatial median=%g", ncol,
                                    sigma, stdev2d, sp_median);
        skip_if (1);
    }


    bug_if (cpl_image_reject_from_mask(spatial, binary));

    bug_if (cpl_image_get_maxpos(spatial, &ifwhm, &jfwhm));

    if (doplot > 1) {
        visir_image_col_plot("","t 'Most intense column' w linespoints",
                             "", flipped, ifwhm, ifwhm, 1);
        visir_image_row_plot("set grid;", "t 'Combined image with "
                             "spectral direction collapsed' w linespoints",
                             "", spatial, 1, 1, 1);
    }

    max = cpl_image_get(spatial, ifwhm, 1, &is_rejected);
    bug_if(is_rejected);
    if (max <= 0.0) {
        (void)cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                                    "Cannot compute FWHM on a collapsed "
                                    "spectrum with a non-positive maximum: %g "
                                    "(at i=%d)", max, (int)ifwhm);
        skip_if (1);
    }

    skip_if (cpl_image_get_fwhm(spatial, ifwhm, 1, &xfwhm,  &yfwhm));

    /* Find centroid in spatial */
    for (ilnoise = ifwhm; ilnoise > 0 &&
             !cpl_image_is_rejected(spatial, ilnoise, 1); ilnoise--);
    bug_if (0);
    for (ihnoise = ifwhm; ihnoise <= ncol &&
             !cpl_image_is_rejected(spatial, ihnoise, 1); ihnoise++);
    bug_if (0);
    /* There may be no negative weights at all */
    if (!ilnoise) ilnoise = 1;
    if (ihnoise > ncol) ihnoise = ncol;

    xcentro = cpl_image_get_centroid_x_window(spatial, ilnoise, 1, ihnoise, 1);

    cpl_msg_info(cpl_func, "Spatial FWHM(%d:%d:%d:%g): %g", (int)ilnoise,
                 (int)ifwhm, (int)ihnoise, xcentro, xfwhm);

    /* Create weights that have an absolute sum of 1 - as an image */
    skip_if (cpl_image_normalise(iweight, CPL_NORM_ABSFLUX));

    if (doplot > 1) visir_image_row_plot("set grid;", "t 'Cleaned, normalized "
                                         "combined image with spectral direction"
                                         " averaged' w linespoints", "",
                                         iweight, 1, 1, 1);

    weight_2norm = sqrt(cpl_image_get_sqflux(iweight));

    cpl_msg_info(cpl_func, "2-norm of weights: %g", weight_2norm);



    /* Determine st.dev. on noise at signal-less pixels */
    if (is_echelle) {
        int ileft = 5;
        int iright = ncol - 5;
        cpl_binary * pbin;


        if (ileft  > xcentro - xfwhm * 2)
            ileft  = xcentro - xfwhm * 2;
        if (iright < xcentro + xfwhm * 2)
            iright = xcentro + xfwhm * 2;

        cpl_msg_info(cpl_func, "HRG pixels of noise: [1 %d] [%d %d]", ileft,
                     iright, ncol);

        bug_if(cpl_mask_xor(binary, binary));

        pbin = cpl_mask_get_data(binary);
        bug_if (0);

        for (i = 0; i < ncol; i++) pbin[i] = CPL_BINARY_0;
        for (i = 0; i < ileft; i++) pbin[i] = CPL_BINARY_1;
        for (i = iright; i < ncol; i++) pbin[i] = CPL_BINARY_1;

    }
    skip_if (0);

    mspix = cpl_mask_count(binary);
    cpl_msg_info(cpl_func, "Pixels of noise(%g +/- %g*%g): %d",
                 sp_median, stdev2d, sigma, mspix);
    skip_if (0);

    if (mspix < 2) {
        /* No noise pixels found */
        cpl_msg_error(cpl_func, "Cannot estimate spectrum noise with just %d "
                      "pixels of noise", mspix);
        visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
        skip_if (1);
    }

    locnoise = cpl_image_new_from_mask(binary);
    cpl_mask_delete(binary);
    binary = NULL;

    skip_if (0);

    error = cpl_vector_new(npix);
    skip_if (0);


    /* Compute for each wavelength the noise */
    for (j=0; j < npix; j++) {

        double npp, stdev1d;


        imrow = cpl_image_extract(flipped, 1, j+1, ncol, j+1);

        skip_if (0);

        objects = cpl_apertures_new_from_image(imrow, locnoise);
        cpl_image_delete(imrow);
        imrow = NULL;
             
        skip_if (0);

        stdev1d = cpl_apertures_get_stdev(objects, 1);
        cpl_apertures_delete(objects);
        objects = NULL;

        /* The noise per pixel is defined as the Standard Deviation
           on the noise (computed from the part of the signal that
           has no object signal) multiplied by the 2-norm of the
           noise-thresholded spatial weights */

        npp = weight_2norm * stdev1d;

        skip_if (cpl_vector_set(error, j, npp));
    }

    /* Spectrum noise computation done */


    /* Iterate through the spatial dimension - sum up the weighted column */
    for (i=1; i <= ncol; i++) {
        const double weight = cpl_image_get(iweight, i, 1, &is_rejected);

        skip_if (0);
        if (is_rejected) {
            /* This would require a whole column to be rejected */
            visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
            skip_if (1);
        }
            
        /* The sigma-clipping may cause many columns to be zero */
        if (weight == 0) continue;

        col = cpl_vector_new_from_image_column(flipped, i); /* or medcorr */
        skip_if (0);

        skip_if (cpl_vector_multiply_scalar(col, weight));

        if (spectrum == NULL) {
            spectrum = col;
        } else {
            skip_if (cpl_vector_add(spectrum, col));
            cpl_vector_delete(col);
        }
        col = NULL;
    }

    fit_gaussians(flipped, error, ifwhm - 20, ifwhm + 20, qclist);

    /* assert( spectrum ); */

    min = cpl_vector_get_min(spectrum);
    if (min <0) cpl_msg_warning(cpl_func, "Extracted spectrum has negative "
                                "intensity: %g", min);

    /* Create 2D-weight map by replicating the 1D-weights over the
       wavelengths */

    *pweight2d = cpl_image_new(ncol, npix, CPL_TYPE_DOUBLE);

    for (j=1; j <= npix; j++)
        skip_if (cpl_image_copy(*pweight2d, iweight, 1, j));

    if (doplot > 0) visir_image_plot("", "t 'The weight map'", "", *pweight2d);

    bug_if(visir_spectro_qclist_obs(qclist, xfwhm, xcentro));

    end_skip;

    cpl_image_delete(locnoise);
    cpl_mask_delete(binary);
    cpl_image_delete(spatial);
    cpl_apertures_delete(objects);
    cpl_vector_delete(col);
    cpl_vector_delete(row);
    cpl_image_delete(imrow);
    cpl_image_delete(iweight);

    if (cpl_error_get_code()) {
        cpl_vector_delete(spectrum);
        cpl_vector_delete(error);
    } else {

        result = cpl_bivector_wrap_vectors(spectrum, error);

        if (doplot > 2) visir_bivector_plot("", "t 'error versus spectrum'",
                                            "", result);
    }

    return result;
}

/*----------------------------------------------------------------------------*/
/**
  @brief  Generate a 1D spectrum from a model and a dispersion relation
  @param  self   Vector to fill with spectrum
  @param  model  Pointer to model object
  @param  disp   1D-Dispersion relation, at least of degree 1
  @return CPL_ERROR_NONE or the relevant #_cpl_error_code_ on error
  @note The model is passed as a @em void pointer so the function can be used
        with cpl_wlcalib_find_best_1d().
  @see cpl_wlcalib_fill_line_spectrum()

 Possible #_cpl_error_code_ set by this function:
  - CPL_ERROR_NULL_INPUT if an input pointer is @em NULL
  - CPL_ERROR_INVALID_TYPE If the input polynomial is not 1D
  - CPL_ERROR_ILLEGAL_INPUT If the input polynomial is non-increasing over
    the given input (pixel) range, or if a model parameter is non-physical
    (e.g. non-positive slit width).
  - CPL_ERROR_DATA_NOT_FOUND If no sky intensities are available in the range
    of the dispersion relation
  - CPL_ERROR_INCOMPATIBLE_INPUT If the wavelengths of two catalog lines are
    found to be in non-increasing order.
 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_spectro_fill(cpl_vector            * self,
                                         const cpl_polynomial  * disp,
                                         irplib_base_spectrum_model * model)
{

    visir_spectrum_model * mymodel = (visir_spectrum_model*)model;
    const cpl_size npix = cpl_vector_get_size(self);

    cpl_ensure_code(self,       CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(model,      CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(disp,       CPL_ERROR_NULL_INPUT);

    cpl_vector * wavelength = cpl_vector_new(npix);
    cpl_bivector * emission = cpl_bivector_wrap_vectors(wavelength, self);
    cpl_vector * boundary = cpl_vector_new(npix + 1);

    /* Compute the wavelengths of the spectrum
       according to the physical model */
    skip_if (cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
                                   disp, 1, 1));
    skip_if (cpl_vector_fill_polynomial(boundary, disp, 0.5, 1));

    /* Get the emission at those wavelengths */
    skip_if (visir_spc_emission(emission, boundary, mymodel->lines,
                                  mymodel->tqeff, mymodel->vsymm,
                                  mymodel->temp));
    end_skip;

    cpl_bivector_unwrap_vectors(emission);
    cpl_vector_delete(wavelength);
    cpl_vector_delete(boundary);

    return cpl_error_get_code();
}



/*----------------------------------------------------------------------------*/
/**
  @brief  Refine the dispersion relation to maximise the cross-correlation
  @param  self      Pre-created 1D-polynomial to hold result
  @param  xc_vector The observed spectrum to correlate against
  @param  pmymodel  Pointer to model object
  @param  phdisp    Best guess at dispersion relation 
  @param  hsize     Half the search-distance to ensure a global-maximum
  @param  doplot    Toggle plotting 
  @param  pxc       On success, *pxc is the cross-correlation
  @param  pdidshift On success, *pdelta is defined iff *pdidshift is TRUE
  @param  pdelta    On success, *pdelta is the applied (sub-pixel) shift
  @return CPL_ERROR_NONE or the relevant CPL error code on error

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_spectro_refine(cpl_polynomial     * self,
                                           const cpl_vector   * xc_vector,
                                           visir_spectrum_model * pmymodel,
                                           const cpl_polynomial * phdisp,
                                           int hsize, cpl_boolean doplot,
                                           visir_spc_resol resol,
                                           double * pxc,
                                           cpl_boolean * pdidshift,
                                           double * pdelta)
{
    const int        subres = VISIR_XC_SUBSEARCH;
    cpl_polynomial * shifted = NULL;
#ifdef VISIR_SPC_CAL_HIGH
    const int        fitdeg  = 2;
    double           pixstep = 0.5;
    double           pixtol  = 1e-5;
    const int        maxite  = fitdeg * 200;
    int              maxfail = 3;
    int              maxcont = 3;
    const int        clines  = (int)(cpl_bivector_get_size(pmymodel->lines) *
                                     cpl_vector_get_size(xc_vector));
    cpl_errorstate prestate = cpl_errorstate_get();
#endif

    cpl_ensure_code(self,      CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(xc_vector, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pmymodel,  CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(phdisp,    CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pxc,       CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pdidshift, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pdelta,    CPL_ERROR_NULL_INPUT);

    skip_if(cpl_polynomial_copy(self, phdisp));

#ifdef VISIR_SPC_CAL_HIGH
    if (irplib_polynomial_find_1d_from_correlation_all
        (self, fitdeg, xc_vector, 1, clines,
         (irplib_base_spectrum_model*)pmymodel,
         visir_spectro_fill, pixtol, pixstep,
         hsize, maxite, maxfail, maxcont, doplot, pxc) || *pxc <= 0.0) {

        irplib_error_recover(prestate, "Could not optimize %d "
                             "coefficients, trying shifting", fitdeg);
        skip_if(cpl_polynomial_copy(self, phdisp));

        skip_if(visir_polynomial_shift_1d_from_correlation
                (self, xc_vector, (irplib_base_spectrum_model*) pmymodel,
                 visir_spectro_fill, hsize, subres, doplot, pxc, pdelta));
        *pdidshift = CPL_TRUE;

        /* Retry optimization */
        shifted = cpl_polynomial_duplicate(self);

        if (irplib_polynomial_find_1d_from_correlation_all
            (self, fitdeg, xc_vector, 1, clines,
             (irplib_base_spectrum_model*)pmymodel,
             visir_spectro_fill, pixtol, pixstep,
             hsize, maxite, maxfail, maxcont, doplot, pxc) || *pxc <= 0.0) {

            irplib_error_recover(prestate, "Could not re-optimize %d "
                                 "coefficients, keeping shifted", fitdeg);
            skip_if(cpl_polynomial_copy(self, shifted));
        }
    }

#else
    cpl_size clow = 0, chigh = 0;
    /* skip highly nonlinear areas */
    if (resol == VISIR_SPC_R_LRP) {
        clow = 155;
        chigh = 155;
    }
    cpl_vector * xc_vector_cut = cpl_vector_extract(xc_vector, clow,
                                                 cpl_vector_get_size(xc_vector)
                                                 - chigh - 1, 1);
    cpl_polynomial_shift_1d(self, 0, clow);
    skip_if(visir_polynomial_shift_1d_from_correlation
            (self, xc_vector_cut, (irplib_base_spectrum_model*) pmymodel,
             visir_spectro_fill, hsize, subres, doplot, pxc, pdelta));
    cpl_polynomial_shift_1d(self, 0, -clow);
    cpl_vector_delete(xc_vector_cut);
    *pdidshift = CPL_TRUE;
#endif

    error_if (*pxc <= 0.0, CPL_ERROR_DATA_NOT_FOUND, "Atmospheric and Model "
              "Spectra have non-positive cross-correlation (%g pixel shift): "
              "%g", *pdelta, *pxc);

    end_skip;

    cpl_polynomial_delete(shifted);

    return cpl_error_get_code();

}

/*----------------------------------------------------------------------------*/
/**
  @brief   Shift self by the amount that maximizes the cross-correlation
  @param   self   1D-Dispersion relation to shift, at least of degree 1
  @param   obs    The observed spectrum to correlate against
  @param   model  Pointer to model parameters
  @param   filler The function to fill the model spectrum
  @param   hsize  Half the search-distance, hsize > 0 [pixel]
  @param   subres The sub-pixel resolution available for the shift, may be 1
  @param   doplot Plot the cross-correlation as a function of pixel shift
  @param   pxc    On success and if non-NULL, the cross-correlation
  @param   pshift On success and if non-NULL, the shift applied to self
  @return  CPL_ERROR_NONE on success, otherwise the relevant CPL error code
  @see irplib_bivector_find_shift_from_correlation(), cpl_polynomial_shift_1d()

  The model spectrum is shifted by a fractions (1/subres) of a pixel and for
  each of these sub-pixel shifts the cross-correlation is evaluated.

  The shift that maximizes the cross-correlation is applied to self.

  The filler and the cross-correlation function are both called subres times.

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code
visir_polynomial_shift_1d_from_correlation(cpl_polynomial * self,
                                           const cpl_vector * obs,
                                           irplib_base_spectrum_model * model,
                                           cpl_error_code (*filler)
                                           (cpl_vector *,
                                            const cpl_polynomial *,
                                            irplib_base_spectrum_model *),
                                           int hsize,
                                           int subres,
                                           cpl_boolean doplot,
                                           double * pxc, double *pshift)
{
    const int          nobs    = cpl_vector_get_size(obs);
    cpl_polynomial   * cand    = NULL;
    cpl_bivector     * xcplot  = NULL;
    double           * xcplotx = NULL;
    double           * xcploty = NULL;
    cpl_vector       * mspec1d = NULL;
    cpl_vector       * vxc;
    double             bestxc = -1.0;
    double             bestdelta = -1.0; /* avoid false unint warning */
    int                bestxxc = -1; /* avoid false unint warning */
    int i;

    cpl_ensure_code(self   != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(obs    != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(model  != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(subres  >  0,   CPL_ERROR_ILLEGAL_INPUT);
    cpl_ensure_code(hsize   >  0,   CPL_ERROR_ILLEGAL_INPUT);

    cand    = cpl_polynomial_new(1);
    mspec1d = cpl_vector_new(2 * hsize + nobs);
    vxc     = cpl_vector_new(2 * hsize + 1);
    if (doplot) {
        xcplot  = cpl_bivector_new(subres * (2 * hsize + 1));
        xcplotx = cpl_bivector_get_x_data(xcplot);
        xcploty = cpl_bivector_get_y_data(xcplot);
    }

    /* subdelta search is in the range [0; 1[ */
    for (i = 0; i < subres; i++) {
        const double delta = i / (double)subres;
        double xc;
        int ixc;

        bug_if (cpl_polynomial_copy(cand, self));
        bug_if (cpl_polynomial_shift_1d(cand, 0, delta - hsize));

        skip_if (filler(mspec1d, cand, model));

        ixc = cpl_vector_correlate(vxc, mspec1d, obs);
        xc = cpl_vector_get(vxc, ixc);

        if (xc > bestxc) {
            bestxc = xc;
            bestxxc = ixc - hsize;
            bestdelta = delta + bestxxc;
            cpl_msg_debug(cpl_func, "Shifting %g = %d + %g pixels (XC=%g)",
                          bestdelta, bestxxc, delta, bestxc);
        }
        if (doplot) {
            int j;
            for (j = 0; j <= 2 * hsize; j++) {
                const double xcj = cpl_vector_get(vxc, j);
                xcplotx[i + j * subres] = (double)(j - hsize) + delta;
                xcploty[i + j * subres] = xcj;
            }
        }
    }

#ifdef IRPLIB_SPC_DUMP
    /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
    irplib_polynomial_dump_corr_step(self, vxc, "Shift");
#endif

    skip_if(cpl_polynomial_shift_1d(self, 0, bestdelta));

    /* Verify correctness of shift, at hsize = 0 */
    cpl_vector_set_size(vxc, 1);
    cpl_vector_set_size(mspec1d, nobs);
    skip_if (filler(mspec1d, self, model));
    bug_if(cpl_vector_correlate(vxc, mspec1d, obs));

    if (doplot) {
        char * title = cpl_sprintf("t 'Cross-correlation of %d-pixel spectrum "
                                   "(max=%.4g at %g pixel)' w points", nobs,
                                   cpl_vector_get(vxc, 0), bestdelta);

        cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';set ylabel "
                          "'Cross-correlation';", title, "", xcplot);
        cpl_free(title);

        irplib_plot_spectrum_and_model(obs, self, model, filler);
    }

    cpl_msg_info(cpl_func, "Shifting %g = %d + %g pixels (XC: %g <=> %g)",
                 bestdelta, bestxxc, bestdelta - (double)bestxxc,
                 cpl_vector_get(vxc, 0), bestxc);

    if (pxc    != NULL) *pxc    = cpl_vector_get(vxc, 0);
    if (pshift != NULL) *pshift = bestdelta;

    end_skip;

    cpl_vector_delete(mspec1d);
    cpl_polynomial_delete(cand);
    cpl_vector_delete(vxc);
    cpl_bivector_delete(xcplot);

    return cpl_error_get_code();

}

/*----------------------------------------------------------------------------*/
/**
  @brief   Create the LRP dispersion relation
  @return  The LRP dispersion 1D-polynomial, or NULL on error
 */
/*----------------------------------------------------------------------------*/
static cpl_polynomial * visir_spc_phys_lrp(void)
{
    const double xval[] = {161, 307, 336, 449, 491, 518, 623, 760, 795, 839};
    const double yval[] = {8.22e-6, 9.50e-06, 9.660e-06, 10.5e-06, 10.82e-6,
                           11.e-06,   11.7e-06, 12.54e-06, 12.76e-06,
                           13.02e-06 };

    const cpl_size    maxdeg1d = 2; /* The polynomial degree */

    cpl_polynomial  * self     = cpl_polynomial_new(1);
    const cpl_boolean sampsym  = CPL_FALSE;
    const size_t      nvals    = sizeof(xval)/sizeof(*xval);

    IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual)
    cpl_matrix * xmatrix = cpl_matrix_wrap(1, nvals, (double*)xval);
    cpl_vector * yvector = cpl_vector_wrap(nvals, (double*)yval);
    IRPLIB_DIAG_PRAGMA_POP;
    cpl_vector * fitres  = cpl_vector_new(nvals);

    const cpl_error_code error = cpl_polynomial_fit(self, xmatrix, &sampsym,
                                                    yvector, NULL,
                                                    CPL_FALSE, NULL, &maxdeg1d)
        || cpl_vector_fill_polynomial_fit_residual(fitres, yvector, NULL, self,
                                                   xmatrix, NULL);

    const double mse = cpl_vector_product(fitres, fitres) / (double)nvals;

    (void)cpl_matrix_unwrap(xmatrix);
    (void)cpl_vector_unwrap(yvector);
    cpl_vector_delete(fitres);

    if (error) {
        cpl_error_set_where(cpl_func);
        cpl_polynomial_delete(self);
        self = NULL;
    } else {
        cpl_msg_info(cpl_func, "Fitted %d degree 1D-polynomial to %u "
                     "wavelengths with a root mean square error [m]: %g",
                     (int)maxdeg1d, (unsigned)nvals, sqrt(mse));
    }

    return self;
}

/*----------------------------------------------------------------------------*/
/**
  @brief   Get the dispersion on a given column
  @param   self The 1D dispersion polynomial
  @param   xval The column number (1 for lowest wavelength)
  @return  The dispersion or undefined on error
 */
/*----------------------------------------------------------------------------*/
static double visir_spc_get_dispersion(const cpl_polynomial * self, double xval)
{

    cpl_errorstate prestate = cpl_errorstate_get();
    double disp;

    (void)cpl_polynomial_eval_1d(self, xval, &disp);

    if (!cpl_errorstate_is_equal(prestate)) {
        (void)cpl_error_set_where(cpl_func);
    }

    return disp;
}
