/*                                                                            *
 *   This file is part of the ESO SINFONI Pipeline                            *
 *   Copyright (C) 2004,2005 European Southern Observatory                    *
 *                                                                            *
 *   This library 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, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA     *
 *                                                                            */

/*
 * $Author: amodigli $
 * $Date: 2012-03-02 08:42:20 $
 * $Revision: 1.3 $
 * $Name: not supported by cvs2svn $
 *
 */

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


/**@{*/
/*---------------------------------------------------------------------------*/
/**
 * @defgroup sinfo_baryvel    Velocity correction
 *
 * Compute barycentric, heliocentric velocity corrections
 *
 * The code in this source file is a 1-to-1 translation of MIDAS COMPUT/BARYCOR
 * as defined in /prim/general/src/compxy.for (only the necessary parts were
 * translated). 
 * The code is not meant to be particularly readable/maintainable. 
 * To understand the computation the best starting point is probably
 * P. Stumpff, A&A Suppl. Ser. 41, pp. 1-8 (1980)
 *
 */
/*---------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------
  Includes
  ---------------------------------------------------------------------------*/

#include <sinfo_baryvel.h>

#include <sinfo_pfits.h>
#include <sinfo_utils.h>
#include <sinfo_error.h>
#include <sinfo_msg.h>
#include <sinfo_functions.h>

#include <cpl.h>

#include <math.h>


/*-----------------------------------------------------------------------------
  Local functions
  ---------------------------------------------------------------------------*/

static double sinfo_pfits_get_geolat(const cpl_propertylist * plist);
static double sinfo_pfits_get_geolon(const cpl_propertylist * plist);
static double sinfo_pfits_get_utc(const cpl_propertylist * plist);



static void deg2dms(double in_val, 
		    double *degs,
		    double *minutes,
		    double *seconds);

static void deg2hms(double in_val, 
		    double *hour,
		    double *min,
		    double *sec);

static void compxy(double inputr[19], char inputc[4],
		   double outputr[4],
		   double utr, double mod_juldat);

static void barvel(double DJE, double DEQ,
		   double DVELH[4], double DVELB[4]);




/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/**
  @brief    Find out the telescope latitude
  @param    plist       Header to read from
  @return   The requested value, or undefined on error
 */
/*--------------------------------------------------------------------------*/
static double sinfo_pfits_get_geolat(const cpl_propertylist * plist)
{
    double returnvalue = 0;
    
    check(returnvalue=cpl_propertylist_get_double(plist, H_GEOLAT), 
       "Error reading keyword '%s'", H_GEOLAT);
    
  cleanup:
    return returnvalue;
}

/*--------------------------------------------------------------------------*/
/**
  @brief    Find out the telescope longitude
  @param    plist       Header to read from
  @return   The requested value, or undefined on error
 */
/*--------------------------------------------------------------------------*/
static double sinfo_pfits_get_geolon(const cpl_propertylist * plist)
{
    double returnvalue = 0;

    check(returnvalue=cpl_propertylist_get_double(plist, H_GEOLON), 
       "Error reading keyword '%s'", H_GEOLON);
      
  cleanup:
    return returnvalue;
}




/*---------------------------------------------------------------------------*/
/**
  @brief    Find out the observation time
  @param    plist       Header to read from
  @return   The requested value, or undefined on error
 */
/*---------------------------------------------------------------------------*/
static double sinfo_pfits_get_utc(const cpl_propertylist * plist)
{
    double returnvalue = 0;

    check(returnvalue=cpl_propertylist_get_double(plist, H_UTC), 
       "Error reading keyword '%s'", H_UTC);
     
  cleanup:
    return returnvalue;
}



#if 0   /* Not used / needed.
	   We simply get the julian date from the input FITS header */

