/* $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 <cxmacros.h>
#include <cxstrutils.h>

#include <cpl_propertylist.h>
#include <cpl_mask.h>
#include <cpl_table.h>
#include <cpl_msg.h>

#include "gialias.h"
#include "gierror.h"
#include "giarray.h"
#include "gimessages.h"
#include "giastroutils.h"
#include "giutils.h"
#include "gifxcalibration.h"


/**
 * @defgroup gifxcalibration Flux calibration
 *
 * TBD
 */

/**@{*/

/*
 * @brief
 *   Compute the angular separation of two objects.
 *
 * @param ra_0   Rightascension of the first object in degrees.
 * @param dec_0  Declination of the first object in degrees.
 * @param ra_1   Rightascension of the second object in degrees.
 * @param dec_1  Declination of the second object in degrees.
 *
 * @return
 *   The angular separation of the two objects in arcsec.
 *
 * Computes the angular separation of the two coordinate pairs given.
 */

inline static cxdouble
_giraffe_compute_separation(cxdouble ra_0, cxdouble dec_0,
                            cxdouble ra_1, cxdouble dec_1)
{

    const cxdouble deg2rad = CX_PI / 180.;

    cxdouble dist = 0.;


    ra_0 *= deg2rad;
    ra_1 *= deg2rad;
    dec_0 *= deg2rad;
    dec_1 *= deg2rad;

    dist = sin(dec_0) * sin(dec_1) +
            cos(dec_0) * cos(dec_1) * cos(ra_0 - ra_1);

    dist = CX_CLAMP(dist, -1., 1.);
    dist = acos(dist) / deg2rad * 3600.;

    return dist;

}


/*
 * @brief
 *  Spline interpolation using Hermite polynomials.
 *
 * @param xp      Abscissa value for which the interpolation is computed.
 * @param x       Array of abscissa values
 * @param y       Array of ordinate values
 * @param istart  Index of the first array element used.
 *
 * @return
 *  The interpolated value of the column @em ylabel.
 *
 * The function performs a spline interpolation using Hermite polynomials.
 * The array @em x and @em y provide the abscissa and ordinate values of
 * the function to be interpolated. The interpolation is computed for the
 * abscissa value @em xp.
 */

inline static cxdouble
_giraffe_spline_hermite(cxdouble xp, const cxdouble* x, const cxdouble* y,
                        cxint n, cxint* istart)
{

    cxint i = 0;

    cxdouble yp = 0.;
    cxdouble yp1 = 0.;
    cxdouble yp2 = 0.;
    cxdouble xpi = 0.;
    cxdouble xpi1 = 0.;
    cxdouble l1 = 0.;
    cxdouble l2 = 0.;
    cxdouble lp1 = 0.;
    cxdouble lp2 = 0.;


    if ((x[0] <= x[n - 1]) && ((xp < x[0]) || (xp > x[n - 1]))) {
        return 0.;
    }

    if ((x[0] > x[n - 1]) && ((xp > x[0]) || (xp < x[n - 1]))) {
        return 0.;
    }

    if (x[0] <= x[n - 1]) {

        for (i = *istart + 1; i <= n && xp >= x[i - 1]; ++i) {
            ;
        }

    }
    else {

        for (i = *istart + 1; i <= n && xp <= x[i - 1]; ++i) {
            ;
        }

    }

    *istart = i;
    --i;


    lp1 = 1. / (x[i - 1] - x[i]);
    lp2 = -lp1;

    if (i == 1) {
        yp1 = (y[1] - y[0]) / (x[1] - x[0]);
    }
    else {
        yp1 = (y[i] - y[i - 2]) / (x[i] - x[i - 2]);
    }

    if (i >= n - 1) {
        yp2 = (y[n - 1] - y[n - 2]) / (x[n - 1] - x[n - 2]);
    }
    else {
        yp2 = (y[i + 1] - y[i - 1]) / (x[i + 1] - x[i - 1]);
    }


    xpi  = xp - x[i - 1];
    xpi1 = xp - x[i];

    l1 = xpi1 * lp1;
    l2 = xpi * lp2;

    yp = y[i - 1] * (1. - 2. * lp1 * xpi) * l1 * l1 +
            y[i] * (1. - 2. * lp2 * xpi1) * l2 * l2 +
            yp1 * xpi * l1 * l1 +
            yp2 * xpi1 * l2 * l2;

    return yp;

}


/*
 * @brief
 *  Spline interpolation of a table column.
 *
 * @param tbl     Table with column to interpolate
 * @param xlabel  Column label of the abscissa column
 * @param ylabel  Column label of the ordinate column
 * @param xp      Abscissa value for which the interpolation is computed.
 * @param istart  Row index of the first table row used.
 *
 * @return
 *  The interpolated value of the column @em ylabel.
 *
 * The function performs a spline interpolation using Hermite polynomials
 * of the table column given by the column label @em ylabel. The column
 * @em xlabel are the corresponding abscissa values, and @em xp is the
 * abscissa value for which the interpolation is computed.
 */

inline static cxdouble
_giraffe_interpolate_spline_hermite(const cpl_table* tbl,
                                    const cxchar* xlabel,
                                    const cxchar* ylabel,
                                    cxdouble xp, cxint* istart)
{

    cxint n = cpl_table_get_nrow(tbl);

    const cxdouble* x = cpl_table_get_data_double_const(tbl, xlabel);
    const cxdouble* y = cpl_table_get_data_double_const(tbl, ylabel);


    return _giraffe_spline_hermite(xp, x, y, n ,istart);

}


