/* $Id$
 *
 * This file is part of the GIRAFFE Pipeline
 * Copyright (C) 2002-2006 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  02110-1301  USA
 */

/*
 * $Author$
 * $Date$
 * $Revision$
 * $Name$
 */

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

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

#include <cxmemory.h>
#include <cxstring.h>
#include <cxstrutils.h>

#include <cpl_parameterlist.h>
#include <cpl_matrix.h>
#include <cpl_table.h>
#include <cpl_msg.h>

#include "gimacros.h"
#include "gierror.h"
#include "gialias.h"
#include "giclip.h"
#include "giarray.h"
#include "giimage.h"
#include "gimatrix.h"
#include "giwindow.h"
#include "gipsfdata.h"
#include "gimodel.h"
#include "gimath.h"
#include "gilocalization.h"
#include "gimessages.h"
#include "gifiberutils.h"
#include "giutils.h"
#include "giextract.h"


/**
 * @defgroup giextract Spectrum Extraction
 *
 * TBD
 */

/**@{*/

enum GiProfileId {
    PROFILE_PSFEXP   = 1 << 1,
    PROFILE_PSFEXP2  = 1 << 2,
    PROFILE_GAUSSIAN = 1 << 3
};

typedef enum GiProfileId GiProfileId;


/*
 * Optimal spectrum extraction algorithm configuration data
 */

struct GiExtractOptimalConfig {

    GiClipParams clip;

    cxbool limits;

    cxint bkgorder;

    cxdouble exptime;
    cxdouble ron;
    cxdouble dark;
    cxdouble ewidth;
};

typedef struct GiExtractOptimalConfig GiExtractOptimalConfig;


/*
 * Original Horne spectrum extraction algorithm configuration data
 */

struct GiExtractHorneConfig {
    GiClipParams clip;

    cxdouble exptime;
    cxdouble ron;
    cxdouble dark;
    cxdouble ewidth;
};

typedef struct GiExtractHorneConfig GiExtractHorneConfig;


struct GiExtractionData {
    cxdouble value;
    cxdouble error;
    cxdouble position;
    cxdouble npixels;
};

typedef struct GiExtractionData GiExtractionData;


struct GiExtractionSlice {
    cxint fsize;
    cxint msize;

    cxint nflx;
    cxint nbkg;

    cpl_matrix* flux;
    cpl_matrix* variance;
    cpl_matrix* model;
};

typedef struct GiExtractionSlice GiExtractionSlice;


struct GiExtractionPsfLimits {
    cxint size;

    cxint* ymin;
    cxint* ymax;
};

typedef struct GiExtractionPsfLimits GiExtractionPsfLimits;


struct GiExtractionWorkspace {
    cpl_matrix* atw;
    cpl_matrix* atwa;
    cpl_matrix* atws;
    cpl_matrix* c;
    cpl_matrix* tmp;
};

typedef struct GiExtractionWorkspace GiExtractionWorkspace;


struct GiVirtualSlit {
    cxint width;

    cxdouble center;
    cxdouble extra_width;

    cxdouble* position;
    cxdouble* signal;
    cxdouble* variance;
    cxdouble* fraction;

    cxint* mask;
    cxint* offset;
};

typedef struct GiVirtualSlit GiVirtualSlit;


/*
 * Extraction slice implementation
 */

inline static GiExtractionSlice*
_giraffe_extractionslice_new(cxint nflx, cxint ndata, cxint nbkg)
{

    GiExtractionSlice* self = cx_malloc(sizeof *self);

    self->nflx = nflx;
    self->nbkg = nbkg;

    self->fsize = nflx + nbkg;
    self->msize = ndata;

    self->flux = cpl_matrix_new(self->fsize, 1);
    self->variance = cpl_matrix_new(self->fsize, 1);
    self->model = cpl_matrix_new(self->msize, 1);

    return self;

}


inline static void
_giraffe_extractionslice_delete(GiExtractionSlice* self)
{

    if (self != NULL) {
        if (self->model != NULL) {
            cpl_matrix_delete(self->model);
            self->model = NULL;
        }

        if (self->variance != NULL) {
            cpl_matrix_delete(self->variance);
            self->variance = NULL;
        }

        if (self->flux != NULL) {
            cpl_matrix_delete(self->flux);
            self->flux = NULL;
        }

        cx_free(self);
    }

    return;

}


inline static GiExtractionPsfLimits*
_giraffe_extraction_psflimits_new(cxint size)
{

    GiExtractionPsfLimits* self = cx_malloc(sizeof *self);

    self->size = size;

    self->ymin = cx_calloc(self->size, sizeof(cxint));
    self->ymax = cx_calloc(self->size, sizeof(cxint));

    return self;

}


inline static void
_giraffe_extraction_psflimits_delete(GiExtractionPsfLimits* self)
{

    if (self != NULL) {
        if (self->ymin != NULL) {
            cx_free(self->ymin);
        }

        if (self->ymax != NULL) {
            cx_free(self->ymax);
        }

        cx_free(self);
    }

    return;

}


inline static GiExtractionWorkspace*
_giraffe_optimal_workspace_new(cxint m, cxint n)
{

    GiExtractionWorkspace* self = cx_malloc(sizeof *self);


    self->atw  = cpl_matrix_new(m, n);
    self->atwa = cpl_matrix_new(m, m);
    self->c    = cpl_matrix_new(m, m);
    self->atws = cpl_matrix_new(m, 1);

    self->tmp  = cpl_matrix_new(m, m);

    return self;

}


inline static void
_giraffe_optimal_workspace_delete(GiExtractionWorkspace* self)
{

    if (self != NULL) {
        if (self->atws != NULL) {
            cpl_matrix_delete(self->atws);
        }

        if (self->atwa != NULL) {
            cpl_matrix_delete(self->atwa);
        }

        if (self->c != NULL) {
            cpl_matrix_delete(self->c);
        }

        if (self->atw != NULL) {
            cpl_matrix_delete(self->atw);
        }

        if (self->tmp != NULL) {
            cpl_matrix_delete(self->tmp);
        }

        cx_free(self);

    }

    return;

}


/*
 * Virtual slit implementation
 */

inline static void
_giraffe_virtualslit_allocate(GiVirtualSlit* self)
{

    if ((self != NULL) && (self->width > 0)) {

        self->position = cx_calloc(self->width, sizeof(cxdouble));
        self->signal = cx_calloc(self->width, sizeof(cxdouble));
        self->variance = cx_calloc(self->width, sizeof(cxdouble));
        self->fraction = cx_calloc(self->width, sizeof(cxdouble));

        self->mask = cx_calloc(self->width, sizeof(cxdouble));
        self->offset = cx_calloc(self->width, sizeof(cxdouble));

    }

    return;

}


inline static GiVirtualSlit*
_giraffe_virtualslit_new(cxdouble extra_width)
{

    GiVirtualSlit* self = cx_calloc(1, sizeof *self);

    self->width = 0;
    self->center = 0.;
    self->extra_width = extra_width;

    self->position = NULL;
    self->signal = NULL;
    self->variance = NULL;
    self->fraction = NULL;
    self->mask = NULL;
    self->offset = NULL;

    return self;

}


inline static void
_giraffe_virtualslit_clear(GiVirtualSlit* self)
{

    if (self != NULL) {

        if (self->position != NULL) {
            cx_free(self->position);
            self->position = NULL;
        }

        if (self->signal != NULL) {
            cx_free(self->signal);
            self->signal = NULL;
        }

        if (self->variance != NULL) {
            cx_free(self->variance);
            self->variance = NULL;
        }

        if (self->fraction != NULL) {
            cx_free(self->fraction);
            self->fraction = NULL;
        }

        if (self->mask != NULL) {
            cx_free(self->mask);
            self->mask = NULL;
        }

        if (self->offset != NULL) {
            cx_free(self->offset);
            self->offset = NULL;
        }

        self->extra_width = 0.;
        self->center = 0.;
        self->width = 0;

    }

    return;

}


inline static void
_giraffe_virtualslit_delete(GiVirtualSlit* self)
{

    if (self != NULL) {
        _giraffe_virtualslit_clear(self);

        cx_free(self);
    }

    return;

}


inline static cxint
_giraffe_virtualslit_setup(GiVirtualSlit* self, cxint bin,
                           cxdouble center, cxdouble width,
                           const cpl_image* signal, const cpl_image* variance,
                           const cpl_image* bpixel)
{

    register cxint ny = cpl_image_get_size_x(signal);
    register cxint offset = bin * cpl_image_get_size_x(signal);

    register cxdouble lower = center - (width + self->extra_width);
    register cxdouble upper = center + (width + self->extra_width);

    register cxint first = (cxint) floor(lower);
    register cxint last = (cxint) ceil(upper);

    const cxdouble* s = cpl_image_get_data_double_const(signal);
    const cxdouble* v = cpl_image_get_data_double_const(variance);


    /*
     * Upper, lower border and width of the virtual slit
     */

    lower = CX_MAX(0., lower);
    upper = CX_MIN(ny, upper);

    first = CX_MAX(0, first);
    last = CX_MIN(ny, last);

    self->center = center;
    self->width = last - first + 1;


    /*
     * Create and fill the buffers
     */

    _giraffe_virtualslit_allocate(self);

    if (bpixel != NULL) {

        register cxint k = 0;
        register cxint y = 0;

        const cxint* _bpixel = cpl_image_get_data_int_const(bpixel);


        for (y = first; y <= last; y++) {

            register cxint ypos = offset + y;

            cxint ok = (_bpixel[ypos] & GIR_M_PIX_SET) == 0 ? 1 : 0;


            self->position[k] = y - center;
            self->fraction[k]  = 1.;

            self->signal[k] = s[ypos];
            self->variance[k] = v[ypos];

            self->mask[k] = ok;
            self->offset[k] = ypos;
            ++k;

        }

    }
    else {

        register cxint k = 0;
        register cxint y = 0;


        for (y = first; y <= last; y++) {

            register cxint ypos = offset + y;

            cxint ok = 1;


            self->position[k] = y - center;
            self->fraction[k]  = 1.;

            self->signal[k] = s[ypos];
            self->variance[k] = v[ypos];

            self->mask[k] = ok;
            self->offset[k] = ypos;
            ++k;

        }

    }


    /*
     * Correct for pixel fractions at the borders of the
     * virtual slit, since they have been set to the full
     * pixel in the above loop.
     */

    self->fraction[0] = ((cxdouble)first + 1.) - lower;
    self->fraction[self->width - 1] = upper - ((cxdouble)last - 1.);

    return self->width;

}


/*
 * Compute the inverse of a square matrix
 */

inline static cxint
_giraffe_matrix_invert(cpl_matrix* m_inv, const cpl_matrix* m, cpl_matrix* lu)
{

    cxint i = 0;
    cxint status = 0;
    cxint n = cpl_matrix_get_ncol(m);

    register cxint sz = n * n * sizeof(cxdouble);

    const cxdouble* _m = cpl_matrix_get_data_const(m);

    cxdouble* _m_inv = cpl_matrix_get_data(m_inv);
    cxdouble* _m_lu = cpl_matrix_get_data(lu);

    cpl_array* perm = cpl_array_new(n, CPL_TYPE_INT);

    register cxint* perm_data = cpl_array_get_data_int(perm);


    memset(_m_inv, 0, sz);
    memcpy(_m_lu, _m, sz);

    if (cpl_matrix_decomp_lu(lu, perm, &i) != 0) {
        cpl_array_delete(perm);
        return 1;
    }


    /*
     * Create an identity matrix with the rows permuted
     */

    for (i = 0; i < n; ++i) {
        _m_inv[i * n + perm_data[i]] = 1.;
    }

    cpl_array_delete(perm);


    status = cpl_matrix_solve_lu(lu, m_inv, NULL);

    if (status != 0) {
        cpl_matrix_delete(m_inv);
        return 2;
    }

    return 0;

}


