gisgcalibration.c

/*
 * This file is part of the GIRAFFE Pipeline
 * Copyright (C) 2002-2019 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
 */
 
#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif
 
#include <math.h>
 
#include <cxmemory.h>
#include <cxmessages.h>
#include <cxstrutils.h>
 
#include <cpl_error.h>
#include <cpl_parameterlist.h>
#include <cpl_propertylist.h>
#include <cpl_matrix.h>
#include <cpl_image.h>
#include <cpl_table.h>
 
#include "gialias.h"
#include "gierror.h"
#include "gimatrix.h"
#include "gifiberutils.h"
#include "gigrating.h"
#include "gimodel.h"
#include "gilocalization.h"
#include "giextraction.h"
#include "girebinning.h"
#include "gisgcalibration.h"
 
 
struct GiMeasurement {
    cxdouble value;
    cxdouble sigma;
};
 
typedef struct GiMeasurement GiMeasurement;
 
 
struct GiSGSetup {
 
    cxint nx;
    cxint nex;
 
    GiRebinScale scale;
 
    cxdouble wlmin;
    cxdouble wlmax;
    cxdouble wlstep;
 
    cxdouble pixelsize;
 
};
 
typedef struct GiSGSetup GiSGSetup;
 
 
struct GiCPFitParams {
 
    cxint dnmin;
    cxint iterations;
 
    cxdouble step;
    cxdouble wfactor;
    cxdouble sigma;
 
    GiRebinScale scale;
 
    GiFitSetup fit;
 
};
 
typedef struct GiCPFitParams GiCPFitParams;
 
 
struct GiCPeakFit {
    GiMeasurement amplitude;
    GiMeasurement background;
    GiMeasurement center;
    GiMeasurement width;
 
    cxint status;
};
 
typedef struct GiCPeakFit GiCPeakFit;
 
 
struct GiSGMask {
 
    cxsize size;
    cxsize nholes;
 
    GiRebinScale scale;
 
    cxdouble start;
    cxdouble step;
 
    cpl_matrix* wavelength;
    cpl_matrix* flux;
 
};
 
typedef struct GiSGMask GiSGMask;
 
 
inline static GiSGMask*
_giraffe_sgmask_new(cxsize size)
{
 
    GiSGMask* self = cx_calloc(1, sizeof *self);
 
    self->wavelength = cpl_matrix_new(1, size);
    self->flux = cpl_matrix_new(1, size);
 
    self->size = size;
    self->nholes = 0;
 
    self->scale = GIREBIN_SCALE_LINEAR;
 
    self->start = 0.;
    self->step = 1.;
 
    return self;
 
}
 
 
inline static void
_giraffe_sgmask_delete(GiSGMask* self)
{
 
    if (self) {
 
        if (self->wavelength != NULL) {
            cpl_matrix_delete(self->wavelength);
            self->wavelength = NULL;
        }
 
        if (self->flux != NULL) {
            cpl_matrix_delete(self->flux);
            self->flux = NULL;
        }
 
        cx_free(self);
 
    }
 
    return;
 
}
 
 
inline static GiSGMask*
_giraffe_sgmask_create(cxsize size, cxdouble start, cxdouble step,
                       GiRebinScale scale, const GiTable* mask)
{
 
    register cxsize i;
 
    cxdouble wlmin = 0.;
    cxdouble wlmax = 0.;
    cxdouble wlstep = 0.;
 
    cpl_table* _mask = NULL;
 
    GiSGMask* self = NULL;
 
 
    cx_assert(mask != NULL);
 
    _mask = giraffe_table_get(mask);
    cx_assert(_mask != NULL);
 
    self = _giraffe_sgmask_new(size);
 
    self->start = start;
    self->step = step;
    self->scale = scale;
 
 
    /*
     * Fill wavelength array
     */
 
    for (i = 0; i < self->size; i++) {
        cpl_matrix_set(self->wavelength, 0, i, self->start + i * self->step);
    }
 
 
    wlmin = cpl_matrix_get(self->wavelength, 0, 0);
    wlmax = cpl_matrix_get(self->wavelength, 0, self->size - 1);
    wlstep = self->step;
 
    if (self->scale == GIREBIN_SCALE_LOG) {
 
        wlmin = exp(wlmin);
        wlmax = exp(wlmax);
        wlstep = exp(wlstep);
 
    }
 
 
    /*
     * Create the mask's flux array from the mask template `mask', i.e.
     * the flux values are set to 1. within the holes and 0. otherwise.
     */
 
    cpl_table_select_all(_mask);
 
    cpl_table_and_selected_double(_mask, "WLEN1", CPL_GREATER_THAN, wlmin);
    cpl_table_and_selected_double(_mask, "WLEN2", CPL_LESS_THAN, wlmax);
 
    _mask = cpl_table_extract_selected(_mask);
 
    if (_mask == NULL || cpl_table_get_nrow(_mask) <= 0) {
        _giraffe_sgmask_delete(self);
        self = NULL;
 
        return NULL;
    }
 
 
    self->nholes = cpl_table_get_nrow(_mask);
 
    for (i = 0; i < self->nholes; i++) {
 
        register cxsize j;
 
        cxdouble hstart = cpl_table_get(_mask, "WLEN1", i, NULL) - wlmin;
        cxdouble hend = cpl_table_get(_mask, "WLEN2", i, NULL) - wlmin;
 
 
        hstart /= wlstep;
        hend /= wlstep;
 
        for (j = (cxsize)(hstart + 0.5); j <= (cxsize)(hend + 0.5); j++) {
 
            cpl_matrix_set(self->flux, 0, j, 1.);
 
        }
 
    }
 
    cpl_table_delete(_mask);
 
    return self;
 
}
 
 
inline static cxsize
_giraffe_sgmask_size(const GiSGMask* self)
{
 
    cx_assert(self != NULL);
 
    return self->size;
 
}
 
 
inline static cxsize
_giraffe_sgmask_holes(const GiSGMask* self)
{
 
    cx_assert(self != NULL);
 
    return self->nholes;
 
}
 
 
inline static cxint
_giraffe_sgmask_set_flux(GiSGMask* self, cxsize position, cxdouble value)
{
 
    cx_assert(self != NULL);
 
    if (position >= (cxsize)cpl_matrix_get_ncol(self->flux)) {
        return 1;
    }
 
    cpl_matrix_set(self->flux, 0, position, value);
 
    return 0;
 
}
 
 
inline static cxdouble
_giraffe_sgmask_get_flux(GiSGMask* self, cxsize position)
{
 
    const cxchar* const fctid = "_giraffe_sgmask_get_flux";
 
 
    cx_assert(self != NULL);
 
    if (position >= (cxsize)cpl_matrix_get_ncol(self->flux)) {
        cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
        return 0.;
    }
 
    return cpl_matrix_get(self->flux, 0, position);
 
}
 
 
inline static const cpl_matrix*
_giraffe_sgmask_get(GiSGMask* self)
{
 
    cx_assert(self != NULL);
 
    return self->flux;
 
}
 
 
inline static cxint
_giraffe_sgmask_crop(GiSGMask* self, cxsize begin, cxsize end)
{
 
    cxsize size = 0;
 
    cpl_matrix* buffer = NULL;
 
 
    cx_assert(self != NULL);
    cx_assert(end > begin);
    cx_assert(cpl_matrix_get_nrow(self->wavelength) == 1);
    cx_assert(cpl_matrix_get_nrow(self->flux) == 1);
 
    if (begin >= (cxsize)cpl_matrix_get_ncol(self->flux)) {
        return 1;
    }
 
    if (end > (cxsize)cpl_matrix_get_ncol(self->flux)) {
        end = cpl_matrix_get_ncol(self->flux);
    }
 
    if (begin == 0 && end == (cxsize)cpl_matrix_get_ncol(self->flux)) {
        return 0;
    }
 
    size = end - begin;
 
    buffer = cpl_matrix_extract(self->wavelength, 0, begin, 1, 1, 1, size);
    cpl_matrix_delete(self->wavelength);
    self->wavelength = buffer;
 
    buffer = cpl_matrix_extract(self->flux, 0, begin, 1, 1, 1, size);
    cpl_matrix_delete(self->flux);
    self->flux = buffer;
 
    cx_assert(cpl_matrix_get_nrow(self->flux) == 1);
    cx_assert((cxsize)cpl_matrix_get_ncol(self->flux) == size);
 
    self->size = size;
 
    return 0;
 
}
 
 
inline static cxdouble
_giraffe_clip_value(cxdouble value, cxdouble low, cxdouble high,
                    cxbool* flag)
{
 
    cxbool status = FALSE;
 
    if (value < low) {
        value = low;
        status = TRUE;
    }
 
    if (value >= high) {
        value = high;
        status = TRUE;
    }
 
    if (flag != NULL) {
        *flag = status;
    }
 
    return value;
 
}
 
 
/*
 * The function performs a linear interpolation and simultaneous re-sampling
 * of the input image `signal' from the input bin size `step1' to a signal
 * with a sampling of `step2'.
 */
 
