/* $Id: visir_spectro.c,v 1.210 2011/12/16 16:37:23 llundin 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: llundin $
 * $Date: 2011/12/16 16:37:23 $
 * $Revision: 1.210 $
 * $Name: visir-3_5_1 $
 */

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

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

/* TEMPORARY SUPPORT OF CPL 5.x */
#include <cpl.h>

#ifndef CPL_SIZE_FORMAT
#define CPL_SIZE_FORMAT "d"
#define cpl_size int
#endif
/* END TEMPORARY SUPPORT OF CPL 5.x */

#include "visir_spectro.h"

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

#include "irplib_framelist.h"

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


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

/*-----------------------------------------------------------------------------
                            Private Function Prototypes
 -----------------------------------------------------------------------------*/
static cpl_bivector * visir_spc_extract(cpl_image *, cpl_propertylist *,
                                        cpl_image **, int);

static cpl_bivector * visir_bivector_load_fits(const char *, const char*,
                                               const char*);
static cpl_error_code visir_bivector_interpolate(cpl_bivector *,
                                                 const cpl_bivector *);

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);
static cpl_error_code visir_vector_convolve_symm(cpl_vector *,
                                                 const cpl_vector *);
static cpl_image * visir_spc_flip(const cpl_image *, double, visir_spc_resol);
static cpl_error_code visir_spc_xcorr(cpl_vector *, cpl_bivector *,
                                      cpl_vector *, const cpl_vector *,
                                      const cpl_bivector *,
                                      const cpl_bivector *,
                                      const cpl_vector *, const cpl_polynomial *,
                                      double, int, double, double *, int *);

static cpl_vector * cpl_spc_convolve_init(int, double, double, int);

static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist *,
                                                int, double, 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_FLEN
#define VISIR_XC_FLEN 3
#endif
#ifndef VISIR_XC_SUBSEARCH
#define VISIR_XC_SUBSEARCH 100
#endif

#ifndef VISIR_SPECTRO_SIGMA
#define VISIR_SPECTRO_SIGMA 3.0
#endif

/**@{*/