/*
 * Compute the PSF profile for a set of abscissa values.
 */

inline static cpl_matrix*
_giraffe_compute_psf(GiModel* psf, const cpl_matrix* x)
{

    register cxint i = 0;
    register cxint n = 0;

    cxint status = 0;

    const cxdouble* _x = NULL;

    cxdouble* _y = NULL;

    cpl_matrix* y = NULL;

    cx_assert(psf != NULL);
    cx_assert(x != NULL);
    cx_assert(cpl_matrix_get_ncol(x) == 1);

    n = cpl_matrix_get_nrow(x);

    y = cpl_matrix_new(n, 1);

    _x = cpl_matrix_get_data_const(x);
    _y = cpl_matrix_get_data(y);

    for (i = 0; i < n; i++) {
        giraffe_model_set_argument(psf, "x", _x[i]);
        giraffe_model_evaluate(psf, &_y[i], &status);

        if (status != 0) {
            cpl_matrix_delete(y);
            return NULL;
        }
    }

    return y;

}


/*
 * Horne extraction of a single wavelength bin for the given virtual
 * slit.
 */

inline static cxint
_giraffe_horne_extract_slit(GiExtractionData* result,
                            const GiVirtualSlit* vslit, GiModel* psf,
                            const GiExtractHorneConfig* config)
{

    cxint i = 0;
    cxint ngood = 0;

    cxdouble var = 0.;
    cxdouble bkg = 0.;
    cxdouble flx = 0.;
    cxdouble norm = 0.;
    cxdouble* tdata = NULL;
    cxdouble* _mnpsf = NULL;

    cpl_matrix* mnpsf = NULL;
    cpl_matrix* mvslit = NULL;



    /*
     * Compute the PSF model.
     */

    mvslit = cpl_matrix_wrap(vslit->width, 1, vslit->position);
    mnpsf = _giraffe_compute_psf(psf, mvslit);

    cpl_matrix_unwrap(mvslit);
    mvslit = NULL;

    if (mnpsf == NULL) {
        return -1;
    }


    /*
     * Enforce positivity and normalization of the profile model.
     */

    _mnpsf = cpl_matrix_get_data(mnpsf);

    norm = 0.;

    for (i = 0; i < vslit->width; ++i) {
        _mnpsf[i] = CX_MAX(_mnpsf[i], 0.);
        norm += _mnpsf[i];
    }

    for (i = 0; i < vslit->width; ++i) {
        _mnpsf[i] /= norm;
    }


    /*
     * Estimate background and determine the number of valid pixels
     */

    tdata = cx_malloc(vslit->width * sizeof(cxdouble));

    i = 0;
    ngood = 0;

    while (i < vslit->width) {
        if (vslit->mask[i] > 0) {
            tdata[ngood] = CX_MAX(vslit->signal[i], 0.);
            ++ngood;
        }
        ++i;
    }

    if (ngood > 1) {
        giraffe_array_sort(tdata, ngood);
        bkg = 0.5 * (tdata[0] + tdata[1]);
    }

    cx_free(tdata);
    tdata = NULL;


    /*
     * Try extraction only if there are good pixels available. If no good
     * pixels are left skip this spectral bin and set the flux and the variance
     * to zero.
     */

    if (ngood > 0) {

        cxint iteration = 0;
        cxint nreject = -1;
        cxint niter = config->clip.iterations;
        cxint nmin = (cxint)config->clip.fraction;

        cxdouble sigma = config->clip.level * config->clip.level;
        cxdouble* variance = NULL;


        /*
         * Compute standard extraction flux and rescale it to account for
         * bad pixels.
         */

        norm = 0.;
        flx = 0.;

        for (i = 0; i < vslit->width; ++i) {
            if (vslit->mask[i] != 0) {
                flx += (vslit->signal[i] - bkg) * vslit->fraction[i];
                norm += vslit->fraction[i] * _mnpsf[i];
            }
        }

        flx /= norm;


        /*
         * Allocate buffer for the variance estimates and compute the initial
         * variances from the expected profile.
         */

        variance = cx_calloc(vslit->width, sizeof(cxdouble));

        for (i = 0; i < vslit->width; ++i) {

            register cxdouble ve = flx * _mnpsf[i] + bkg;

            variance[i] = vslit->variance[i] + fabs(vslit->fraction[i] * ve);

        }


        /*
         * Reject cosmics and extract spectrum
         */

        nreject = -1;

        while ((iteration < niter) && (ngood > nmin) && (nreject != 0)) {

            cxint imax = 0;

            cxdouble _flx = 0.;
            cxdouble mmax = 0.;


            norm = 0.;
            var = 0.;
            nreject = 0;


            /*
             * Reject cosmics
             */

            for (i = 0; i < vslit->width; ++i) {

                if (vslit->mask[i] != 0) {

                    cxdouble m = vslit->signal[i] - bkg - flx * _mnpsf[i];

                    m *= vslit->fraction[i];
                    m *= m / variance[i] ;

                    if (m > mmax) {
                        mmax = m;
                        imax = i;
                    }

                }

            }

            if ((sigma > 0.) && (mmax > sigma)) {
                vslit->mask[imax] = 0;
                ++nreject;
                --ngood;
            }


            /*
             * Compute flux and variance estimates.
             */

            for (i = 0; i < vslit->width; ++i) {

                if (vslit->mask[i] != 0) {

                    register cxdouble data = vslit->signal[i] - bkg;
                    register cxdouble p    = _mnpsf[i];

                    data *= vslit->fraction[i];
                    p    *= vslit->fraction[i];

                    norm += p * p / variance[i];
                    _flx += p * data / variance[i];
                    var  += p;

                }

            }

            flx = _flx / norm;
            var /= norm;


            /*
             * Update variance estimates
             */

            for (i = 0; i < vslit->width; ++i) {

                register cxdouble ve = flx * _mnpsf[i] + bkg;

                variance[i] = vslit->variance[i] + fabs(vslit->fraction[i] * ve);

            }

            ++iteration;

        }

        cx_free(variance);
        variance = NULL;

    }

    cpl_matrix_delete(mnpsf);
    mnpsf = NULL;

    result->value = flx;
    result->error = sqrt(var);
    result->position = vslit->center;
    result->npixels = ngood;

    return ngood == 0 ? 1 : 0;

}


/*
 * @brief
 *   Compute the optimal extracted flux and its variance for a single
 *   wavelength bin.
 *
 * @param slice   The results container to store the flux, variance and
 *                extraction model.
 * @param AT      The transposed design matrix of the linear system.
 * @param S       Column vector of the measured signal.
 * @param W       Matrix of weights of the measured signals.
 * @param limits  Cutoff parameters.
 * @param ws      Workspace for the matrix operations.
 *
 * @return
 *   The function returns 0 on success, and a non-zero value if an error
 *   occurred.
 *
 * The functions computes the optimal extracted fluxes for a single wavelength
 * bin by solving the linear system:
 * @f[
 *   \mathbf{f}\left(x\right) =
 *       \left(\mathbf{A}^\mathrm{T}\mathbf{W}\mathbf{A}\right)^{-1}
 *       \mathbf{A}^\mathrm{T}\mathbf{W}\mathbf{s}
 * @f]
 * where the @f$\mathbf{s}@f$ is the column vector of the measured fluxes
 * written as an @f$\left(n \times 1\right)@f$ matrix, @f$\mathbf{W}@f$ is the
 * diagonal @f$\left(n \times n\right)@f$ matrix of the weights, and
 * @f$\mathbf{A}^\mathrm{T}@f$ is the transposed of the
 * @f$\left(n \times m\right)@f$ design matrix @f$\mathbf{A}@f$.
 *
 * Defining the matrix @f$\mathbf{C} = \left(c_\mathrm{ij}\right) \equiv
 * \left(\mathbf{A}^\mathrm{T}\mathbf{W}\mathbf{A}\right)^{-1}@f$, and using
 * @f$a_\mathrm{ij}@f$ and @f$w_\mathrm{ij}@f$ to denote the elements of the
 * transposed design matrix and the weight matrix respectively, the extracted
 * flux can be written as the following sum:
 * @f[
 *   f_\mathrm{i} = \sum\limits_{\mathrm{l} = 0}^{\mathrm{m} - 1} c_\mathrm{il}
 *                  \sum\limits_{\mathrm{k} = 0}^{\mathrm{n} - 1} a_\mathrm{lk}
 *                    w_\mathrm{kk} s_\mathrm{k}
 * @f]
 *
 */

inline static cxint
_giraffe_optimal_extract_slice(GiExtractionSlice* slice,
                               const cpl_matrix* AT,
                               const cpl_matrix* S,
                               const cpl_matrix* W,
                               GiExtractionPsfLimits* limits,
                               GiExtractionWorkspace* ws)
{

    register cxint i = 0;
    register cxint n = cpl_matrix_get_ncol(AT);
    register cxint m = cpl_matrix_get_nrow(AT);

    cxint status = 0;

    const cxdouble* at = cpl_matrix_get_data_const(AT);
    const cxdouble* w = cpl_matrix_get_data_const(W);
    const cxdouble* s = cpl_matrix_get_data_const(S);
    const cxdouble* c = cpl_matrix_get_data_const(ws->c);

    cxdouble* atw = cpl_matrix_get_data(ws->atw);
    cxdouble* atwa = cpl_matrix_get_data(ws->atwa);
    cxdouble* atws = cpl_matrix_get_data(ws->atws);
    cxdouble* sf = cpl_matrix_get_data(slice->flux);
    cxdouble* sv = cpl_matrix_get_data(slice->variance);
    cxdouble* sm = cpl_matrix_get_data(slice->model);


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

        register cxint j = 0;
        register cxint im = i * m;
        register cxint in = i * n;
        register cxint ymin = limits->ymin[i];
        register cxint ymax = limits->ymax[i];


        atws[i] = 0.;

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

            register cxint k = in + j;


            atw[k] = w[j] * at[k];
            atws[i] += atw[k] * s[j];

        }

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

            register cxint k = 0;
            register cxint l = im + j;

            atwa[l] = 0.;
            for (k = ymin; k < ymax; ++k) {
                atwa[l] += atw[in + k] * at[j * n + k];
            }

            atwa[j * m + i] = atwa[l];

        }

        atwa[im + i] = 0.;

        for (j = ymin; j < ymax; ++j) {
            atwa[im + i] += atw[in + j] * at[in + j];
        }

    }


    status = _giraffe_matrix_invert(ws->c, ws->atwa, ws->tmp);

    if (status != 0) {
        return 1;
    }

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

        register cxint j = 0;
        register cxint im = i * m;


        sf[i] = 0.;
        sv[i] = c[im + i];

        for (j = 0; j < m; ++j) {
            sf[i] += c[im + j] * atws[j];
        }

    }

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

        register cxint j = 0;


        sm[i] = 0.;

        for (j = 0; j < m; ++j) {
            sm[i] += at[j * n + i] * sf[j];
        }

    }

    return 0;

}