//      SUBROUTINE JULDAT(INDATE,UTR,JD)
//C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//C
//C.IDENTIFICATION
//C  FORTRAN subroutine                    JULDAT     version 1.0       870102
//C  original coding:                      D. Gillet        ESO - Garching
//C  variables renamed and restructured:   D. Baade         ST-ECF, Garching
//C
//C.KEYWORDS
//C  geocentric Julian date
//C
//C.PURPOSE
//C  calculate geocentric Julian date for any civil date (time in UT)
//C
//C.ALGORITHM
//C adapted from MEEUS J.,1980, ASTRONOMICAL FORMULAE FOR CALCULATORS
//C
//C.INPUT/OUTPUT
//C the following are passed from and to the calling program:
//C  INDATE(3)    :         civil date as year,month,day OR year.fraction
//C  UT           :         universal time expressed in real hours
//C  JD           :         real geocentric Julian date
//C
//C.REVISIONS
//C made to accept also REAL dates         D. Baade             910408
//C
//C---------------------------------------------------------------------------
//C

static void 
juldat(double *INDATE,
       double UTR,
       double *JD)
{
  double UT;

  int DATE[4];

  UT=UTR / 24.0;

  /*
    CHECK FORMAT OF DATE: may be either year,month,date OR year.fraction,0,0 
    (Note that the fraction of the year must NOT include fractions of a day.)
    For all other formats exit and terminate also calling command sequence.
  
    IF ((INDATE(1)-INT(INDATE(1))).GT.1.0E-6) THEN 
    IF ((INDATE(2).GT.1.0E-6).OR.(INDATE(3).GT.1.0E-6)) 
    +       CALL   STETER(1,'Error: Date was entered in wrong format.')

    copy date input buffer copy to other buffer so that calling program 
    does not notice any changes

    FIRST CASE: format was year.fraction

    DATE(1)=INT(INDATE(1))
    FRAC=INDATE(1)-DATE(1)
    DATE(2)=1
    DATE(3)=1
    ELSE
  
    SECOND CASE: format was year,month,day
  */

  DATE[1]=sinfo_round_double(INDATE[1]);

  FRAC = 0;

  DATE[2]=sinfo_round_double(INDATE[2]);

  DATE[3]=sinfo_round_double(INDATE[3]);

  if ((DATE[2] == 0) &&  (DATE[3] == 0)) {

    DATE[2]=1;

    DATE[3]=1;

  }

  /*
    from here on, the normal procedure applies which is based on the 
    format year,month,day:
  */
  if (DATE[2] > 2) {
    YP=DATE[1];
    P=DATE[2];
  } else {
    YP=DATE[1]-1;
    P=DATE(2)+12.0;
  }

  C = DATE[1] + DATE[2]*1.E-2 + DATE[3]*1.E-4 + UT*1.E-6;

  if (C  >   1582.1015E0) {
    IA=(int) (YP/100.D0);
    A=IA;
    IB=2-IA+((int)(A/4.D0));
  } else {
    IB=0;
  }

  *JD = ((int) (365.25E0*YP)) + ((int)(30.6001D0*(P+1.D0))) + DATE[3] + UT
    + IB + 1720994.5E0;

  /*
    finally, take into account fraction of year (if any), respect leap
    year conventions
  */
  if (FRAC > 1.0E-6) {
    ND=365;

    IF (C >= 1582.1015E0) {
      IC = DATE[1] % 4;
      if (IC == 0) {
        ND=366;
        IC = DATE[1] % 100;
        if (IC == 0) {
	  IC = DATE[1] % 400;
	  if (IC != 0) ND=365;
        }
      }
    }

    if (fabs(FRAC*ND-sinfo_round_double(FRAC*ND)) > 0.3) {
      sinfo_msg_warning("Fraction of year MAY not correspond to "
			"integer number of days");
    }

    *JD = *JD+sinfo_round_double(FRAC*ND);
  }

  return;
}

#endif

/** To get the exact same behaviour as MIDAS this should
    be define'd to 1. (Fixing it does not seem to make a
    difference in the resulting numbers but do it anyway) */
#define MIDAS_BUG 0
/*---------------------------------------------------------------------------*/
/**
   @brief    convert hours -> degrees, minutes, seconds
   @param    in_val     the value to convert
   @param    hours      (output) hours (integer). 360 degrees correspond to 24 h
   @param    minutes    (output) minutes (integer)
   @param    seconds    (output) seconds (fractional)
*/
/*---------------------------------------------------------------------------*/

