nutation.c

/* nutation (in IAU (1980) expression) and abberation; stern
 * on an HP PA processor, this reproduces the Almanac nutation values
 * (given to 0.001") EXACTLY over 750 days (1995 and 1996)
 */
#include <stdio.h>
#include <math.h>

#include "astro.h"

#define NUT_SCALE	1e4
#define NUT_SERIES	106
#define NUT_MAXMUL	4
#define SECPERCIRC	(3600.*360.)

/* Delaunay arguments, in arc seconds; they differ slightly from ELP82B */
static double delaunay[5][4] = {
    {485866.733,  1717915922.633, 31.310,  0.064}, /* M', moon mean anom */
    {1287099.804, 129596581.224,  -0.577, -0.012}, /* M, sun mean anom */
    {335778.877,  1739527263.137, -13.257, 0.011}, /* F, moon arg lat */
    {1072261.307, 1602961601.328, -6.891,  0.019}, /* D, elong moon sun */
    {450160.280,  -6962890.539,   7.455,   0.008}, /* Om, moon l asc node */
};

/* multipliers for Delaunay arguments */
static short multarg[NUT_SERIES][5] = {
	/* bounds:  -2..3, -2..2, -2/0/2/4, -4..4, 0..2 */
    {0, 0, 0, 0, 1},
    {0, 0, 0, 0, 2},
    {-2, 0, 2, 0, 1},
    {2, 0, -2, 0, 0},
    {-2, 0, 2, 0, 2},
    {1, -1, 0, -1, 0},
    {0, -2, 2, -2, 1},
    {2, 0, -2, 0, 1},
    {0, 0, 2, -2, 2},
    {0, 1, 0, 0, 0},
    {0, 1, 2, -2, 2},
    {0, -1, 2, -2, 2},
    {0, 0, 2, -2, 1},
    {2, 0, 0, -2, 0},
    {0, 0, 2, -2, 0},
    {0, 2, 0, 0, 0},
    {0, 1, 0, 0, 1},
    {0, 2, 2, -2, 2},
    {0, -1, 0, 0, 1},
    {-2, 0, 0, 2, 1},
    {0, -1, 2, -2, 1},
    {2, 0, 0, -2, 1},
    {0, 1, 2, -2, 1},
    {1, 0, 0, -1, 0},
    {2, 1, 0, -2, 0},
    {0, 0, -2, 2, 1},
    {0, 1, -2, 2, 0},
    {0, 1, 0, 0, 2},
    {-1, 0, 0, 1, 1},
    {0, 1, 2, -2, 0},
    {0, 0, 2, 0, 2},
    {1, 0, 0, 0, 0},
    {0, 0, 2, 0, 1},
    {1, 0, 2, 0, 2},
    {1, 0, 0, -2, 0},
    {-1, 0, 2, 0, 2},
    {0, 0, 0, 2, 0},
    {1, 0, 0, 0, 1},
    {-1, 0, 0, 0, 1},
    {-1, 0, 2, 2, 2},
    {1, 0, 2, 0, 1},
    {0, 0, 2, 2, 2},
    {2, 0, 0, 0, 0},
    {1, 0, 2, -2, 2},
    {2, 0, 2, 0, 2},
    {0, 0, 2, 0, 0},
    {-1, 0, 2, 0, 1},
    {-1, 0, 0, 2, 1},
    {1, 0, 0, -2, 1},
    {-1, 0, 2, 2, 1},
    {1, 1, 0, -2, 0},
    {0, 1, 2, 0, 2},
    {0, -1, 2, 0, 2},
    {1, 0, 2, 2, 2},
    {1, 0, 0, 2, 0},
    {2, 0, 2, -2, 2},
    {0, 0, 0, 2, 1},
    {0, 0, 2, 2, 1},
    {1, 0, 2, -2, 1},
    {0, 0, 0, -2, 1},
    {1, -1, 0, 0, 0},
    {2, 0, 2, 0, 1},
    {0, 1, 0, -2, 0},
    {1, 0, -2, 0, 0},
    {0, 0, 0, 1, 0},
    {1, 1, 0, 0, 0},
    {1, 0, 2, 0, 0},
    {1, -1, 2, 0, 2},
    {-1, -1, 2, 2, 2},
    {-2, 0, 0, 0, 1},
    {3, 0, 2, 0, 2},
    {0, -1, 2, 2, 2},
    {1, 1, 2, 0, 2},
    {-1, 0, 2, -2, 1},
    {2, 0, 0, 0, 1},
    {1, 0, 0, 0, 2},
    {3, 0, 0, 0, 0},
    {0, 0, 2, 1, 2},
    {-1, 0, 0, 0, 2},
    {1, 0, 0, -4, 0},
    {-2, 0, 2, 2, 2},
    {-1, 0, 2, 4, 2},
    {2, 0, 0, -4, 0},
    {1, 1, 2, -2, 2},
    {1, 0, 2, 2, 1},
    {-2, 0, 2, 4, 2},
    {-1, 0, 4, 0, 2},
    {1, -1, 0, -2, 0},
    {2, 0, 2, -2, 1},
    {2, 0, 2, 2, 2},
    {1, 0, 0, 2, 1},
    {0, 0, 4, -2, 2},
    {3, 0, 2, -2, 2},
    {1, 0, 2, -2, 0},
    {0, 1, 2, 0, 1},
    {-1, -1, 0, 2, 1},
    {0, 0, -2, 0, 1},
    {0, 0, 2, -1, 2},
    {0, 1, 0, 2, 0},
    {1, 0, -2, -2, 0},
    {0, -1, 2, 0, 1},
    {1, 1, 0, -2, 1},
    {1, 0, -2, 2, 0},
    {2, 0, 0, 2, 0},
    {0, 0, 2, 4, 2},
    {0, 1, 0, 1, 0}
};