/*
 * @brief
 *   Extract spectra by simple summation.
 *
 * @param mz      Pixels values [nx, ny]
 * @param mslz    Scattered light model pixel values [nx, ny]
 * @param fibers  List of fibers to extract
 * @param my      Fiber centroid positions [ns, ny]
 * @param mw      Fiber widths [ns, ny]
 * @param ms      Extracted flux [ns, ny]
 * @param mse     Extracted flux error [ns, ny]
 * @param msn     Number of extracted pixels [ns, ny]
 * @param msy     Extracted flux centroid position [ns, ny]
 *
 * For each X bin and each spectrum the flux is computed as the sum of
 * pixels value from @em mz[nx,ny] along the virtual slit computed using
 * the localization mask @em my[ns, ny] and @em mw[ns, ny].
 * The table @em fibers specifies the spectra to extract.
 *
 * The images @em ms[ns, ny], @em mse[ns, ny], @em msn[ns, ny] and
 * @em msy[ns, ny] must be allocated by the caller.
 */

inline static cxint
_giraffe_extract_summation(const cpl_image* mz, const cpl_image* mvarz,
                           const cpl_table* fibers, const cpl_image* my,
                           const cpl_image* mw, cpl_image* mbpx,
                           cpl_image* ms, cpl_image* mse,
                           cpl_image* msn, cpl_image* msy)
{

    register cxint nn;

    const cxchar* idx = NULL;

    cxint ny = cpl_image_get_size_x(mz);
    cxint nfibers = cpl_table_get_nrow(fibers);
    cxint nspectra = cpl_image_get_size_x(my);
    cxint nbins = cpl_image_get_size_y(my);

    const cxdouble* pixels = cpl_image_get_data_double_const(mz);
    const cxdouble* variances = cpl_image_get_data_double_const(mvarz);
    const cxdouble* locy = cpl_image_get_data_double_const(my);
    const cxdouble* locw = cpl_image_get_data_double_const(mw);

    cxdouble* flux = cpl_image_get_data_double(ms);
    cxdouble* flux_error = cpl_image_get_data_double(mse);
    cxdouble* flux_npixels = cpl_image_get_data_double(msn);
    cxdouble* flux_ypos = cpl_image_get_data_double(msy);


    /*
     * The number of fibers to be process must be less or equal to the
     * number of spectra available in the localization.
     */

    cx_assert(nfibers <= nspectra);

    idx = giraffe_fiberlist_query_index(fibers);

    cx_assert(cpl_table_has_column(fibers, idx) != 0);

    if (mbpx != NULL) {

        const cxint* bpx = cpl_image_get_data_int(mbpx);

        for (nn = 0; nn < nfibers; nn++) {

            register cxint x;
            register cxint ns = cpl_table_get_int(fibers, idx, nn, NULL) - 1;


            for (x = 0; x < cpl_image_get_size_y(mz) && x < nbins; x++) {

                cxint y;
                cxint yup, ylo;
                cxint lx = x * nspectra + ns;
                cxint sx = x * nfibers + nn;

                cxdouble ylower = locy[lx] - locw[lx];
                cxdouble yupper = locy[lx] + locw[lx];
                cxdouble zsum = 0.;
                cxdouble ysum = 0.;
                cxdouble error2 = 0.;


                flux[sx] = 0.;
                flux_npixels[sx] = 0.;
                flux_error[sx] = 0.;
                flux_ypos[sx] = 0.;


                /*
                 * Skip zero-width (invalid) spectra
                 */

                if (locw[lx] <= 0.0) {
                    continue;
                }


                /*
                 * Upper and lower border of the virtual slit. The real ones
                 * and the borders corrected for pixel fractions. If we are
                 * out of the the image boundaries we skip the extraction
                 * for this bin and fiber.
                 */

                ylo = (cxint) ceil(ylower);
                yup = (cxint) floor(yupper);


                if (yup < 0. || ylo - 1 >= ny) {
                    continue;
                }


                /*
                 * Summation along the virtual slit. Check that y is always
                 * in the range of valid pixels [0, ny[. Take into account
                 * pixel fractions at the beginning and the end of the
                 * virtual slit.
                 */

                /*
                 * Lower ordinate pixel fraction
                 */

                y = ylo - 1;

                if (y >= 0) {

                    if (!(bpx[x * ny + y] & GIR_M_PIX_SET)) {

                        cxdouble extcoeff  = (cxdouble)ylo - ylower;
                        cxdouble extcoeff2 = extcoeff * extcoeff;
                        cxdouble px = CX_MAX(pixels[x * ny + y], 0.);

                        flux[sx] = pixels[x * ny + y] * extcoeff;
                        flux_npixels[sx] = extcoeff;
                        error2 = variances[x * ny + y] * extcoeff2;

                        zsum = px * extcoeff;
                        ysum = y * px * extcoeff;

                    }

                }


                /*
                 * Sum pixel values along virtual slit.
                 */

                for (y = CX_MAX(ylo, 0); (y < yup) && (y < ny); y++) {

                    if (!(bpx[x * ny + y] & GIR_M_PIX_SET)) {

                        cxdouble px = CX_MAX(pixels[x * ny + y], 0.);

                        flux[sx] += pixels[x * ny + y];
                        flux_npixels[sx] += 1.0;
                        error2 += variances[x * ny + y];

                        zsum += px;
                        ysum += y * px;

                    }

                }


                /*
                 * Upper ordinate pixel fraction
                 */

                y = yup;

                if (y < ny) {

                    if (!(bpx[x * ny + y] & GIR_M_PIX_SET)) {

                        cxdouble extcoeff  = yupper - (cxdouble)yup;
                        cxdouble extcoeff2 = extcoeff * extcoeff;
                        cxdouble px = CX_MAX(pixels[x * ny + y], 0.);

                        flux[sx] += pixels[x * ny + y] * extcoeff;
                        flux_npixels[sx] += extcoeff;
                        error2 += variances[x * ny + y] * extcoeff2;

                        zsum += px * extcoeff;
                        ysum += y * px * extcoeff;

                    }

                }

                flux_error[sx] = sqrt(error2);

                // FIXME: Check this protection from division by zero. Also
                //        the minimum condition for the pixel values above.

                if (fabs(ysum) < DBL_EPSILON || fabs(zsum) < DBL_EPSILON) {
                    flux_ypos[sx] = 0.5 * (yupper + ylower);
                }
                else {
                    flux_ypos[sx] = ysum / zsum;
                }

            }

        }

    }
    else {

        for (nn = 0; nn < nfibers; nn++) {

            register cxint x;
            register cxint ns = cpl_table_get_int(fibers, idx,
                                                  nn, NULL) - 1;


            for (x = 0; x < cpl_image_get_size_y(mz) && x < nbins; x++) {

                cxint y;
                cxint yup, ylo;
                cxint lx = x * nspectra + ns;
                cxint sx = x * nfibers + nn;

                cxdouble yupper, ylower;
                cxdouble zsum = 0.;
                cxdouble ysum = 0.;
                cxdouble error2 = 0.;


                flux[sx] = 0.;
                flux_npixels[sx] = 0.;
                flux_error[sx] = 0.;
                flux_ypos[sx] = 0.;


                /*
                 * Skip zero-width (invalid) spectra
                 */

                if (locw[lx] <= 0.0) {
                    continue;
                }


                /*
                 * Upper and lower border of the virtual slit. The real ones
                 * and the borders corrected for pixel fractions. If we are
                 * out of the the image boundaries we skip the extraction
                 * for this bin and fiber.
                 */

                yupper = locy[lx] + locw[lx];
                ylower = locy[lx] - locw[lx];

                ylo = (cxint) ceil(ylower);
                yup = (cxint) floor(yupper);


                if (yup < 0. || ylo - 1 >= ny) {
                    continue;
                }


                /*
                 * Summation along the virtual slit. Check that y is always
                 * in the range of valid pixels [0, ny[. Take into account
                 * pixel fractions at the beginning and the end of the
                 * virtual slit.
                 */

                /*
                 * Lower ordinate pixel fraction
                 */

                y = ylo - 1;

                if (y >= 0) {

                    cxdouble extcoeff  = (cxdouble)ylo - ylower;
                    cxdouble extcoeff2 = extcoeff * extcoeff;
                    cxdouble px = CX_MAX(pixels[x * ny + y], 0.);

                    flux[sx] = pixels[x * ny + y] * extcoeff;
                    flux_npixels[sx] = extcoeff;
                    error2 = variances[x * ny + y] * extcoeff2;

                    zsum = px * extcoeff;
                    ysum = y * px * extcoeff;

                }


                /*
                 * Sum pixel values along virtual slit.
                 */

                for (y = CX_MAX(ylo, 0); (y < yup) && (y < ny); y++) {

                    cxdouble px = CX_MAX(pixels[x * ny + y], 0.);

                    flux[sx] += pixels[x * ny + y];
                    flux_npixels[sx] += 1.0;
                    error2 += variances[x * ny + y];

                    zsum += px;
                    ysum += y * px;
                }


                /*
                 * Upper ordinate pixel fraction
                 */

                y = yup;

                if (y < ny) {

                    cxdouble extcoeff  = yupper - (cxdouble)yup;
                    cxdouble extcoeff2 = extcoeff * extcoeff;
                    cxdouble px = CX_MAX(pixels[x * ny + y], 0.);

                    flux[sx] += pixels[x * ny + y] * extcoeff;
                    flux_npixels[sx] += extcoeff;
                    error2 += variances[x * ny + y] * extcoeff2;

                    zsum += px * extcoeff;
                    ysum += y * px * extcoeff;

                }

                flux_error[sx] = sqrt(error2);

                // FIXME: Check this protection from division by zero. Also
                //        the minimum condition for the pixel values above.

                if (fabs(ysum) < DBL_EPSILON || fabs(zsum) < DBL_EPSILON) {
                    flux_ypos[sx] = 0.5 * (yupper + ylower);
                }
                else {
                    flux_ypos[sx] = ysum / zsum;
                }

            }

        }

    }

    return 0;

}


/*
 * @brief
 *   Extract spectra using the optimal extraction method.
 *
 * @param mz      Pixels values [nx, ny]
 * @param mvar    Initial variance [nx, ny]
 * @param fibers  List of fibers to extract
 * @param my      Fiber centroid positions [ns, ny]
 * @param mw      Fiber widths [ns, ny]
 * @param ms      Extracted flux [ns, ny]
 * @param mse     Extracted flux error [ns, ny]
 * @param msn     Number of extracted pixels [ns, ny]
 * @param msy     Extracted flux centroid position [ns, ny]
 * @param config  Optimal extraction method setup
 *
 * TBD
 *
 * The images @em ms[ns, ny], @em mse[ns, ny], @em msn[ns, ny] and
 * @em msy[ns, ny] must be allocated by the caller.
 */