/*
 * @brief
 *  Creates a 2d table of a flux standard star catalog spectrum
 *
 * @param catalog  3d table of flux standard reference spectra.
 * @param row      Table row from which the reference spectrum is extracted.
 *
 * @return
 *  The function returns a newly allocated 2d table containing the
 *  tabulated spectrum of the flux standard, or @c NULL if an error
 *  occurred.
 *
 * The input catalog @em catalog contains one flux standard spectrum per
 * table row. The function takes a spectrum from the the given row @em row
 * and stores it in an ordinary table structures. The output table contains
 * 3 columns, which give the wavelength and the width of each wavelength bin,
 * and the reference flux at this wavelength. The column names are
 * "LAMBDA", "BIN_WIDTH" and "F_LAMBDA" respectively.
 *
 * If the catalog contains wavelength in Angstrom, all 3 columns are
 * converted to nano meters.
 */

inline static cpl_table*
_giraffe_create_flux_table(const cpl_table* catalog, cxint row)
{

    const cxchar* const _id = "_giraffe_create_flux_table";


    const cxchar* columns[] = {"LAMBDA", "BIN_WIDTH", "F_LAMBDA"};
    const cxchar* units = NULL;

    cxint ndata = cpl_table_get_int(catalog, "NDATA", row, NULL);

    cxsize i = 0;

    const cxdouble ang2nm = 0.1;  /* Conversion factor Angstroem to nm */

    cpl_table* flux = NULL;



    if (ndata <= 0) {
        return NULL;
    }

    giraffe_error_push();

    flux = cpl_table_new(ndata);

    for (i = 0; i < CX_N_ELEMENTS(columns); ++i) {

        const cpl_array* data = cpl_table_get_array(catalog, columns[i], row);

        cpl_type type = cpl_table_get_column_type(catalog, columns[i]);


        cpl_table_new_column(flux, columns[i], CPL_TYPE_DOUBLE);

        if ((data != NULL) && (ndata <= cpl_array_get_size(data))) {

            switch (type & ~CPL_TYPE_POINTER) {
                case CPL_TYPE_FLOAT:
                {

                    cxint j = 0;

                    register cxdouble value = 0.;


                    for (j = 0; j < ndata; ++j) {
                        value = cpl_array_get_float(data, j, NULL);
                        cpl_table_set_double(flux, columns[i], j, value);
                    }

                    break;

                }

                case CPL_TYPE_DOUBLE:
                {

                    cxint j = 0;

                    register cxdouble value = 0.;


                    for (j = 0; j < ndata; ++j) {
                        value = cpl_array_get_double(data, j, NULL);
                        cpl_table_set_double(flux, columns[i], j, value);
                    }

                    break;

                }

                default:
                {
                    cpl_error_set(_id, CPL_ERROR_INVALID_TYPE);
                    break;

                }
            }

        }

    }


   /*
    * The fluxes of the catalog spectra are scaled by a factor of 1.e+16.
    * This scaling is reversed here.
    */

    cpl_table_multiply_scalar(flux, columns[2], 1.e-16);


    /*
     * If catalog wavelengths are given in terms of Angstrom all columns
     * are converted to nm, assuming that the catalog columns are consistent.
     * If no unit is given, or the unit string is empty, it is assumed that
     * the table data is already given in nm.
     */

    units = cpl_table_get_column_unit(catalog, columns[0]);

    if ((units != NULL) && (cx_strncasecmp(units, "ang", 3) == 0)) {

        cpl_msg_debug(_id, "Found units '%s'. Converting flux standard "
                      "from Angstrom to nano meters", units);

        cpl_table_multiply_scalar(flux, columns[0], ang2nm);
        cpl_table_set_column_unit(flux, columns[0], "nm");

        cpl_table_multiply_scalar(flux, columns[1], ang2nm);
        cpl_table_set_column_unit(flux, columns[1], "nm");

        cpl_table_divide_scalar(flux, columns[2], ang2nm);
        cpl_table_set_column_unit(flux, columns[2], "erg/s/cm^2/nm");

    }
    else {

        if (units == NULL) {

            cpl_msg_debug(_id, "No units for wavelength column. Assuming "
                          "nano meters.");

        }
        else {

            cpl_msg_debug(_id, "Found unknown units ('%s') for wavelength "
                    "column. Assuming nano meters.", units);

        }

    }


    if (cpl_error_get_code() != CPL_ERROR_NONE) {
        cpl_table_delete(flux);
        flux = NULL;

        return NULL;
    }

    giraffe_error_pop();

    return flux;

}


/*
 * @brief
 *  Create a standardized extinction table from input table.
 *
 * @param extinction  Input extinction table.
 *
 * @return
 *  The created standard extinction table, or @c NULL if an error occurred.
 *
 * The function creates a new extinction table from the input table. If the
 * input table contains wavelength in units of Angstroem the wavelength are
 * converted to nano meters. The column of the extinction coefficients to
 * use is copied from the input table and renamed to "EXTINCTION".
 */