static void
deg2hms(double in_val, 
	double *hours,
	double *minutes,
	double *seconds)
{
  double tmp;
  char sign;
  if (in_val < 0) {
    in_val = fabs(in_val);
    sign = '-';
  }
  else {
    sign = '+';
  }

  tmp   = in_val / 15;

  /* takes the integer part = hours */
#if MIDAS_BUG
  *hours= sinfo_round_double(tmp);
#else
  *hours= (int) tmp;
#endif

  /* takes the mantissa */
  tmp   = tmp - *hours;
  /* converts the mantissa in minutes */
  tmp   = tmp * 60;

  /* takes the integer part = minutes */
#if MIDAS_BUG
  *minutes= sinfo_round_double(tmp);
#else
  *minutes= (int) tmp;
#endif

  /* takes the mantissa */
  tmp   = tmp - *minutes;

  /* converts the mantissa in seconds = seconds (with decimal) */
  *seconds= tmp * 60;

  /* Rather than returning it explicitly, just  attach sign to hours */
  if (sign == '-') *hours = -(*hours);

  return;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    convert degrees -> degrees, minutes, seconds
   @param    in_val     the value to convert
   @param    degs       (output) degrees (integer)
   @param    minutes    (output) minutes (integer)
   @param    seconds    (output) seconds (fractional)
*/
/*---------------------------------------------------------------------------*/

static void
deg2dms(double in_val, 
	double *degs,
	double *minutes,
	double *seconds)
{
  deg2hms(in_val*15, degs, minutes, seconds);
}





/* @cond Convert FORTRAN indexing -> C indexing */
#define DCFEL(x,y)  dcfel[y][x]
#define DCFEPS(x,y) dcfeps[y][x]
#define CCSEL(x,y)  ccsel[y][x]
#define DCARGS(x,y) dcargs[y][x]
#define CCAMPS(x,y) ccamps[y][x]
#define CCSEC(x,y)  ccsec[y][x]
#define DCARGM(x,y) dcargm[y][x]
#define CCAMPM(x,y) ccampm[y][x]
#define DCEPS(x)    dceps[x]
#define FORBEL(x)   forbel[x]
#define SORBEL(x)   sorbel[x]
#define SN(x)       sn[x]
#define SINLP(x)    sinlp[x]
#define COSLP(x)    coslp[x]
#define CCPAMV(x)   ccpamv[x]
/* @endcond */
/*---------------------------------------------------------------------------*/
/**
   @brief    compute rectangular heliocentric and barycentric components of
   the earth's orbital velocity
   @param    DJE        Julian date
   @param    DEQ        ???
   @param    DVELH      (output) heliocentric velocity
   @param    DVELB      (output) barycentric velocity

   REFERENCE : STUMPFF P. ASTRON. ASTOPHYS. SUPPL. 41,1,1980
   MODIFICATION : D. GILLET 1983-9-15

*/
/*---------------------------------------------------------------------------*/


static 
void barvel(double DJE, double DEQ,
	    double DVELH[4], double DVELB[4])
{
  double sn[5];
  double DT,DTL,DTSQ;
  double DRD,DRLD;
  double DXBD,DYBD,DZBD,DZHD,DXHD,DYHD;
  double DYAHD,DZAHD,DYABD,DZABD;
  double DEPS,PHI,PHID,PSID,DPARAM,PARAM;

  double PERTL,PERTLD,PERTRD,PERTP,PERTR,PERTPD;
  double SINA,TL;
  double COSA,ESQ;
  double A,B,F,SINF,COSF,T,TSQ,TWOE,TWOG;

  double DPSI,D1PDRO,DSINLS;
  double DCOSLS,DSINEP,DCOSEP;
  double forbel[8], sorbel[18], sinlp[5], coslp[5];
  double SINLM,COSLM,SIGMA;
  /* int IDEQ; */
  int K,N;

  double *E = sorbel + 1 - 1;
  double *G = forbel + 1 - 1;
  double DC2PI = 6.2831853071796E0;
  double CC2PI = 6.283185;             /* ??? */

  double DC1 = 1.0;
  double DCT0 = 2415020.0E0;
  double DCJUL = 36525.0E0;

  double dcfel[][4] = { {0, 0, 0, 0},
			{0, 1.7400353E+00, 6.2833195099091E+02, 5.2796E-06},
			{0, 6.2565836E+00, 6.2830194572674E+02,-2.6180E-06},
			{0, 4.7199666E+00, 8.3997091449254E+03,-1.9780E-05},
			{0, 1.9636505E-01, 8.4334662911720E+03,-5.6044E-05},
			{0, 4.1547339E+00, 5.2993466764997E+01, 5.8845E-06},
			{0, 4.6524223E+00, 2.1354275911213E+01, 5.6797E-06},
			{0, 4.2620486E+00, 7.5025342197656E+00, 5.5317E-06},
			{0, 1.4740694E+00, 3.8377331909193E+00, 5.6093E-06} };
    
  double dceps[4] = {0, 4.093198E-01,-2.271110E-04,-2.860401E-08};

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


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


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



  double CCSEC3 = -7.757020E-08;

  double ccsec[][4] = { {0, 0, 0, 0},
			{0, 1.289600E-06,  5.550147E-01,  2.076942E+00},
			{0, 3.102810E-05,  4.035027E+00,  3.525565E-01},
			{0, 9.124190E-06,  9.990265E-01,  2.622706E+00},
			{0, 9.793240E-07,  5.508259E+00,  1.559103E+01}};

  double DCSLD =  1.990987E-07, CCSGD = 1.990969E-07;

  double CCKM = 3.122140E-05, CCMLD = 2.661699E-06, CCFDI = 2.399485E-07;

  double dcargm[][3] = {{0, 0, 0},
			{0, 5.1679830E+00,  8.3286911095275E+03},
			{0, 5.4913150E+00, -7.2140632838100E+03},
			{0, 5.9598530E+00,  1.5542754389685E+04}};

  double ccampm[][5] = {{0, 0, 0, 0, 0},
			{0,  1.097594E-01,  2.896773E-07,  5.450474E-02,  1.438491E-07},
			{0, -2.223581E-02,  5.083103E-08,  1.002548E-02, -2.291823E-08},
			{0,  1.148966E-02,  5.658888E-08,  8.249439E-03,  4.063015E-08} };

  double ccpamv[] = {0, 8.326827E-11, 1.843484E-11, 1.988712E-12, 1.881276E-12};

  double DC1MME = 0.99999696E0;

  /* not used later
   * IDEQ=DEQ; */


  DT=(DJE-DCT0)/DCJUL;

  T=DT;

  DTSQ=DT*DT;

  TSQ=DTSQ;

  double DML = 0;  /* Suppress warning */

  /* special case K == 1 */
  DML=fmod(DCFEL(1,1)+DT*DCFEL(2,1)+DTSQ*DCFEL(3,1),DC2PI);

  /* other cases K> 1 */
  for (K = 2; K <= 8; K++) {

    FORBEL(K-1)=fmod(DCFEL(1,K)+DT*DCFEL(2,K)+DTSQ*DCFEL(3,K),DC2PI);

  }

  DEPS=fmod(DCEPS(1)+DT*DCEPS(2)+DTSQ*DCEPS(3), DC2PI);

  for (K = 1; K <= 17; K++) {

    SORBEL(K)=fmod(CCSEL(1,K)+T*CCSEL(2,K)+TSQ*CCSEL(3,K),CC2PI);

  }

  for (K = 1; K <= 4; K++) {

    A=fmod(CCSEC(2,K)+T*CCSEC(3,K),CC2PI);

    SN(K)=sin(A);

  }

  PERTL =  CCSEC(1,1)          *SN(1) +CCSEC(1,2)*SN(2)
    +(CCSEC(1,3)+T*CCSEC3)*SN(3) +CCSEC(1,4)*SN(4);

  PERTLD=0.0;
  PERTR =0.0;
  PERTRD=0.0;

  for (K = 1; K <= 15; K++) {

    A=fmod(DCARGS(1,K)+DT*DCARGS(2,K), DC2PI);

    COSA=cos(A);

    SINA=sin(A);

    PERTL =PERTL+CCAMPS(1,K)*COSA+CCAMPS(2,K)*SINA;

    PERTR =PERTR+CCAMPS(3,K)*COSA+CCAMPS(4,K)*SINA;

    if (K >= 11) break;

    PERTLD=PERTLD+(CCAMPS(2,K)*COSA-CCAMPS(1,K)*SINA)*CCAMPS(5,K);

    PERTRD=PERTRD+(CCAMPS(4,K)*COSA-CCAMPS(3,K)*SINA)*CCAMPS(5,K);

  }


  ESQ=E[1]*E[1];

  DPARAM=DC1-ESQ;

  PARAM=DPARAM;

  TWOE=E[1]+E[1];

  TWOG=G[1]+G[1];

  PHI=TWOE*((1.0-ESQ*0.125  )*sin(G[1])+E[1]*0.625  *sin(TWOG)
	    +ESQ*0.5416667  *sin(G[1]+TWOG) ) ;
    
  F=G[1]+PHI;

  SINF=sin(F);

  COSF=cos(F);

  DPSI=DPARAM/(DC1+E[1]*COSF);

  PHID=TWOE*CCSGD*((1.0+ESQ*1.5  )*COSF+E[1]*(1.25  -SINF*SINF*0.5  ));

  PSID=CCSGD*E[1]*SINF/sqrt(PARAM);

  D1PDRO=(DC1+PERTR);

  DRD=D1PDRO*(PSID+DPSI*PERTRD);

  DRLD=D1PDRO*DPSI*(DCSLD+PHID+PERTLD);

  DTL=fmod(DML+PHI+PERTL, DC2PI);

  DSINLS=sin(DTL);

  DCOSLS=cos(DTL);

  DXHD = DRD*DCOSLS-DRLD*DSINLS;

  DYHD = DRD*DSINLS+DRLD*DCOSLS;

  PERTL =0.0;

  PERTLD=0.0;

  PERTP =0.0;

  PERTPD=0.0;

  for (K = 1; K <= 3; K++) {
    A=fmod(DCARGM(1,K)+DT*DCARGM(2,K), DC2PI);

    SINA  =sin(A);

    COSA  =cos(A);

    PERTL =PERTL +CCAMPM(1,K)*SINA;

    PERTLD=PERTLD+CCAMPM(2,K)*COSA;

    PERTP =PERTP +CCAMPM(3,K)*COSA;

    PERTPD=PERTPD-CCAMPM(4,K)*SINA;
  }
    
  TL=FORBEL(2)+PERTL;

  SINLM=sin(TL);

  COSLM=cos(TL);

  SIGMA=CCKM/(1.0+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(3));

  DXBD=DXHD*DC1MME;

  DYBD=DYHD*DC1MME;

  DZBD=DZHD*DC1MME;

  for (K = 1; K <= 4; K++) {

    double PLON=FORBEL(K+3);

    double POMG=SORBEL(K+1);

    double PECC=SORBEL(K+9);

    TL=fmod(PLON+2.0*PECC* sin(PLON-POMG), CC2PI);

    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));

  }
    
  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;

  DVELH[1]=DXHD;
  DVELH[2]=DYAHD;
  DVELH[3]=DZAHD;

  DVELB[1]=DXBD;
  DVELB[2]=DYABD;
  DVELB[3]=DZABD;

  for (N = 1; N <= 3; N++) {
    DVELH[N]=DVELH[N]*1.4959787E8;
    DVELB[N]=DVELB[N]*1.4959787E8;
  }
  return;
}




