/* $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 <string.h>

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

#include <cpl_matrix.h>

#include "girvcorrection.h"



/**
 * @defgroup girvcorrection Heliocentric and barycentric correction
 *
 * TBD
 */

/**@{*/

/*
 * Constants
 */

static const cxdouble dct0   = 2415020.0;
static const cxdouble dcjul  = 36525.0;
static const cxdouble dc1900 = 1900.0;
static const cxdouble dctrop = 365.24219572;
static const cxdouble dcbes  = 0.313;

static const cxdouble RV_DPI  =
    3.1415926535897932384626433832795028841971693993751;   /* pi      */

static const cxdouble RV_D2PI =
    6.2831853071795864769252867665590057683943387987502;   /* 2pi     */

static const cxdouble RV_D4PI =
    12.566370614359172953850573533118011536788677597500;   /* 4pi     */

static const cxdouble RV_DPIBY2 =
    1.5707963267948966192313216916397514420985846996876;   /* pi/2   */

static const cxdouble RV_DD2R =
    0.017453292519943295769236907684886127134428718885417; /* pi/180  */

static const cxdouble RV_DAS2R =
    4.8481368110953599358991410235794797595635330237270e-6; /* pi/(180*3600) */


/*
 * @brief
 *   Generate a rotation matrix from a set of Euler angles
 *
 * @param mode   List of axis to rotate about (intrinsic rotations).
 * @param phi    Angle of the first rotation.
 * @param theta  Angle of the second rotation.
 * @param psi    Angle of the third rotation.
 *
 * @return
 *   The function returns the created 3x3 rotation matrix, or @c NULL in case
 *   an error occurs.
 *
 * The function creates a rotation matrix from the Euler angles @em phi,
 * @em theta and @em psi, by applying three successive rotations of the
 * respective angle about the cartesian axes given in the list @em mode.
 *
 * The rotations are intrinsic rotations and are carried out in the order
 * the axes are given by @em mode. The axes designations which may appear
 * in the list mode are 'x', 'y', and 'z' for the first, second, and third
 * axis respectively.
 *
 * The angles are defined according to the right hand rule, i.e. they are
 * positive if they represent a rotation which appears counter-clockwise
 * when observed from a point on the positive part of the rotation axis, and
 * they are negative for clockwise rotations.
 */

inline static cpl_matrix *
_giraffe_create_rotation(const cxchar *mode, cxdouble phi, cxdouble theta,
                         cxdouble psi)
{

    cxint nrotations = strlen(mode);

    cpl_matrix *self = cpl_matrix_new(3, 3);


    nrotations = nrotations <= 3 ? nrotations : 3;


    /*
     * Initialize the rotation matrix as identity
     */

    cpl_matrix_fill_diagonal(self, 1., 0);


    /*
     * Create the general rotation matrix by successively left
     * multiplying the rotation matrices about the given axes.
     */

    if (nrotations > 0) {

        const cxchar *_mode = cx_strlower(cx_strdup(mode));

        register cxint i = 0;

        cpl_matrix *R = cpl_matrix_new(3, 3);

        cxdouble angle[3] = {phi, theta, psi};
        cxdouble *_R = cpl_matrix_get_data(R);


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

            cxdouble sa = sin(angle[i]);
            cxdouble ca = cos(angle[i]);

            cpl_matrix *mt = NULL;


            cpl_matrix_fill(R, 0.);

            switch (_mode[i]) {
                case 'x':
                {
                    _R[0] =  1.;
                    _R[4] =  ca;
                    _R[5] =  sa;
                    _R[7] = -sa;
                    _R[8] =  ca;
                    break;
                }

                case 'y':
                {
                    _R[0] =  ca;
                    _R[2] = -sa;
                    _R[4] =  1.;
                    _R[6] =  sa;
                    _R[8] =  ca;
                    break;
                }

                case 'z':
                {
                    _R[0] =  ca;
                    _R[1] =  sa;
                    _R[3] = -sa;
                    _R[4] =  ca;
                    _R[8] =  1.;
                    break;
                }

                default:
                {
                    /* Invalid axis designation */

                    cpl_matrix_delete(R);
                    cpl_matrix_delete(self);

                    cx_free((cxchar*)_mode);

                    return NULL;
                    break;
                }

            }

            mt = cpl_matrix_product_create(R, self);

            cpl_matrix_delete(self);
            self = mt;

        }

        cpl_matrix_delete(R);
        cx_free((cxchar *)_mode);

    }

    return self;

}