inline static cpl_table*
_giraffe_setup_extinction(const cpl_table* extinction)
{

    const cxchar* const _id = "_giraffe_setup_extinction";

    const cxchar* site = NULL;
    const cxchar* units = NULL;
    const cxchar* sites[] = {"PARANAL", "LA_SILLA", NULL};

    cxint i = 0;
    cxint rows = 0;

    const cxdouble ang2nm = 0.1;  /* Conversion factor Angstroem to nm */

    cxdouble scale = 1.;

    cpl_table* _extinction = NULL;


    if (cpl_table_has_column(extinction, "LAMBDA") == FALSE) {

        cpl_error_set(_id, CPL_ERROR_ILLEGAL_INPUT);
        return NULL;

    }


    /*
     * Convert wavelength units from Angstroem to nano meters
     */

    units = cpl_table_get_column_unit(extinction, "LAMBDA");

    if ((units != NULL) && (cx_strncasecmp(units, "ang", 3) == 0)) {

        scale = ang2nm;

        cpl_msg_debug(_id, "Found units '%s'. Converting wavelength"
                "from Angstrom to nano meters", units);

    }
    else {

        if (units == NULL) {

            cpl_msg_debug(_id, "No units for wavelength column. "
                    "Assuming nano meters.");

        }
        else {

            if (cx_strncasecmp(units, "nm", 2) == 0) {

                cpl_msg_debug(_id, "Found units nano meters ('%s') for "
                        "wavelength column.", units);

            }
            else {

                cpl_msg_debug(_id, "Found unknown units ('%s') for "
                        "wavelength column. Assuming nano meters.", units);

            }

        }

    }


    /*
     * Select the extinction coefficients for the
     */

    while ((site == NULL) && (sites[i] != NULL)) {

        if (cpl_table_has_column(extinction, sites[i]) == TRUE) {

            site = sites[i];
            break;

        }

        ++i;

    }

    if (site == NULL) {
        cpl_msg_debug(_id, "No matching observatory site found!");
        return NULL;
    }


    /*
     * Setup the final extinction table
     */

    rows = cpl_table_get_nrow(extinction);

    giraffe_error_push();

    _extinction = cpl_table_new(rows);
    cpl_table_new_column(_extinction, "LAMBDA", CPL_TYPE_DOUBLE);
    cpl_table_set_column_unit(_extinction, "LAMBDA", "nm");

    cpl_table_new_column(_extinction, "EXTINCTION", CPL_TYPE_DOUBLE);
    cpl_table_set_column_unit(_extinction, "EXTINCTION", "mag/airmass");

    if (cpl_error_get_code() != CPL_ERROR_NONE) {

        cpl_table_delete(_extinction);
        _extinction = NULL;

        return NULL;

    }

    giraffe_error_pop();


    switch (cpl_table_get_column_type(extinction, "LAMBDA")) {
        case CPL_TYPE_FLOAT:
        {
            for (i = 0; i < rows; ++i) {

                register cxdouble lambda = cpl_table_get_float(extinction,
                        "LAMBDA", i, NULL);

                cpl_table_set_double(_extinction, "LAMBDA", i,
                                     scale * lambda);

            }
            break;
        }

        case CPL_TYPE_DOUBLE:
        {
            for (i = 0; i < rows; ++i) {

                register cxdouble lambda = cpl_table_get_double(extinction,
                        "LAMBDA", i, NULL);

                cpl_table_set_double(_extinction, "LAMBDA", i,
                                     scale * lambda);

            }
            break;
        }

        default:
        {
            cpl_table_delete(_extinction);
            _extinction = NULL;

            cpl_msg_debug(_id, "Column type (%d) is not supported for "
                    "extinction tables!",
                    cpl_table_get_column_type(extinction, "LAMBDA"));

            return NULL;
            break;
        }
    }

    switch (cpl_table_get_column_type(extinction, site)) {
        case CPL_TYPE_FLOAT:
        {
            for (i = 0; i < rows; ++i) {

                register cxdouble aext = cpl_table_get_float(extinction,
                        site, i, NULL);

                cpl_table_set_double(_extinction, "EXTINCTION", i, aext);

            }
            break;
        }

        case CPL_TYPE_DOUBLE:
        {
            for (i = 0; i < rows; ++i) {

                register cxdouble aext = cpl_table_get_double(extinction,
                        site, i, NULL);

                cpl_table_set_double(_extinction, "EXTINCTION", i, aext);

            }
            break;
        }

        default:
        {
            cpl_table_delete(_extinction);
            _extinction = NULL;

            cpl_msg_debug(_id, "Column type (%d) is not supported for "
                    "extinction tables!",
                    cpl_table_get_column_type(extinction, site));

            return NULL;
            break;
        }
    }


    return _extinction;

}


inline static cpl_image*
_giraffe_compute_mean_sky(const cpl_image* spectra, const cpl_table* fibers)
{

    cxint i = 0;
    cxint ns = cpl_image_get_size_x(spectra);
    cxint nw = cpl_image_get_size_y(spectra);
    cxint nsky = 0;
    cxint* sky_fibers = cx_calloc(ns, sizeof(cxint));

    const cxdouble* _spectra = cpl_image_get_data_double_const(spectra);

    cxdouble* _sky = NULL;

    cpl_image* sky = NULL;


    cx_assert(ns == cpl_table_get_nrow(fibers));


    /*
     * Count the available sky fibers, and save their position indices.
     */

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

        const cxchar* s = cpl_table_get_string(fibers, "Retractor", i);

        if (strstr(s, "-Sky") != NULL) {
            sky_fibers[nsky] =
                cpl_table_get_int(fibers, "INDEX", i, NULL) - 1;
            ++nsky;
        }

    }

    if (nsky == 0) {

        cx_free(sky_fibers);
        sky_fibers = NULL;

        return NULL;

    }


    /*
     * Compute the mean sky. If more than 2 sky fibers were used, the mean
     * sky is the median of all sky fibers, in order to get rid of spurious
     * artifacts, cosmics for instance. If there are less than 3 sky fibers
     * the mean sky is the simple average of all sky fibers.
     */

    sky = cpl_image_new(1, nw, CPL_TYPE_DOUBLE);
    _sky = cpl_image_get_data_double(sky);

    if (nsky > 2) {

        if (cpl_table_has_column(fibers, "TRANSMISSION") == TRUE) {

            cxdouble* sky_raw = cx_calloc(nsky, sizeof(cxdouble));


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

                register cxint j = 0;


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

                    cxdouble t = cpl_table_get_double(fibers, "TRANSMISSION",
                                                      sky_fibers[j], NULL);


                    cx_assert(t > 0.);

                    sky_raw[j] = _spectra[i * ns + sky_fibers[j]] / t;

                }

                _sky[i] = giraffe_array_median(sky_raw, nsky);

            }

            cx_free(sky_raw);
            sky_raw = NULL;

        }
        else {

            cxdouble* sky_raw = cx_calloc(nsky, sizeof(cxdouble));


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

                register cxint j = 0;


                for (j = 0; j < nsky; ++j) {
                    sky_raw[j] = _spectra[i * ns + sky_fibers[j]];
                }

                _sky[i] = giraffe_array_median(sky_raw, nsky);

            }

            cx_free(sky_raw);
            sky_raw = NULL;

        }

    }
    else {

        if (cpl_table_has_column(fibers, "TRANSMISSION") == TRUE) {

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

                register cxint j = 0;

                cxdouble t = cpl_table_get_double(fibers, "TRANSMISSION",
                                                  sky_fibers[i], NULL);


                cx_assert(t > 0.);

                for (j = 0; j < nw; ++j) {
                    _sky[j] += _spectra[j * ns + sky_fibers[i]] / t;
                }

            }

        }
        else {

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

                register cxint j = 0;


                for (j = 0; j < nw; ++j) {
                    _sky[j] += _spectra[j * ns + sky_fibers[i]];
                }

            }

        }

        cpl_image_divide_scalar(sky, nsky);

    }

    cx_free(sky_fibers);
    sky_fibers = NULL;

    return sky;

}