/*-----------------------------------------------------------------------------
                                Function 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]
  @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)
{
    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;
    double             sl = 0.0; /* Avoid (false) uninit warning */
    cpl_boolean        need_temp = ptemp != NULL;
    int                n;
    int                i;

    /* 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 nm difference */
    skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_WLEN,
                                      CPL_TYPE_DOUBLE, CPL_TRUE, 1e-3));

     /* 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 (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;


        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); 
        sl_tmp = visir_pfits_get_slitwidth(plist);
        spx_tmp = visir_pfits_get_pixspace(plist);
        pfits = visir_pfits_get_resol(plist);
        
        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;

            /* Divide the slit width with the
               Spectral PFOV = 0.127 Arcseconds/pixel */
            /* FIXME: The Spectral PFOV may change with a new detector */
            *pslitw = sl / 0.127; /* 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 [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("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 (visir_spc_optmod_init(resol, *pwlen, &ins_settings)) {
                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 (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));
    cpl_bivector * boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,
                                                        ybounds);
    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 (visir_bivector_interpolate(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)
{

    /* 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);
    cpl_ensure_code(npix == cpl_image_get_size_y(hcycle),
                        CPL_ERROR_ILLEGAL_INPUT);


    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));

    /* Convert the combined image */
    flipped = visir_spc_flip(combined, wlen, resol);
    skip_if (0);

    /* Extract spectrum with error from the combined image */
    /* FIXME: Move inside */
    spc_n_err = visir_spc_extract(flipped, qclist, pweight2d,
                                  doplot);
    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)
  @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)
{

    /* Dispersion relation from physical model */
    cpl_polynomial * phdisp = NULL;
    /* Dispersion relation corrected by cross-correlation */
    cpl_polynomial * xcdisp = 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_bivector * xc_subres = NULL;

    cpl_vector   * vsymm   = NULL;

    cpl_vector   * vxc       = NULL;

    cpl_vector   * xc_subresx;
    cpl_vector   * xc_subresy;

    const int      npix = cpl_image_get_size_y(hcycle);
    int            delta, bestdelta, rawdelta;
    double         subdelta;
#if 0
    double         xc0;
#endif
    double         qcxc, qcsubdelta;
    double         hc_min;
    int            convohlen;
    int            xc_flen;
    const cpl_size i0 = 0;
    const cpl_size i1 = 1;
    int            i;
    int            minpos;
    double       * pemiss;
    cpl_vector   * xemiss;


    assert( VISIR_XC_LEN >=0 && VISIR_XC_FLEN >=0);
    assert( VISIR_XC_SUBSEARCH == 1 ||
           (VISIR_XC_SUBSEARCH  > 1 && (VISIR_XC_SUBSEARCH&1)) == 0);

    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));
    }      

    /* Average the spatial dimension - into a cpl_vector */
    xc_image = cpl_image_collapse_create(corrected, 1);
    skip_if (0);
    skip_if (cpl_image_divide_scalar(xc_image, npix));

    cpl_image_delete(corrected);
    corrected = NULL;

    /* The dispersion relation goes from the top of the image to the bottom */
    if (resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) {
        /* Flip (if A-side), nothing else */
        corrected = visir_spc_flip(xc_image, wlen, resol);
        skip_if (0);

        cpl_image_delete(xc_image);
        xc_image = corrected;
        corrected = NULL;
    } else {
        skip_if (cpl_image_flip(xc_image, 0));
    }

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

    emission = cpl_bivector_new(npix + 2 * VISIR_XC_LEN);
    skip_if (0);

    boundary = cpl_vector_new(npix + 2 * VISIR_XC_LEN + 1);
    skip_if (0);

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

    cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
                 " %gm + ipix * %gm/pixel [ipix = 1, 2, ..., %d]",
                 cpl_polynomial_get_coeff(phdisp, &i0),
                 cpl_polynomial_get_coeff(phdisp, &i1), npix);

    temiss = visir_bivector_load_fits(linefile, "Wavelength", "Emission");
    if (cpl_error_get_code()) {
        cpl_msg_error(cpl_func, "Could not load file with Emission Lines");
        skip_if (1);
    }

    tqeff  = visir_bivector_load_fits(qefffile, "Wavelength", "Efficiency");
    if (cpl_error_get_code()) {
        cpl_msg_error(cpl_func, "Could not load file with Quantum-Efficiencies");
        skip_if (1);
    }

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

    skip_if (cpl_table_new_column(*pspc_table, "WLEN", CPL_TYPE_DOUBLE));
    skip_if (cpl_table_new_column(*pspc_table, "SPC_MODEL_PH", CPL_TYPE_DOUBLE));
    skip_if (cpl_table_new_column(*pspc_table, "SPC_MODEL_XC", CPL_TYPE_DOUBLE));
    skip_if (cpl_table_new_column(*pspc_table, "SPC_SKY", CPL_TYPE_DOUBLE));

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


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

    skip_if (vsymm == NULL);

    convohlen = cpl_vector_get_size(vsymm);

    skip_if (convohlen < 1);

    xc_flen = convohlen-1 < VISIR_XC_FLEN ? VISIR_XC_FLEN
        : (convohlen-1 > VISIR_XC_LEN ? VISIR_XC_LEN : convohlen-1);


    /* Determine the (possibly large) initial pixel shift */
  
    xc_subres = cpl_bivector_new(VISIR_XC_SUBSEARCH);
    skip_if (0);

    xc_subresy = cpl_bivector_get_y(xc_subres);
    skip_if (0);
    xc_subresx = cpl_bivector_get_x(xc_subres);
    skip_if (0);

    /* Copy the dispersion relation */
    xcdisp = cpl_polynomial_new(1);
    skip_if (cpl_polynomial_copy(xcdisp, phdisp));


    vxc = cpl_vector_new(2 * VISIR_XC_LEN + 1);
    skip_if (visir_spc_xcorr(vxc, emission, boundary, xc_vector, temiss, tqeff,
                             vsymm, xcdisp, -VISIR_XC_LEN, VISIR_XC_LEN,
                             temp, &qcxc, &rawdelta));

    if (doplot > 0) {
        cpl_vector   * xaxis = cpl_vector_new(2 * VISIR_XC_LEN + 1);
        cpl_bivector * bivxc = cpl_bivector_wrap_vectors(xaxis, vxc);

        for (i=0; i < 2 * VISIR_XC_LEN + 1; i++)
            if (cpl_vector_set(xaxis, i, i-VISIR_XC_LEN)) break;

        if (!cpl_error_get_code())
            visir_bivector_plot("set grid;set xlabel 'Offset [pixel]';",
                                "t 'Cross-correlation (coarse)'", "", bivxc);
        cpl_bivector_unwrap_vectors(bivxc);
        cpl_vector_delete(xaxis);
    }

    skip_if (cpl_vector_set_size(vxc, 2 * VISIR_XC_FLEN + 1));

    skip_if (cpl_vector_set(xc_subresx, VISIR_XC_SUBSEARCH/2, rawdelta));
    skip_if (cpl_vector_set(xc_subresy, VISIR_XC_SUBSEARCH/2, qcxc));

    qcsubdelta = rawdelta;
    bestdelta = 0;

    cpl_msg_debug(cpl_func, "xc (%d): %g", rawdelta, qcxc);

    /*  Dump the unshifted model spectrum to the table
        - The unshifted signal starts at index VISIR_XC_LEN */
    pemiss = cpl_bivector_get_y_data(emission) + VISIR_XC_LEN;
    skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_MODEL_PH", pemiss));

    /* Apply the initial pixel shift */
    skip_if (cpl_polynomial_shift_1d(xcdisp, 0, rawdelta));

    /* emission & boundary can be made shorter, but npix+VISIR_XC_FLEN
       elements must be free of edge-convolution effects */
    cpl_bivector_delete(emission);
    emission = NULL;
    cpl_vector_delete(boundary);
    boundary = NULL;

    emission = cpl_bivector_new(npix + 2 * xc_flen);
    skip_if (0);

    boundary = cpl_vector_new(npix + 2 * xc_flen + 1);
    skip_if (0);

    /* subdelta search starts with an offset of minus a half pixel
       and is in the range [-0.5; 0.5 [ */
    minpos = 0;
    subdelta = VISIR_XC_SUBSEARCH == 1 ? 0 : -0.5;
    for (i = 0; i < VISIR_XC_SUBSEARCH; i++,
             subdelta += 1/(double)VISIR_XC_SUBSEARCH) {
        double xc;

        if (2*i == VISIR_XC_SUBSEARCH) continue; /* subdelta == 0 */

        skip_if (visir_spc_xcorr(vxc, emission, boundary, xc_vector, temiss,
                                 tqeff, vsymm, xcdisp, -xc_flen + subdelta,
                                 VISIR_XC_FLEN, temp, &xc, &delta));

        skip_if (cpl_vector_set(xc_subresx, i, rawdelta+delta+subdelta));
        skip_if (cpl_vector_set(xc_subresy, i, xc));
        if (rawdelta+delta+subdelta < cpl_vector_get(xc_subresx, minpos))
            minpos = i;

        cpl_msg_debug(cpl_func, "xc (%g): %g %g", rawdelta+delta+subdelta, xc,
                      qcxc);

        skip_if (0);

        if (xc <= qcxc) continue; /* FIXME: Reverse expression ?! */

        qcxc = xc;
        bestdelta = delta;
        qcsubdelta = delta + subdelta + rawdelta;

    }

    if (minpos > 0) {
        /* Move the minimum offset to the beginning of the bivector */
        /* Currently only needed for plotting */
        const size_t size1 = sizeof(double) * minpos;
        const size_t size2 = sizeof(double) * (VISIR_XC_SUBSEARCH-minpos);
        double * swap = cpl_malloc(size1);
        double * pdata;

        pdata = cpl_vector_get_data(xc_subresx);
        memcpy(swap, pdata, size1);
        memmove(pdata, pdata + minpos, size2);
        memcpy(pdata+(VISIR_XC_SUBSEARCH-minpos), swap, size1);

        pdata = cpl_vector_get_data(xc_subresy);
        memcpy(swap, pdata, size1);
        memmove(pdata, pdata + minpos, size2);
        memcpy(pdata+(VISIR_XC_SUBSEARCH-minpos), swap, size1);

        cpl_free(swap);
    }

    cpl_vector_delete(boundary);
    boundary = NULL;
    cpl_bivector_delete(emission);
    emission = NULL;

    skip_if (0);

    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,"XC pixel-shift: %d + %d + %g", rawdelta, bestdelta,
                     qcsubdelta - rawdelta - bestdelta);
        cpl_msg_info(cpl_func,"Cross-correlation (%g pixel shift): %g",
                     qcsubdelta, qcxc);
        assert( bestdelta <   VISIR_XC_LEN);
        assert( bestdelta >  -VISIR_XC_LEN);
    }

    if (qcxc <= 0) {
        /* Absolutely no cross-correlation */
        cpl_msg_error(cpl_func, "Atmospheric and Model Spectra have non-"
                      "positive cross-correlation (%g pixel shift): %g", 
                      qcsubdelta, qcxc);
        visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
        skip_if(1);
    }

    /* Apply the sub-pixel precision shift - ignore the initial shift */
    skip_if (cpl_polynomial_shift_1d(xcdisp, 0, qcsubdelta - rawdelta));

    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));

    /* Generate the new wavelengths based on the cross-correlation shift */
    emission = cpl_bivector_new(npix);
    xemiss = cpl_bivector_get_x(emission);
    skip_if (cpl_vector_fill_polynomial(xemiss, xcdisp, 1, 1));

    /* 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
       results */
    if (cpl_vector_get(xemiss,0) < N_upper &&
        N_upper < cpl_vector_get(xemiss,cpl_vector_get_size(xemiss)-1))
        cpl_msg_warning(cpl_func, "Spectrum goes above N-band (%gm). Wavelength "
                        "Calibration may be entirely inaccurate", N_upper);

    skip_if (cpl_table_copy_data_double(*pspc_table, "WLEN",
                                        cpl_bivector_get_x_data(emission)));

    /* - and the corresponding pixel boundaries */
    boundary = cpl_vector_new(npix + 1);
    skip_if (0);
    skip_if (cpl_vector_fill_polynomial(boundary, xcdisp, 0.5, 1));

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

    skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_MODEL_XC", 
                                        cpl_bivector_get_y_data(emission)));

    skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_SKY", 
                                        cpl_vector_get_data(xc_vector)));

    /* The spectrum generated with xcdisp should have the maximum
       cross-correlation at zero offset */
    skip_if (cpl_vector_set_size(vxc, 1));

    delta = cpl_vector_correlate(vxc, cpl_bivector_get_y(emission),
                                 xc_vector);
    skip_if (delta < 0);