/**
 * @brief
 *   Generate the matrix of precession between two epochs.
 *
 * @param epoch1  Initial fixed epoch
 * @param epoch2  Epoch of the date
 *
 * @return
 *   The matrix of general precession
 *
 * The function generates the 3 x 3 precession matrix from an arbitrary, fixed
 * start epoch @em epoch1 to the epoch of date @em epoch2, using the
 * model of Simon et al. (1994), which is suitable for long periods of time.
 *
 * The function is modeled following the idea of the slalib routine slPREL
 * (P. T. Wallace / Starlink, 23 August 1996). The code is based on the
 * constants and formulae given in Simon et al. (cf. example code prcupd.f)
 *
 * Reference:
 *   Simon, J. L., et al., 1994 A&A 282, 663
 */

inline static cpl_matrix *
_giraffe_precession_matrix(cxdouble epoch0, cxdouble epoch1)
{

    /*
     * Variable names follow the notation of Simon et al.
     */

    const cxdouble sigma0 = 2000.;    /* The basic epoch of J2000 */
    const cxdouble sigmaF = epoch0;   /* The arbitrary fixed epoch */
    const cxdouble sigmaD = epoch1;   /* The epoch of the date */

    /*
     *  Time differences between the given epochs, in units of 1000 years:
     *
     *  JD(sigmaF) - JD(sigma0) / 365250.
     *  JD(sigmaD) - JD(sigmaF) / 365250.
     */

    const cxdouble T = (sigmaF - sigma0) / 1000.;
    const cxdouble t = (sigmaD - sigmaF) / 1000.;


    cpl_matrix *mprc = NULL;

    cxdouble thetaA = RV_DAS2R;
    cxdouble zetaA  = RV_DAS2R;
    cxdouble zA     = RV_DAS2R;

    cxdouble T2 = T  * T;
    cxdouble T3 = T2 * T;
    cxdouble T4 = T3 * T;
    cxdouble T5 = T4 * T;

    cxdouble t2 = t  * t;
    cxdouble t3 = t2 * t;
    cxdouble t4 = t3 * t;
    cxdouble t5 = t4 * t;
    cxdouble t6 = t5 * t;


    /*
     * Compute the Euler angles (in units of radians)
     *
     * The constants in the following are the constants given in the example
     * code prcupd.f of Simon et al. (1994) converted to units of arcsec
     * (the constants in the example are given in units of 1/10000 arcsec).
     */


    thetaA *= (20042.0207 - 85.3131 * T - 0.2111  * T2 + 0.3642  * T3 +
               0.0008  * T4 -0.0005  * T5) * t +
              (-42.6566 - 0.2111 * T + 0.5463 * T2 + 0.0017 * T3 -
               0.0012 * T4) * t2 +
              (-41.8238 + 0.0359 * T + 0.0027 * T2 - 0.0001 * T3) * t3 +
              (-0.0731 + 0.0019 * T + 0.0009 * T2) * t4 +
              (-0.0127 + 0.0011 * T) * t5 +
              (0.0004) * t6;

    zetaA *= (23060.9097 + 139.7495 * T - 0.0038 * T2 - 0.5918 * T3 -
              0.0037 * T4 + 0.0007 * T5) * t +
             (30.2226 - 0.2523 * T - 0.3840 * T2 - 0.0014 * T3 +
              0.0007 * T4) * t2 +
             (18.0183 - 0.1326 * T + 0.0006 * T2 + 0.0005 * T3) * t3 +
             (-0.0583 - 0.0001 * T + 0.0007 * T2) * t4 +
             (-0.0285) * t5 +
             (-0.0002) * t6;

    zA *= (23060.9097 + 139.7495 * T - 0.0038 * T2 - 0.5918 * T3 -
           0.0037 * T4 + 0.0007 * T5) * t +
          (109.5270 + 0.2446 * T - 1.3913 * T2 - 0.0134 * T3 +
           0.0026 * T4) * t2 +
          (18.2667 - 1.1400 * T - 0.0173 * T2 + 0.0044 * T3) * t3 +
          (-0.2821 - 0.0093 * T + 0.0032 * T2) * t4 +
          (-0.0301 + 0.0006 * T) * t5 +
          (-0.0001) * t6;


    /*
     *  Create precession matrix
     */

    mprc = _giraffe_create_rotation("zyz", -zetaA, thetaA, -zA);

    return mprc;

}


/*
 * @brief
 *  Compute the mean local sideral time
 *
 * @param djd    julian date
 * @param dlong  observer's longitude (radians)
 *
 * @return
 *   Mean local sideral time (radians).
 *
 * @note
 *  Constants taken from the american ephemeris and nautical almanac, 1980)
 *  Translated from the FORTRAN version written by G. Torres (1989)
 */