inline static cpl_image*
_giraffe_subtract_mean_sky(const cpl_image* spectra, const cpl_image* sky,
                           const cpl_table* fibers)
{

    cxint i = 0;
    cxint ns = cpl_image_get_size_x(spectra);
    cxint nw = cpl_image_get_size_y(spectra);

    const cxdouble* _spectra = cpl_image_get_data_double_const(spectra);
    const cxdouble* _sky = cpl_image_get_data_double_const(sky);

    cpl_image* result = cpl_image_new(ns, nw, CPL_TYPE_DOUBLE);

    cxdouble* _result = cpl_image_get_data_double(result);


    cx_assert((fibers == NULL) || (ns == cpl_table_get_nrow(fibers)));
    cx_assert(nw == cpl_image_get_size_y(sky));


    /*
     * If a fiber table is present and it contains the relative fiber
     * transmission data, the sky spectrum is corrected for that before
     * it is subtracted. Otherwise a fiber transmission of 1. is assumed.
     */

    if ((fibers != NULL) &&
        (cpl_table_has_column(fibers, "TRANSMISSION") == TRUE)) {

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

            register cxint j = 0;
            register cxint k =
                cpl_table_get_int(fibers, "INDEX", i, NULL) - 1;

            cxdouble t = cpl_table_get_double(fibers, "TRANSMISSION",
                                              k, NULL);


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

                register cxint l = j * ns + i;

                _result[l] += _spectra[l] - t * _sky[j];

            }

        }

    }
    else {

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

            register cxint j = 0;

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

                register cxint k = j * ns + i;

                _result[k] += _spectra[k] - _sky[j];

            }

        }

    }

    return result;

}


inline static cpl_image*
_giraffe_integrate_flux(const cpl_image* spectra, const cpl_table* fibers)
{

    cxint i = 0;
    cxint nw = cpl_image_get_size_y(spectra);
    cxint ns = cpl_image_get_size_x(spectra);

    cpl_image* result = cpl_image_new(1, nw, CPL_TYPE_DOUBLE);


    cx_assert(ns == cpl_table_get_nrow(fibers));

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

        const cxchar* s = cpl_table_get_string(fibers, "Retractor", i);

        cxint rp = cpl_table_get_int(fibers, "RP", i, NULL);


        /*
         * Add up the flux of all fibers for each wavelength bin,
         * ignoring all sky and simultaneous calibration fibers.
         */

        if ((rp != -1) && (strstr(s, "-Sky") == NULL)) {

            register cxint j = 0;

            const cxdouble* _spectra =
                cpl_image_get_data_double_const(spectra);

            cxdouble* _result = cpl_image_get_data_double(result);


            for (j = 0; j < nw; ++j) {
                _result[j] += _spectra[j * ns + i];
            }

        }

    }

    return result;

}


/*
 * @brief
 *   Correct a spectrum for the atmospheric extinction.
 *
 * @param spectrum    The spectrum to be corrected.
 * @param properties  Properties of the input spectrum.
 * @param extinction  The table containing the atmospheric extinction.
 *
 * @return
 *   The function returns 0 on success, or a non-zero value otherwise.
 *
 * The function corrects the input spectrum @em spectrum for the atmospheric
 * extinction. The atmospheric extinction as a function of wavelength is
 * taken from the table @em extinction.
 *
 * The extinction table is expected to contain a wavelength column "LAMBDA"
 * in units of nano meters. To support legacy tables "Angstroem" are
 * also accepted, but not recommended.
 */