inline static cpl_image*
_giraffe_resample_image(cpl_image* signal, cxdouble step1, cxdouble step2)
{
 
    cxint i;
    cxint nx1 = 0;
    cxint ny = 0;
    cxint nx2 = 0;
    cxint step = CX_MAX(1, (cxint)(step1/step2));
 
    cpl_image* _signal = NULL;
 
 
    cx_assert(signal != NULL);
 
    ny = cpl_image_get_size_x(signal);
    nx1 = cpl_image_get_size_y(signal);
 
    nx2 = (nx1 - 1) * step + 1;
 
    _signal = cpl_image_new(ny, nx2, CPL_TYPE_DOUBLE);
 
    for (i = 0; i < ny; i++) {
 
        register cxint j;
 
        register cxdouble* data = cpl_image_get_data(signal);
        register cxdouble* _data = cpl_image_get_data(_signal);
 
 
        for (j = 0; j < nx1 - 1; j++) {
 
            register cxint k;
            register cxint l = j * ny + i;
            register cxint m = j * ny * step + i;
 
            for (k = 0; k < step; k++) {
 
                cxdouble f = (cxdouble)k / (cxdouble)step;
 
                _data[m + k * ny] = (1. - f) * data[l] + f * data[l + ny];
 
            }
 
        }
 
        _data[nx2 - 1] = data[nx1 - 1];
 
    }
 
    return _signal;
 
}
 
 
/*
 * Compute cross-correlation function s * T for the window [start, end]
 */
 