inline static cxdouble
sideral_time(cxdouble djd, cxdouble dlong)
{

    /*
     * Constants D1,D2,D3 for calculating Greenwich
     * Mean Sideral Time at 0 UT
     */

    const cxdouble d1 = 1.739935934667999;
    const cxdouble d2 = 6.283319509909095e02;
    const cxdouble d3 = 6.755878646261384e-06;

    const cxdouble df = 1.00273790934;

    cxdouble dut  = 0.;
    cxdouble dt   = 0.;
    cxdouble dst0 = 0.;
    cxdouble dst  = 0.;
    cxdouble djd0 = floor(djd) + 0.5;

    if (djd0 > djd) {
        djd0 -= 1.;
    }

    dut = (djd - djd0) * RV_D2PI;

    dt = (djd0 - dct0) / dcjul;
    dst0 = d1 + d2 * dt + d3 * dt * dt;
    dst0 = fmod(dst0, RV_D2PI);
    dst = df * dut + dst0 - dlong;
    dst = fmod(dst + RV_D4PI, RV_D2PI);

    return dst;

}


/*
 * @brief
 *  Compute correction from topocentric radial velocity to geocentric.
 *
 * @param dlat  observer's geodetic latitude (radians)
 * @param dalt  observer's elevation above sea level (meters)
 * @param dec   star's declination (radians) for mean
 *              equator and equinox of date
 * @param dha   star's hour angle (radians)
 *
 * @return
 *  Geocentric correction in km/s.
 *
 * Calculates the correction required to transform the topocentric radial
 * velocity of a given star to geocentric. The maximum error of this
 * routine is not expected to be larger than 0.1 m/s.
 *
 * @note
 *  vr = r.w.cos(dec).sin(hour angle), where r = geocentric radius at
 *  observer's latitude and elevation, and w = 2.pi/t, t = length of sideral
 *  day 23 hours 56 minutes and 4 seconds in seconds.
 *  The hour angle is positive east of the meridian.
 *  Other relevant equations from E. W. Woolard & G. M. Clemence (1966),
 *  Spherical Astronomy,  p.45 and p.48
 *
 * Author:
 *  - G. Torres (1989)
 *  - G. Simond (C translation)
 */

inline static cxdouble
geo_correction(cxdouble dlat, cxdouble dalt, cxdouble dec, cxdouble dha)
{

    /*
     * Earth's equatorial radius (km)  (Geod. ref. sys., 1980)
     */

    const cxdouble da = 6378.137;

    /*
     * Polar flattening (Geod. ref. sys., 1980)
     */

    const cxdouble df =  1./298.257222;

    /*
     * Angular rotation rate (2.pi/t)
     */

    const cxdouble dw = RV_D2PI/86164.;


    const cxdouble de2 = df * (2.0 - df);
    const cxdouble dsdlats = sin (dlat) * sin (dlat);

    cxdouble d1    = 0.;
    cxdouble d2    = 0.;
    cxdouble dr0   = 0.;
    cxdouble dlatg = 0.;
    cxdouble drh   = 0.;
    cxdouble dvelg = 0.;


    /*
     * Calculate geocentric radius dr0 at sea level (km)
     */

    d1 = 1.0 - de2 * (2.0 - de2) * dsdlats;
    d2 = 1.0 - de2 * dsdlats;
    dr0 = da * sqrt(d1 / d2);


    /*
     * Calculate geocentric latitude dlatg
     */

    d1 = de2 * sin(2.0 * dlat);
    d2 = 2.0 * d2;
    dlatg = dlat - atan(d1 / d2);


    /*
     * Calculate geocentric radius drh at elevation dalt (km)
     */

    drh = dr0 * cos(dlatg) + (dalt / 1000.) * cos(dlat);


    /*
     * Projected component to star at declination = dec and
     * at hour angle = dha, in units of km/s
     */

    dvelg = dw * drh * cos(dec) * sin(dha);

    return dvelg;

}