inline static cxint
_giraffe_correct_extinction(cpl_image* spectrum, cpl_propertylist* properties,
                            const cpl_table* extinction)
{

    const cxchar* const _id = "_giraffe_correct_extinction";


    cxint i = 0;
    cxint status = 0;
    cxint nw = 0;

    cxdouble alpha = 0.;
    cxdouble delta = 0.;
    cxdouble lst = 0.;
    cxdouble latitude = 0.;
    cxdouble exptime = 0.;
    cxdouble wlstart = 0.;
    cxdouble wlstep = 0.;
    cxdouble airmass = -1.;
    cxdouble* flx = NULL;

    cpl_table* _extinction = NULL;


    if ((spectrum == NULL) || (properties == NULL) || (extinction == NULL)) {
        return -1;
    }


    if (cpl_image_get_size_x(spectrum) != 1) {

        cpl_msg_debug(_id, "Input spectrum is not a 1d spectrum!");
        return -1;

    }


    /*
     * Setup the extinction table. This will convert wavelengths from
     * Angstroem to nano meters if it is necessary, and set the
     * name of the column of extinction coefficients to "Extinction".
     */

    _extinction = _giraffe_setup_extinction(extinction);

    if (_extinction == NULL) {
        return 1;
    }


    /*
     * Get the wavelength grid parameters of the observered spectrum
     */

    if ((cpl_propertylist_has(properties, GIALIAS_BINWLMIN) == FALSE) ||
         (cpl_propertylist_has(properties, GIALIAS_BINSTEP) == FALSE)) {

        cpl_msg_debug(_id, "Observed spectrum does not have a valid "
                "wavelength grid!");

        cpl_table_delete(_extinction);
        _extinction = NULL;

        return 2;

    }

    wlstart = cpl_propertylist_get_double(properties, GIALIAS_BINWLMIN);
    wlstep = cpl_propertylist_get_double(properties, GIALIAS_BINSTEP);


    /*
     * Compute the airmass for the time of the observation
     */

    giraffe_error_push();

    alpha = cpl_propertylist_get_double(properties, GIALIAS_RADEG);
    delta = cpl_propertylist_get_double(properties, GIALIAS_DECDEG);
    lst = cpl_propertylist_get_double(properties, GIALIAS_LST);
    latitude = cpl_propertylist_get_double(properties, GIALIAS_TEL_LAT);
    exptime = cpl_propertylist_get_double(properties, GIALIAS_EXPTIME);

    status = cpl_error_get_code();

    if (status == CPL_ERROR_NONE) {

        airmass = giraffe_compute_airmass(alpha, delta, lst, exptime,
                                        latitude);

    }

    if ((airmass < 1.) || (status != CPL_ERROR_NONE)) {

        cxbool start = cpl_propertylist_has(properties,
                GIALIAS_AIRMASS_START);
        cxbool end = cpl_propertylist_has(properties,
                                        GIALIAS_AIRMASS_END);

        if ((start == FALSE) || (end == FALSE)) {

            cpl_msg_debug(_id, "Unable to compute airmass of the "
                    "observation!");

            cpl_table_delete(_extinction);
            _extinction = NULL;

            return 3;

        }
        else {

            airmass = 0.5 * (cpl_propertylist_get_double(properties,
                            GIALIAS_AIRMASS_START) +
                    cpl_propertylist_get_double(properties,
                                    GIALIAS_AIRMASS_END));

        }

    }

    giraffe_error_pop();


    /*
     * Apply the correction to the input spectrum
     */

    nw = cpl_image_get_size_y(spectrum);
    flx = cpl_image_get_data_double(spectrum);

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

        cxint first = 0;

        cxdouble wlen = wlstart + (i - 1) * wlstep;
        cxdouble ext = 1.;


        giraffe_error_push();

        ext = _giraffe_interpolate_spline_hermite(_extinction,
                "LAMBDA", "EXTINCTION", wlen, &first);

        if (cpl_error_get_code() != CPL_ERROR_NONE) {

            cpl_table_delete(_extinction);
            _extinction = NULL;

            return 3;

        }

        giraffe_error_pop();


        /*
         * Correct the spectrum flux of this wavelength bin for
         * atmospheric extinction.
         *
         * The extinction ext is given in mag/airmass. The correction for
         * the effect of the earth atmoshpere gives for the observed
         * magnitude at the top of the atmosphere m_top = m - ext * airmass
         *
         * Converting the magnitude into a flux using m = -2.5 * log10(flux)
         * the correction factor to be applied is 10^(0.4 * ext * airmass)
         */

        flx[i] *= pow(10., 0.4 * ext * airmass);

    }

    cpl_table_delete(_extinction);
    _extinction = NULL;

    return 0;

}


/*
 * @brief
 *   Compute the instrument spectral response function.
 *
 * @param spectrum    Observed flux standard spectrum image.
 * @param properties  Properties of the observed flux standard.
 * @param refflux     Reference fluxes of the flux standard.
 *
 * @return
 *   On success the function returns the instruments spectral response
 *   function as an image, or @c NULL otherwise.
 *
 * The instruments spectral response function is computed, by interpolating
 * the tabulated reference flux of the observed flux standard onto the
 * wavelength grid of the observed spectrum, and dividing the observed
 * flux by the reference flux values.
 */

inline static cpl_image*
_giraffe_compute_response(const cpl_image* spectrum,
                          const cpl_propertylist* properties,
                          const cpl_table* refflux)
{

    const cxchar* const _id = "giraffe_compute_response";


    cxint i = 0;
    cxint nw = 0;

    const cxdouble* flx = NULL;

    cxdouble wlstart = 0.;
    cxdouble wlstep = 0.;
    cxdouble* rdata = NULL;


    cpl_image* response = NULL;



    if ((spectrum == NULL) || (properties == NULL) || (refflux == NULL)) {
        return NULL;
    }

    if (cpl_image_get_size_x(spectrum) != 1) {

        cpl_msg_debug(_id, "Observed spectrum is not a 1d spectrum!");
        return NULL;

    }


    /*
     * Get the wavelength grid parameters of the observered spectrum
     */

    if ((cpl_propertylist_has(properties, GIALIAS_BINWLMIN) == FALSE) ||
        (cpl_propertylist_has(properties, GIALIAS_BINSTEP) == FALSE)) {

        cpl_msg_debug(_id, "Observed spectrum does not have a valid "
                      "wavelength grid!");
        return NULL;

    }

    wlstart = cpl_propertylist_get_double(properties, GIALIAS_BINWLMIN);
    wlstep = cpl_propertylist_get_double(properties, GIALIAS_BINSTEP);

    nw = cpl_image_get_size_y(spectrum);


    /*
     * Compute the response for each spectrum and wavelength bin of the
     * observed spectrum image.
     */

    flx = cpl_image_get_data_double_const(spectrum);

    response = cpl_image_new(1, nw, CPL_TYPE_DOUBLE);
    rdata = cpl_image_get_data_double(response);

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

        cxint first = 0;

        cxdouble wlen = wlstart + (i - 1) * wlstep;
        cxdouble sflx = 0.;


        giraffe_error_push();

        sflx = _giraffe_interpolate_spline_hermite(refflux,
                "LAMBDA", "F_LAMBDA", wlen, &first);

        if (cpl_error_get_code() != CPL_ERROR_NONE) {

            cpl_image_delete(response);
            response = NULL;

            return NULL;

        }

        giraffe_error_pop();

        rdata[i] = flx[i] / sflx;

    }

    return response;

}