/* amplitudes which  have secular terms; in 1/NUT_SCALE arc seconds
 * {index, constant dPSI, T/10 in dPSI, constant in dEPS, T/10 in dEPS}
 */
static long ampsecul[][5] = {
    {0  ,-171996 ,-1742 ,92025 ,89},
    {1  ,2062    ,2     ,-895  ,5},
    {8  ,-13187  ,-16   ,5736  ,-31},
    {9  ,1426    ,-34   ,54    ,-1},
    {10 ,-517    ,12    ,224   ,-6},
    {11 ,217     ,-5    ,-95   ,3},
    {12 ,129     ,1     ,-70   ,0},
    {15 ,17      ,-1    ,0     ,0},
    {17 ,-16     ,1     ,7     ,0},
    {30 ,-2274   ,-2    ,977   ,-5},
    {31 ,712     ,1     ,-7    ,0},
    {32 ,-386    ,-4    ,200   ,0},
    {33 ,-301    ,0     ,129   ,-1},
    {37 ,63      ,1     ,-33   ,0},
    {38 ,-58     ,-1    ,32    ,0},
    /* termination */  { -1, }
};

/* amplitudes which only have constant terms; same unit as above
 * {dPSI, dEPS}
 * indexes which are already in ampsecul[][] are zeroed
 */