/*--------------------------------------------------------------------------*/
/**
   @brief    Compute velocity correction
   @param    inputr     input parameters
   @param    inputc     input parameters
   @param    outputr    output parameters
   @param    utr        observation time (seconds)
   @param    mod_juldat observation modified julian date

   INPUTR/R/1/3    date: year,month,day
   INPUTR/R/4/3    universal time: hour,min,sec
   INPUTR/R/7/3    EAST longitude of observatory: degree,min,sec  !! NOTE
   INPUTR/R/10/3   latitude of observatory: degree,min,sec
   INPUTR/R/13/3   right ascension: hour,min,sec
   INPUTR/R/16/3   declination: degree,min,sec
   OUTPUTD/D/1/1   barycentric correction to time (days)
   OUTPUTD/D/2/1   heliocentric correction to time (days)
   OUTPUTR/R/1/1   barycentric correction to radial velocity (km/s)
   OUTPUTR/R/2/1   heliocentric correction to radial velocity (km/s)
   OUTPUTR/R/3/1   diurnal rotation of the earth

*/
/*--------------------------------------------------------------------------*/
static void
compxy(double inputr[19], char inputc[4],
       double outputr[4],
       double utr, double mod_juldat)
{
  double STR;
  double t0, dl, theta0, pe, st0hg, stg;
  double jd, jd0h;
  double dvelb[4], dvelh[4];
  double alp, del, beov, berv, EDV;
  double HAR, phi, heov, herv;
  double *rbuf;
  char inpsgn[4];
  double *olong, *olat, *alpha, *delta;
  char signs[] = "+++";
  rbuf = inputr;
  inpsgn[1] = inputc[1];
  inpsgn[2] = inputc[2];
  inpsgn[3] = inputc[3];
  olong = rbuf + 7 - 1;
  olat  = rbuf + 10 - 1;
  alpha = rbuf + 13 - 1;
  delta = rbuf + 16 - 1;
  // ... convert UT to real hours, calculate Julian date
  /* We know this one already but convert seconds -> hours */
  utr /= 3600;


  jd = mod_juldat + 2400000.5;
  
  // ... likewise convert longitude and latitude of observatory to real hours
  // ... and degrees, respectively; take care of signs
  // ... NOTE: east longitude is assumed for input !!

  if (olong[1] < 0 || olong[2] < 0 ||
      olong[3] < 0 || inpsgn[1] == '-') {
    signs[1] = '-';
    olong[1] = fabs(olong[1]);
    olong[2] = fabs(olong[2]);
    olong[3] = fabs(olong[3]);
  }
  dl = olong[1]+olong[2]/60.  +olong[3]/3600.;
  if (signs[1]   == '-') dl = -dl;
  dl = -dl*24.  /360.;

  if (olat[1] < 0 || olat[2] < 0 ||
      olat[3] < 0 || inpsgn[2] == '-') {
    signs[2] = '-';
 
    olat[1] = fabs(olat[1]);
    olat[2] = fabs(olat[2]);
    olat[3] = fabs(olat[3]);

  }

  phi = olat[1]+olat[2]/60.  +olat[3]/3600.;

  if (signs[2]   == '-') phi = -phi;

  phi = phi*M_PI/180. ;

  // ... convert right ascension and declination to real radians

  alp = (alpha[1]*3600. +alpha[2]*60. +alpha[3])*M_PI/(12.  *3600.  );

  if (delta[1] < 0 || delta[2] < 0 ||
      delta[3] < 0 || inpsgn[3] == '-') {

    signs[3] = '-';

    delta[1] = fabs(delta[1]);
    delta[2] = fabs(delta[2]);
    delta[3] = fabs(delta[3]);

  }

  del = (delta[1]*3600.0  + delta[2]*60.   + delta[3])
    * M_PI/(3600. *180. );



  if (signs[3]   == '-') del = - del;

  // ... calculate earth's orbital velocity in rectangular coordinates X,Y,Z
  // ... for both heliocentric and barycentric frames (DVELH, DVELB)
  // ... Note that setting the second argument of BARVEL to zero as done below
  // ... means that the input coordinates will not be corrected for precession.


  barvel(jd, 0.0, dvelh, dvelb);

  // ... with the rectangular velocity components known, the respective projections
  // ... HEOV and BEOV on a given line of sight (ALP,DEL) can be determined:

  // ... REFERENCE: THE ASTRONOMICAL ALMANAC 1982 PAGE:B17

  beov =
    dvelb[1]*cos(alp)*cos(del)+
    dvelb[2]*sin(alp)*cos(del)+
    dvelb[3]*sin(del);
      
  heov =
    dvelh[1]*cos(alp)*cos(del)+
    dvelh[2]*sin(alp)*cos(del)+
    dvelh[3]*sin(del);
      

  // ... For determination also of the contribution due to the diurnal rotation of
  // ... the earth (EDV), the hour angle (HAR) is needed at which the observation
  // ... was made which requires conversion of UT to sidereal time (ST).

  // ... Therefore, first compute ST at 0 hours UT (ST0HG)

  // ... REFERENCE : MEEUS J.,1980,ASTRONOMICAL FORMULAE FOR CALCULATORS


  jd0h = jd - (utr/24.0);
      
  t0 = (jd0h-2415020.  )/36525. ;
      

  theta0 = 0.276919398  +100.0021359  *t0+0.000001075  *t0*t0 ;

  pe = (int) theta0;

  theta0 = theta0 - pe;

  st0hg = theta0*24. ;

  // ... now do the conversion UT -> ST (MEAN SIDEREAL TIME)

  // ... REFERENCE : THE ASTRONOMICAL ALMANAC 1983, P B7
  // ... IN 1983: 1 MEAN SOLAR DAY = 1.00273790931 MEAN SIDEREAL DAYS
  // ... ST WITHOUT EQUATION OF EQUINOXES CORRECTION => ACCURACY +/- 1 SEC
  //
  stg = st0hg+utr*1.00273790931 ;
      
  if (stg < dl) stg = stg +24. ;

  STR = stg-dl;


  if (STR >= 24. ) STR = STR-24. ;

  STR = STR*M_PI/12. ;

  HAR = STR-alp;
      

  EDV = -0.4654  * sin(HAR)* cos(del)* cos(phi);

  // ... the total correction (in km/s) is the sum of orbital and diurnal components


  herv=heov+EDV;
  berv=beov+EDV;

  /* The following is not needed. Do not translate */

#if 0
  // ... Calculation of the barycentric and heliocentric correction times
  // ... (BCT and HCT) requires knowledge of the earth's position in its
  // ... orbit. Subroutine BARCOR returns the rectangular barycentric (DCORB)
  // ... and heliocentric (DCORH) coordinates.

  //      CALL BARCOR(DCORH,DCORB)

  // ... from this, the correction times (in days) can be determined:
  // ... (REFERENCE: THE ASTRONOMICAL ALMANAC 1982 PAGE:B16)

  //      BCT=+0.0057756D0*(DCORB(1)*DCOS(ALP)*DCOS(DEL)+
  //     1                DCORB(2)*DSIN(ALP)*DCOS(DEL)+
  //     2                DCORB(3)*          DSIN(DEL))
  //      HCT=+0.0057756D0*(DCORH(1)*DCOS(ALP)*DCOS(DEL)+
  //     1                DCORH(2)*DSIN(ALP)*DCOS(DEL)+
  //     2                DCORH(3)*          DSIN(DEL))

  //... write results to keywords

  //      CALL STKWRD('OUTPUTD',BCT,1,1,KUN,STAT)    ! barycentric correction time
  //      CALL STKWRD('OUTPUTD',HCT,2,1,KUN,STAT)    ! heliocentric correction time
#endif

  rbuf[1] = berv;   /* barocentric RV correction */
  rbuf[2] = herv;   /* heliocentric RV correction */
  rbuf[3] = EDV;    /* diurnal RV correction */


  outputr[1] = rbuf[1];
  outputr[2] = rbuf[2];
  outputr[3] = rbuf[3];

  return;
}