GiTable*
giraffe_select_flux_standard(const GiTable* catalog, const GiImage* spectra,
                             cxdouble max_dist)
{

    const cxchar* const _id = "giraffe_select_flux_standard";

    cxint row = 0;
    cxint nmatch = 0;

    cxdouble ra = 0.;
    cxdouble dec = 0.;
    cxdouble std_ra = 0.;
    cxdouble std_dec = 0.;
    cxdouble min_dist = 0.;

    const cpl_table* _catalog = NULL;

    cpl_table* _flux = NULL;

    const cpl_propertylist* properties = NULL;

    GiTable* flux = NULL;


    if ((catalog == NULL) || (spectra == NULL)) {
        return NULL;
    }

    _catalog = giraffe_table_get(catalog);
    cx_assert(_catalog != NULL);


    /*
    * Get the telescope pointing from the properties of the
    * rebinned spectra
    */

    properties = giraffe_image_get_properties(spectra);
    cx_assert(properties != NULL);

    giraffe_error_push();

    ra = cpl_propertylist_get_double(properties, GIALIAS_RADEG);
    dec = cpl_propertylist_get_double(properties, GIALIAS_DECDEG);

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

    giraffe_error_pop();


    /*
     * Search for matching objects in the flux standards catalog
     */

    cpl_msg_debug(_id, "Searching flux standard by name...");

    if ((cpl_propertylist_has(properties, GIALIAS_TARGET) == TRUE) &&
        (cpl_table_has_column(_catalog, "OBJECT") == TRUE)) {

        const cxchar* target = cpl_propertylist_get_string(properties,
                GIALIAS_TARGET);


        if ((target != NULL) && (target[0] != '\0')) {

            register cxint i = 0;


            for (i = 0; i < cpl_table_get_nrow(_catalog); ++i) {

                const cxchar* object = cpl_table_get_string(_catalog,
                        "OBJECT", i);


                if (strcmp(target, object) == 0) {

                    cxdouble cat_ra = cpl_table_get_double(_catalog,
                            "RA_DEG", i, NULL);
                    cxdouble cat_dec = cpl_table_get_double(_catalog,
                            "DEC_DEG", i, NULL);


                    std_ra = cpl_table_get_double(_catalog,
                            "RA_DEG", i, NULL);
                    std_dec = cpl_table_get_double(_catalog,
                            "DEC_DEG", i, NULL);

                    min_dist = _giraffe_compute_separation(ra, dec,
                            cat_ra, cat_dec);

                    row = i;
                    ++nmatch;

                }

            }

        }

    }

    cpl_msg_debug(_id, "%d flux standards found...", nmatch);


    if (nmatch == 0) {

        cxint i = 0;


        cpl_msg_debug(_id, "Searching flux standard by coordinates...");

        if ((cpl_table_has_column(_catalog, "RA_DEG") == FALSE) ||
            (cpl_table_has_column(_catalog, "DEC_DEG") == FALSE)) {

            cpl_error_set(_id, CPL_ERROR_DATA_NOT_FOUND);

            return NULL;

        }


        for (i = 0; i < cpl_table_get_nrow(_catalog); ++i) {

            cxdouble cat_ra = cpl_table_get_double(_catalog, "RA_DEG",
                    i, NULL);
            cxdouble cat_dec = cpl_table_get_double(_catalog, "DEC_DEG",
                    i, NULL);

            cxdouble dist = 0.;


            /*
             * Compute angular separation between the observation and the
             * positions given in the flux standards catalog.
             */

            dist = _giraffe_compute_separation(ra, dec, cat_ra, cat_dec);

            if ((i == 0) || (dist < min_dist)) {

                std_ra = cat_ra;
                std_dec = cat_dec;
                min_dist = dist;

                if (dist < max_dist) {
                    ++nmatch;
                    row = i;
                }

            }

        }

        cpl_msg_debug(_id, "%d flux standards found...", nmatch);

    }


    switch (nmatch) {

        case 0:
        {

            const cxchar* object = cpl_table_get_string(_catalog,
                    "OBJECT", row);

            cpl_msg_debug(_id, "No flux standard found within %.4f arcsec",
                          max_dist);
            cpl_msg_debug(_id, "The closest object ('%s') at (RA, Dec) = "
                          "(%.4f, %.4f) is %.4f arcsec away", object, std_ra,
                          std_dec, min_dist);

            cpl_error_set(_id, CPL_ERROR_INCOMPATIBLE_INPUT);

            return NULL;
            break;

        }

        case 1:
        {

            const cxchar* object = cpl_table_get_string(_catalog,
                    "OBJECT", row);

            cpl_msg_debug(_id, "Flux standard ('%s') at (RA, Dec) = "
                          "(%.4f, %.4f) found at a distance of %.4f arcsec",
                          object, std_ra, std_dec, min_dist);

            /*
             * Create flux table of the flux standart object found.
             */

            _flux = _giraffe_create_flux_table(_catalog, row);

            break;

        }

        default:
        {

            const cxchar* object = cpl_table_get_string(_catalog,
                    "OBJECT", row);

            cpl_msg_debug(_id, "%d flux standards found within %.4f arcsec",
                          nmatch, max_dist);
            cpl_msg_debug(_id, "The closest object ('%s') at (RA, Dec) = "
                          "(%.4f, %.4f) is %.4f arcsec away", object, std_ra,
                          std_dec, min_dist);

            cpl_error_set(_id, CPL_ERROR_INCOMPATIBLE_INPUT);

            return NULL;
            break;

        }

    }

    if (_flux != NULL) {

        flux = giraffe_table_new();
        giraffe_table_set(flux, _flux);

    }

    cpl_table_delete(_flux);
    _flux = NULL;

    return flux;

}