inline static cxint
_giraffe_extract_horne(const cpl_image* mz, const cpl_image* mzvar,
                       const cpl_table* fibers, const cpl_image* my,
                       const cpl_image* mw, const GiPsfData* psfdata,
                       cpl_image* mbpx, cpl_image* ms, cpl_image* mse,
                       cpl_image* msn, cpl_image* msy,
                       const GiExtractHorneConfig* config)
{

    const cxchar* idx = NULL;

    cxint nx = 0;
    cxint ny = 0;
    cxint fiber = 0;
    cxint nfibers = 0;

    const cxdouble* locy = NULL;
    const cxdouble* locw = NULL;
    const cxdouble* width = NULL;
    const cxdouble* exponent = NULL;

    GiModel* psfmodel = NULL;


    cx_assert(mz != NULL);
    cx_assert(mzvar != NULL);

    cx_assert(fibers != NULL);

    cx_assert(my != NULL);
    cx_assert(mw != NULL);

    cx_assert(psfdata != NULL);

    cx_assert(ms != NULL);
    cx_assert(mse != NULL);
    cx_assert(msn != NULL);
    cx_assert(msy != NULL);

    cx_assert(config != NULL);

    ny = cpl_image_get_size_x(mz);
    nx = cpl_image_get_size_y(mz);
    nfibers = cpl_table_get_nrow(fibers);

    locy = cpl_image_get_data_double_const(my);
    locw = cpl_image_get_data_double_const(mw);

    cx_assert((ny == cpl_image_get_size_x(mzvar)) &&
              (nx == cpl_image_get_size_y(mzvar)));

    cx_assert(cpl_image_get_size_x(my) == cpl_image_get_size_x(mw));
    cx_assert(cpl_image_get_size_y(my) == cpl_image_get_size_y(mw));

    cx_assert(giraffe_psfdata_fibers(psfdata) ==
              (cxsize)cpl_image_get_size_x(my));
    cx_assert(giraffe_psfdata_bins(psfdata) ==
              (cxsize)cpl_image_get_size_y(my));

    cx_assert((nfibers == cpl_image_get_size_x(ms)) &&
              (nx == cpl_image_get_size_y(ms)));
    cx_assert((nfibers == cpl_image_get_size_x(mse)) &&
              (nx == cpl_image_get_size_y(mse)));
    cx_assert((nfibers == cpl_image_get_size_x(msn)) &&
              (nx == cpl_image_get_size_y(msn)));
    cx_assert((nfibers == cpl_image_get_size_x(msy)) &&
              (nx == cpl_image_get_size_y(msy)));

    cx_assert((mbpx == NULL) || ((ny == cpl_image_get_size_x(mbpx)) &&
                                 (nx == cpl_image_get_size_y(mbpx))));


    /*
     * Get the index column mapping the current spectum number to the
     * corresponding reference localization spectrum number.
     */

    idx = giraffe_fiberlist_query_index(fibers);

    cx_assert(cpl_table_has_column(fibers, idx) != 0);


    /*
     * Get the PSF profile data arrays for efficency reasons in the
     * following loops.
     */

    if (giraffe_psfdata_contains(psfdata, "Center") == FALSE) {
        return -1;
    }

    if (giraffe_psfdata_contains(psfdata, "Width2") == TRUE) {
        exponent = cpl_image_get_data_const(giraffe_psfdata_get_data(psfdata,
            "Width2"));
    }

    width = cpl_image_get_data_const(giraffe_psfdata_get_data(psfdata,
        "Width1"));


    /*
     * Create the PSF profile model from the PSF data object.
     */

    psfmodel = giraffe_model_new(giraffe_psfdata_get_model(psfdata));

    if (psfmodel == NULL) {
        return -2;
    }

    giraffe_model_set_parameter(psfmodel, "Center", 0.);
    giraffe_model_set_parameter(psfmodel, "Amplitude", 1.);
    giraffe_model_set_parameter(psfmodel, "Background", 0.);


    /*
     * Extract each fiber spectrum
     */

    for (fiber = 0; fiber < nfibers; ++fiber) {

        register cxint bin = 0;
        register cxint fidx = cpl_table_get_int(fibers, idx, fiber, NULL) - 1;

        cxint nbins = CX_MIN(nx, cpl_image_get_size_y(my));

        cxdouble* _ms = cpl_image_get_data_double(ms);
        cxdouble* _mse  = cpl_image_get_data_double(mse);
        cxdouble* _msy = cpl_image_get_data_double(msy);
        cxdouble* _msn = cpl_image_get_data_double(msn);


        for (bin = 0; bin < nbins; bin++) {

            register cxint lpos = bin * cpl_image_get_size_x(my) + fidx;
            register cxint spos = bin * nfibers + fiber;

            cxint status = 0;
            cxint vwidth = 0;

            register cxdouble lcenter = locy[lpos];
            register cxdouble lwidth = locw[lpos];

            register cxdouble ylower = lcenter - lwidth;
            register cxdouble yupper = lcenter + lwidth;

            GiVirtualSlit* vslit = NULL;

            GiExtractionData result = {0., 0., 0., 0.};


            /*
             * Skip zero-width, invalid spectra
             */

            if ((lwidth <= 0.) || (yupper < 0.) || (ylower > ny)) {
                continue;
            }

            /*
             * Fill the virtual slit with data
             */

            vslit = _giraffe_virtualslit_new(config->ewidth);

            vwidth = _giraffe_virtualslit_setup(vslit, bin, lcenter, lwidth,
                                                mz, mzvar, mbpx);

            if (vwidth == 0) {
                _giraffe_virtualslit_delete(vslit);
                vslit = NULL;

                continue;
            }


            /*
             * Update PSF profile model width and exponent
             */

            giraffe_model_set_parameter(psfmodel, "Width1", width[lpos]);

            if (exponent != NULL) {
                giraffe_model_set_parameter(psfmodel, "Width2",
                                            exponent[lpos]);
            }


            /*
             * Compute flux from the virtual slit using Horne's optimal
             * extraction algorithm.
             */

            status = _giraffe_horne_extract_slit(&result, vslit, psfmodel,
                                                 config);

            _giraffe_virtualslit_delete(vslit);
            vslit = NULL;

            if (status < 0) {

                giraffe_model_delete(psfmodel);
                psfmodel = NULL;

                return 1;
            }

            _ms[spos] = result.value;
            _mse[spos] = result.error;
            _msy[spos] = result.position;
            _msn[spos] = result.npixels;

        }

    }


    giraffe_model_delete(psfmodel);
    psfmodel = NULL;

    return 0;

}


/*
 * Fill extraction matrix with the fiber profiles and the coefficients of
 * the Chebyshev polynomial model of the background.
 */

inline static cxint
_giraffe_optimal_build_profiles(cpl_matrix* profiles,
                                GiExtractionPsfLimits* limits,
                                const cpl_image* my, const cpl_image* mw,
                                const cpl_table* fibers, cxint bin,
                                GiModel* psf, const cxdouble* width,
                                const cxdouble* exponent, cxdouble wfactor)
{

    const cxchar* idx = giraffe_fiberlist_query_index(fibers);

    cxint fiber = 0;
    cxint nfibers = cpl_table_get_nrow(fibers);
    cxint ny = cpl_matrix_get_ncol(profiles);

    const cxdouble* locy = cpl_image_get_data_double_const(my);
    const cxdouble* locw = cpl_image_get_data_double_const(mw);

    cxdouble* _profiles = cpl_matrix_get_data(profiles);

    cxdouble* ypos = NULL;


    cx_assert(cpl_table_has_column(fibers, idx) != 0);
    cx_assert((limits == NULL) ||
              (cpl_matrix_get_nrow(profiles) == limits->size));

    ypos = cx_calloc(ny, sizeof(cxdouble));

    for (fiber = 0; fiber < nfibers; ++fiber) {

        register cxint i = 0;
        register cxint y = 0;
        register cxint k = 0;

        cxint fidx = cpl_table_get_int(fibers, idx, fiber, NULL) - 1;
        cxint lpos = bin * cpl_image_get_size_x(my) + fidx;

        register cxdouble lcenter = locy[lpos];
        register cxdouble lwidth = locw[lpos];

        register cxdouble ylower = lcenter - fabs(wfactor) * lwidth;
        register cxdouble yupper = lcenter + fabs(wfactor) * lwidth;

        register cxint first = (cxint) floor(ylower);
        register cxint last = (cxint) ceil(yupper);

        register cxint vwidth = 0;

        cxdouble norm = 0.;
        cxdouble* _mnpsf = NULL;

        cpl_matrix* positions = NULL;
        cpl_matrix* mnpsf = NULL;


        /*
         * Upper, lower border and width of the virtual slit
         */

        ylower = CX_MAX(0., ylower);
        yupper = CX_MIN(ny - 1., yupper);

        first = CX_MAX(0, first);
        last = CX_MIN(ny - 1, last);

        vwidth = last - first + 1;

        if (limits != NULL) {
            limits->ymin[fiber] = first;
            limits->ymax[fiber] = last + 1;
        }


        /*
         * Update PSF profile model width and exponent
         */

        giraffe_model_set_parameter(psf, "Width1", width[lpos]);

        if (exponent != NULL) {
            giraffe_model_set_parameter(psf, "Width2", exponent[lpos]);
        }


        /*
         * Compute normalized psf model
         */

        k = 0;
        for (y = first; y <= last; ++y) {
            ypos[k] = y - lcenter;
            ++k;
        }

        positions = cpl_matrix_wrap(vwidth, 1, ypos);
        mnpsf = _giraffe_compute_psf(psf, positions);

        cpl_matrix_unwrap(positions);
        positions = NULL;

        if (mnpsf == NULL) {
            cx_free(ypos);
            ypos = NULL;

            return 1;
        }

        _mnpsf = cpl_matrix_get_data(mnpsf);

        for (i = 0; i < vwidth; ++i) {
            _mnpsf[i] = CX_MAX(_mnpsf[i], 0.);
            norm += _mnpsf[i];
        }

        for (i = 0; i < vwidth; ++i) {
            _mnpsf[i] /= norm;
        }

        k = fiber * ny + first;
        for (y = 0; y < vwidth; ++y) {
            _profiles[k + y] = _mnpsf[y];
        }

        cpl_matrix_delete(mnpsf);
        mnpsf = NULL;

    }

    cx_free(ypos);
    ypos = NULL;

    return 0;

}