static short ampconst[NUT_SERIES][2] = {
    {0,0},
    {0,0},
    {46,-24},
    {11,0},
    {-3,1},
    {-3,0},
    {-2,1},
    {1,0},
    {0,0},
    {0,0},
    {0,0},
    {0,0},
    {0,0},
    {48,1},
    {-22,0},
    {0,0},
    {-15,9},
    {0,0},
    {-12,6},
    {-6,3},
    {-5,3},
    {4,-2},
    {4,-2},
    {-4,0},
    {1,0},
    {1,0},
    {-1,0},
    {1,0},
    {1,0},
    {-1,0},
    {0,0},
    {0,0},
    {0,0},
    {0,0},
    {-158,-1},
    {123,-53},
    {63,-2},
    {0,0},
    {0,0},
    {-59,26},
    {-51,27},
    {-38,16},
    {29,-1},
    {29,-12},
    {-31,13},
    {26,-1},
    {21,-10},
    {16,-8},
    {-13,7},
    {-10,5},
    {-7,0},
    {7,-3},
    {-7,3},
    {-8,3},
    {6,0},
    {6,-3},
    {-6,3},
    {-7,3},
    {6,-3},
    {-5,3},
    {5,0},
    {-5,3},
    {-4,0},
    {4,0},
    {-4,0},
    {-3,0},
    {3,0},
    {-3,1},
    {-3,1},
    {-2,1},
    {-3,1},
    {-3,1},
    {2,-1},
    {-2,1},
    {2,-1},
    {-2,1},
    {2,0},
    {2,-1},
    {1,-1},
    {-1,0},
    {1,-1},
    {-2,1},
    {-1,0},
    {1,-1},
    {-1,1},
    {-1,1},
    {1,0},
    {1,0},
    {1,-1},
    {-1,0},
    {-1,0},
    {1,0},
    {1,0},
    {-1,0},
    {1,0},
    {1,0},
    {-1,0},
    {-1,0},
    {-1,0},
    {-1,0},
    {-1,0},
    {-1,0},
    {-1,0},
    {1,0},
    {-1,0},
    {1,0}
};

/* given the modified JD, mj, find the nutation in obliquity, *deps, and
 * the nutation in longitude, *dpsi, each in radians.
 */
void
nutation (
double mj,
double *deps,	/* on input:  precision parameter in arc seconds */
double *dpsi)
{
	static double lastmj = -10000, lastdeps, lastdpsi;
	double T, T2, T3, T10;			/* jul cent since J2000 */
	double prec;				/* series precis in arc sec */
	int i, isecul;				/* index in term table */
	static double delcache[5][2*NUT_MAXMUL+1];
			/* cache for multiples of delaunay args
			 * [M',M,F,D,Om][-min*x, .. , 0, .., max*x]
			 * make static to have unfilled fields cleared on init
			 */

	if (mj == lastmj) {
	    *deps = lastdeps;
	    *dpsi = lastdpsi;
	    return;
	}

	prec = 0.0;

#if 0	/* this is if deps should contain a precision value */
	prec =* deps;
	if (prec < 0.0 || prec > 1.0)	/* accept only sane value */
		prec = 1.0;
#endif

	/* augment for abundance of small terms */
	prec *= NUT_SCALE/10;

	T = (mj - J2000)/36525.;
	T2 = T * T;
	T3 = T2 * T;
	T10 = T/10.;

	/* calculate delaunay args and place in cache */
	for (i = 0; i < 5; ++i) {
	    double x;
	    short j;

	    x = delaunay[i][0] +
		delaunay[i][1] * T +
		delaunay[i][2] * T2 +
		delaunay[i][3] * T3;

	    /* convert to radians */
	    x /= SECPERCIRC;
	    x -= floor(x);
	    x *= 2.*PI;

	    /* fill cache table */
	    for (j = 0; j <= 2*NUT_MAXMUL; ++j)
		delcache[i][j] = (j - NUT_MAXMUL) * x;
	}

	/* find dpsi and deps */
	lastdpsi = lastdeps = 0.;
	for (i = isecul = 0; i < NUT_SERIES ; ++i) {
	    double arg = 0., ampsin, ampcos;
	    short j;

	    if (ampconst[i][0] || ampconst[i][1]) {
		/* take non-secular terms from simple array */
		ampsin = ampconst[i][0];
		ampcos = ampconst[i][1];
	    } else {
		/* secular terms from different array */
		ampsin = ampsecul[isecul][1] + ampsecul[isecul][2] * T10;
		ampcos = ampsecul[isecul][3] + ampsecul[isecul][4] * T10;
		++isecul;
	    }

	    for (j = 0; j < 5; ++j)
		arg += delcache[j][NUT_MAXMUL + multarg[i][j]];

	    if (fabs(ampsin) >= prec)
		lastdpsi += ampsin * sin(arg);

	    if (fabs(ampcos) >= prec)
		lastdeps += ampcos * cos(arg);

	}

	/* convert to radians.
	 */
	lastdpsi = degrad(lastdpsi/3600./NUT_SCALE);
	lastdeps = degrad(lastdeps/3600./NUT_SCALE);

	lastmj = mj;
	*deps = lastdeps;
	*dpsi = lastdpsi;
}