/**
 * @brief
 *   Compute the response and efficiency curves.
 *
 * @param result      The object where the results are stored.
 * @param spectra     The rebinned spectra of a flux standard.
 * @param fibers      The list of used fibers.
 * @param flat        The extracted flat field.
 * @param flux        Table with the reference flux of the observed standard.
 * @param extinction  Table with the wavelength dependent atmospheric
 *                    extinction coefficients.
 * @param config      The configuration options.
 *
 * @return
 *   The function returns 0 on success, or a non-zero value if an error
 *   occurred.
 *
 * The function computes the wavelength dependent instrument response and
 * efficiency curves from the observed and rebinned spectrum of a flux
 * standard, and stores them in the result object @em result. The response
 * is defined as the function by which the incident spectrum at the top
 * of the atmosphere has to be multiplied, in order to obtain the spectrum
 * recorded with the detector. The efficiency is the ratio of detected
 * photons (corrected for the atmospheric extinction) over the number of
 * incident photons.
 *
 * The function expects as input an observation of a single flux standard,
 * i.e. no other target is visible with in the Argus field of view, or, in
 * case of an IFU observation, all buttons are either used to observe the
 * target, or point to blank sky. As additional constraint, the individual
 * fiber spectra of the flux standard have to be rebinned to a common
 * wavelength grid, i.e. the wavelength range for all fibers has to be the
 * same.
 *
 * The total observed flux of the flux standard is computed by adding up the
 * spectra of all fibers. No background subtraction, and, in the case of
 * Argus, no source detection is performed. The response and the efficiency
 * curves are computed for the wavelength range given by the rebinned flux
 * standard observation.
 */