#if 0
    xc0 = qcxc - cpl_vector_get(vxc, delta);
#endif
    cpl_vector_delete(vxc);
    vxc = NULL;

#if 0
    /* FIXME: This check is broken with new concolution scheme */
    /* FIX ME: Why npix squared ? */
    /* The imperfect convolution at the spectral ends causes a warning here 
       when threshold is: 10 * npix * npix * DBL_EPSILON */

    if (delta || npix * fabs(xc0) > 25 * sigma)
        cpl_msg_warning(cpl_func, "Cross-correlation inconsistency(%d): %g",
                        delta, xc0);
#endif

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

        visir_bivector_plot("set grid;set xlabel 'Offset [pixel]';", "t 'Cross-"
                            "correlation (fine)' w linespoints", "", xc_subres);

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

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

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

    }

    /* Get the emissivity (range 0 to 1) for the calibrated wavelengths */
    skip_if (visir_vector_resample(cpl_bivector_get_y(emission),
                                      boundary, temiss));

    skip_if (cpl_table_new_column(*pspc_table, "SPC_EMISSIVITY",
                                  CPL_TYPE_DOUBLE));

    skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_EMISSIVITY", 
                                        cpl_bivector_get_y_data(emission)));

    cpl_vector_delete(boundary);
    boundary = NULL;

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

    if (doplot) {

        visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
                             "t 'Atmospheric Emissivity' w linespoints",
                             "", emission);

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

        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;

    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);
    cpl_vector_unwrap(xc_vector);
    cpl_bivector_delete(xc_subres);
    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)
  @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)
{

    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);
    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    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,
                                                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 phdisp1  = cpl_polynomial_get_coeff(phdisp, &phdegree);
    const double phdisp0  = cpl_polynomial_eval_1d(phdisp, 1.0, NULL);

    const double xcdisp1  = cpl_polynomial_get_coeff(xcdisp, &xcdegree);
    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);


    bug_if (0);
    bug_if (phdegree != 1);
    bug_if (xcdegree != 1);

    bug_if (cpl_propertylist_append_double(self, "ESO QC XC",       xc));
    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 PHDISPX1", phdisp1));
    bug_if (cpl_propertylist_append_double(self, "ESO QC PHDISPX0", phdisp0));

    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 XCDISPX1", xcdisp1));
    bug_if (cpl_propertylist_append_double(self, "ESO QC XCDISPX0", xcdisp0));

    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    Interpolation of a 1d-function
  @param    out    Preallocated 1d-function to contain result
  @param    in     Reference 1d-function
  @return   CPL_ERROR_NONE or the relevant #_cpl_error_code_

  in must have both its abscissa and ordinate defined.
  out must have its abscissa defined and its ordinate allocated.

  Currently only linear interpolation is supported.

  The linear interpolation will be done from the values in in to the abscissa
  points in out.

  The abscissa points of both in and out must be growing, x_i < x_i+1.

  The abscissa points of out must be in range of those of in
  (i.e. extrapolation is not allowed).

  in must be of at least length 2 while out must be at least of length 1.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT
  - CPL_ERROR_ILLEGAL_INPUT
 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_bivector_interpolate(cpl_bivector * out,
                                                 const cpl_bivector * in)
{
    const cpl_error_code err = CPL_ERROR_ILLEGAL_INPUT;

    int m, n;

    const double * xref;
    const double * yref;
    double * xout;
    double * yout;

    /* Initialize to avoid unjustified compiler warning */
    double grad = 0.0;
    double y00  = 0.0;
    /* Start interpolation from below */
    int iabove = 0;
    int ibelow = 0;  /* Avoid (false) uninit warning */
    int i;


    cpl_ensure_code(out,   CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(in,    CPL_ERROR_NULL_INPUT);

    m = cpl_bivector_get_size(in);
    n = cpl_bivector_get_size(out);

    cpl_ensure_code(m > 1, err);
    cpl_ensure_code(n > 0, err);

    xref = cpl_bivector_get_x_data_const(in);
    yref = cpl_bivector_get_y_data_const(in);
    xout = cpl_bivector_get_x_data(out);
    yout = cpl_bivector_get_y_data(out);

    assert( xref);
    assert( yref);
    assert( xout);
    assert( yout);

    /* Verify that extrapolation is not necessary */
    cpl_ensure_code(xref[0  ] <= xout[0  ], err);
    cpl_ensure_code(xout[0  ] <  xout[n-1], err);
    cpl_ensure_code(xout[n-1] <= xref[m-1], err);

    for (i = 0; i < n; i++) {
        /* When possible reuse reference function abscissa points */
        if (xout[i] > xref[iabove] || i == 0) {
            /* No, need new points */
            while (xout[i] > xref[++iabove]);
            ibelow = iabove - 1;

            /* Verify that reference abscissa points are valid */
            cpl_ensure_code(xref[iabove] > xref[ibelow], err);

            grad = (yref[iabove] - yref[ibelow])
                 / (xref[iabove] - xref[ibelow]);

            y00   = yref[ibelow] - grad * xref[ibelow];
        } else
            /* Interpolation point may not be smaller than
               the lower reference point */
            cpl_ensure_code(xout[i] >= xref[ibelow], err);

        yout[i] = y00 + grad * xout[i];

    }

    return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
  @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
  @param    resol   Resolution
  @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.

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

 */
/*----------------------------------------------------------------------------*/
static cpl_image * visir_spc_flip(const cpl_image * image, double wlen,
                              visir_spc_resol resol)
{
    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_error_set(CPL_ERROR_ILLEGAL_INPUT);
        skip_if (1);
    }

    /* The dispersion relation goes from the top of the image to the bottom
       - except using the B-side (in high resolution) */
    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)
  @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)
{

    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),
               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);

    /* 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    Compute the cross-correlation for a given wavelength offset 
  @param    vxc         Vector with the cross-correlations for each offset
  @param    emission    Bivector with the wavelengths in the x-vector
  @param    boundary    Vector with the wavelengths boundaries
  @param    xc_vector   The observed spectrum to correlate against
  @param    temiss      Bivector with the atmospheric emission 
  @param    tqeff       Bivector with detector quantum efficiency
  @param    vsymm       Vector with symmetric convolution function
  @param    xcdisp      Best guess at dispersion relation 
  @param    firstpix    The first pixel used in evaluation of dispersion relation
  @param    half_search Half-size of the search domain.
  @param    temp           The telescope (M1) temperature [Kelvin]
  @param    pdelta      Pixel shift
  @param    pxc         Cross-correlation factor
  @return   CPL_ERROR_NONE, or the relevant CPL_ERROR.

  The cross-correlation and pixel-shift are undefined in case of an error.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT

 */
