/* $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 <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) */


/*
 * Slalib functions
 */

/*
 *  - - - - - - - - - -
 *   s l a D e u l e r
 *  - - - - - - - - - -
 *
 *  Form a rotation matrix from the Euler angles - three successive
 *  rotations about specified Cartesian axes.
 *
 *  (double precision)
 *
 *  Given:
 *    *order char     specifies about which axes the rotations occur
 *    phi    double   1st rotation (radians)
 *    theta  double   2nd rotation (   "   )
 *    psi    double   3rd rotation (   "   )
 *
 *  Returned:
 *    Matrix   rmat  rotation matrix
 *
 *  A rotation is positive when the reference frame rotates
 *  anticlockwise as seen looking towards the origin from the
 *  positive region of the specified axis.
 *
 *  The characters of order define which axes the three successive
 *  rotations are about.  A typical value is 'zxz', indicating that
 *  rmat is to become the direction cosine matrix corresponding to
 *  rotations of the reference frame through phi radians about the
 *  old z-axis, followed by theta radians about the resulting x-axis,
 *  then psi radians about the resulting z-axis.
 *
 *  The axis names can be any of the following, in any order or
 *  combination:  x, y, z, uppercase or lowercase, 1, 2, 3.  Normal
 *  axis labelling/numbering conventions apply;  the xyz (=123)
 *  triad is right-handed.  Thus, the 'zxz' example given above
 *  could be written 'zxz' or '313' (or even 'zxz' or '3xz').  Order
 *  is terminated by length or by the first unrecognized character.
 *
 *  Fewer than three rotations are acceptable, in which case the later
 *  angle arguments are ignored.  Zero rotations leaves rmat set to the
 *  identity matrix.
 *
 *  Last revision:   9 December 1996
 *
 *  Copyright P.T.Wallace.  All rights reserved.
 */

inline static void
slaDeuler(const cxchar* order, cxdouble phi, cxdouble theta, cxdouble psi,
          cpl_matrix* rmat)
{
    register cxint j, i, l, n, k;
    cxdouble result[3][3], rotn[3][3], angle, s, c , w, wm[3][3];
    cxchar axis;

    /* Initialize result matrix */
    for ( j = 0; j < 3; j++ ) {
        for ( i = 0; i < 3; i++ ) {
            result[i][j] = ( i == j ) ? 1.0 : 0.0;
        }
    }

    /* Establish length of axis string */
    l = strlen ( order );

    /* Look at each character of axis string until finished */
    for ( n = 0; n < 3; n++ ) {
        if ( n <= l ) {

            /* Initialize rotation matrix for the current rotation */
            for ( j = 0; j < 3; j++ ) {
                for ( i = 0; i < 3; i++ ) {
                    rotn[i][j] = ( i == j ) ? 1.0 : 0.0;
                }
            }

            /* Pick up the appropriate Euler angle and take sine & cosine */
            switch ( n ) {
            case 0 :
                angle = phi;
                break;
            case 1 :
                angle = theta;
                break;
            default:
                angle = psi;
                break;
            }
            s = sin ( angle );
            c = cos ( angle );

            /* Identify the axis */
            axis =  order[n];
            if ( ( axis == 'X' ) || ( axis == 'x' ) || ( axis == '1' ) ) {

                /* Matrix for x-rotation */
                rotn[1][1] = c;
                rotn[1][2] = s;
                rotn[2][1] = -s;
                rotn[2][2] = c;
            }
            else if ( ( axis == 'Y' ) || ( axis == 'y' ) || ( axis == '2' ) ) {

                /* Matrix for y-rotation */
                rotn[0][0] = c;
                rotn[0][2] = -s;
                rotn[2][0] = s;
                rotn[2][2] = c;
            }
            else if ( ( axis == 'Z' ) || ( axis == 'z' ) || ( axis == '3' ) ) {

                /* Matrix for z-rotation */
                rotn[0][0] = c;
                rotn[0][1] = s;
                rotn[1][0] = -s;
                rotn[1][1] = c;
            }
            else {

                /* Unrecognized character - fake end of string */
                l = 0;
            }

            /* Apply the current rotation (matrix rotn x matrix result) */
            for ( i = 0; i < 3; i++ ) {
                for ( j = 0; j < 3; j++ ) {
                    w = 0.0;
                    for ( k = 0; k < 3; k++ ) {
                        w += rotn[i][k] * result[k][j];
                    }
                    wm[i][j] = w;
                }
            }
            for ( j = 0; j < 3; j++ ) {
                for ( i= 0; i < 3; i++ ) {
                    result[i][j] = wm[i][j];
                }
            }
        }
    }

    /* Copy the result */
    for ( j = 0; j < 3; j++ ) {
        for ( i = 0; i < 3; i++ ) {
            cpl_matrix_set(rmat, i, j, result[i][j]);
        }
    }

    return;

}