cxint
giraffe_calibrate_flux(GiResponse* result, const GiRebinning* spectra,
                       const GiTable* fibers, const GiImage* flat,
                       const GiTable* flux, const GiTable* extinction,
                       const GiFxCalibrationConfig* config)
{

    const cxchar* const _id = "giraffe_calibrate_flux";


    const cxint xrad = 0;
    const cxint yrad = 7;

    const cxdouble UT_M1_VIGNETTED_AREA = 517533.407382;  /* cm^2    */
    const cxdouble H_PLANCK = 6.62606896e-27;             /* erg s   */
    const cxdouble C_LIGHT = 2.99792458e17;               /* nm s^-1 */

    cxint i = 0;
    cxint status = 0;
    cxint nw = 0;

    const cxdouble* rdata = NULL;

    cxdouble conad = 0.;
    cxdouble wlstep = 0.;
    cxdouble wlstart = 0.;
    cxdouble exptime = 0.;
    cxdouble avgsky = 0.;
    cxdouble scale = UT_M1_VIGNETTED_AREA / (H_PLANCK * C_LIGHT);

    cpl_propertylist* properties = NULL;

    cpl_mask* filter = NULL;

    cpl_image* _spectra = NULL;
    cpl_image* fluxobs = NULL;
    cpl_image* response = NULL;
    cpl_image* fresponse = NULL;

    cpl_table* _extinction = NULL;
    cpl_table* _flux = NULL;
    cpl_table* efficiency = NULL;

    (void) flat;  /* Not used. */

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

    if ((spectra == NULL) || (spectra->spectra == NULL)) {
        return -2;
    }

    if (fibers == NULL) {
        return -3;
    }

    if ((flux == NULL) || (extinction == NULL)) {
        return -4;
    }

    if (config == NULL) {
        return -5;
    }


    if ((result->response != NULL) || (result->efficiency != NULL)) {

        gi_warning("%s: Results structure at %p is not empty! Contents "
                "might be lost.", _id, result);

    }

    properties = giraffe_image_get_properties(spectra->spectra);
    cx_assert(properties != NULL);

    _spectra = giraffe_image_get(spectra->spectra);
    cx_assert(_spectra != NULL);

    _extinction = giraffe_table_get(extinction);
    cx_assert(_extinction != NULL);

    _flux = giraffe_table_get(flux);
    cx_assert(_flux != NULL);



    /*
     * Compute the total observed flux. No background subtraction is
     * performed, but it is assumed that the background is negligible.
     * Also, no attempt is made to figure out which fibers actually
     * were illuminated by the object.
     */

    if (config->sky_subtraction == TRUE) {

        cpl_image* sky_spectrum = NULL;
        cpl_image* sspectra = NULL;

        cpl_table* _fibers = giraffe_table_get(fibers);


        sky_spectrum = _giraffe_compute_mean_sky(_spectra, _fibers);

        if (sky_spectrum == NULL) {
            return 1;
        }

        giraffe_error_push();

        avgsky = cpl_image_get_mean(sky_spectrum);

        sspectra = _giraffe_subtract_mean_sky(_spectra, sky_spectrum,
                                              _fibers);

        fluxobs = _giraffe_integrate_flux(sspectra, _fibers);

        cpl_image_delete(sky_spectrum);
        sky_spectrum = NULL;

        cpl_image_delete(sspectra);
        sspectra = NULL;

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

        giraffe_error_pop();

    }
    else {

        cpl_table* _fibers = giraffe_table_get(fibers);

        fluxobs = _giraffe_integrate_flux(_spectra, _fibers);

    }


    /*
     * Correct for the atmospheric extinction
     */

    status = _giraffe_correct_extinction(fluxobs, properties, _extinction);

    if (status != 0) {
        cpl_msg_warning(_id, "Extinction correction failed!");
    }


    exptime = cpl_propertylist_get_double(properties, GIALIAS_EXPTIME);
    wlstep = cpl_propertylist_get_double(properties, GIALIAS_BINSTEP);
    wlstart = cpl_propertylist_get_double(properties, GIALIAS_BINWLMIN);

    conad = giraffe_propertylist_get_conad(properties);


    /*
     * Convert the observed spectrum from ADU to e- / s / nm
     */

    cpl_image_multiply_scalar(fluxobs, conad / exptime / wlstep);


    /*
     * Compute the response function R = Fobs / Fref in units of
     * 'e- erg^-1 cm^2'
     */

    response = _giraffe_compute_response(fluxobs, properties, _flux);

    cpl_image_delete(fluxobs);
    fluxobs = NULL;

    if (response == NULL) {
        return 2;
    }

    filter = cpl_mask_new(2 * xrad + 1, 2 * yrad + 1);
    for (i = 0; i < cpl_mask_get_size_x(filter); ++i) {

        cxint j = 0;

        for (j = 0; j < cpl_mask_get_size_y(filter); ++j)
        {
           cpl_mask_set(filter, i + 1, j + 1, CPL_BINARY_1);
        }

    }

    fresponse = cpl_image_new(cpl_image_get_size_x(response),
                              cpl_image_get_size_y(response),
                              cpl_image_get_type(response));

    cpl_image_filter_mask(fresponse, response, filter,
                          CPL_FILTER_MEDIAN, CPL_BORDER_FILTER);

    cpl_mask_delete(filter);
    filter = NULL;

    cpl_image_delete(response);
    response = fresponse;

    if (response == NULL) {
        return 3;
    }


    /*
     * Compute instrument efficiency
     */

    giraffe_error_push();

    nw = cpl_image_get_size_y(response);

    efficiency = cpl_table_new(nw);

    cpl_table_new_column(efficiency, "WLEN", CPL_TYPE_DOUBLE);
    cpl_table_new_column(efficiency, "BINWIDTH", CPL_TYPE_DOUBLE);
    cpl_table_new_column(efficiency, "EFFICIENCY", CPL_TYPE_DOUBLE);

    cpl_table_set_column_unit(efficiency, "WLEN", "nm");
    cpl_table_set_column_unit(efficiency, "BINWIDTH", "nm");

    if (cpl_error_get_code() != CPL_ERROR_NONE) {

        cpl_table_delete(efficiency);
        efficiency = NULL;

        cpl_image_delete(response);
        response = NULL;

        return 4;

    }

    giraffe_error_pop();


    rdata = cpl_image_get_data_double_const(response);

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

        cxdouble wl = wlstart + i * wlstep;

        cpl_table_set_double(efficiency, "WLEN", i, wl);
        cpl_table_set_double(efficiency, "BINWIDTH", i, wlstep);
        cpl_table_set_double(efficiency, "EFFICIENCY", i,
                             rdata[i] / (scale * wl));

    }

    rdata = NULL;


    /*
     * Fill the results object
     */


    if (config->sky_subtraction == TRUE) {
        cpl_propertylist_update_double(properties, GIALIAS_SKY_LEVEL, avgsky);
        cpl_propertylist_set_comment(properties, GIALIAS_SKY_LEVEL,
                                     "Mean sky level used [ADU].");
    }

    result->response = giraffe_image_new(CPL_TYPE_DOUBLE);
    giraffe_image_set_properties(result->response, properties);
    giraffe_image_set(result->response, response);

    cpl_image_delete(response);
    response = NULL;

    result->efficiency = giraffe_table_new();
    giraffe_table_set_properties(result->efficiency, properties);
    giraffe_table_set(result->efficiency, efficiency);

    cpl_table_delete(efficiency);
    efficiency = NULL;

    return 0;

}


GiFxCalibrationConfig*
giraffe_fxcalibration_config_create(cpl_parameterlist* parameters)
{

    cpl_parameter *p = NULL;

    GiFxCalibrationConfig* self = NULL;


    if (parameters == NULL) {
        return NULL;
    }

    self = cx_calloc(1, sizeof *self);
    cx_assert(self != NULL);


    /*
     * Set application defaults
     */

    self->sky_subtraction = FALSE;

    /*
     * Lookup the parameters in the given parameter list and set the
     * value accordingly if it is found.
     */

    p = cpl_parameterlist_find(parameters,
            "giraffe.fxcalibration.sky.correct");

    if (p != NULL) {
        self->sky_subtraction = cpl_parameter_get_bool(p);
    }

    return self;

}


/**
 * @brief
 *   Destroy a flux calibration setup structure.
 *
 * @param self  The setup structure to destroy.
 *
 * @return
 *   Nothing.
 *
 * The function deallocates the memory used by the setup structure @em self,
 * and the setup structure itself.
 */

void
giraffe_fxcalibration_config_destroy(GiFxCalibrationConfig* self)
{

    if (self != NULL) {
        cx_free(self);
    }

    return;

}


/**
 * @brief
 *   Add flux calibration parameters to a parameter list
 *
 * @param parameters  The list of parameters to update.
 *
 * @return
 *   Nothing
 *
 * The function updates the list of parameters @em parameters with the
 * configuration parameters of the flux calibration task.
 */

void
giraffe_fxcalibration_config_add(cpl_parameterlist* parameters)
{

    cpl_parameter* p = NULL;


    if (parameters == NULL) {
        return;
    }

    p = cpl_parameter_new_value("giraffe.fxcalibration.sky.correct",
                                CPL_TYPE_BOOL,
                                "Correct spectra for the sky emission",
                                "giraffe.fxcalibration",
                                FALSE);
    cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, "flx-skycorr");
    cpl_parameterlist_append(parameters, p);

    return;

}
/**@}*/