/*----------------------------------------------------------------------------*/
static cpl_error_code visir_spc_xcorr(cpl_vector * vxc,
                                      cpl_bivector * emission,
                                      cpl_vector   * boundary,
                                      const cpl_vector * xc_vector,
                                      const cpl_bivector * temiss,
                                      const cpl_bivector * tqeff,
                                      const cpl_vector   * vsymm,
                                      const cpl_polynomial * xcdisp,
                                      double firstpix,
                                      int half_search,
                                      double temp,
                                      double * pxc,
                                      int    * pdelta)
{

    cpl_ensure_code(emission, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(boundary, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(xc_vector,CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(temiss,   CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(tqeff,    CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(vsymm,  CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(xcdisp,   CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pxc,      CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(pdelta,   CPL_ERROR_NULL_INPUT);


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

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

    *pdelta = cpl_vector_correlate(vxc, cpl_bivector_get_y(emission),
                                   xc_vector);
    skip_if (*pdelta < 0);

    *pxc = cpl_vector_get(vxc, *pdelta);

    skip_if (0);

    *pdelta -= half_search;

    end_skip;

    return cpl_error_get_code();

}


/*----------------------------------------------------------------------------*/
/**
  @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
  @return   A bivector or NULL on error.

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

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

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

    cpl_bivector * result = NULL;
    cpl_table    * table  = NULL;
    double       * prow;
    int            nlines;


    skip_if (0);

    table = cpl_table_load(file, 1, 0);
    if (cpl_error_get_code()) {
        cpl_msg_error(cpl_func, "Could not load FITS table from file: %s",
                      file ? file : "<NULL>");
        skip_if (1);
    }

    nlines = cpl_table_get_nrow(table);
    skip_if (0);

    prow = cpl_table_get_data_double(table, labelx);
    skip_if (0);

    result = cpl_bivector_new(nlines);
    skip_if (0);

    skip_if (!memcpy(cpl_bivector_get_x_data(result), prow,
                     nlines * sizeof(double)));

    prow = cpl_table_get_data_double(table, labely);
    skip_if (0);

    skip_if (!memcpy(cpl_bivector_get_y_data(result), prow,
                     nlines * sizeof(double)));

    cpl_msg_info(cpl_func, "Read %d rows from %s [%g;%g]",
                 nlines, file,
                 cpl_vector_get(cpl_bivector_get_x(result), 0),
                 cpl_vector_get(cpl_bivector_get_x(result), nlines-1));

    end_skip;

    cpl_table_delete(table);

    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);


    cpl_ensure_code(emission, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(boundary, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(temiss,   CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(tqeff,    CPL_ERROR_NULL_INPUT);

    /* npix is currently 256 */
    cpl_ensure_code(npix > 1, CPL_ERROR_ILLEGAL_INPUT);

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


    skip_if (0);

    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 (visir_bivector_interpolate(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;

}

/*----------------------------------------------------------------------------*/
/**
  @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)
{
    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 (0);

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

    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(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));

            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;
    }

    /* 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;
}