inline static cpl_matrix*
_giraffe_compute_cross_correlation(const cpl_matrix* signal,
                                   const cpl_matrix* template,
                                   cxint start, cxint end)
{
 
    const cxchar* const fctid = "_giraffe_compute_cross_correlation";
 
 
    cxint i;
    cxint n = 0;
    cxint nmax = 0;
    cxint ns = 0;
    cxint nccf = 0;
 
    cxdouble sum = 0.;
 
    cpl_matrix* _signal = (cpl_matrix*)signal;
    cpl_matrix* _template = (cpl_matrix*)template;
    cpl_matrix* ccf = NULL;
    cpl_matrix* _ccf = NULL;
 
 
    cx_assert(_signal != NULL);
    cx_assert(cpl_matrix_get_nrow(_signal) == 1);
 
    cx_assert(_template != NULL);
    cx_assert(cpl_matrix_get_nrow(_template) == 1);
 
    ns = cpl_matrix_get_ncol(_signal);
    cx_assert(ns == cpl_matrix_get_ncol(_template));
 
    cx_assert(start <= end);
 
 
    /*
     * The number of shifts should not exceed the half-window
     */
 
    nmax = cpl_matrix_get_ncol(_signal) / 2;
 
    start = CX_MAX(CX_MIN(start, nmax), -nmax);
    end = CX_MAX(CX_MIN(end, nmax), -nmax);
 
    nccf = end - start;
 
    cpl_msg_debug(fctid, "Cross-correlation function: signal size = %"
                  CPL_SIZE_FORMAT ", template size = %" CPL_SIZE_FORMAT
                  ", window start = %d, window end = %d",
                  cpl_matrix_get_ncol(_signal), cpl_matrix_get_ncol(_template),
                  start, end);
 
 
    ccf = cpl_matrix_new(1, nccf);
 
    for (i = start; i < end; i++) {
 
        if (i < 0) {
 
            cxint j;
 
 
            /*
             * - shift template i < 0
             */
 
            sum = 0.;
 
            for (j = 0; j < ns + i; j++) {
 
                cxdouble s = cpl_matrix_get(_signal, 0, j);
                cxdouble t = cpl_matrix_get(_template, 0, j - i);
 
                sum += t * s;
 
            }
 
            sum /= (cxdouble)(ns + i);
 
            cpl_matrix_set(ccf, 0, i - start, sum);
 
        }
        else if (i > 0) {
 
            cxint j;
 
 
            /*
             * + shift template i > 0
             */
 
            sum = 0.;
 
            for (j = i; j < ns; j++) {
 
                cxdouble s = cpl_matrix_get(_signal, 0, j);
                cxdouble t = cpl_matrix_get(_template, 0, j - i);
 
                sum += t * s;
 
            }
 
            sum /= (cxdouble)(ns - i);
 
            cpl_matrix_set(ccf, 0, i - start, sum);
 
        }
        else {
 
            cxint j;
 
 
            /*
             * The central value
             */
 
            sum = 0.;
 
            for (j = 0; j < ns; j++) {
 
                cxdouble t = cpl_matrix_get(_template, 0, j);
                cxdouble s = cpl_matrix_get(_signal, 0, j);
 
                sum += t * s;
 
            }
 
            sum /= (cxdouble)ns;
 
            cpl_matrix_set(ccf, 0, -start, sum);
 
        }
 
 
    }
 
 
    /*
     * Normalize peak to approximately 1.0. For this purpose the 10% of
     * the cross-correlation function's data points with the highest
     * values are used.
     */
 
    n = CX_MAX(1, nccf / 10);
 
    _ccf = cpl_matrix_duplicate(ccf);
    giraffe_matrix_sort(_ccf);
 
    sum = 0.;
 
    for (i = nccf - n; i < nccf; i++) {
        sum += cpl_matrix_get(_ccf, 0, i);
    }
 
    sum /= (cxdouble)n;
 
    cpl_matrix_delete(_ccf);
    _ccf = NULL;
 
    if (sum != 0.) {
 
        for (i = 0; i < nccf; i++) {
            cpl_matrix_set(ccf, 0, i, cpl_matrix_get(ccf, 0, i) / sum);
        }
 
    }
 
    return ccf;
 
}
 
 
inline static cxint
_giraffe_create_setup(GiSGSetup* setup, const GiImage* spectra)
{
 
    cpl_propertylist* properties = NULL;
 
    cpl_image* _spectra = NULL;
 
 
    cx_assert(setup != NULL);
    cx_assert(spectra != NULL);
 
    properties = giraffe_image_get_properties(spectra);
    cx_assert(properties != NULL);
 
    _spectra = giraffe_image_get(spectra);
    cx_assert(_spectra != NULL);
 
 
    /*
     * Retrieve rebinned spectra information.
     */
 
    setup->nx = cpl_image_get_size_y(_spectra);
 
 
    if (!cpl_propertylist_has(properties, GIALIAS_EXT_NX)) {
        return 1;
    }
    else {
 
        setup->nex = cpl_propertylist_get_int(properties, GIALIAS_EXT_NX);
 
    }
 
    if (!cpl_propertylist_has(properties, GIALIAS_BINSCALE)) {
        return 1;
    }
    else {
 
        const cxchar* s = cpl_propertylist_get_string(properties,
            GIALIAS_BINSCALE);
 
 
        if (cx_strncasecmp(s, "log", 3) == 0) {
            setup->scale = GIREBIN_SCALE_LOG;
        }
        else {
            setup->scale = GIREBIN_SCALE_LINEAR;
        }
 
    }
 
    if (!cpl_propertylist_has(properties, GIALIAS_BINWLMIN)) {
        return 1;
    }
    else {
        setup->wlmin = cpl_propertylist_get_double(properties,
            GIALIAS_BINWLMIN);
    }
 
    if (!cpl_propertylist_has(properties, GIALIAS_BINSTEP)) {
        return 1;
    }
    else {
        setup->wlstep = cpl_propertylist_get_double(properties,
            GIALIAS_BINSTEP);
    }
 
    setup->wlmax = setup->wlmin + (setup->nx - 1) * setup->wlstep;
 
 
    if (!cpl_propertylist_has(properties, GIALIAS_PIXSIZY)) {
        return 1;
    }
    else {
        setup->pixelsize = cpl_propertylist_get_double(properties,
            GIALIAS_PIXSIZY);
    }
 
    return 0;
 
}
 
 
inline static cxint
_giraffe_peak_fit(GiCPeakFit* peak, const cpl_matrix* lambda,
                  const cpl_matrix* ccf, const GiGrating* grating,
                  const GiCPFitParams* setup)
{
 
    const cxchar* const fctid = "_giraffe_peak_fit";
 
 
    cxbool stop = FALSE;
 
    cxint i;
    cxint dn1 = 0;
    cxint dn2 = 0;
 
    cxdouble amplitude = 0.;
    cxdouble background = 0.;
    cxdouble center = 0.;
    cxdouble width = 0.;
    cxdouble lower = 0.;
    cxdouble upper = 0.;
 
    struct {
        cxdouble amplitude;
        cxdouble background;
        cxdouble center;
        cxdouble width;
    } initial = {0., 0., 0., 0.};
 
    cpl_size nr = 0;
    cpl_size nc = 0;
 
    GiModel* model = giraffe_model_new("gaussian");
 
 
 
    cx_assert(model != NULL);
    cx_assert(strcmp(giraffe_model_get_name(model), "gaussian") == 0);
    cx_assert(lambda != NULL);
    cx_assert(ccf != NULL);
    cx_assert(grating != NULL);
    cx_assert(setup != NULL);
 
 
    /*
     * Initial guesses of the peak profile model. For the background
     * 0. can be used in case of ThAr spectra, otherwise the mean of
     * the 2 lowest values of the CCF should be used. The half-width
     * is derived from the nominal resolution of the grating.
     */
 
    background = 0.;
 
    amplitude = cpl_matrix_get_max((cpl_matrix*)ccf) - background;
 
    cpl_matrix_get_maxpos((cpl_matrix*)ccf, &nr, &nc);
    cx_assert(nr == 0);
 
    center = cpl_matrix_get((cpl_matrix*)lambda, 0, nc);
 
 
    if (setup->scale == GIREBIN_SCALE_LOG) {
        width = 0.5 / grating->resol;
    }
    else {
        width = 0.5 / grating->resol * grating->wlen0;
    }
 
    giraffe_model_set_parameter(model, "Background", background);
    giraffe_model_set_parameter(model, "Amplitude", amplitude);
    giraffe_model_set_parameter(model, "Center", center);
    giraffe_model_set_parameter(model, "Width1", width);
 
    giraffe_model_thaw(model);
 
    giraffe_model_set_iterations(model, setup->fit.iterations);
    giraffe_model_set_tests(model, setup->fit.tests);
    giraffe_model_set_delta(model, setup->fit.delta);
 
 
    /*
     * Save the initial parameter values.
     */
 
    initial.amplitude = amplitude;
    initial.background = background;
    initial.center = center;
    initial.width = width;
 
    i = 0;
 
    while (i < setup->iterations && !stop) {
 
        cxint j;
        cxint _dn1 = 0;
        cxint _dn2 = 0;
 
        cxdouble dwc = 0.;
        cxdouble dwd = 0.;
 
        cpl_matrix* tlambda = (cpl_matrix*)lambda;
        cpl_matrix* tccf = (cpl_matrix*)ccf;
 
 
        /*
         * The second iteration uses a weighted mean of the initial guess and
         * the first result. For all further iterations the new parameter
         * values are just taken from the previous iteration.
         */
 
        if (i == 1) {
 
            const cxdouble da = 0.2;
            const cxdouble dc = 1.;
            const cxdouble db = 1.;
            const cxdouble dw = 0.2;
 
            cxdouble value = 0.;
 
            value = giraffe_model_get_parameter(model, "Amplitude") * da;
            value += (1. - da) * initial.amplitude;
 
            giraffe_model_set_parameter(model, "Amplitude", value);
 
 
            value = giraffe_model_get_parameter(model, "Center") * dc;
            value += (1. - dc) * initial.center;
 
            giraffe_model_set_parameter(model, "Center", value);
 
 
            value = giraffe_model_get_parameter(model, "Background") * db;
            value += (1. - db) * initial.background;
 
            giraffe_model_set_parameter(model, "Background", value);
 
 
            value = giraffe_model_get_parameter(model, "Width1") * dw;
            value += (1. - dw) * initial.width;
 
            giraffe_model_set_parameter(model, "Width1", value);
 
        }
 
 
        /*
         * Set the window center and width. For the width a lower limit is
         * established to guarantee a minimum number of point for the fit.
         */
 
        dwd = 2. * giraffe_model_get_parameter(model, "Width1") *
            setup->wfactor;
        dwc = giraffe_model_get_parameter(model, "Center");
 
        dwd = CX_MAX(setup->dnmin, 2. * dwd / setup->step) * setup->step / 2.;
 
        lower = dwc + 0.5 * setup->step - dwd;
        upper = dwc + 0.5 * setup->step + dwd;
 
 
        /*
         * Extract the slices corresponding to the reduced window size
         * from the input data arrays. This is the data set which is
         * actually fitted.
         */
 
        for (j = 0; j < cpl_matrix_get_ncol(tlambda); j++) {
 
            if (cpl_matrix_get(tlambda, 0, j) > lower) {
                _dn1 = j;
                break;
            }
 
        }
 
        for (j = cpl_matrix_get_ncol(tlambda) - 1; j >= 0; j--) {
 
            if (cpl_matrix_get(tlambda, 0, j) < upper) {
                _dn2 = j + 1;
                break;
            }
 
        }
 
 
        if (i > 0 && dn1 == _dn1 && dn2 == _dn2) {
 
            cxdouble _width = giraffe_model_get_parameter(model, "Width1");
 
            /*
             * This is the same set of points. The fitting stops after
             * one last iteration on the further reduced data set.
             */
 
            dwd = CX_MAX(setup->dnmin, 4. * _width * setup->wfactor /
                         setup->step) * setup->step / 2.;
 
            lower = dwc + 0.5 * setup->step - dwd;
            upper = dwc + 0.5 * setup->step + dwd;
 
            for (j = 0; j < cpl_matrix_get_ncol(tlambda); j++) {
 
                if (cpl_matrix_get(tlambda, 0, j) > lower) {
                    _dn1 = j;
                    break;
                }
 
            }
 
            for (j = cpl_matrix_get_ncol(tlambda) - 1; j <= 0; j--) {
 
                if (cpl_matrix_get(tlambda, 0, j) < upper) {
                    _dn2 = j + 1;
                    break;
                }
 
            }
 
            stop = TRUE;
 
        }
 
 
        /* FIXME: The original code uses i == 0 instead of i <= 1. Check
         *        whether there is a reason for that or if this is just
         *        a bug.
         */
 
        if (i <= 1 || dn1 != _dn1 || dn2 != _dn2) {
 
            cxbool flag = FALSE;
 
            const cxint pflag = 1;
            cxint status = 0;
 
            cxdouble damplitude = 0.;
            cxdouble dbackground = 0.;
            cxdouble dcenter = 0.;
            cxdouble dwidth = 0.;
 
            cpl_matrix* x = NULL;
            cpl_matrix* y = NULL;
            cpl_matrix* sigma = NULL;
 
 
            dn1 = _dn1;
            dn2 = _dn2;
 
            x = cpl_matrix_new(dn2 - dn1, 1);
            y = cpl_matrix_new(dn2 - dn1, 1);
            sigma = cpl_matrix_new(dn2 - dn1, 1);
 
            for (j = 0; j < cpl_matrix_get_nrow(y); j++) {
 
                cpl_matrix_set(x, j, 0, cpl_matrix_get(tlambda, 0, dn1 + j));
                cpl_matrix_set(y, j, 0, cpl_matrix_get(tccf, 0, dn1 + j));
                cpl_matrix_set(sigma, j, 0, setup->sigma);
 
            }
 
 
            /*
             * Finally, fit the peak profile.
             */
 
            status = giraffe_model_fit(model, x, y, sigma);
 
            if (status != 0) {
 
                peak->amplitude.value = initial.amplitude;
                peak->background.value = initial.background;
                peak->center.value = initial.center;
                peak->width.value = initial.width;
 
                peak->amplitude.sigma = 1.;
                peak->background.sigma = 1.;
                peak->center.sigma = 1.;
                peak->width.sigma = 1.;
 
                peak->status = -1;
 
                cpl_matrix_delete(x);
                cpl_matrix_delete(y);
                cpl_matrix_delete(sigma);
 
                giraffe_model_delete(model);
 
                return 1;
 
            }
 
 
            /*
             * Check `out of bounds' condition for the fitted parameters.
             * and their uncertainties.
             */
 
            amplitude = giraffe_model_get_parameter(model, "Amplitude");
            damplitude = giraffe_model_get_sigma(model, "Amplitude");
 
            center = giraffe_model_get_parameter(model, "Center");
            dcenter = giraffe_model_get_sigma(model, "Center");
 
            background = giraffe_model_get_parameter(model, "Background");
            dbackground = giraffe_model_get_sigma(model, "Background");
 
            width = giraffe_model_get_parameter(model, "Width1");
            dwidth = giraffe_model_get_sigma(model, "Width1");
 
 
            /* FIXME: Where do these limits come from? (RP)
             */
 
            /* Amplitude */
 
            lower = -9. * (1 - pflag) + 1.e-5 * pflag;
            upper =  9. * pflag - 1.e-5 * (1 - pflag);
 
            peak->amplitude.value = _giraffe_clip_value(amplitude, lower,
                                                        upper, &flag);
            peak->amplitude.sigma = _giraffe_clip_value(damplitude, 0.,
                                                        1., NULL);
 
            stop = stop == FALSE ? flag == TRUE ? TRUE : FALSE : stop;
 
            /* Center */
 
            lower = cpl_matrix_get(x, 1, 0);
            upper = cpl_matrix_get(x, cpl_matrix_get_nrow(x) - 2, 0);
 
            peak->center.value = _giraffe_clip_value(center, lower,
                                                     upper, &flag);
            peak->center.sigma = _giraffe_clip_value(dcenter, 0.,
                                                     initial.width, NULL);
 
            stop = stop == FALSE ? flag == TRUE ? TRUE : FALSE : stop;
 
            /* Background */
 
            lower = -2;
            upper =  2.;
 
            peak->background.value = _giraffe_clip_value(background, lower,
                                                         upper, &flag);
            peak->background.sigma = _giraffe_clip_value(dbackground, 0.,
                                                         1., NULL);
 
            stop = stop == FALSE ? flag == TRUE ? TRUE : FALSE : stop;
 
            /* Width */
 
            lower = 0.5 * initial.width;
            upper = 2. * (cpl_matrix_get(x, cpl_matrix_get_nrow(x) - 2, 0) -
                          cpl_matrix_get(x, 0, 0));
 
            peak->width.value = _giraffe_clip_value(width, lower,
                                                    upper, &flag);
            peak->width.sigma = _giraffe_clip_value(dwidth, 0.,
                                                    9., NULL);
 
            stop = stop == FALSE ? flag == TRUE ? TRUE : FALSE : stop;
 
            cpl_matrix_delete(x);
            cpl_matrix_delete(y);
            cpl_matrix_delete(sigma);
 
            if (stop == TRUE) {
                cpl_msg_debug(fctid, "Cross-correlation peak fit "
                              "parameter out of bounds!");
 
                peak->status = 1;
            }
            else {
                peak->status = 0;
            }
 
            ++i;
 
        }
        else {
 
            stop = TRUE;
 
        }
 
    }
 
    giraffe_model_delete(model);
 
    return 0;
 
}
 
 
inline static cxint
_giraffe_compute_fiber_offsets(cpl_table* offsets,
                               const GiGrating* grating,
                               const GiSGSetup* setup)
{
 
    cxint i;
 
    const cxdouble ccdfactor = 1.1;
 
    cxdouble gcamera = 1.;
    cxdouble cfactor = 1.;
    cxdouble lincorr = 1.;
    cxdouble wlen0 = 0.;
 
 
    cx_assert(offsets != NULL);
 
    if (!cpl_table_has_column(offsets, "WAVELENGTH")) {
        return 1;
    }
 
    if (!cpl_table_has_column(offsets, "DWF")) {
        cpl_table_new_column(offsets, "DWF", CPL_TYPE_DOUBLE);
    }
 
    if (!cpl_table_has_column(offsets, "DXF")) {
        cpl_table_new_column(offsets, "DXF", CPL_TYPE_DOUBLE);
    }
 
 
    /*
     * Compute the central wavelength of the spectral band, taking into
     * account the scaling used to rebin the spectra.
     */
 
    if (setup->scale == GIREBIN_SCALE_LOG) {
        wlen0 = 0.5 * (exp(setup->wlmin) + exp(setup->wlmax));
    }
    else {
        wlen0 = 0.5 * (setup->wlmin + setup->wlmax);
    }
 
 
    /*
     * Approximate magnification of the camera.
     */
 
    /*
     * FIXME: Any hint on these numbers? (RP)
     */
 
    gcamera = 0.3894 - 5. * (1. / wlen0 - 1. / 550.) -
        0.00025 * pow(1. / wlen0 - 1. / 550., 2.);
 
    /*
     * Conversion factor from CCD displacement to slit geometry.
     */
 
    /* FIXME: This will be used until there is a better formula
     *        (OGL comment).
     */
 
    cfactor = (setup->nex * setup->pixelsize / 1000. * ccdfactor) /
        ((grating->wlenmax - grating->wlenmin) * gcamera);
 
 
    /*
     * Correction factor for linear scale on the correlation
     */
 
    if (setup->scale == GIREBIN_SCALE_LOG) {
        lincorr = 1.0;
    }
    else {
        lincorr = 0.5 * (setup->wlmin + setup->wlmax) /
            exp(0.5 * (log(setup->wlmin) + log(setup->wlmax)));
    }
 
 
    /*
     * Compute slit offsets
     */
 
    for (i = 0; i < cpl_table_get_nrow(offsets); i++) {
 
 
        cxdouble dwf = cpl_table_get_double(offsets, "WAVELENGTH", i, NULL);
        cxdouble dxf = 0.;
 
 
        dwf *= -lincorr;
        dxf = dwf * cfactor;
 
        cpl_table_set_double(offsets, "DWF", i, dwf);
        cpl_table_set_double(offsets, "DXF", i, dxf);
 
    }
 
    return 0;
 
}
 
 
inline static cpl_table*
_giraffe_compute_offsets(const GiImage* spectra, const GiTable* mask,
                         const cpl_table* fibers, const GiGrating* grating,
                         const GiSGSetup* setup, const GiSGCalConfig* config)
{
 
    const cxchar* const fctid = "_giraffe_compute_offsets";
 
    const cxint dnmin = 7;  /* Minimum number of points */
 
    cxint i;
    cxint k;
    cxint status = 0;
    cxint sampling = 0;
    cxint pixel0 = 0;
    cxint dn1 = 0;
    cxint dn2 = 0;
    cxint dnc = 0;
    cxint dnd = 0;
    cxint xc1 = 0;
    cxint xc2 = 0;
 
    const cxdouble clight = 299702.547;   /* light speed in air [km/s] */
 
    cxdouble cstep = 0.;
    cxdouble wlen0 = 0.;
    cxdouble nm2km = clight;
    cxdouble hpixels = 0.;
    cxdouble dv1 = 0.;
    cxdouble dv2 = 0.;
    cxdouble dw1 = 0.;
    cxdouble dw2 = 0.;
    cxdouble dwc = 0.;
    cxdouble dwd = 0.;
 
    cpl_matrix* spectrum = NULL;
 
    cpl_image* _spectra = NULL;
    cpl_image* tspectra = NULL;
 
    cpl_table* peakdata = NULL;
 
    GiSGMask* _mask = NULL;
 
 
    cx_assert(spectra != NULL);
    cx_assert(mask != NULL);
    cx_assert(fibers != NULL);
    cx_assert(grating != NULL);
    cx_assert(setup != NULL);
    cx_assert(config != NULL);
 
 
    /*
     * Compute the sampling step size
     */
 
    if (config->cc_step <= 0.) {
        sampling = 1;
    }
    else {
 
        if (setup->scale == GIREBIN_SCALE_LOG) {
 
            cxdouble wlstep = (exp(setup->wlmax) - exp(setup->wlmin)) /
                setup->nx;
 
            sampling = (cxint)(0.5 + wlstep / config->cc_step);
 
        }
        else {
 
            sampling = (cxint)(0.5 + setup->wlstep / config->cc_step);
 
        }
 
    }
 
    cstep = setup->wlstep / sampling;
 
 
    /*
     * Create and initialize the final mask
     */
 
    _mask = _giraffe_sgmask_create((setup->nx - 1) * sampling + 1,
                                   setup->wlmin, cstep, setup->scale,
                                   mask);
 
    if (_mask == NULL) {
        return NULL;
    }
 
 
    /*
     * Prepare the initial window
     */
 
    pixel0 = setup->nx / 2;
 
    if (setup->scale == GIREBIN_SCALE_LOG) {
 
        /*
         * Logarithmic scale: dv / clight = d(log(lambda))
         */
 
        wlen0 = 0.5 * (exp(setup->wlmin) + exp(setup->wlmax));
        nm2km = clight;
 
    }
    else {
 
        /*
         * Linear scale: dv / clight = d(log(lambda)) / lambda
         */
 
        wlen0 = 0.5 * (setup->wlmin + setup->wlmax);
        nm2km = clight / wlen0;
 
    }
 
 
    /*
     * Window limits in km/s, nm and pxl and window center and
     * half-width in nm and pxl.
     */
 
    dv1 = giraffe_range_get_min(config->rv_limits);
    dv2 = giraffe_range_get_max(config->rv_limits);
 
    dw1 = dv1 / nm2km;
    dw2 = dv2 / nm2km;
 
    cpl_msg_debug(fctid, "Cross-correlation limits: RVlow = %.4f km/s "
                  "(%.4f nm), RVhigh = %.4f km/s (%.4f nm)", dv1, dw1,
                  dv2, dw2);
 
    dwd = (dw2 - dw1) / 2.;
    dwc = (dw2 + dw1) / 2.;
 
    dnd = CX_MIN(pixel0, CX_MAX(dnmin, (cxint)(dwd / cstep + 0.5)));
    dnc = CX_MIN(pixel0, CX_MAX(-pixel0, (cxint)(dwc / cstep + 0.5)));
 
    dn1 = CX_MIN(pixel0 + 1, CX_MAX(-pixel0, dnc - dnd));
    dn2 = CX_MIN(pixel0 + 1, CX_MAX(-pixel0, dnc + dnd + 1));
 
    cpl_msg_debug(fctid, "Cross-correlation window: center = %.4f nm "
                  "(%d pxl) half-width = %.4f nm (%d pxl)", dwc, dnc,
                  dwd, dnd);
 
 
    /*
     * Select spectral range of the spectra and the template which should
     * be used for the cross-correlation.
     */
 
    xc1 = (cxint)(giraffe_range_get_min(config->cc_domain) * sampling);
    xc2 = (cxint)(giraffe_range_get_max(config->cc_domain) * sampling);
 
    if (xc1 > 0 || xc2 > 0) {
        _giraffe_sgmask_crop(_mask, xc1, xc2);
    }
 
    for (i = 0; (cxsize)i < _giraffe_sgmask_size(_mask); i++) {
 
        cxdouble value = _giraffe_sgmask_get_flux(_mask, i);
 
        if (value > 0.) {
            hpixels += value;
        }
 
    }
 
    hpixels /= _giraffe_sgmask_holes(_mask);
 
 
    /*
     * The left- and rightmost dn1 points of the mask are set to 0. In
     * addition partial holes at the beginning and the end of the mask
     * removed, i.e. set to 0 flux.
     */
 
    i = 0;
    k = CX_MAX(0, -dn1);
 
    while (i < k || _giraffe_sgmask_get_flux(_mask, i) > 0.) {
 
        _giraffe_sgmask_set_flux(_mask, i, 0.);
        ++i;
 
    }
 
    cpl_msg_debug(fctid, "Mask cleared from 0 to %d", i - 1);
 
    i = _giraffe_sgmask_size(_mask);
    k = _giraffe_sgmask_size(_mask) - CX_MAX(0, dn2);
 
    while (i > k || _giraffe_sgmask_get_flux(_mask, i) > 0.) {
 
        _giraffe_sgmask_set_flux(_mask, i, 0.);
        --i;
 
    }
 
    cpl_msg_debug(fctid, "Mask cleared from %d to %ld", k,
                  (long)(_giraffe_sgmask_size(_mask) - 1));
 
 
    /*
     * Resample the input image to the mask's sampling step and crop its
     * spectral range so that it matches the template.
     */
 
    _spectra = cpl_image_duplicate(giraffe_image_get(spectra));
 
    if (_spectra == NULL) {
 
        _giraffe_sgmask_delete(_mask);
 
        return NULL;
 
    }
 
 
    if (config->zmax > 0.) {
 
        cpl_image_threshold(_spectra, CX_MINDOUBLE, config->zmax,
                            0., config->zmax);
 
    }
 
 
    tspectra = _giraffe_resample_image(_spectra, setup->wlstep, cstep);
 
    if (tspectra == NULL) {
 
        cpl_image_delete(_spectra);
 
        _giraffe_sgmask_delete(_mask);
 
        return NULL;
 
    }
 
    cpl_image_delete(_spectra);
    _spectra = NULL;
 
    if (xc1 > 0 || xc2 > 0) {
 
        _spectra = cpl_image_extract(tspectra, 1, xc1 + 1,
                                     cpl_image_get_size_x(tspectra), xc2 + 1);
 
        if (_spectra == NULL) {
 
            cpl_image_delete(tspectra);
 
            _giraffe_sgmask_delete(_mask);
 
            return NULL;
 
        }
 
        cpl_image_delete(tspectra);
        tspectra = NULL;
 
    }
    else {
 
        _spectra = tspectra;
        tspectra = NULL;
 
    }
 
 
    /*
     * Create the table to record the results from the cross-correlation
     * peak fitting for each fiber.
     */
 
    peakdata = cpl_table_new(cpl_table_get_nrow(fibers));
 
    cpl_table_duplicate_column(peakdata, "INDEX", (cpl_table*)fibers,
                               "INDEX");
    cpl_table_duplicate_column(peakdata, "FPS", (cpl_table*)fibers,
                               "FPS");
 
    cpl_table_new_column(peakdata, "WAVELENGTH", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "FWHM", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "AMPLITUDE", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "BACKGROUND", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "RV", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "RVERR", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "RESOLUTION", CPL_TYPE_DOUBLE);
    cpl_table_new_column(peakdata, "STATUS", CPL_TYPE_INT);
 
 
    /*
     * Compute the cross-correlation with the mask for each spectrum in
     * the input image.
     */
 
    cpl_msg_debug(fctid, "Computing cross-correlation: central wavelength = "
                  "%.4f, window = [%.4f, %.4f] [km/s]", wlen0, dv1, dv2);
 
    spectrum = cpl_matrix_new(1, cpl_image_get_size_y(_spectra));
 
    for (i = 0; i < cpl_table_get_nrow(fibers); i++) {
 
        cxint j;
        cxint ns = cpl_image_get_size_x(_spectra);
        cxint fiber = cpl_table_get_int(fibers, "FPS", i, NULL);
        cxint idx = cpl_table_get_int(fibers, "INDEX", i, NULL) - 1;
 
        const cxdouble fwhm_ratio = 2. * sqrt(2. * log(2.));
 
        cxdouble avsigma = 0.;
        cxdouble fx = 0.;
        cxdouble sum = 0.;
        cxdouble position = 0.;
        cxdouble fwhm = 0.;
        cxdouble width = 0.;
        cxdouble resolution = 0.;
        cxdouble rv = 0.;
        cxdouble rverr = 0.;
        cxdouble* data = cpl_image_get_data(_spectra);
 
        const cpl_matrix* template = NULL;
        cpl_matrix* ccf = NULL;
        cpl_matrix* lambda = NULL;
 
        GiCPFitParams peak_setup;
        GiCPeakFit peak;
 
 
 
        /*
         * Copy the current spectrum to the working matrix and
         * compute the total flux of the masked spectrum.
         */
 
        for (j = 0; j < cpl_matrix_get_ncol(spectrum); j++) {
 
            cxdouble flux = data[j * ns + idx];
 
 
            cpl_matrix_set(spectrum, 0, j, flux);
\
            fx += flux * _giraffe_sgmask_get_flux(_mask, j);
 
        }
 
        fx /= sampling;
 
        if (fx > 0.) {
            avsigma = 1. / sqrt(fx);
        }
 
        cpl_msg_debug(fctid, "Cross-correlation of spectrum %d in window "
                      "from %d pxl to %d pxl (%.4f nm to %.4f nm)", fiber,
                      dn1, dn2, dw1, dw2);
 
 
        /*
         * Wavelength within the cross-correlation window
         */
 
        lambda = cpl_matrix_new(1, dn2 - dn1);
 
        for (j = dn1; j < dn2; j++) {
            cpl_matrix_set(lambda, 0, j - dn1, j * cstep);
        }
 
 
        /*
         * Cross-correlation
         */
 
        template = _giraffe_sgmask_get(_mask);
 
        ccf = _giraffe_compute_cross_correlation(spectrum, template, dn1, dn2);
 
        if (ccf == NULL) {
 
            cpl_matrix_delete(lambda);
            cpl_matrix_delete(spectrum);
 
            cpl_image_delete(_spectra);
 
            cpl_table_delete(peakdata);
 
            _giraffe_sgmask_delete(_mask);
 
            return NULL;
 
        }
 
        sum = 0.;
 
        for (j = 0; j < cpl_matrix_get_ncol(ccf); j++) {
            sum += cpl_matrix_get(ccf, 0, j);
        }
 
        if (sum <= 0.) {
            cpl_msg_debug(fctid, "Cross-correlation failed: Skipping "
                          "spectrum %d.", fiber);
 
            cpl_matrix_delete(lambda);
            lambda = NULL;
 
            continue;
        }
 
 
        /*
         * Fit the cross-correlation peak
         */
 
        peak_setup.dnmin = dnmin;
        peak_setup.iterations = config->rv_niter;
        peak_setup.step = cstep;
        peak_setup.wfactor = config->rv_wfactor;
        peak_setup.sigma = avsigma;
        peak_setup.scale = setup->scale;
 
        peak_setup.fit.iterations = config->pf_niter;
        peak_setup.fit.tests = config->pf_ntest;
        peak_setup.fit.delta = config->pf_dchisq;
 
        status = _giraffe_peak_fit(&peak, lambda, ccf, grating, &peak_setup);
 
        if (status < 0) {
 
            cpl_matrix_delete(ccf);
            cpl_matrix_delete(lambda);
 
            cpl_matrix_delete(spectrum);
            cpl_image_delete(_spectra);
 
            cpl_table_delete(peakdata);
 
            _giraffe_sgmask_delete(_mask);
 
            return NULL;
 
        }
 
 
        /*
         * Save the results to the output table.
         */
 
        if (setup->scale == GIREBIN_SCALE_LOG) {
            position = peak.center.value * wlen0;
            fwhm = (exp(peak.width.value) - 1.) * wlen0;
        }
        else {
            position = peak.center.value;
            fwhm = peak.width.value;
        }
 
        width = pow(fwhm_ratio * fwhm, 2.) - pow(0.6 * hpixels * cstep, 2.);
        resolution = width > 0. ? wlen0 / sqrt(width) : 0.;
 
        fwhm *= 2.;
 
        rv = CX_MAX(dv1, CX_MIN(dv2, peak.center.value * nm2km));
        rverr = CX_MIN(dv2 - dv1, peak.center.sigma * nm2km);
 
        cpl_table_set_double(peakdata, "WAVELENGTH", i, position);
        cpl_table_set_double(peakdata, "FWHM", i, fwhm);
        cpl_table_set_double(peakdata, "AMPLITUDE", i, peak.amplitude.value);
        cpl_table_set_double(peakdata, "BACKGROUND", i,
                             peak.background.value);
        cpl_table_set_double(peakdata, "RESOLUTION", i, resolution);
        cpl_table_set_double(peakdata, "RV", i, rv);
        cpl_table_set_double(peakdata, "RVERR", i, rverr);
        cpl_table_set_int(peakdata, "STATUS", i, peak.status);
 
        cpl_matrix_delete(lambda);
        cpl_matrix_delete(ccf);
 
    }
 
    cpl_matrix_delete(spectrum);
    cpl_image_delete(_spectra);
 
    _giraffe_sgmask_delete(_mask);
 
    return peakdata;
 
}
 
 
inline static cpl_table*
_giraffe_compute_slitgeometry(const GiImage* spectra, const GiTable* mask,
                              const GiTable* slitgeometry,
                              const GiGrating* grating,
                              const GiSGCalConfig* config)
{
 
    cxint status = 0;
 
    cpl_table* _slitgeometry = giraffe_table_get(slitgeometry);
    cpl_table* peakdata = NULL;
 
    GiSGSetup setup;
 
 
    /*
     * Get setup information from the rebinned spectra frame
     */
 
    status = _giraffe_create_setup(&setup, spectra);
 
    if (status != 0) {
        return NULL;
    }
 
    /*
     * Compute the wavelength shifts between the reference mask and
     * the arc-lamp spectra, from the position of the cross-correlation
     * peak.
     *
     * Note that either a fiber, or a slitgeometry table may be passed to
     * _giraffe_compute_offsets(). Actually any table providing the
     * columns "INDEX" and "FPS", describing the pixel column of each
     * spectrum in the input image and the fiber position within the
     * pseudo slit.
     */
 
    peakdata = _giraffe_compute_offsets(spectra, mask, _slitgeometry,
                                        grating, &setup, config);
 
    if (peakdata == NULL) {
        return NULL;
    }
 
 
    /*
     * Compute the offsets of the fibers in the pseudo-slit (i.e. in the
     * focal plane.
     */
 
    status = _giraffe_compute_fiber_offsets(peakdata, grating, &setup);
 
    if (status != 0) {
        cpl_table_delete(peakdata);
        return NULL;
    }
 
 
    /*
     * Compute fiber positions
     */
 
    cpl_table_duplicate_column(peakdata, "XF", _slitgeometry, "XF");
    cpl_table_add_columns(peakdata, "XF", "DXF");
 
    return peakdata;
 
}
 
 
inline static GiTable*
_giraffe_slitgeometry_table(const cpl_table* offsets,
                            const GiImage* spectra,
                            const GiTable* fibers,
                            const GiTable* slitgeometry,
                            const GiSGCalConfig* config)
{
 
    const cxchar* idx = NULL;
 
    cxint i;
 
    cpl_propertylist* properties = NULL;
    cpl_propertylist* _properties = NULL;
 
    cpl_table* _slit = NULL;
    cpl_table* _fibers = NULL;
    cpl_table* _slitgeometry = NULL;
 
    GiTable* slit = NULL;
 
 
    cx_assert(spectra != NULL);
    cx_assert(fibers != NULL);
 
    _fibers = giraffe_table_get(fibers);
    cx_assert(_fibers != NULL);
 
    _slitgeometry = giraffe_table_get(slitgeometry);
    cx_assert(_slitgeometry != NULL);
 
    if (offsets == NULL) {
        return NULL;
    }
 
 
    slit = giraffe_table_new();
 
    properties = giraffe_image_get_properties(spectra);
    cx_assert(properties != NULL);
 
    giraffe_error_push();
 
    _properties = cpl_propertylist_new();
 
    giraffe_propertylist_copy(_properties, GIALIAS_INSTRUMENT, properties,
                              GIALIAS_INSTRUMENT);
 
    giraffe_propertylist_copy(_properties, GIALIAS_DATEOBS, properties,
                              GIALIAS_DATEOBS);
 
    giraffe_propertylist_copy(_properties, GIALIAS_MJDOBS, properties,
                              GIALIAS_MJDOBS);
 
    giraffe_propertylist_copy(_properties, GIALIAS_INSMODE, properties,
                              GIALIAS_INSMODE);
 
    giraffe_propertylist_copy(_properties, GIALIAS_INSMODE, properties,
                              GIALIAS_INSMODE);
 
    giraffe_propertylist_copy(_properties, GIALIAS_SETUPNAME, properties,
                              GIALIAS_SETUPNAME);
 
    giraffe_propertylist_copy(_properties, GIALIAS_SLITNAME, properties,
                              GIALIAS_SLITNAME);
 
    giraffe_propertylist_copy(_properties, GIALIAS_FILTNAME, properties,
                              GIALIAS_FILTNAME);
 
    giraffe_propertylist_copy(_properties, GIALIAS_GRATNAME, properties,
                              GIALIAS_GRATNAME);
 
    giraffe_propertylist_copy(_properties, GIALIAS_GRATWLEN, properties,
                              GIALIAS_GRATWLEN);
 
    giraffe_propertylist_copy(_properties, GIALIAS_GRATORDER, properties,
                              GIALIAS_GRATORDER);
 
    cpl_propertylist_update_double(_properties, GIALIAS_SCAL_CUTOFF,
                                   config->zmax);
    cpl_propertylist_set_comment(_properties, GIALIAS_SCAL_CUTOFF,
                                 "Cutoff pixel value.");
 
    cpl_propertylist_update_string(_properties, GIALIAS_GIRFTYPE, "SLITGEOTAB");
    cpl_propertylist_set_comment(_properties, GIALIAS_GIRFTYPE,
                                 "Giraffe frame type.");
 
 
    _slit = cpl_table_new(cpl_table_get_nrow(_fibers));
 
    cpl_table_new_column(_slit, "INDEX", CPL_TYPE_INT);
 
    for (i = 0; i < cpl_table_get_nrow(_slit); i++) {
        cpl_table_set_int(_slit, "INDEX", i, i + 1);
    }
 
    cpl_table_duplicate_column(_slit, "FPS", (cpl_table*)_fibers, "FPS");
    cpl_table_duplicate_column(_slit, "SSN", (cpl_table*)_fibers, "SSN");
    cpl_table_duplicate_column(_slit, "XF", (cpl_table*)offsets, "XF");
    cpl_table_duplicate_column(_slit, "YF", (cpl_table*)_slitgeometry, "YF");
 
    if (cpl_table_has_column(_slitgeometry, "ZF")) {
        cpl_table_duplicate_column(_slit, "ZF",
                                   (cpl_table*)_slitgeometry, "ZF");
    }
 
    if (cpl_table_has_column(_slitgeometry, "ZDEFOCUS")) {
        cpl_table_duplicate_column(_slit, "ZDEFOCUS",
                                   (cpl_table*)_slitgeometry, "ZDEFOCUS");
    }
 
    cpl_table_duplicate_column(_slit, "RV", (cpl_table*)offsets, "RV");
    cpl_table_duplicate_column(_slit, "RVERR", (cpl_table*)offsets, "RVERR");
    cpl_table_duplicate_column(_slit, "RESOLUTION", (cpl_table*)offsets,
                               "RESOLUTION");
 
    idx = giraffe_fiberlist_query_index(_fibers);
    cpl_table_duplicate_column(_slit, "RINDEX", _fibers, idx);
 
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        cpl_propertylist_delete(_properties);
        cpl_table_delete(_slit);
 
        giraffe_table_delete(slit);
 
        return NULL;
    }
 
    giraffe_error_pop();
 
    giraffe_table_set_properties(slit, _properties);
    cpl_propertylist_delete(_properties);
 
    giraffe_table_set(slit, _slit);
    cpl_table_delete(_slit);
 
    return slit;
 
}
 
 
cxint
giraffe_calibrate_slit(GiTable* result, const GiExtraction* extraction,
                       const GiLocalization* localization,
                       const GiTable* fibers, const GiTable* wlsolution,
                       const GiTable* slitgeometry, const GiTable* grating,
                       const GiTable* mask, const GiSGCalConfig* config)
{
 
    const cxchar* const fctid = "giraffe_calibrate_slit";
 
    cxint i;
    cxint status = 0;
 
    cpl_table* _fibers = NULL;
    cpl_table* _slitgeometry = NULL;
    cpl_table* offsets = NULL;
 
    GiTable* slit = NULL;
 
    GiGrating* setup = NULL;
 
    GiExtraction* _extraction = NULL;
 
 
    if (result == NULL) {
        return 1;
    }
 
    if (extraction == NULL) {
        return 1;
    }
 
    if (extraction->spectra == NULL) {
        return 1;
    }
 
    if (localization == NULL) {
        return 1;
    }
 
    if (fibers == NULL) {
        return 1;
    }
 
    if (wlsolution == NULL) {
        return 1;
    }
 
    if (slitgeometry == NULL) {
        return 1;
    }
 
    if (grating == NULL) {
        return 1;
    }
 
    if (mask == NULL) {
        return 1;
    }
 
    if (config == NULL) {
        return 1;
    }
 
 
    _fibers = giraffe_table_get(fibers);
    cx_assert(_fibers != NULL);
 
    _slitgeometry = giraffe_table_get(slitgeometry);
    cx_assert(_slitgeometry != NULL);
 
    if (cpl_table_get_nrow(_fibers) != cpl_table_get_nrow(_slitgeometry)) {
        return 2;
    }
 
 
    /*
     * Create grating setup
     */
 
    setup = giraffe_grating_create(extraction->spectra, grating);
 
    if (setup == NULL) {
        return 3;
    }
 
 
    /*
     * Set up the spectrum rebinning. Make sure that only the spectra are
     * rebinned.
     */
 
    _extraction = giraffe_extraction_new();
 
    _extraction->spectra = extraction->spectra;
    _extraction->error = NULL;
 
 
    slit = giraffe_table_duplicate(slitgeometry);
 
    for (i = 0; i < config->repeat; i++) {
 
        cxint fps_rvmin = 0;
        cxint fps_rvmax = 0;
 
        cxdouble rvmin = 0.;
        cxdouble rvmax = 0.;
        cxdouble rvmean = 0.;
 
        cpl_size row = 0;
 
        GiRebinning* rebinning = giraffe_rebinning_new();
 
        GiRebinConfig rebin_config = {
            GIREBIN_METHOD_LINEAR,
            TRUE,
            0.005,
            GIREBIN_SCALE_LINEAR,
            0,
            GIREBIN_RANGE_SETUP
        };
 
 
        status = giraffe_rebin_spectra(rebinning, _extraction, fibers,
                                       localization, grating, slit,
                                       wlsolution, &rebin_config);
 
        if (status != 0) {
            giraffe_table_delete(slit);
 
            giraffe_extraction_delete(_extraction);
            giraffe_rebinning_destroy(rebinning);
 
            giraffe_grating_delete(setup);
 
            return 4;
        }
 
        offsets = _giraffe_compute_slitgeometry(rebinning->spectra, mask,
                                                slit, setup, config);
 
        if (offsets == NULL) {
            giraffe_table_delete(slit);
 
            giraffe_extraction_delete(_extraction);
            giraffe_rebinning_destroy(rebinning);
 
            giraffe_grating_delete(setup);
 
            return 5;
        }
 
 
        /*
         * Build new slit geometry table
         */
 
        cx_assert(cpl_table_get_nrow(offsets) == cpl_table_get_nrow(_fibers));
 
        giraffe_table_delete(slit);
        slit = _giraffe_slitgeometry_table(offsets, rebinning->spectra,
                                           fibers, slitgeometry, config);
 
        if (slit == NULL) {
 
            cpl_table_delete(offsets);
 
            giraffe_extraction_delete(_extraction);
            giraffe_rebinning_destroy(rebinning);
 
            giraffe_grating_delete(setup);
 
            return 6;
        }
 
        cpl_table_delete(offsets);
        offsets = NULL;
 
        rvmin = cpl_table_get_column_min(giraffe_table_get(slit), "RV");
        cpl_table_get_column_minpos(giraffe_table_get(slit), "RV", &row);
        fps_rvmin = cpl_table_get_int(giraffe_table_get(slit), "FPS",
                                      row, NULL);
 
        rvmax = cpl_table_get_column_max(giraffe_table_get(slit), "RV");
        cpl_table_get_column_maxpos(giraffe_table_get(slit), "RV", &row);
        fps_rvmax = cpl_table_get_int(giraffe_table_get(slit), "FPS",
                                      row, NULL);
 
        rvmean = cpl_table_get_column_mean(giraffe_table_get(slit), "RV");
 
        cpl_msg_info(fctid, "Iteration %d: Fiber offsets [km/s]: minimum = "
                     "%.6e (fps %d), maximum = %.6e (fps %d), mean = %.6e",
                     i + 1, rvmin, fps_rvmin, rvmax, fps_rvmax, rvmean);
 
        giraffe_rebinning_destroy(rebinning);
        rebinning = NULL;
 
    }
 
    giraffe_extraction_delete(_extraction);
    giraffe_grating_delete(setup);
 
    cx_assert(slit != NULL);
 
    giraffe_table_set_properties(result, giraffe_table_get_properties(slit));
    giraffe_table_set(result, giraffe_table_get(slit));
 
    giraffe_table_delete(slit);
 
    return 0;
 
}
 
 
cxint
giraffe_compute_offsets(GiTable* fibers, const GiRebinning* rebinning,
                        const GiTable* grating, const GiTable* mask,
                        const GiSGCalConfig* config)
{
 
    cxint status = 0;
    cxint nfibers = 0;
    cxint fiber = 0;
    cxint peak = 0;
    cxint fps = 0;
    cxint fps0 = 0;
    cxint fps1 = 0;
 
    cxdouble dwf0 = 0.;
 
    cpl_table* _fibers = NULL;
    cpl_table* peakdata = NULL;
 
    GiGrating* _grating = NULL;
 
    GiSGSetup setup;
 
 
    if ((rebinning == NULL) || (rebinning->spectra == NULL)) {
        return -1;
    }
 
    if (fibers == NULL) {
        return -2;
    }
 
    if (grating == NULL) {
        return -3;
    }
 
    if (mask == NULL) {
        return -4;
    }
 
    if (config == NULL) {
        return -5;
    }
 
 
    _fibers = giraffe_table_get(fibers);
    cx_assert(_fibers != NULL);
 
 
    /*
     * Extract the  SIWC fibers from the fiber table. The simultaneous
     * calibration spectra are indicated by a -1 as retractor position.
     */
 
    cpl_table_unselect_all(_fibers);
    cpl_table_or_selected_int(_fibers, "RP", CPL_EQUAL_TO, -1);
 
    _fibers = cpl_table_extract_selected(_fibers);
 
    if (_fibers == NULL) {
        return 1;
    }
 
 
    /*
     * Create grating setup
     */
 
    _grating = giraffe_grating_create(rebinning->spectra, grating);
 
    if (_grating == NULL) {
        cpl_table_delete(_fibers);
        return 2;
    }
 
    /*
     * Get setup information from the rebinned spectra frame
     */
 
    status = _giraffe_create_setup(&setup, rebinning->spectra);
 
    if (status != 0) {
 
        giraffe_grating_delete(_grating);
        cpl_table_delete(_fibers);
 
        return 3;
 
    }
 
 
    /*
     * Compute the wavelength shifts between the reference mask and
     * the arc-lamp spectra, from the position of the cross-correlation
     * peak.
     *
     * Note that either a fiber, or a slitgeometry table may be passed to
     * _giraffe_compute_offsets(). Actually any table providing the
     * columns "INDEX" and "FPS", describing the pixel column of each
     * spectrum in the input image and the fiber position within the
     * pseudo slit.
     */
 
    peakdata = _giraffe_compute_offsets(rebinning->spectra, mask, _fibers,
                                        _grating, &setup, config);
 
    if (peakdata == NULL) {
 
        giraffe_grating_delete(_grating);
        cpl_table_delete(_fibers);
 
        return 4;
 
    }
 
 
    /*
     * Compute the offsets of the fibers in the pseudo-slit (i.e. in the
     * focal plane.
     */
 
    status = _giraffe_compute_fiber_offsets(peakdata, _grating, &setup);
 
    if (status != 0) {
        cpl_table_delete(peakdata);
        cpl_table_delete(_fibers);
 
        return 5;
    }
 
    giraffe_grating_delete(_grating);
    cpl_table_delete(_fibers);
 
 
    /*
     * Interpolate the wavelength offsets between the position of 2 adjacent
     * simultaneous calibration fibers.
     *
     * Note: The while loops traversing the fiber table _fiber just check
     *       whether the two fiber positions are equal or not. In that way
     *       it is possible to process Argus data, where the order of the
     *       fibers is reversed, without sorting the fiber and peakdata
     *       tables, or using dedicated code for Argus observations.
     */
 
    _fibers = giraffe_table_get(fibers);
 
    giraffe_error_push();
 
    cpl_table_new_column(_fibers, "WLRES", CPL_TYPE_DOUBLE);
    cpl_table_set_column_unit(_fibers, "WLRES", "nm");
 
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        cpl_table_delete(peakdata);
        return 6;
    }
 
    giraffe_error_pop();
 
 
    giraffe_error_push();
 
    fps0 = cpl_table_get_int(peakdata, "FPS", 0, NULL);
    dwf0 = cpl_table_get_double(peakdata, "DWF", 0, NULL);
 
    nfibers = cpl_table_get_nrow(_fibers);
 
    fps = cpl_table_get_int(_fibers, "FPS", 0, NULL);
 
    while (fps != fps0) {
 
        cpl_table_set_double(_fibers, "WLRES", fiber, dwf0);
 
        ++fiber;
        fps = cpl_table_get_int(_fibers, "FPS", fiber, NULL);
 
    }
 
    for (peak = 1; peak < cpl_table_get_nrow(peakdata); ++peak) {
 
        cxdouble dwf1 = cpl_table_get_double(peakdata, "DWF", peak, NULL);
        cxdouble slope = 0.;
 
 
        fps1 = cpl_table_get_int(peakdata, "FPS", peak, NULL);
 
        slope = (dwf1 - dwf0) / ((cxdouble)(fps1 - fps0));
 
        while (fps != fps1) {
 
            cpl_table_set_double(_fibers, "WLRES", fiber,
                                 slope * (fps - fps0) + dwf0);
 
            ++fiber;
            fps = cpl_table_get_int(_fibers, "FPS", fiber, NULL);
        }
 
        fps0 = fps1;
        dwf0 = dwf1;
 
    }
 
    fps1 = cpl_table_get_int(_fibers, "FPS", nfibers - 1, NULL);
 
    while (fps != fps1) {
 
        cpl_table_set_double(_fibers, "WLRES", fiber, dwf0);
 
        ++fiber;
        fps = cpl_table_get_int(_fibers, "FPS", fiber, NULL);
 
    }
 
    cpl_table_set_double(_fibers, "WLRES", fiber, dwf0);
 
    cx_assert(fiber == nfibers - 1);
 
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        cpl_table_delete(peakdata);
        return 7;
    }
 
    cpl_table_delete(peakdata);
 
    giraffe_error_pop();
 
    return 0;
 
}
 
 
GiSGCalConfig*
giraffe_sgcalibration_config_create(cpl_parameterlist* list)
{
 
    const cxchar* s = NULL;
 
    cpl_parameter* p = NULL;
 
    GiSGCalConfig* config = NULL;
 
 
    if (!list) {
        return NULL;
    }
 
    config = cx_calloc(1, sizeof *config);
 
    config->cc_wdomain = FALSE;
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.iterations");
    config->repeat = cpl_parameter_get_int(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.zmax");
    config->zmax = cpl_parameter_get_double(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.cc.step");
    config->cc_step = cpl_parameter_get_double(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.cc.domain");
    s = cpl_parameter_get_string(p);
 
    if (s) {
 
        cxchar** values = cx_strsplit(s, ",", 3);
 
        if (values == NULL) {
 
            giraffe_sgcalibration_config_destroy(config);
            return NULL;
 
        }
        else {
 
            cxchar* last;
 
            cxdouble lower = 0.;
            cxdouble upper = 0.;
 
 
            lower = strtod(values[0], &last);
 
            if (*last != '\0') {
 
                cx_strfreev(values);
                giraffe_sgcalibration_config_destroy(config);
 
                return NULL;
 
            }
 
            lower = lower >= 0. ? lower : 0.;
 
 
            if (values[1] != NULL) {
 
                upper = strtod(values[1], &last);
 
                if (*last != '\0') {
 
                    cx_strfreev(values);
                    giraffe_sgcalibration_config_destroy(config);
 
                    return NULL;
 
                }
 
                upper = upper > lower ? upper : 0.;
 
            }
 
            config->cc_domain = giraffe_range_create(lower, upper);
            cx_assert(config->cc_domain != NULL);
 
        }
 
        cx_strfreev(values);
        values = NULL;
 
    }
 
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.rv.limits");
    s = cpl_parameter_get_string(p);
 
    if (s) {
 
        cxchar** values = cx_strsplit(s, ",", 3);
 
        if (values == NULL) {
 
            giraffe_sgcalibration_config_destroy(config);
            return NULL;
 
        }
        else {
 
            cxchar* last;
 
            cxdouble lower = 0.;
            cxdouble upper = 0.;
 
 
            lower = strtod(values[0], &last);
 
            if (*last != '\0') {
 
                cx_strfreev(values);
                giraffe_sgcalibration_config_destroy(config);
 
                return NULL;
 
            }
 
            if (values[1] != NULL) {
 
                upper = strtod(values[1], &last);
 
                if (*last != '\0') {
 
                    cx_strfreev(values);
                    giraffe_sgcalibration_config_destroy(config);
 
                    return NULL;
 
                }
 
                if (lower > 0 || upper < lower) {
 
                    cx_strfreev(values);
                    giraffe_sgcalibration_config_destroy(config);
 
                    return NULL;
 
                }
 
            }
            else {
 
                if (lower > 0.) {
 
                    upper = lower;
                    lower = -upper;
 
                }
                else {
 
                    upper = -lower;
 
                }
 
            }
 
            cx_assert(lower <= 0);
            cx_assert(lower < upper);
 
            config->rv_limits = giraffe_range_create(lower, upper);
            cx_assert(config->rv_limits != NULL);
 
        }
 
        cx_strfreev(values);
        values = NULL;
 
    }
 
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.rv.iterations");
    config->rv_niter = cpl_parameter_get_int(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.rv.wfactor");
    config->rv_wfactor = cpl_parameter_get_double(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.peak.iterations");
    config->pf_niter = cpl_parameter_get_int(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.peak.tests");
    config->pf_ntest = cpl_parameter_get_int(p);
 
    p = cpl_parameterlist_find(list, "giraffe.sgcalibration.peak.dchisquare");
    config->pf_dchisq = cpl_parameter_get_double(p);
 
    return config;
 
}
 
 
void
giraffe_sgcalibration_config_destroy(GiSGCalConfig* config)
{
 
    if (config) {
        if (config->cc_domain) {
            giraffe_range_delete(config->cc_domain);
        }
 
        if (config->rv_limits) {
            giraffe_range_delete(config->rv_limits);
        }
 
        cx_free(config);
    }
 
    return;
}
 
 
void
giraffe_sgcalibration_config_add(cpl_parameterlist* list)
{
 
    cpl_parameter* p;
 
 
    if (!list) {
        return;
    }
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.iterations",
                                CPL_TYPE_INT,
                                "Slit geometry calibration maximum number "
                                "of iterations.",
                                "giraffe.sgcalibration",
                                1);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-cniter");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.zmax",
                                CPL_TYPE_DOUBLE,
                                "Maximum allowed pixel value. To be "
                                "effective it must be larger than 0.",
                                "giraffe.sgcalibration",
                                10000.);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-zmax");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.cc.step",
                                CPL_TYPE_DOUBLE,
                                "Cross-correlation step.",
                                "giraffe.sgcalibration",
                                -0.005);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-cstep");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.cc.domain",
                                CPL_TYPE_STRING,
                                "Restricts the cross-correlation to the "
                                "given domain.",
                                "giraffe.sgcalibration",
                                "0.,0.");
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-cdomain");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.rv.limits",
                                CPL_TYPE_STRING,
                                "Delta RV limits of the cross-correlation "
                                "window in km/s.",
                                "giraffe.sgcalibration",
                                "-200.,200.");
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-rvlimits");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.rv.iterations",
                                CPL_TYPE_INT,
                                "Maximum number of iterations used for the "
                                "RV determination.",
                                "giraffe.sgcalibration",
                                3);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-rvniter");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.rv.wfactor",
                                CPL_TYPE_DOUBLE,
                                "Data window width factor. The FWHM times "
                                "this value determines the window width.",
                                "giraffe.sgcalibration",
                                1.5);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-rvwfactor");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.peak.iterations",
                                CPL_TYPE_INT,
                                "Peak model fit maximum number of "
                                "iterations.",
                                "giraffe.sgcalibration",
                                50);
 
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-pfniter");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.peak.tests",
                                CPL_TYPE_INT,
                                "Cross-correlation peak fit maximum number "
                                "of tests",
                                "giraffe.sgcalibration",
                                7);
 
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-pfntest");
    cpl_parameterlist_append(list, p);
 
 
    p = cpl_parameter_new_value("giraffe.sgcalibration.peak.dchisquare",
                                CPL_TYPE_DOUBLE,
                                "Cross-correlation peak fit minimum "
                                "chi-square difference.",
                                "giraffe.sgcalibration",
                                0.0001);
 
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "scal-pfdchisq");
    cpl_parameterlist_append(list, p);
 
    return;
 
}