Equation of the equinoxes complementary terms, consistent with IAU 2000 resolutions.
Status: canonical model.
The TT date DATE1+DATE2 is a Julian Date, apportioned in any convenient way between the two arguments. For example, JD(TT)=2450123.7 could be expressed in any of these ways, among others:
DATE1 DATE2
2450123.7D0 0D0 (JD method)
2451545D0 -1421.3D0 (J2000 method)
2400000.5D0 50123.2D0 (MJD method)
2450123.5D0 0.2D0 (date & time method)
The JD method is the most natural and convenient to use in cases where the loss of several decimal digits of resolution is acceptable. The J2000 method is best matched to the way the argument is handled internally and will deliver the optimum resolution. The MJD method and the date & time methods are both good compromises between resolution and convenience.
The "complementary terms" are part of the equation of the equinoxes (EE), classically the difference between apparent and mean Sidereal Time:
GAST = GMST + EE
with:
EE = dpsi * cos(eps)
where dpsi is the nutation in longitude and eps is the obliquity of date. However, if the rotation of the Earth were constant in an inertial frame the classical formulation would lead to apparent irregularities in the UT1 timescale traceable to side-effects of precession-nutation. In order to eliminate these effects from UT1, "complementary terms" were introduced in 1994 (IAU, 1994) and took effect from 1997 (Capitaine and Gontier, 1993):
GAST = GMST + CT + EE
By convention, the complementary terms are included as part of the equation of the equinoxes rather than as part of the mean Sidereal Time. This slightly compromises the "geometrical" interpretation of mean sidereal time but is otherwise inconsequential.
The present routine computes CT in the above expression, compatible with IAU 2000 resolutions (Capitaine et al., 2002, and IERS Conventions 2003).
Capitaine, N. & Gontier, A.-M., Astron.Astrophys., 275, 645-650 (1993)
Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to implement the IAU 2000 definition of UT1", Astron.Astrophys., 406, 1135-1149 (2003)
IAU Resolution C7, Recommendation 3 (1994)
McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003), IERS Technical Note No. 32, BKG (2004)
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=wp), | intent(in) | :: | date1 | TT as a 2-part Julian Date (Note 1) |
||
| real(kind=wp), | intent(in) | :: | date2 | TT as a 2-part Julian Date (Note 1) |
complementary terms (Note 2)
function EECT00 ( date1, date2 ) result(res)
implicit none
real(wp),intent(in) :: date1 !! TT as a 2-part Julian Date (Note 1)
real(wp),intent(in) :: date2 !! TT as a 2-part Julian Date (Note 1)
real(wp) :: res !! complementary terms (Note 2)
! Time since J2000.0, in Julian centuries
real(wp) :: t
! Miscellaneous
integer :: i, j
real(wp) :: a, s0, s1
! Fundamental arguments
real(wp) :: fa(14)
! -----------------------------------------
! The series for the EE complementary terms
! -----------------------------------------
! Number of terms in the series
integer,parameter :: ne0 = 33
integer,parameter :: ne1 = 1
! Coefficients of l,l',F,D,Om,LVe,LE,pA
! Argument coefficients for t^0
integer,dimension( 8, ne0 ),parameter :: ke0 = reshape( &
[ 0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 0, 0, 2, 0, 0, 0, &
0, 0, 2, -2, 3, 0, 0, 0, &
0, 0, 2, -2, 1, 0, 0, 0, &
0, 0, 2, -2, 2, 0, 0, 0, &
0, 0, 2, 0, 3, 0, 0, 0, &
0, 0, 2, 0, 1, 0, 0, 0, &
0, 0, 0, 0, 3, 0, 0, 0, &
0, 1, 0, 0, 1, 0, 0, 0, &
0, 1, 0, 0, -1, 0, 0, 0, &
1, 0, 0, 0, -1, 0, 0, 0, &
1, 0, 0, 0, 1, 0, 0, 0, &
0, 1, 2, -2, 3, 0, 0, 0, &
0, 1, 2, -2, 1, 0, 0, 0, &
0, 0, 4, -4, 4, 0, 0, 0, &
0, 0, 1, -1, 1, -8, 12, 0, &
0, 0, 2, 0, 0, 0, 0, 0, &
0, 0, 2, 0, 2, 0, 0, 0, &
1, 0, 2, 0, 3, 0, 0, 0, &
1, 0, 2, 0, 1, 0, 0, 0, &
0, 0, 2, -2, 0, 0, 0, 0, &
0, 1, -2, 2, -3, 0, 0, 0, &
0, 1, -2, 2, -1, 0, 0, 0, &
0, 0, 0, 0, 0, 8,-13, -1, &
0, 0, 0, 2, 0, 0, 0, 0, &
2, 0, -2, 0, -1, 0, 0, 0, &
1, 0, 0, -2, 1, 0, 0, 0, &
0, 1, 2, -2, 2, 0, 0, 0, &
1, 0, 0, -2, -1, 0, 0, 0, &
0, 0, 4, -2, 4, 0, 0, 0, &
0, 0, 2, -2, 4, 0, 0, 0, &
1, 0, -2, 0, -3, 0, 0, 0, &
1, 0, -2, 0, -1, 0, 0, 0 ], [8, ne0])
! Argument coefficients for t^1
integer,dimension( 8, ne1 ),parameter :: ke1 = reshape(&
[0, 0, 0, 0, 1, 0, 0, 0],[8,1])
! Sine and cosine coefficients
! Sine and cosine coefficients for t^0
real(wp),dimension( 2, ne0 ),parameter :: se0 = reshape([ &
+2640.96e-6_wp, -0.39e-6_wp, &
+63.52e-6_wp, -0.02e-6_wp, &
+11.75e-6_wp, +0.01e-6_wp, &
+11.21e-6_wp, +0.01e-6_wp, &
-4.55e-6_wp, +0.00e-6_wp, &
+2.02e-6_wp, +0.00e-6_wp, &
+1.98e-6_wp, +0.00e-6_wp, &
-1.72e-6_wp, +0.00e-6_wp, &
-1.41e-6_wp, -0.01e-6_wp, &
-1.26e-6_wp, -0.01e-6_wp, &
-0.63e-6_wp, +0.00e-6_wp, &
-0.63e-6_wp, +0.00e-6_wp, &
+0.46e-6_wp, +0.00e-6_wp, &
+0.45e-6_wp, +0.00e-6_wp, &
+0.36e-6_wp, +0.00e-6_wp, &
-0.24e-6_wp, -0.12e-6_wp, &
+0.32e-6_wp, +0.00e-6_wp, &
+0.28e-6_wp, +0.00e-6_wp, &
+0.27e-6_wp, +0.00e-6_wp, &
+0.26e-6_wp, +0.00e-6_wp, &
-0.21e-6_wp, +0.00e-6_wp, &
+0.19e-6_wp, +0.00e-6_wp, &
+0.18e-6_wp, +0.00e-6_wp, &
-0.10e-6_wp, +0.05e-6_wp, &
+0.15e-6_wp, +0.00e-6_wp, &
-0.14e-6_wp, +0.00e-6_wp, &
+0.14e-6_wp, +0.00e-6_wp, &
-0.14e-6_wp, +0.00e-6_wp, &
+0.14e-6_wp, +0.00e-6_wp, &
+0.13e-6_wp, +0.00e-6_wp, &
-0.11e-6_wp, +0.00e-6_wp, &
+0.11e-6_wp, +0.00e-6_wp, &
+0.11e-6_wp, +0.00e-6_wp ], [2, ne0])
! Sine and cosine coefficients for t^1
real(wp),dimension( 2, ne1 ),parameter :: se1 = reshape([ &
-0.87e-6_wp, +0.00e-6_wp ],[2, ne1])
! Interval between fundamental epoch J2000.0 and current date (JC).
t = ( ( date1-dj00 ) + date2 ) / djc
! Fundamental Arguments (from IERS Conventions 2003)
! Mean anomaly of the Moon.
fa(1) = FAL03 ( t )
! Mean anomaly of the Sun.
fa(2) = FALP03 ( t )
! Mean longitude of the Moon minus that of the ascending node.
fa(3) = FAF03 ( t )
! Mean elongation of the Moon from the Sun.
fa(4) = FAD03 ( t )
! Mean longitude of the ascending node of the Moon.
fa(5) = FAOM03 ( t )
! Mean longitude of Venus.
fa(6) = FAVE03 ( t )
! Mean longitude of Earth.
fa(7) = FAE03 ( t )
! General precession in longitude.
fa(8) = FAPA03 ( t )
! Evaluate the EE complementary terms.
s0 = 0.0_wp
s1 = 0.0_wp
do i = ne0,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ke0(j,i),wp)*fa(j)
end do
s0 = s0 + ( se0(1,i)*sin(a) + se0(2,i)*cos(a) )
end do
do i = ne1,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ke1(j,i),wp)*fa(j)
end do
s1 = s1 + ( se1(1,i)*sin(a) + se1(2,i)*cos(a) )
end do
res = ( s0 + s1 * t ) * das2r
end function EECT00