/*----------------------------------------------------------------------------*/
/**
   @brief    Compute velocity correction
   @param    raw_header input FITS header
   @param    bary_corr  (output) baryocentric correction
   @param    helio_corr (output) heliocentric correction
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
sinfo_baryvel(const cpl_propertylist *raw_header,
         double *bary_corr,
         double *helio_corr)
{

    double outputr[4];

    char inputc[] = "X+++";       /* 0th index not used */

    double rneg = 1.0;

    double inputr[19];                  /* Do not use the zeroth element */


/*
  qc_ra       = m$value({p1},O_POS(1))
  qc_dec      = m$value({p1},O_POS(2))
  qc_geolat   = m$value({p1},{h_geolat})
  qc_geolon   = m$value({p1},{h_geolon})
  qc_obs_time = m$value({p1},O_TIME(7))  !using an image as input it take the
                                         !date from the descriptor O_TIME(1,2,3)
                                         !and the UT from O_TIME(5)
*/
    double qc_ra;
    double qc_dec;
    double qc_geolat;
    double qc_geolon;

    double utr;
    double mod_juldat;

    double ra_hour, ra_min, ra_sec;
    double dec_deg, dec_min, dec_sec;
    double lat_deg, lat_min, lat_sec;
    double lon_deg, lon_min, lon_sec;

    check( qc_ra       = sinfo_pfits_get_ra(raw_header),  /* in degrees */
       "Error getting object right ascension");
    check( qc_dec      = sinfo_pfits_get_dec(raw_header),
       "Error getting object declination");

    check( qc_geolat   = sinfo_pfits_get_geolat(raw_header),
       "Error getting telescope latitude");
    check( qc_geolon   = sinfo_pfits_get_geolon(raw_header),
       "Error getting telescope longitude");

    /* double qc_obs_time = sinfo_pfits_get_exptime(raw_header);   Not used! */

    check( utr         = sinfo_pfits_get_utc(raw_header),
       "Error reading UTC");
    check( mod_juldat  = sinfo_pfits_get_mjdobs(raw_header),
       "Error julian date");

    deg2hms(qc_ra,     &ra_hour, &ra_min, &ra_sec);
    deg2dms(qc_dec,    &dec_deg, &dec_min, &dec_sec);
    deg2dms(qc_geolat, &lat_deg, &lat_min, &lat_sec);
    deg2dms(qc_geolon, &lon_deg, &lon_min, &lon_sec);


    inputr[7] = lon_deg;
    inputr[8] = lon_min;
    inputr[9] = lon_sec;


    rneg = (inputr[7]*3600.)+(inputr[8]*60.)+inputr[9];

    inputc[1] = (lon_deg >= 0) ? '+' : '-';

    if (rneg < 0) inputc[1] = '-';


    inputr[10] = lat_deg;
    inputr[11] = lat_min;
    inputr[12] = lat_sec;


    rneg = (inputr[10]*3600.)+(inputr[11]*60.)+inputr[12];

    inputc[2] = (lat_deg >= 0) ? '+' : '-';

    if (rneg < 0) inputc[2] = '-';


    inputr[13] = ra_hour;
    inputr[14] = ra_min;
    inputr[15] = ra_sec;


    inputr[16] = dec_deg;
    inputr[17] = dec_min;
    inputr[18] = dec_sec;


    inputc[3] = (dec_deg >= 0) ? '+' : '-';

    rneg = (inputr[16]*3600.)+(inputr[17]*60.)+inputr[18];

    if (rneg < 0) inputc[3] = '-';
    

//C  INPUTR/R/1/3    date: year,month,day
//C  INPUTR/R/4/3    universal time: hour,min,sec
//C  INPUTR/R/7/3    EAST longitude of observatory: degree,min,sec  !! NOTE
//C  INPUTR/R/10/3   latitude of observatory: degree,min,sec
//C  INPUTR/R/13/3   right ascension: hour,min,sec
//C  INPUTR/R/16/3   declination: degree,min,sec

    /* compute the corrections */
    compxy(inputr, inputc, outputr, utr, mod_juldat);

   sinfo_msg_debug("        Total barycentric RV correction:  %f km/s", outputr[1]);
   sinfo_msg_debug("        Total heliocentric RV correction: %f km/s", outputr[2]);
   sinfo_msg_debug("          (incl. diurnal RV correction of %f km/s)", outputr[3]);


   *bary_corr = outputr[1];
   *helio_corr = outputr[2];

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE) {
       sinfo_check_rec_status(0);
    }
    return cpl_error_get_code();
}