/*
 * @brief
 *  Compute the heliocentric and barycentric velocity components of the earth.
 *
 *  @param dje  Julian ephermeris date
 *  @param deq  Epoch of mean equator and mean equinox of @em hvel
 *              and @em bvel. If @em deq is @c 0, both vectors refer
 *              to the mean equator and equinox of @em dje
 *
 * @return
 *  The components (dx/dt, dy/dt, dz/dt, k=1,2,3  A.U./s) of the
 *  heliocentric and barycentric velocity are returned in the
 *  vectors @em hvel and @em bvel respectively.
 *
 * Calculates the heliocentric and barycentric velocity components
 * of the earth.  The largest deviations from the JPL-de96 ephemeris
 * are 42 cm/s for both heliocentric and barycentric velocity
 * components.
 *
 * @note
 *  vr = r.w.cos(dec).sin(hour angle), where r = geocentric radius at
 *  observer's latitude and elevation, and w = 2.pi/t, t = length of sideral
 *  day (sec). The hour angle is positive east of the meridian.
 *  Other relevant equations from E. W. Woolard  & G. M. Clemence (1966),
 *  Spherical Astronomy,  p.45 and p.48
 *
 * Authors:
 *  - P. Stumpff (ibm-version 1979): astron. astrophys. suppl. ser. 41,
 *    1 (1980)
 *  - M. H.Slovak (vax 11/780 implementation 1986)
 *  - G. Torres (1989)
 *  - G. Simond (C translation)
 */