/* given the modified JD, mj, correct, IN PLACE, the right ascension *ra
 * and declination *dec (both in radians) for nutation.
 */
void
nut_eq (double mj, double *ra, double *dec)
{
	static double lastmj = -10000;
	static double a[3][3];		/* rotation matrix */
	double xold, yold, zold, x, y, z;

	if (mj != lastmj) {
	    double epsilon, dpsi, deps;
	    double se, ce, sp, cp, sede, cede;

	    obliquity(mj, &epsilon);
	    nutation(mj, &deps, &dpsi);

	    /* the rotation matrix a applies the nutation correction to
	     * a vector of equatoreal coordinates Xeq to Xeq' by 3 subsequent
	     * rotations:  R1 - from equatoreal to ecliptic system by
	     * rotation of angle epsilon about x, R2 - rotate ecliptic
	     * system by -dpsi about its z, R3 - from ecliptic to equatoreal
	     * by rotation of angle -(epsilon + deps)
	     *
	     *	Xeq' = A * Xeq = R3 * R2 * R1 * Xeq
	     * 
	     *		[ 1       0          0    ]
	     * R1 =	[ 0   cos(eps)   sin(eps) ]
	     *		[ 0  - sin(eps)  cos(eps) ]
	     * 
	     *		[ cos(dpsi)  - sin(dpsi)  0 ]
	     * R2 =	[ sin(dpsi)   cos(dpsi)   0 ]
	     *		[      0           0      1 ]
	     * 
	     *		[ 1         0                 0         ]
	     * R3 =	[ 0  cos(eps + deps)  - sin(eps + deps) ]
	     *		[ 0  sin(eps + deps)   cos(eps + deps)  ]
	     * 
	     * for efficiency, here is a explicitely:
	     */
	    
	    se = sin(epsilon);
	    ce = cos(epsilon);
	    sp = sin(dpsi);
	    cp = cos(dpsi);
	    sede = sin(epsilon + deps);
	    cede = cos(epsilon + deps);

	    a[0][0] = cp;
	    a[0][1] = -sp*ce;
	    a[0][2] = -sp*se;

	    a[1][0] = cede*sp;
	    a[1][1] = cede*cp*ce+sede*se;
	    a[1][2] = cede*cp*se-sede*ce;

	    a[2][0] = sede*sp;
	    a[2][1] = sede*cp*ce-cede*se;
	    a[2][2] = sede*cp*se+cede*ce;

	    lastmj = mj;
	}

	sphcart(*ra, *dec, 1.0, &xold, &yold, &zold);
	x = a[0][0] * xold + a[0][1] * yold + a[0][2] * zold;
	y = a[1][0] * xold + a[1][1] * yold + a[1][2] * zold;
	z = a[2][0] * xold + a[2][1] * yold + a[2][2] * zold;
	cartsph(x, y, z, ra, dec, &zold);	/* radius should be 1.0 */
	if (*ra < 0.) *ra += 2.*PI;		/* make positive for display */
}

/* For RCS Only -- Do Not Edit */
static char *rcsid[2] = {(char *)rcsid, "@(#) $RCSfile: nutation.c,v $ $Date: 2003/03/20 08:51:37 $ $Revision: 1.4 $ $Name:  $"};