inline static cxint
_giraffe_extract_optimal(const cpl_image* mz, const cpl_image* mzvar,
                         const cpl_table* fibers, const cpl_image* my,
                         const cpl_image* mw, const GiPsfData* psfdata,
                         cpl_image* mbpx, cpl_image* ms, cpl_image* mse,
                         cpl_image* msm, cpl_image* msy,
                         const GiExtractOptimalConfig* config)
{

    const cxbool nolimits = (config->limits == TRUE) ? FALSE : TRUE;

    const cxint bkg_nc = config->bkgorder + 1;
    const cxint niter = config->clip.iterations;

    register cxint i = 0;

    cxint nx = 0;
    cxint ny = 0;
    cxint bin = 0;
    cxint nbins = 0;
    cxint nfibers = 0;

    const cxdouble wfactor = config->ewidth;
    const cxdouble sigma = config->clip.level * config->clip.level;
    const cxdouble fraction = config->clip.fraction;

    const cxdouble* width = NULL;
    const cxdouble* exponent = NULL;

    cxdouble* _ypos = NULL;
    cxdouble* _bkg_base = NULL;
    cxdouble* _profiles = NULL;
    cxdouble* _signal = NULL;
    cxdouble* _variance = NULL;
    cxdouble* _mask = NULL;
    cxdouble* _weights = NULL;

    cpl_matrix* ypos = NULL;
    cpl_matrix* bkg_base = NULL;
    cpl_matrix* profiles = NULL;
    cpl_matrix* weights = NULL;
    cpl_matrix* signal = NULL;
    cpl_matrix* variance = NULL;
    cpl_matrix* mask = NULL;

    GiModel* psfmodel = NULL;

    GiExtractionPsfLimits* limits = NULL;

    GiExtractionSlice* slice = NULL;

    GiExtractionWorkspace* workspace;


    cx_assert(mz != NULL);
    cx_assert(mzvar != NULL);

    cx_assert(fibers != NULL);

    cx_assert(my != NULL);
    cx_assert(mw != NULL);

    cx_assert(psfdata != NULL);

    cx_assert(ms != NULL);
    cx_assert(mse != NULL);
    cx_assert(msm != NULL);
    cx_assert(msy != NULL);

    ny = cpl_image_get_size_x(mz);
    nx = cpl_image_get_size_y(mz);

    nfibers = cpl_table_get_nrow(fibers);
    nbins = CX_MIN(nx, cpl_image_get_size_y(my));

    cx_assert((ny == cpl_image_get_size_x(mzvar)) &&
              (nx == cpl_image_get_size_y(mzvar)));

    cx_assert(cpl_image_get_size_x(my) == cpl_image_get_size_x(mw));
    cx_assert(cpl_image_get_size_y(my) == cpl_image_get_size_y(mw));

    cx_assert(giraffe_psfdata_fibers(psfdata) ==
              (cxsize)cpl_image_get_size_x(my));
    cx_assert(giraffe_psfdata_bins(psfdata) ==
              (cxsize)cpl_image_get_size_y(my));

    cx_assert((nfibers == cpl_image_get_size_x(ms)) &&
              (nx == cpl_image_get_size_y(ms)));
    cx_assert((nfibers == cpl_image_get_size_x(mse)) &&
              (nx == cpl_image_get_size_y(mse)));
    cx_assert((nfibers == cpl_image_get_size_x(msy)) &&
              (nx == cpl_image_get_size_y(msy)));
    cx_assert((ny == cpl_image_get_size_x(msm)) &&
              (nx == cpl_image_get_size_y(msm)));

    cx_assert((mbpx == NULL) || ((ny == cpl_image_get_size_x(mbpx)) &&
                                 (nx == cpl_image_get_size_y(mbpx))));


    /*
     * Get the PSF profile data arrays for efficiency reasons in the
     * following loops.
     */

    if (giraffe_psfdata_contains(psfdata, "Center") == FALSE) {
        return -1;
    }

    if (giraffe_psfdata_contains(psfdata, "Width2") == TRUE) {
        exponent = cpl_image_get_data_const(giraffe_psfdata_get_data(psfdata,
            "Width2"));
    }

    width = cpl_image_get_data_const(giraffe_psfdata_get_data(psfdata,
        "Width1"));


    /*
     * Create the PSF profile model from the PSF data object.
     */

    psfmodel = giraffe_model_new(giraffe_psfdata_get_model(psfdata));

    if (psfmodel == NULL) {
        return -2;
    }

    giraffe_model_set_parameter(psfmodel, "Amplitude", 1.);
    giraffe_model_set_parameter(psfmodel, "Background", 0.);
    giraffe_model_set_parameter(psfmodel, "Center", 0.);


    /*
     * Set up the vector of pixel positions
     */

    ypos = cpl_matrix_new(ny, 1);

    if (ypos == NULL) {
        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _ypos = cpl_matrix_get_data(ypos);

    for (i = 0; i < ny; ++i) {
        _ypos[i] = i;
    }


    /*
     * Create profile matrix and the matrices for the signal, bad
     * pixel mask, variance and the weights.
     */

    profiles = cpl_matrix_new(nfibers + bkg_nc, ny);

    if (profiles == NULL) {
        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _profiles = cpl_matrix_get_data(profiles);


    signal = cpl_matrix_new(ny, 1);

    if (signal == NULL) {
        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _signal = cpl_matrix_get_data(signal);


    variance = cpl_matrix_new(ny, 1);

    if (variance == NULL) {
        cpl_matrix_delete(signal);
        signal = NULL;

        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _variance = cpl_matrix_get_data(variance);


    mask = cpl_matrix_new(ny, 1);

    if (mask == NULL) {
        cpl_matrix_delete(variance);
        variance = NULL;

        cpl_matrix_delete(signal);
        signal = NULL;

        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _mask = cpl_matrix_get_data(mask);


    weights  = cpl_matrix_new(ny, 1);

    if (weights == NULL) {
        cpl_matrix_delete(mask);
        mask = NULL;

        cpl_matrix_delete(variance);
        variance = NULL;

        cpl_matrix_delete(signal);
        signal = NULL;

        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _weights = cpl_matrix_get_data(weights);


    /*
     * Fill design matrix with the basis functions of the
     * background polynomial model.
     */

    bkg_base = giraffe_chebyshev_base1d(0., ny, bkg_nc, ypos);

    cpl_matrix_delete(ypos);
    ypos = NULL;

    if (bkg_base == NULL) {
        cpl_matrix_delete(weights);
        weights = NULL;

        cpl_matrix_delete(mask);
        mask = NULL;

        cpl_matrix_delete(variance);
        variance = NULL;

        cpl_matrix_delete(signal);
        signal = NULL;

        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }

    _bkg_base = cpl_matrix_get_data(bkg_base);

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

        register cxint j = 0;
        register cxint offset = nfibers * ny;

        for (j = 0; j < ny; ++j) {
            _profiles[i * ny + j + offset] = _bkg_base[i * ny + j];
        }

    }

    _bkg_base = NULL;

    cpl_matrix_delete(bkg_base);
    bkg_base = NULL;


    /*
     * Extract all fiber spectra simultaneously for each wavelength bin
     */

    slice = _giraffe_extractionslice_new(nfibers, ny, bkg_nc);

    if (slice == NULL) {
        cpl_matrix_delete(weights);
        weights = NULL;

        cpl_matrix_delete(mask);
        mask = NULL;

        cpl_matrix_delete(variance);
        variance = NULL;

        cpl_matrix_delete(signal);
        signal = NULL;

        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;
    }


    limits = _giraffe_extraction_psflimits_new(nfibers + bkg_nc);

    if (limits == NULL) {

        _giraffe_extractionslice_delete(slice);
        slice = NULL;

        cpl_matrix_delete(weights);
        weights = NULL;

        cpl_matrix_delete(mask);
        mask = NULL;

        cpl_matrix_delete(variance);
        variance = NULL;

        cpl_matrix_delete(signal);
        signal = NULL;

        cpl_matrix_delete(profiles);
        profiles = NULL;

        cpl_matrix_delete(ypos);
        ypos = NULL;

        giraffe_model_delete(psfmodel);
        psfmodel = NULL;

        return -3;

    }

    for (i = 0; i < limits->size; ++i) {
        limits->ymin[i] = 0;
        limits->ymax[i] = ny;
    }


    /*
     * Allocate workspace for matrix multiplications
     */

    workspace = _giraffe_optimal_workspace_new(nfibers + bkg_nc, ny);

    for (bin = 0; bin < nbins; ++bin) {

        cxbool stop = FALSE;

        cxint iter = 0;
        cxint nmin = 0;
        cxint ngood = ny;

        const cxdouble* _my = cpl_image_get_data_double_const(my);
        const cxdouble* _mz = cpl_image_get_data_double_const(mz);
        const cxdouble* _mzvar = cpl_image_get_data_double_const(mzvar);

        cxdouble* _ms = cpl_image_get_data_double(ms);
        cxdouble* _mse = cpl_image_get_data_double(mse);
        cxdouble* _msy = cpl_image_get_data_double(msy);
        cxdouble* _msm = cpl_image_get_data_double(msm);

        cxint status = 0;

        GiExtractionPsfLimits* _limits = (nolimits == FALSE) ? limits : NULL;

        cx_assert(_mz != NULL);
        cx_assert(_mzvar != NULL);


        /*
         * Fill the design matrix with the fiber profiles for the
         * current wavelength bin
         */

        status = _giraffe_optimal_build_profiles(profiles, _limits, my, mw,
                                                 fibers, bin, psfmodel, width,
                                                 exponent, wfactor);

        if (status != 0) {
            _giraffe_optimal_workspace_delete(workspace);
            workspace = NULL;

            _giraffe_extraction_psflimits_delete(limits);
            limits = NULL;

            _giraffe_extractionslice_delete(slice);
            slice = NULL;

            cpl_matrix_delete(weights);
            weights = NULL;

            cpl_matrix_delete(mask);
            mask = NULL;

            cpl_matrix_delete(variance);
            variance = NULL;

            cpl_matrix_delete(signal);
            signal = NULL;

            cpl_matrix_delete(profiles);
            profiles = NULL;

            cpl_matrix_delete(ypos);
            ypos = NULL;

            giraffe_model_delete(psfmodel);
            psfmodel = NULL;

            return -4;
        }


        /*
         * Fill the signal, variance, mask and weight matrices
         */


        if (mbpx != NULL) {

            const cxint* _mbpx = cpl_image_get_data_int_const(mbpx);


            cx_assert(_mbpx != NULL);

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

                cxbool bad = (_mbpx[bin * ny + i] & GIR_M_PIX_SET) ||
                    (_mz[bin * ny + i] < 0.);

                _signal[i] = _mz[bin * ny + i];
                _variance[i] = _signal[i] + _mzvar[bin * ny + i];
                _mask[i] = 1.;

                if (bad == TRUE) {
                    _mask[i] = 0.;
                    --ngood;
                }

                _weights[i] = _mask[i] / _variance[i];

            }

        }
        else {

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

                cxbool bad = (_mz[bin * ny + i] < 0.);

                _signal[i] = _mz[bin * ny + i];
                _variance[i] = _signal[i] + _mzvar[bin * ny + i];
                _mask[i] = 1.;

                if (bad == TRUE) {
                    _mask[i] = 0.;
                    --ngood;
                }

                _weights[i] = _mask[i] / _variance[i];

            }

        }


        /*
         * Extract simultaneously the fluxes of all fibers for the current
         * wavelength bin
         */

        nmin = (cxint)(fraction * ngood);

        while ((iter < niter) && (stop == FALSE)) {

            cxint nreject = 0;

            const cxdouble* _model = NULL;


            status = _giraffe_optimal_extract_slice(slice, profiles,
                signal, weights, limits, workspace);

            if (status != 0) {
                _giraffe_optimal_workspace_delete(workspace);
                workspace = NULL;

                _giraffe_extraction_psflimits_delete(limits);
                limits = NULL;

                _giraffe_extractionslice_delete(slice);
                slice = NULL;

                cpl_matrix_delete(weights);
                weights = NULL;

                cpl_matrix_delete(mask);
                mask = NULL;

                cpl_matrix_delete(variance);
                variance = NULL;

                cpl_matrix_delete(signal);
                signal = NULL;

                cpl_matrix_delete(profiles);
                profiles = NULL;

                cpl_matrix_delete(ypos);
                ypos = NULL;

                giraffe_model_delete(psfmodel);
                psfmodel = NULL;

                return -5;
            }


            /*
             * Update weighting factors
             */

            _model = cpl_matrix_get_data(slice->model);

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

                if (_mask[i] > 0.) {

                    cxbool bad = FALSE;
                    cxdouble residual = _signal[i] - _model[i];


                    _variance[i] = _model[i] + _mzvar[bin * ny + i];

                    bad = (residual * residual) > (sigma * _variance[i]) ?
                        TRUE : FALSE;

                    if (bad == TRUE) {
                        _mask[i] = 0.;
                        ++nreject;
                        --ngood;
                    }

                    _weights[i] = _mask[i] / _variance[i];

                }

            }

            if ((nreject == 0) || (ngood <= nmin)) {
                stop = TRUE;
            }

            ++iter;

        }


        /*
         * Copy the extracted fluxes, their variance and the modeled signal
         * to the result images.
         */

        memcpy(&_ms[bin * nfibers], cpl_matrix_get_data(slice->flux),
               slice->nflx * sizeof(cxdouble));
        memcpy(&_mse[bin * nfibers], cpl_matrix_get_data(slice->variance),
               slice->nflx * sizeof(cxdouble));
        memcpy(&_msm[bin * ny], cpl_matrix_get_data(slice->model),
               slice->msize * sizeof(cxdouble));

        memcpy(&_msy[bin * nfibers], &_my[bin * nfibers],
               nfibers * sizeof(cxdouble));


        /*
         * Reset the profile part of the design matrix
         */

        cpl_matrix_fill_window(profiles, 0., 0, 0, nfibers, ny);

    }


    /*
     * Compute errors of the extracted spectra from the variance
     */

    cpl_image_power(mse, 0.5);

    _giraffe_optimal_workspace_delete(workspace);
    workspace = NULL;

    _giraffe_extraction_psflimits_delete(limits);
    limits = NULL;

    _giraffe_extractionslice_delete(slice);
    slice = NULL;

    cpl_matrix_delete(weights);
    weights = NULL;

    cpl_matrix_delete(mask);
    mask = NULL;

    cpl_matrix_delete(variance);
    variance = NULL;

    cpl_matrix_delete(signal);
    signal = NULL;

    cpl_matrix_delete(profiles);
    profiles = NULL;

    giraffe_model_delete(psfmodel);
    psfmodel = NULL;

    return 0;

}


/**
 * @brief
 *   Extracts the spectra from a preprocessed frame.
 *
 * @param result  The result of the spectrum extraction task.
 * @param image   The image from which the spectra are extracted.
 * @param fibers  The fibers/spectra to be extracted.
 * @param sloc    Spectrum localization data for the spectra to extract.
 * @param bpixel  Bad pixel map to use.
 * @param slight  Scattered light model to use.
 * @param config  Setup parameters for the spectrum extraction task.
 *
 * @return The fuction returns 0 on success and 1 in case of errors.
 *
 * The function expects a preprocessed, i.e. bias corrected and optionally
 * dark subtracted, as input @em image. The list of fibers to extract from
 * @em image is passed by the table @em fibers. The localization mask
 * position and half-width frames are passed as components of the
 * localization @em sloc. Optionally a bad pixel map and the fitted
 * scattered light may be provided by @em bpixel and @em slight respectively.
 * The setup parameters for the spectrum extraction task have to be provided
 * by the structure @em config.
 */

cxint
giraffe_extract_spectra(GiExtraction* result, GiImage* image,
                        GiTable* fibers, GiLocalization* sloc,
                        GiImage* bpixel, GiImage* slight,
                        GiExtractConfig* config)
{

    const cxchar *fctid = "giraffe_extract_spectra";


    cxint ns = 0;
    cxint nx = 0;
    cxint ny = 0;
    cxint status  = 0;
    cxint nframes = 1;

    cxdouble bias_ron   = 0.;
    cxdouble bias_sigma = 0.;
    cxdouble dark_value = 0.;
    cxdouble exptime    = 0.;
    cxdouble conad      = 1.;

    cpl_propertylist *properties;

    cpl_image* _image = NULL;
    cpl_image* _locy = NULL;
    cpl_image* _locw = NULL;
    cpl_image* _spectra = NULL;
    cpl_image* _error = NULL;
    cpl_image* _npixels = NULL;
    cpl_image* _centroid = NULL;
    cpl_image* _model = NULL;

    cpl_table* _fibers = NULL;


    /*
     * Preprocessing
     */

    if (!result || !image || !fibers || !sloc || !config) {
        cpl_error_set(fctid, CPL_ERROR_NULL_INPUT);
        return 1;
    }


    if ((sloc->locy == NULL) || (sloc->locw == NULL)) {
        cpl_error_set(fctid, CPL_ERROR_NULL_INPUT);
        return 1;
    }


    if (result->spectra != NULL || result->error != NULL ||
        result->npixels != NULL || result->centroid != NULL ||
        result->model != NULL) {
        gi_warning("%s: Results structure at %p is not empty! Contents "
                   "might be lost.", fctid, result);
    }


    _fibers = giraffe_table_get(fibers);

    if (_fibers == NULL) {
        cpl_error_set(fctid, CPL_ERROR_DATA_NOT_FOUND);
        return 1;
    }


    if ((config->emethod == GIEXTRACT_OPTIMAL) && (sloc->psf == NULL)) {
        cpl_msg_error(fctid, "Missing data: PSF profile data is required "
                      "for optimal spectrum extraction!");
        cpl_error_set(fctid, CPL_ERROR_NULL_INPUT);

        return 1;
    }


    properties = giraffe_image_get_properties(image);

    if (properties == NULL) {
        cpl_error_set(fctid, CPL_ERROR_DATA_NOT_FOUND);
        return 1;
    }


    giraffe_error_push();

    conad = giraffe_propertylist_get_conad(properties);

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

    giraffe_error_pop();


    if (!cpl_propertylist_has(properties, GIALIAS_BIASERROR)) {
        cpl_msg_warning(fctid, "Missing bias error property (%s)! Setting "
                        "bias error to 0.", GIALIAS_BIASERROR);
        bias_sigma = 0.;
    }
    else {
        bias_sigma = cpl_propertylist_get_double(properties, GIALIAS_BIASERROR);
    }


    if (config->ron > 0.) {

        cpl_msg_info(fctid, "Setting bias RMS property (%s) to %.4g ADU",
                     GIALIAS_BIASSIGMA, config->ron);

        cpl_propertylist_update_double(properties, GIALIAS_BIASSIGMA,
                                       config->ron);
    }

    bias_ron = giraffe_propertylist_get_ron(properties);


    if (!cpl_propertylist_has(properties, GIALIAS_DARKVALUE)) {

        dark_value = 0.;

        cpl_msg_warning(fctid, "Missing dark value property (%s), will be "
                        "set to 0.!", GIALIAS_DARKVALUE);
        cpl_propertylist_append_double(properties, GIALIAS_DARKVALUE,
                                       dark_value);

    }
    else {
        dark_value = cpl_propertylist_get_double(properties,
                                                 GIALIAS_DARKVALUE);
    }


    if (!cpl_propertylist_has(properties, GIALIAS_EXPTIME)) {
        cpl_msg_error(fctid, "Missing exposure time property (%s)!",
                      GIALIAS_EXPTIME);
        return 1;
    }
    else {
        exptime = cpl_propertylist_get_double(properties, GIALIAS_EXPTIME);
    }


    if (cpl_propertylist_has(properties, GIALIAS_DATANCOM)) {
        nframes = cpl_propertylist_get_int(properties, GIALIAS_DATANCOM);
    }


    /*
     * Processing
     */

    /*
     * Convert the bias and dark errors from ADU to electrons.
     */

    bias_sigma *= conad;
    dark_value *= conad;

    /*
     * For extracting the spectra, the bias and dark corrected raw image is
     * converted from ADU to electrons, and, in case it is an averaged frame,
     * it is scaled by the number of frames which were used. This turns the
     * raw frame into an image of the total number of the recorded
     * photoelectrons.
     *
     * To compensate for that, the extracted spectra, their errors, and,
     * possibly the spectrum model are rescaled after the extraction step
     * is completed.
     */

    _image = cpl_image_multiply_scalar_create(giraffe_image_get(image),
                                              nframes * conad);

    _locy = giraffe_image_get(sloc->locy);
    _locw = giraffe_image_get(sloc->locw);

    ny = cpl_image_get_size_x(_image);
    nx = cpl_image_get_size_y(_locw);
    ns = cpl_table_get_nrow(_fibers);


    switch (config->emethod) {
        case GIEXTRACT_SUM:
        {

            cxint xsize = cpl_image_get_size_x(_image);
            cxint ysize = cpl_image_get_size_y(_image);

            cxdouble ron_variance  = bias_ron * bias_ron;
            cxdouble bias_variance = bias_sigma * bias_sigma;
            cxdouble dark_variance = dark_value * exptime;

            cpl_image* bpixmap = NULL;
            cpl_image* variance = NULL;


            result->spectra = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->error = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->npixels = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->centroid = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->model = NULL;

            _spectra = giraffe_image_get(result->spectra);
            _error = giraffe_image_get(result->error);
            _npixels = giraffe_image_get(result->npixels);
            _centroid = giraffe_image_get(result->centroid);

            if (bpixel != NULL) {

                bpixmap = giraffe_image_get(bpixel);

                if (cpl_image_get_size_x(bpixmap) != xsize ||
                    cpl_image_get_size_y(bpixmap) != ysize) {

                    cxbool crop = FALSE;

                    cpl_propertylist *p =
                            giraffe_image_get_properties(bpixel);

                    GiWindow w = {1, 1, 0, 0};


                    w.x1 = cpl_image_get_size_x(bpixmap);
                    w.y1 = cpl_image_get_size_y(bpixmap);

                    if (cpl_propertylist_has(p, GIALIAS_PRSCX)) {
                        w.x0 += cpl_propertylist_get_int(p, GIALIAS_PRSCX);
                        crop = TRUE;
                    }

                    if (cpl_propertylist_has(p, GIALIAS_OVSCX)) {
                        w.x1 -= cpl_propertylist_get_int(p, GIALIAS_OVSCX);
                        crop = TRUE;
                    }

                    if (cpl_propertylist_has(p, GIALIAS_PRSCY)) {
                        w.y0 += cpl_propertylist_get_int(p, GIALIAS_PRSCY);
                        crop = TRUE;
                    }

                    if (cpl_propertylist_has(p, GIALIAS_OVSCY)) {
                        w.y1 -= cpl_propertylist_get_int(p, GIALIAS_OVSCY);
                        crop = TRUE;
                    }

                    if ((w.x1 - w.x0 + 1) != xsize ||
                        (w.y1 - w.y0 + 1) != ysize) {
                        cpl_msg_error(fctid, "Invalid bad pixel map! Image "
                                      "sizes do not match!");

                        giraffe_image_delete(result->spectra);
                        result->spectra = NULL;

                        giraffe_image_delete(result->error);
                        result->error = NULL;

                        giraffe_image_delete(result->npixels);
                        result->npixels = NULL;

                        giraffe_image_delete(result->centroid);
                        result->centroid = NULL;

                        giraffe_image_delete(result->model);
                        result->model = NULL;

                        cpl_image_delete(_image);
                        _image = NULL;

                        return 1;
                    }

                    if (crop == TRUE) {
                        bpixmap = cpl_image_extract(bpixmap, w.x0, w.y0,
                                                    w.x1, w.y1);
                    }

                }

            }

            if (slight != NULL) {
                cpl_msg_warning(fctid, "Scattered light model will be "
                                "ignored for extraction method `SUM'");
            }

            variance = cpl_image_abs_create(_image);

            /*
             * Add readout noise for the raw frame, and the errors due
             * to bias and dark subtraction, rescaled to the number of
             * frames used to create the input frame.
             */

            cpl_image_add_scalar(variance, nframes * (ron_variance + nframes *
                                 (bias_variance + dark_variance)));

            status = _giraffe_extract_summation(_image, variance, _fibers,
                                                _locy, _locw, bpixmap,
                                                _spectra, _error, _npixels,
                                                _centroid);

            cpl_image_delete(variance);
            if (bpixmap != giraffe_image_get(bpixel)) {
                cpl_image_delete(bpixmap);
            }
            bpixmap = NULL;

            break;

        }

        case GIEXTRACT_OPTIMAL:
        {

            cxint xsize = cpl_image_get_size_x(_image);
            cxint ysize = cpl_image_get_size_y(_image);

            cxdouble v0 = 0.;
            cxdouble ron_variance  = bias_ron * bias_ron;
            cxdouble bias_variance = bias_sigma * bias_sigma;
            cxdouble dark_variance = dark_value * exptime;

            cpl_image* variance = NULL;
            cpl_image* bpixmap = NULL;

            GiExtractOptimalConfig setup;


            result->spectra = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->error = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->npixels = NULL;
            result->model = giraffe_image_create(CPL_TYPE_DOUBLE, ny, nx);
            result->centroid = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);

            _spectra = giraffe_image_get(result->spectra);
            _error = giraffe_image_get(result->error);
            _model = giraffe_image_get(result->model);
            _centroid = giraffe_image_get(result->centroid);

            setup.clip.iterations = config->psf.iterations;
            setup.clip.level = config->psf.sigma;
            setup.clip.fraction = config->optimal.fraction;
            setup.limits = config->optimal.wfactor < 0. ? FALSE : TRUE;
            setup.ewidth = CX_MAX(1., fabs(config->optimal.wfactor));
            setup.bkgorder = config->optimal.bkgorder;
            setup.exptime = exptime;
            setup.ron = bias_sigma;
            setup.dark = dark_value;


            if (bpixel != NULL) {

                bpixmap = giraffe_image_get(bpixel);

                if (cpl_image_get_size_x(bpixmap) != xsize ||
                    cpl_image_get_size_y(bpixmap) != ysize) {

                        cxbool crop = FALSE;

                        cpl_propertylist *p =
                            giraffe_image_get_properties(bpixel);

                        GiWindow w = {1, 1, 0, 0};


                        w.x1 = cpl_image_get_size_x(bpixmap);
                        w.y1 = cpl_image_get_size_y(bpixmap);

                        if (cpl_propertylist_has(p, GIALIAS_PRSCX)) {
                            w.x0 += cpl_propertylist_get_int(p, GIALIAS_PRSCX);
                            crop = TRUE;
                        }

                        if (cpl_propertylist_has(p, GIALIAS_OVSCX)) {
                            w.x1 -= cpl_propertylist_get_int(p, GIALIAS_OVSCX);
                            crop = TRUE;
                        }

                        if (cpl_propertylist_has(p, GIALIAS_PRSCY)) {
                            w.y0 += cpl_propertylist_get_int(p, GIALIAS_PRSCY);
                            crop = TRUE;
                        }

                        if (cpl_propertylist_has(p, GIALIAS_OVSCY)) {
                            w.y1 -= cpl_propertylist_get_int(p, GIALIAS_OVSCY);
                            crop = TRUE;
                        }

                        if ((w.x1 - w.x0 + 1) != xsize ||
                            (w.y1 - w.y0 + 1) != ysize) {

                                cpl_msg_error(fctid, "Invalid bad pixel map! "
                                    "Image sizes do not match!");

                                giraffe_image_delete(result->spectra);
                                result->spectra = NULL;

                                giraffe_image_delete(result->error);
                                result->error = NULL;

                                giraffe_image_delete(result->npixels);
                                result->npixels = NULL;

                                giraffe_image_delete(result->centroid);
                                result->centroid = NULL;

                                giraffe_image_delete(result->model);
                                result->model = NULL;

                                cpl_image_delete(_image);
                                _image = NULL;

                                return 1;

                            }

                        if (crop == TRUE) {
                            bpixmap = cpl_image_extract(bpixmap, w.x0, w.y0,
                                w.x1, w.y1);
                        }

                    }

            }

            variance = cpl_image_new(xsize, ysize, CPL_TYPE_DOUBLE);

            /*
             * Add readout noise for the raw frame, and the errors due
             * to bias and dark subtraction, rescaled to the number of
             * frames used to create the input frame.
             */

            v0 = nframes * (ron_variance + nframes *
                    (bias_variance + dark_variance));


            /*
             * If a scattered light map has been used, add its contribution
             * to the variance, rescaled to the number of raw frames used, and
             * converted to photoelectrons.
             */

            if (slight != NULL) {

                register cxsize i = 0;
                register cxsize npixels = xsize * ysize;

                const cxdouble* _slight =
                    cpl_image_get_data_double(giraffe_image_get(slight));

                cxdouble* _variance = cpl_image_get_data_double(variance);

                for (i = 0; i < npixels; i++) {
                    _variance[i] = v0 + fabs(_slight[i]) * conad * nframes;
                }

            }
            else {

                register cxsize i = 0;
                register cxsize npixels = xsize * ysize;

                cxdouble* _variance = cpl_image_get_data_double(variance);

                for (i = 0; i < npixels; i++) {
                    _variance[i] = v0;
                }

            }


            status = _giraffe_extract_optimal(_image, variance, _fibers,
                                              _locy, _locw, sloc->psf,
                                              bpixmap, _spectra, _error,
                                              _model, _centroid, &setup);

            cpl_image_delete(variance);
            variance = NULL;

            if (bpixmap != giraffe_image_get(bpixel)) {
                cpl_image_delete(bpixmap);
            }
            bpixmap = NULL;

            break;

        }

        case GIEXTRACT_HORNE:
        {

            cxint xsize = cpl_image_get_size_x(_image);
            cxint ysize = cpl_image_get_size_y(_image);

            cxdouble v0 = 0.;
            cxdouble ron_variance  = bias_ron * bias_ron;
            cxdouble bias_variance = bias_sigma * bias_sigma;
            cxdouble dark_variance = dark_value * exptime;

            cpl_image* variance = NULL;
            cpl_image* bpixmap = NULL;

            GiExtractHorneConfig setup;


            result->spectra = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->error = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->npixels = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->centroid = giraffe_image_create(CPL_TYPE_DOUBLE, ns, nx);
            result->model = NULL;

            _spectra = giraffe_image_get(result->spectra);
            _error = giraffe_image_get(result->error);
            _npixels = giraffe_image_get(result->npixels);
            _centroid = giraffe_image_get(result->centroid);

            setup.clip.iterations = config->psf.iterations;
            setup.clip.level = config->psf.sigma;
            setup.clip.fraction = config->horne.mingood;
            setup.ewidth = config->horne.ewidth;
            setup.exptime = exptime;
            setup.ron = bias_sigma;
            setup.dark = dark_value;

            if (bpixel != NULL) {

                bpixmap = giraffe_image_get(bpixel);

                if (cpl_image_get_size_x(bpixmap) != xsize ||
                    cpl_image_get_size_y(bpixmap) != ysize) {

                    cxbool crop = FALSE;

                    cpl_propertylist *p =
                        giraffe_image_get_properties(bpixel);

                    GiWindow w = {1, 1, 0, 0};


                    w.x1 = cpl_image_get_size_x(bpixmap);
                    w.y1 = cpl_image_get_size_y(bpixmap);

                    if (cpl_propertylist_has(p, GIALIAS_PRSCX)) {
                        w.x0 += cpl_propertylist_get_int(p, GIALIAS_PRSCX);
                        crop = TRUE;
                    }

                    if (cpl_propertylist_has(p, GIALIAS_OVSCX)) {
                        w.x1 -= cpl_propertylist_get_int(p, GIALIAS_OVSCX);
                        crop = TRUE;
                    }

                    if (cpl_propertylist_has(p, GIALIAS_PRSCY)) {
                        w.y0 += cpl_propertylist_get_int(p, GIALIAS_PRSCY);
                        crop = TRUE;
                    }

                    if (cpl_propertylist_has(p, GIALIAS_OVSCY)) {
                        w.y1 -= cpl_propertylist_get_int(p, GIALIAS_OVSCY);
                        crop = TRUE;
                    }

                    if ((w.x1 - w.x0 + 1) != xsize ||
                        (w.y1 - w.y0 + 1) != ysize) {

                        cpl_msg_error(fctid, "Invalid bad pixel map! "
                                        "Image sizes do not match!");

                        giraffe_image_delete(result->spectra);
                        result->spectra = NULL;

                        giraffe_image_delete(result->error);
                        result->error = NULL;

                        giraffe_image_delete(result->npixels);
                        result->npixels = NULL;

                        giraffe_image_delete(result->centroid);
                        result->centroid = NULL;

                        giraffe_image_delete(result->model);
                        result->model = NULL;

                        cpl_image_delete(_image);
                        _image = NULL;

                        return 1;

                    }

                    if (crop == TRUE) {
                        bpixmap = cpl_image_extract(bpixmap, w.x0, w.y0,
                            w.x1, w.y1);
                    }

                }

            }

            variance = cpl_image_new(xsize, ysize, CPL_TYPE_DOUBLE);

            /*
             * Add readout noise for the raw frame, and the errors due
             * to bias and dark subtraction, rescaled to the number of
             * frames used to create the input frame.
             */

            v0 = nframes * (ron_variance + nframes *
                    (bias_variance + dark_variance));


            /*
             * If a scattered light map has been used, add its contribution
             * to the variance, rescaled to the number of raw frames used, and
             * converted to photoelectrons.
             */


            if (slight != NULL) {

                register cxsize i = 0;
                register cxsize npixels = xsize * ysize;

                const cxdouble* _slight =
                    cpl_image_get_data_double(giraffe_image_get(slight));

                cxdouble* _variance = cpl_image_get_data_double(variance);

                for (i = 0; i < npixels; i++) {
                    _variance[i] = v0 + fabs(_slight[i]) * nframes * conad;
                }

            }
            else {

                register cxsize i = 0;
                register cxsize npixels = xsize * ysize;

                cxdouble* _variance = cpl_image_get_data_double(variance);

                for (i = 0; i < npixels; i++) {
                    _variance[i] = v0;
                }

            }


            status = _giraffe_extract_horne(_image, variance, _fibers,
                                            _locy, _locw, sloc->psf,
                                            bpixmap, _spectra, _error,
                                            _npixels, _centroid, &setup);

            cpl_image_delete(variance);
            variance = NULL;

            if (bpixmap != giraffe_image_get(bpixel)) {
                cpl_image_delete(bpixmap);
            }
            bpixmap = NULL;

            break;

        }

        default:
            gi_message("%s: Method %d selected for spectrum extraction.",
                       fctid, config->emethod);
            cpl_msg_error(fctid, "Invalid extraction method!");

            status = 1;
            break;
    }

    cpl_image_delete(_image);
    _image = NULL;

    if (status) {

        giraffe_image_delete(result->spectra);
        result->spectra = NULL;

        giraffe_image_delete(result->error);
        result->error = NULL;

        giraffe_image_delete(result->npixels);
        result->npixels = NULL;

        giraffe_image_delete(result->centroid);
        result->centroid = NULL;

        giraffe_image_delete(result->model);
        result->model = NULL;

        cpl_msg_error(fctid, "Spectrum extraction (method %d) failed!",
                      config->emethod);

        cpl_image_delete(_image);
        _image = NULL;

        return 1;

    }


    /*
     * Postprocessing
     */


    /*
     * Rescale the spectrum extraction products to the original, averaged
     * input raw frame.
     */

    if (result->spectra) {
        cpl_image_divide_scalar(giraffe_image_get(result->spectra),
                                nframes * conad);
    }

    if (result->model) {
        cpl_image_divide_scalar(giraffe_image_get(result->model),
                                nframes * conad);
    }

    if (result->error) {
        cpl_image_divide_scalar(giraffe_image_get(result->error),
                                nframes * conad);
    }


    /*
     * Extracted spectra frame
     */

    properties = giraffe_image_get_properties(image);
    giraffe_image_set_properties(result->spectra, properties);

    properties = giraffe_image_get_properties(result->spectra);

    /*
     * Copy some properties from the localization frame.
     */

    // FIXME: Is this really needed? (RP)

    giraffe_propertylist_update(properties,
                                giraffe_image_get_properties(sloc->locy),
                                "^ESO PRO LOC.*");

    cpl_propertylist_set_int(properties, GIALIAS_NAXIS1,
                             cpl_image_get_size_x(_spectra));
    cpl_propertylist_set_int(properties, GIALIAS_NAXIS2,
                             cpl_image_get_size_y(_spectra));

    cpl_propertylist_set_int(properties, GIALIAS_BITPIX, -32);
    cpl_propertylist_set_double(properties, GIALIAS_BZERO, 0.);
    cpl_propertylist_set_double(properties, GIALIAS_BSCALE, 1.);

    cpl_propertylist_update_int(properties, GIALIAS_NFIBERS,
                                cpl_image_get_size_x(_spectra));

    cpl_propertylist_append_int(properties, GIALIAS_EXT_NX,
                                cpl_image_get_size_y(_spectra));
    cpl_propertylist_append_int(properties, GIALIAS_EXT_NS,
                                cpl_image_get_size_x(_spectra));

    switch (config->emethod) {
        case GIEXTRACT_SUM:
            cpl_propertylist_append_string(properties, GIALIAS_EXT_METHOD,
                                           "SUM");
            cpl_propertylist_set_comment(properties, GIALIAS_EXT_METHOD,
                                         "Spectrum extraction method");
        break;

        case GIEXTRACT_HORNE:
        {

            cpl_propertylist_append_string(properties, GIALIAS_EXT_METHOD,
                                           "HORNE");
            cpl_propertylist_set_comment(properties, GIALIAS_EXT_METHOD,
                                         "Spectrum extraction method");

            cpl_propertylist_append_string(properties, GIALIAS_EXTPSF_MODEL,
                                           config->psf.model);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTPSF_MODEL,
                                         "PSF model used");
            cpl_propertylist_append_double(properties, GIALIAS_EXTPSF_SIGMA,
                                           config->psf.sigma);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTPSF_SIGMA,
                                         "PSF fit sigma clipping threshold");
            cpl_propertylist_append_int(properties, GIALIAS_EXTPSF_NITER,
                                        config->psf.iterations);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTPSF_NITER,
                                         "PSF fit maximum number of "
                                         "iterations");

            cpl_propertylist_append_int(properties, GIALIAS_EXTHRN_EWIDTH,
                                        config->horne.ewidth);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTHRN_EWIDTH,
                                         "Number of extra pixels used");
            cpl_propertylist_append_int(properties, GIALIAS_EXTHRN_MINGOOD,
                                           config->horne.mingood);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTHRN_MINGOOD,
                                         "Minimum number of pixels to keep");


            break;
        }

        case GIEXTRACT_OPTIMAL:
            cpl_propertylist_append_string(properties, GIALIAS_EXT_METHOD,
                                           "OPTIMAL");
            cpl_propertylist_set_comment(properties, GIALIAS_EXT_METHOD,
                                         "Spectrum extraction method");

            cpl_propertylist_append_string(properties, GIALIAS_EXTPSF_MODEL,
                                           config->psf.model);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTPSF_MODEL,
                                         "PSF model used");
            cpl_propertylist_append_double(properties, GIALIAS_EXTPSF_SIGMA,
                                           config->psf.sigma);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTPSF_SIGMA,
                                         "PSF fit sigma clipping threshold");
            cpl_propertylist_append_int(properties, GIALIAS_EXTPSF_NITER,
                                        config->psf.iterations);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTPSF_NITER,
                                         "PSF fit maximum number of "
                                         "iterations");

            cpl_propertylist_append_double(properties, GIALIAS_EXTOPT_FRACTION,
                                        config->optimal.fraction);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTOPT_FRACTION,
                                         "Minimum fraction of pixels used.");
            cpl_propertylist_append_double(properties, GIALIAS_EXTOPT_WFACTOR,
                                           config->optimal.wfactor);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTOPT_WFACTOR,
                                         "Multiple of the fiber PSF half "
                                         "width used for spectrum "
                                         "extraction.");
            cpl_propertylist_append_int(properties, GIALIAS_EXTOPT_BGORDER,
                                        config->optimal.bkgorder);
            cpl_propertylist_set_comment(properties, GIALIAS_EXTOPT_BGORDER,
                                         "Order of the background polynomial "
                                         "model along the spatial direction.");

            break;

        default:
            break;
    }

    cpl_propertylist_update_string(properties, GIALIAS_GIRFTYPE, "EXTSP");
    cpl_propertylist_set_comment(properties, GIALIAS_GIRFTYPE,
                                 "Extracted spectra");


    /*
     * Extracted spectra errors frame
     */

    giraffe_image_set_properties(result->error, properties);
    properties = giraffe_image_get_properties(result->error);

    cpl_propertylist_set_string(properties, GIALIAS_GIRFTYPE, "EXTERRS");
    cpl_propertylist_set_comment(properties, GIALIAS_GIRFTYPE,
                                 "Extracted spectra errors");


    /*
     * Extracted spectra centroids frame
     */

    giraffe_image_set_properties(result->centroid, properties);
    properties = giraffe_image_get_properties(result->centroid);

    cpl_propertylist_set_string(properties, GIALIAS_GIRFTYPE, "EXTYCEN");
    cpl_propertylist_set_comment(properties, GIALIAS_GIRFTYPE,
                                 "Extracted spectra centroids");


    /*
     * Extracted spectra npixels frame
     */

    if (result->npixels != NULL) {
        giraffe_image_set_properties(result->npixels, properties);
        properties = giraffe_image_get_properties(result->npixels);

        cpl_propertylist_set_string(properties, GIALIAS_GIRFTYPE, "EXTNPIX");
        cpl_propertylist_set_comment(properties, GIALIAS_GIRFTYPE,
                                    "Extracted spectra npixels");
    }


    /*
     * Model spectra frame
     */

    if (result->model != NULL) {
        giraffe_image_set_properties(result->model, properties);
        properties = giraffe_image_get_properties(result->model);

        cpl_propertylist_set_string(properties, GIALIAS_GIRFTYPE, "EXTMODEL");
        cpl_propertylist_set_comment(properties, GIALIAS_GIRFTYPE,
                                     "Model spectra used for extraction");
    }

    return 0;

}