inline static void
earth_velocity(cxdouble dje, cxdouble deq, cxdouble* const hvel,
               cxdouble* const bvel)
{


    /*
     * Constants dcfel(i, k) of fast-changing elements
     *
     *   i = 1          i = 2                 i = 3
     */

    const cxdouble dcfel[][3] = {
        {1.7400353e+00, 6.2833195099091e+02,  5.2796e-06},
        {6.2565836e+00, 6.2830194572674e+02, -2.6180e-06},
        {4.7199666e+00, 8.3997091449254e+03, -1.9780e-05},
        {1.9636505e-01, 8.4334662911720e+03, -5.6044e-05},
        {4.1547339e+00, 5.2993466764997e+01,  5.8845e-06},
        {4.6524223e+00, 2.1354275911213e+01,  5.6797e-06},
        {4.2620486e+00, 7.5025342197656e+00,  5.5317e-06},
        {1.4740694e+00, 3.8377331909193e+00,  5.6093e-06}
    };


    /*
     * Constants dceps and ccsel(i,k) of slowly changing elements
     *
     *  i = 1          i = 2          i = 3
     */

    const cxdouble dceps[3] = {
         4.093198e-01,
        -2.271110e-04,
        -2.860401e-08
    };

    const cxdouble ccsel[][3] = {
        {1.675104e-02, -4.179579e-05, -1.260516e-07},
        {2.220221e-01,  2.809917e-02,  1.852532e-05},
        {1.589963e+00,  3.418075e-02,  1.430200e-05},
        {2.994089e+00,  2.590824e-02,  4.155840e-06},
        {8.155457e-01,  2.486352e-02,  6.836840e-06},
        {1.735614e+00,  1.763719e-02,  6.370440e-06},
        {1.968564e+00,  1.524020e-02, -2.517152e-06},
        {1.282417e+00,  8.703393e-03,  2.289292e-05},
        {2.280820e+00,  1.918010e-02,  4.484520e-06},
        {4.833473e-02,  1.641773e-04, -4.654200e-07},
        {5.589232e-02, -3.455092e-04, -7.388560e-07},
        {4.634443e-02, -2.658234e-05,  7.757000e-08},
        {8.997041e-03,  6.329728e-06, -1.939256e-09},
        {2.284178e-02, -9.941590e-05,  6.787400e-08},
        {4.350267e-02, -6.839749e-05, -2.714956e-07},
        {1.348204e-02,  1.091504e-05,  6.903760e-07},
        {3.106570e-02, -1.665665e-04, -1.590188e-07}
    };


    /*
     * Constants of the arguments of the short-period perturbations by
     * the planets: dcargs(i, k)
     *
     *   i = 1        i = 2
     */

    const cxdouble dcargs[][2] = {
        {5.0974222e+00, -7.8604195454652e+02},
        {3.9584962e+00, -5.7533848094674e+02},
        {1.6338070e+00, -1.1506769618935e+03},
        {2.5487111e+00, -3.9302097727326e+02},
        {4.9255514e+00, -5.8849265665348e+02},
        {1.3363463e+00, -5.5076098609303e+02},
        {1.6072053e+00, -5.2237501616674e+02},
        {1.3629480e+00, -1.1790629318198e+03},
        {5.5657014e+00, -1.0977134971135e+03},
        {5.0708205e+00, -1.5774000881978e+02},
        {3.9318944e+00,  5.2963464780000e+01},
        {4.8989497e+00,  3.9809289073258e+01},
        {1.3097446e+00,  7.7540959633708e+01},
        {3.5147141e+00,  7.9618578146517e+01},
        {3.5413158e+00, -5.4868336758022e+02}
    };


    /*
     * Amplitudes ccamps(n, k) of the short-period perturbations
     *
     *   n = 1          n = 2         n = 3         n = 4        n = 5
     */

    const cxdouble ccamps[][5] = {
        {-2.279594e-5,  1.407414e-5,  8.273188e-6,  1.340565e-5, -2.490817e-7},
        {-3.494537e-5,  2.860401e-7,  1.289448e-7,  1.627237e-5, -1.823138e-7},
        { 6.593466e-7,  1.322572e-5,  9.258695e-6, -4.674248e-7, -3.646275e-7},
        { 1.140767e-5, -2.049792e-5, -4.747930e-6, -2.638763e-6, -1.245408e-7},
        { 9.516893e-6, -2.748894e-6, -1.319381e-6, -4.549908e-6, -1.864821e-7},
        { 7.310990e-6, -1.924710e-6, -8.772849e-7, -3.334143e-6, -1.745256e-7},
        {-2.603449e-6,  7.359472e-6,  3.168357e-6,  1.119056e-6, -1.655307e-7},
        {-3.228859e-6,  1.308997e-7,  1.013137e-7,  2.403899e-6, -3.736225e-7},
        { 3.442177e-7,  2.671323e-6,  1.832858e-6, -2.394688e-7, -3.478444e-7},
        { 8.702406e-6, -8.421214e-6, -1.372341e-6, -1.455234e-6, -4.998479e-8},
        {-1.488378e-6, -1.251789e-5,  5.226868e-7, -2.049301e-7,  0.0e0},
        {-8.043059e-6, -2.991300e-6,  1.473654e-7, -3.154542e-7,  0.0e0},
        { 3.699128e-6, -3.316126e-6,  2.901257e-7,  3.407826e-7,  0.0e0},
        { 2.550120e-6, -1.241123e-6,  9.901116e-8,  2.210482e-7,  0.0e0},
        {-6.351059e-7,  2.341650e-6,  1.061492e-6,  2.878231e-7,  0.0e0}
    };


    /*
     * Constants of the secular perturbations in longitude
     * ccsec3 and ccsec(n,k)
     *   n = 1         n = 2         n = 3
     */

    const cxdouble ccsec3 = -7.757020e-08;

    const cxdouble ccsec[][3] = {
        {1.289600e-06, 5.550147e-01, 2.076942e+00},
        {3.102810e-05, 4.035027e+00, 3.525565e-01},
        {9.124190e-06, 9.990265e-01, 2.622706e+00},
        {9.793240e-07, 5.508259e+00, 1.559103e+01}
    };


    /*
     * Sideral rate dcsld in longitude, rate ccsgd in mean anomaly
     */

    const cxdouble dcsld = 1.990987e-07;
    const cxdouble ccsgd = 1.990969e-07;


    /*
     * Some constants used in the calculation of the
     * lunar contribution
     */

    const cxdouble cckm  = 3.122140e-05;
    const cxdouble ccmld = 2.661699e-06;
    const cxdouble ccfdi = 2.399485e-07;


    /*
     * Constants dcargm(i,k) of the arguments of the
     * perturbations of the motion of the moon
     *
     *   i = 1          i = 2
     */

    const cxdouble dcargm[][2] = {
        {5.1679830e+00,  8.3286911095275e+03},
        {5.4913150e+00, -7.2140632838100e+03},
        {5.9598530e+00,  1.5542754389685e+04}
    };


    /*
     * Amplitudes ccampm(n,k) of the perturbations of the moon
     *    n = 1         n = 2         n = 3         n = 4
     */

    const cxdouble ccampm[][4] = {
        { 1.097594e-01, 2.896773e-07, 5.450474e-02,  1.438491e-07},
        {-2.223581e-02, 5.083103e-08, 1.002548e-02, -2.291823e-08},
        { 1.148966e-02, 5.658888e-08, 8.249439e-03,  4.063015e-08}
    };


    /*
     * ccpamv = a * m * dl/dt (planets)
     */

    const cxdouble ccpamv[4] = {
        8.326827e-11,
        1.843484e-11,
        1.988712e-12,
        1.881276e-12
    };


    /*
     * dc1mme = 1 - mass(earth + moon)
     */

    const cxdouble dc1mme = 0.99999696;


    register cxint k = 0;
    register cxint n = 0;

    cxint ideq = 0;

    cxdouble a      = 0.;
    cxdouble b      = 0.;
    cxdouble f      = 0.;
    cxdouble dt     = 0.;
    cxdouble t      = 0.;
    cxdouble tl     = 0.;
    cxdouble dtsq   = 0.;
    cxdouble tsq    = 0.;
    cxdouble dml    = 0.;
    cxdouble dlocal = 0.;
    cxdouble deps   = 0.;
    cxdouble pertl  = 0.;
    cxdouble pertld = 0.;
    cxdouble pertr  = 0.;
    cxdouble pertrd = 0.;
    cxdouble pertp  = 0.;
    cxdouble pertpd = 0.;
    cxdouble sina   = 0.;
    cxdouble cosa   = 0.;
    cxdouble twoe   = 0.;
    cxdouble twog   = 0.;
    cxdouble param  = 0.;
    cxdouble dparam = 0.;
    cxdouble dpsi   = 0.;
    cxdouble phi    = 0.;
    cxdouble phid   = 0.;
    cxdouble psid   = 0.;
    cxdouble sin_f  = 0.;
    cxdouble cos_f  = 0.;
    cxdouble esq    = 0.;
    cxdouble d1pdro = 0.;
    cxdouble drd    = 0.;
    cxdouble drld   = 0.;
    cxdouble dsinls = 0.;
    cxdouble dcosls = 0.;
    cxdouble dtl    = 0.;
    cxdouble dxhd   = 0.;
    cxdouble dyhd   = 0.;
    cxdouble dzhd   = 0.;
    cxdouble sinlm  = 0.;
    cxdouble coslm  = 0.;
    cxdouble sigma  = 0.;
    cxdouble plon   = 0.;
    cxdouble pomg   = 0.;
    cxdouble dxbd   = 0.;
    cxdouble dybd   = 0.;
    cxdouble dzbd   = 0.;
    cxdouble pecc   = 0.;
    cxdouble dcosep = 0.;
    cxdouble dsinep = 0.;
    cxdouble dyahd  = 0.;
    cxdouble dzahd  = 0.;
    cxdouble dyabd  = 0.;
    cxdouble dzabd  = 0.;
    cxdouble sn[4]      = {0., 0., 0., 0.};
    cxdouble sinlp[4]   = {0., 0., 0., 0.};
    cxdouble coslp[4]   = {0., 0., 0., 0.};
    cxdouble forbel[7]  = {0., 0., 0., 0., 0., 0., 0.};
    cxdouble sorbel[17];


    memset(sorbel, 0, sizeof sorbel);


    /*
     * Control-parameter ideq, and time-arguments
     */

    ideq = (cxint)deq;
    dt = (dje - dct0) / dcjul;
    t = dt;
    dtsq = dt * dt;
    tsq = dtsq;


    /*
     * Values of all elements for the instant dje
     */

    for (k = 0; k < 8; k++) {

        dlocal = fmod(dcfel[k][0] + dt * dcfel[k][1] + dtsq * dcfel[k][2],
                         RV_D2PI);

        if (k == 0) {
            dml = dlocal;
        }

        if (k != 0) {
            forbel[k - 1] = dlocal;
        }

    }

    deps = fmod(dceps[0] + dt * dceps[1] + dtsq * dceps[2], RV_D2PI);

    for (k = 0; k < 17; k++) {

        sorbel[k] = fmod(ccsel[k][0] + t * ccsel[k][1] + tsq * ccsel[k][2],
                         RV_D2PI);

    }


    /*
     * Secular perturbations in longitude
     */

    for (k = 0; k < 4; k++) {

        a = fmod(ccsec[k][1] + t * ccsec[k][2], RV_D2PI);
        sn[k] = sin(a);

    }


    /*
     * Periodic perturbations of the earth-moon barycenter
     */

    pertl = ccsec[0][0] * sn[0] + ccsec[1][0] * sn[1] +
        (ccsec[2][0] + t * ccsec3) * sn[2] + ccsec[3][0] * sn[3];

    pertld = 0.;
    pertr  = 0.;
    pertrd = 0.;

    for (k = 0; k < 15; k++) {

        a = fmod(dcargs[k][0] + dt * dcargs[k][1], RV_D2PI);
        cosa = cos (a);
        sina = sin (a);
        pertl += (ccamps[k][0] * cosa + ccamps[k][1] * sina);
        pertr += (ccamps[k][2] * cosa + ccamps[k][3] * sina);

        if (k >= 10) {
            continue;
        }

        pertld += ((ccamps[k][1] * cosa - ccamps[k][0] * sina) * ccamps[k][4]);
        pertrd += ((ccamps[k][3] * cosa - ccamps[k][2] * sina) * ccamps[k][4]);

    }


    /*
     * Elliptic part of the motion of the earth-moon barycenter
     */

    esq = sorbel[0] * sorbel[0];
    dparam = 1. - esq;
    param = dparam;
    twoe = sorbel[0] + sorbel[0];
    twog = forbel[0] + forbel[0];
    phi = twoe * ((1.0 - esq * (1.0 / 8.0)) * sin (forbel[0]) +
                  sorbel[0] * (5.0 / 8.0) * sin (twog) +
                  esq * 0.5416667 * sin (forbel[0] + twog));
    f = forbel[0] + phi;
    sin_f = sin(f);
    cos_f = cos(f);
    dpsi = dparam / (1. + sorbel[0] * cos_f);
    phid = twoe * ccsgd * ((1.0 + esq * 1.50) * cos_f +
                           sorbel[0] * (1.250 - sin_f * sin_f * 0.50));
    psid = ccsgd * sorbel[0] * sin_f / sqrt(param);


    /*
     * Perturbed heliocentric motion of the earth-moon barycenter
     */

    d1pdro = 1. + pertr;
    drd = d1pdro * (psid + dpsi * pertrd);
    drld = d1pdro * dpsi * (dcsld + phid + pertld);
    dtl = fmod(dml + phi + pertl, RV_D2PI);
    dsinls = sin(dtl);
    dcosls = cos(dtl);
    dxhd = drd * dcosls - drld * dsinls;
    dyhd = drd * dsinls + drld * dcosls;


    /*
     * Influence of eccentricity, evection and variation of
     * the geocentric motion of the moon
     */

    pertl  = 0.;
    pertld = 0.;
    pertp  = 0.;
    pertpd = 0.;

    for (k = 0; k < 3; k++) {

        a = fmod(dcargm[k][0] + dt * dcargm[k][1], RV_D2PI);
        sina = sin(a);
        cosa = cos(a);
        pertl += ccampm[k][0] * sina;
        pertld += ccampm[k][1] * cosa;
        pertp += ccampm[k][2] * cosa;
        pertpd -= ccampm[k][3] * sina;

    }


    /*
     * Heliocentric motion of the earth
     */

    tl = forbel[1] + pertl;
    sinlm = sin(tl);
    coslm = cos(tl);
    sigma = cckm / (1. + pertp);
    a = sigma * (ccmld + pertld);
    b = sigma * pertpd;
    dxhd = dxhd + a * sinlm + b * coslm;
    dyhd = dyhd - a * coslm + b * sinlm;
    dzhd = -sigma * ccfdi * cos(forbel[2]);


    /*
     * Barycentric motion of the earth
     */

    dxbd = dxhd * dc1mme;
    dybd = dyhd * dc1mme;
    dzbd = dzhd * dc1mme;

    for (k = 0; k < 4; k++) {

        plon = forbel[k + 3];
        pomg = sorbel[k + 1];
        pecc = sorbel[k + 9];
        tl = fmod(plon + 2.0 * pecc * sin (plon - pomg), RV_D2PI);
        sinlp[k] = sin(tl);
        coslp[k] = cos(tl);
        dxbd = dxbd + ccpamv[k] * (sinlp[k] + pecc * sin(pomg));
        dybd = dybd - ccpamv[k] * (coslp[k] + pecc * cos(pomg));
        dzbd = dzbd - ccpamv[k] * sorbel[k + 13] * cos(plon - sorbel[k + 5]);

    }


    /*
     * Transition to mean equator of date
     */

    dcosep = cos(deps);
    dsinep = sin(deps);
    dyahd = dcosep * dyhd - dsinep * dzhd;
    dzahd = dsinep * dyhd + dcosep * dzhd;
    dyabd = dcosep * dybd - dsinep * dzbd;
    dzabd = dsinep * dybd + dcosep * dzbd;

    if (ideq == 0) {

        hvel[0] = dxhd;
        hvel[1] = dyahd;
        hvel[2] = dzahd;

        bvel[0] = dxbd;
        bvel[1] = dyabd;
        bvel[2] = dzabd;

    }
    else {

        /*
         * General precession from epoch dje to deq
         */

        cxdouble deqdat = (dje - dct0 - dcbes) / dctrop + dc1900;

        cpl_matrix* prec = _giraffe_precession_matrix(deqdat, deq);


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

            hvel[n] =
                dxhd  * cpl_matrix_get(prec, 0, n) +
                dyahd * cpl_matrix_get(prec, 1, n) +
                dzahd * cpl_matrix_get(prec, 2, n);

            bvel[n] =
                dxbd  * cpl_matrix_get(prec, 0, n) +
                dyabd * cpl_matrix_get(prec, 1, n) +
                dzabd * cpl_matrix_get(prec, 2, n);
        }

        cpl_matrix_delete(prec);

    }

    return;

}