/*
 * @brief
 *  Calculates the matrix of general precession from ep0 to ep1
 *
 * @param ep0  Initial epoch of mean equator and equinox e.g., 1950.0
 * @param ep1  Final epoch of mean equator and equinox
 *
 * @return
 *   The 3 x 3 matrix of general precession.
 *
 * Form the matrix of precession between two epochs, using the
 * model of Simon et al (1994), which is suitable for long
 * periods of time.
 *
 * @notes
 *   -# The epochs are TDB (loosely ET) Julian epochs.
 *   -# The matrix is in the sense   v(ep1)  =  rmatp * v(ep0)
 *   -# The absolute accuracy of the model is limited by the
 *      uncertainty in the general precession, about 0.3 arcsec per
 *      1000 years.  The remainder of the formulation provides a
 *      precision of 1 mas over the interval from 1000AD to 3000AD,
 *      0.1 arcsec from 1000BC to 5000AD and 1 arcsec from
 *      4000BC to 8000AD.
 *
 * Reference:
 *  Simon, J. L., et al., 1994. Astron.Astrophys., 282, 663-683.
 *
 * Author:
 *  P. T. Wallace. 23 August 1994
 */

inline static cpl_matrix*
slaPrecession (cxdouble ep0, cxdouble ep1)
{

    cxdouble t = 0.;
    cxdouble w = 0.;
    cxdouble z = 0.;
    cxdouble t0 = 0.;
    cxdouble zeta = 0.;
    cxdouble theta = 0.;
    cxdouble tas2r = 0.;

    cpl_matrix* mprec = NULL;


   /*
    * Interval between basic epoch J2000.0 and beginning epoch (1000JY)
    */

    t0 = ( ep0 - 2000.0 ) / 1000.0;


   /*
    * Interval over which precession required (1000JY)
    */

    t =  ( ep1 - ep0 ) / 1000.0;


   /*
    * Euler angles
    */

    tas2r = t * RV_DAS2R;
    w = 23060.9097 +
        (139.7459 +
         (-0.0038 +
          (-0.5918 +
           (-0.0037 +
            0.0007 * t0) * t0) * t0) * t0) * t0;

    zeta = (w +
            (30.2226 +
             (-0.2523 +
              (-0.3840 +
               (-0.0014 +
                0.0007 * t0) * t0) * t0) * t0 +
             (18.0183 +
              (-0.1326 +
               (0.0006 +
                0.0005 * t0) * t0) * t0 +
              (-0.0583 +
               (-0.0001 +
                0.0007 * t0) * t0 +
               (-0.0285 +
                -0.0002 * t) * t) * t) * t) * t) * tas2r;

    z = (w +
         (109.5270 +
          (0.2446 +
           (-1.3913 +
            (-0.0134 +
             0.0026 * t0) * t0) * t0) * t0 +
          (18.2667 +
           (-1.1400 +
            (-0.0173 +
             0.0044 * t0) * t0) * t0 +
           (-0.2821 +
            (-0.0093 +
             0.0032 * t0) * t0 +
            (-0.0301 +
             0.0006 * t0 +
             -0.0001 * t) * t) * t) * t) * t) * tas2r;

    theta = (20042.0207 +
             (-85.3131 +
              (-0.2111 +
               (0.3642 +
                (0.0008 +
                 -0.0005 * t0) * t0) * t0) * t0) * t0 +
             (-42.6566 +
              (-0.2111 +
               (0.5463 +
                (0.0017 +
                 -0.0012 * t0) * t0) * t0) * t0 +
              (-41.8238 +
               (0.0359 +
                (0.0027 +
                 -0.0001 * t0) * t0) * t0 +
               (-0.0731 +
                (0.0019 +
                 0.0009 * t0) * t0 +
                (-0.0127 +
                 0.0011 * t0 + 0.0004 * t) * t) * t) * t) * t) * tas2r;


   /*
    * Rotation matrix
    */

    mprec = cpl_matrix_new(3, 3);
    slaDeuler("ZYZ", -zeta, theta, -z, mprec);

    return mprec;

}



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

}
/**@}*/