/**
 * @brief
 *   Creates a setup structure for the spectrum extraction.
 *
 * @param list  Parameter list from which the setup informations is read.
 *
 * @return A newly allocated and initialized setup structure if no errors
 *   occurred, or @c NULL otherwise.
 */

GiExtractConfig*
giraffe_extract_config_create(cpl_parameterlist* list)
{

    const cxchar* s;
    cpl_parameter* p;

    GiExtractConfig* config = NULL;


    if (!list) {
        return NULL;
    }

    config = cx_calloc(1, sizeof *config);

    p = cpl_parameterlist_find(list, "giraffe.extraction.method");
    s = cpl_parameter_get_string(p);
    if (!strcmp(s, "OPTIMAL")) {
        config->emethod = GIEXTRACT_OPTIMAL;
    }
    else if (!strcmp(s, "HORNE")) {
        config->emethod = GIEXTRACT_HORNE;
    }
    else {
        config->emethod = GIEXTRACT_SUM;
    }

    p = cpl_parameterlist_find(list, "giraffe.extraction.ron");
    config->ron = cpl_parameter_get_double(p);

    p = cpl_parameterlist_find(list, "giraffe.extraction.psf.model");
    config->psf.model = cx_strdup(cpl_parameter_get_string(p));

    p = cpl_parameterlist_find(list, "giraffe.extraction.psf.sigma");
    config->psf.sigma = cpl_parameter_get_double(p);

    p = cpl_parameterlist_find(list, "giraffe.extraction.psf.iterations");
    config->psf.iterations = cpl_parameter_get_int(p);


    p = cpl_parameterlist_find(list, "giraffe.extraction.horne.extrawidth");
    config->horne.ewidth = cpl_parameter_get_int(p);

    p = cpl_parameterlist_find(list, "giraffe.extraction.horne.mingood");
    config->horne.mingood = cpl_parameter_get_double(p);


    p = cpl_parameterlist_find(list, "giraffe.extraction.optimal.fraction");
    config->optimal.fraction = cpl_parameter_get_double(p);

    p = cpl_parameterlist_find(list, "giraffe.extraction.optimal.wfactor");
    config->optimal.wfactor = cpl_parameter_get_double(p);

    p = cpl_parameterlist_find(list, "giraffe.extraction.optimal.bkgorder");
    config->optimal.bkgorder = cpl_parameter_get_int(p);

    return config;

}