/*
 * Public functions
 */

/**
 * @brief
 *  Compute heliocentric, barycentric and  geocentric correction.
 *
 * @param rv         Result structure to store the computed corrections
 * @param jdate      Heliocentric Julian date (days)
 * @param longitude  Geodetic longitude (degrees, west positive)
 * @param latitude   Geodetic latitude (degrees)
 * @param elevation  Altitude above sea level (meters)
 * @param ra         Right ascension of star (hours)
 * @param dec        Declination of star (degrees)
 * @param equinox    Mean equator and equinox for coordinates e.g., 1950.0
 *
 * @return
 *  Nothing.
 * @retval bcvel - Barycentric correction (km/s)
 * @retval hcvel - Heliocentric correction (km/s)
 * @retval gcvel - Geocentric correction (km/s)
 *
 * Calculates the correction required to reduce observed (topocentric)
 * radial velocities of a given star to the barycenter of the solar system.
 * It includes correction for the effect of the earth's rotation.
 * The maximum error of this routine is not expected to be larger than
 * 0.6 m/sec
 *
 * The computed corrections are in km / s.
 *
 * Authors:
 *   - G. Torres (1989)
 *   - Modified by D. Mink
 *   - G. Simond (C translation)
 */

void
giraffe_rvcorrection_compute(GiRvCorrection* rv,
                             cxdouble jdate, cxdouble longitude,
                             cxdouble latitude, cxdouble elevation,
                             cxdouble ra, cxdouble dec,
                             cxdouble equinox)
{

    cxint i = 0;

    const cxdouble aukm = 1.4959787e08;   /* 1 UA = 149 597 870 km */

    cxdouble eqt    = 0.;
    cxdouble ha     = 0.;
    cxdouble ra2    = 0.;
    cxdouble dec2   = 0.;
    cxdouble dc[3]  = {0., 0., 0.};
    cxdouble dcc[3] = {0., 0., 0.};
    cxdouble hv[3]  = {0., 0., 0.};
    cxdouble bv[3]  = {0., 0., 0.};
    cxdouble _long  = longitude * RV_DD2R;
    cxdouble _lat   = latitude * RV_DD2R;
    cxdouble _ra    = ra * 15.0 * RV_DD2R;
    cxdouble _dec   = dec * RV_DD2R;
    cxdouble st     = sideral_time(jdate, _long);

    cpl_matrix* precession = NULL;


    /*
     * Precess r.a. and dec. to mean equator and equinox of date
     */

    eqt = (jdate - dct0 - dcbes) / dctrop + dc1900;

    dc[0] = cos(_ra) * cos(_dec);
    dc[1] = sin(_ra) * cos(_dec);
    dc[2] = sin(_dec);

    precession = _giraffe_precession_matrix(equinox, eqt);

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

        dcc[i] =
            dc[0] * cpl_matrix_get(precession, i, 0) +
            dc[1] * cpl_matrix_get(precession, i, 1) +
            dc[2] * cpl_matrix_get(precession, i, 2);

    }

    cpl_matrix_delete(precession);
    precession = NULL;


    if (dcc[0] != 0.) {

        cxdouble darg = dcc[1] / dcc[0];


        ra2 = atan(darg);

        if (dcc[0] < 0.) {
            ra2 += RV_DPI;
        }
        else {
            if (dcc[1] < 0.) {
                ra2 += RV_D2PI;
            }
        }

    }
    else {

        if (dcc[1] > 0.) {
            ra2 = RV_DPIBY2;
        }
        else {
            ra2 = 1.5 * RV_DPI;
        }

    }

    dec2 = asin(dcc[2]);


    /*
     * Calculate hour angle = local sideral time - r.a.
     */

    ha = st - ra2;


    /*
     * Calculate observer's geocentric velocity
     * (elevation assumed to be zero)
     */

    rv->gc = geo_correction(_lat, elevation, dec2, -ha);


    /*
     * Calculate components of earth's barycentric velocity,
     * bvel(i), i=1,2,3  in units of a.u./s
     */

    earth_velocity (jdate, eqt, hv, bv);


    /*
     * Project barycentric velocity to the direction of the
     * star, and convert to km/s
     */

    rv->bc = 0.;
    rv->hc = 0.;

    for (i = 0; i < 3; ++i) {
        rv->bc += bv[i] * dcc[i] * aukm;
        rv->hc += hv[i] * dcc[i] * aukm;
    }

    return;

}
/**@}*/