/**
 * @brief
 *   Destroys a spectrum extraction setup structure.
 *
 * @param config  The setup structure to destroy.
 *
 * @return Nothing.
 *
 * The function deallocates the memory used by the setup structure
 * @em config.
 */

void
giraffe_extract_config_destroy(GiExtractConfig* config)
{

    if (config) {

        if (config->psf.model) {
            cx_free(config->psf.model);
        }

        cx_free(config);

    }

    return;

}


/**
 * @brief
 *   Adds parameters for the spectrum extraction.
 *
 * @param list  Parameter list to which parameters are added.
 *
 * @return Nothing.
 *
 * TBD
 */

void
giraffe_extract_config_add(cpl_parameterlist* list)
{

    cpl_parameter* p = NULL;


    if (list == NULL) {
        return;
    }

    p = cpl_parameter_new_enum("giraffe.extraction.method",
                               CPL_TYPE_STRING,
                               "Extraction method: 'SUM', 'HORNE' or "
                               "'OPTIMAL'",
                               "giraffe.extraction",
                               "SUM", 3, "SUM", "OPTIMAL", "HORNE");
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-method");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.ron",
                                CPL_TYPE_DOUBLE,
                                "New bias sigma (RON) value for "
                                "bias and dark "
                                "corrected image",
                                "giraffe.extraction",
                                -1.);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-ron");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_enum("giraffe.extraction.psf.model",
                               CPL_TYPE_STRING,
                               "PSF profile model: `psfexp', `psfexp2'",
                               "giraffe.extraction.psf",
                               "psfexp2", 2, "psfexp", "psfexp2");
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-psfmodel");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.psf.sigma",
                                CPL_TYPE_DOUBLE,
                                "Sigma clippging threshold used for "
                                "rejecting data points during PSF fitting "
                                "(Horne's sigma). It is used to reject bad "
                                "pixels and cosmics.",
                                "giraffe.extraction.psf",
                                7.);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-psfsigma");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.psf.iterations",
                                CPL_TYPE_INT,
                                "Maximum number of iterations used for "
                                "fitting the PSF profile.",
                                "giraffe.extraction.psf",
                                2);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-psfniter");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.horne.extrawidth",
                                CPL_TYPE_INT,
                                "Horne extraction method: Number of "
                                "extra pixels added to the fiber "
                                "half-width.",
                                "giraffe.extraction.horne",
                                2);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-hewidth");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.horne.mingood",
                                CPL_TYPE_INT,
                                "Horne extraction method: Minimum number of "
                                "points used for the profile fit. It sets "
                                "the lower limit of data points for the "
                                "pixel rejection.",
                                "giraffe.extraction.horne",
                                3);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-hmingood");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_range("giraffe.extraction.optimal.fraction",
                                CPL_TYPE_DOUBLE,
                                "Optimal extraction method: Minimum fraction "
                                "of the data points used for fitting the "
                                "fiber profiles. It sets the lower limit "
                                "for the pixel rejection.",
                                "giraffe.extraction.optimal",
                                0.9, 0.0, 1.0);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-omfrac");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.optimal.wfactor",
                                CPL_TYPE_DOUBLE,
                                "Optimal extraction method: Factor by which "
                                "the fiber PSF half width is multiplied. "
                                "Adjacent spectra within this area are "
                                "assumed to affect the spectrum being "
                                "extracted.",
                                "giraffe.extraction.optimal",
                                3.);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-owfactor");
    cpl_parameterlist_append(list, p);


    p = cpl_parameter_new_value("giraffe.extraction.optimal.bkgorder",
                                CPL_TYPE_INT,
                                "Optimal extraction method: Order of the "
                                "polynomial background model, which is "
                                "fitted for each wavelength bin along the "
                                "spatial direction.",
                                "giraffe.extraction.optimal",
                                2);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "extr-obkgorder");
    cpl_parameterlist_append(list, p);


    return;

}
/**@}*/
