The CIO locator s, positioning the Celestial Intermediate Origin on the equator of the Celestial Intermediate Pole, given the CIP's X,Y coordinates. Compatible with IAU 2000A precession-nutation.
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 CIO locator s is the difference between the right ascensions of the same point in two systems: the two systems are the GCRS and the CIP,CIO, and the point is the ascending node of the CIP equator. The quantity s remains below 0.1 arcsecond throughout 1900-2100.
The series used to compute s is in fact for s+XY/2, where X and Y are the x and y components of the CIP unit vector; this series is more compact than a direct series for s would be. This routine requires X,Y to be supplied by the caller, who is responsible for providing values that are consistent with the supplied date.
The model is consistent with the IAU 2000A precession-nutation.
Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., "Expressions for the Celestial Intermediate Pole and Celestial Ephemeris Origin consistent with the IAU 2000A precession-nutation model", Astron.Astrophys. 400, 1145-1154 (2003)
n.b. The celestial ephemeris origin (CEO) was renamed "celestial intermediate origin" (CIO) by IAU 2006 Resolution 2.
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) |
||
| real(kind=wp), | intent(in) | :: | x | CIP coordinates (Note 3) |
||
| real(kind=wp), | intent(in) | :: | y | CIP coordinates (Note 3) |
the CIO locator s in radians (Note 2)
function S00 ( date1, date2, x, y ) result(s)
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),intent(in) :: x !! CIP coordinates (Note 3)
real(wp),intent(in) :: y !! CIP coordinates (Note 3)
real(wp) :: s !! the CIO locator s in radians (Note 2)
! Time since J2000.0, in Julian centuries
real(wp) :: t
! Miscellaneous
integer :: i, j
real(wp) :: a, s0, s1, s2, s3, s4, s5
! Fundamental arguments
real(wp) :: fa(8)
! ---------------------
! The series for s+XY/2
! ---------------------
! Number of terms in the series
integer,parameter :: nsp = 6
integer,parameter :: ns0 = 33
integer,parameter :: ns1 = 3
integer,parameter :: ns2 = 25
integer,parameter :: ns3 = 4
integer,parameter :: ns4 = 1
! Polynomial coefficients
real(wp),dimension(nsp),parameter :: sp = [ &
94.0e-6_wp, &
3808.35e-6_wp, &
-119.94e-6_wp, &
-72574.09e-6_wp, &
27.70e-6_wp, &
15.61e-6_wp ]
! Coefficients of l,l',F,D,Om,LVe,LE,pA
! Argument coefficients for t^0
integer, dimension( 8, ns0 ), parameter :: ks0 = 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, &
0, 1, 2, -2, 2, 0, 0, 0, &
1, 0, 0, -2, 1, 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, ns0])
! Argument coefficients for t^1
integer, dimension( 8, ns1 ), parameter :: ks1 = reshape([ &
0, 0, 0, 0, 2, 0, 0, 0, &
0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 2, -2, 3, 0, 0, 0 ], [8, ns1])
! Argument coefficients for t^2
integer, dimension( 8, ns2 ), parameter :: ks2 = reshape([ &
0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 2, -2, 2, 0, 0, 0, &
0, 0, 2, 0, 2, 0, 0, 0, &
0, 0, 0, 0, 2, 0, 0, 0, &
0, 1, 0, 0, 0, 0, 0, 0, &
1, 0, 0, 0, 0, 0, 0, 0, &
0, 1, 2, -2, 2, 0, 0, 0, &
0, 0, 2, 0, 1, 0, 0, 0, &
1, 0, 2, 0, 2, 0, 0, 0, &
0, 1, -2, 2, -2, 0, 0, 0, &
1, 0, 0, -2, 0, 0, 0, 0, &
0, 0, 2, -2, 1, 0, 0, 0, &
1, 0, -2, 0, -2, 0, 0, 0, &
0, 0, 0, 2, 0, 0, 0, 0, &
1, 0, 0, 0, 1, 0, 0, 0, &
1, 0, -2, -2, -2, 0, 0, 0, &
1, 0, 0, 0, -1, 0, 0, 0, &
1, 0, 2, 0, 1, 0, 0, 0, &
2, 0, 0, -2, 0, 0, 0, 0, &
2, 0, -2, 0, -1, 0, 0, 0, &
0, 0, 2, 2, 2, 0, 0, 0, &
2, 0, 2, 0, 2, 0, 0, 0, &
2, 0, 0, 0, 0, 0, 0, 0, &
1, 0, 2, -2, 2, 0, 0, 0, &
0, 0, 2, 0, 0, 0, 0, 0 ], [8, ns2])
! Argument coefficients for t^3
integer, dimension( 8, ns3 ), parameter :: ks3 = reshape([ &
0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 2, -2, 2, 0, 0, 0, &
0, 0, 2, 0, 2, 0, 0, 0, &
0, 0, 0, 0, 2, 0, 0, 0 ], [8, ns3])
! Argument coefficients for t^4
integer, dimension( 8, ns4 ), parameter :: ks4 = reshape([ &
0, 0, 0, 0, 1, 0, 0, 0 ], [8, ns4])
! Sine and cosine coefficients
! Sine and cosine coefficients for t^0
real(wp), dimension( 2, ns0 ), parameter :: ss0 = reshape([ &
-2640.73e-6_wp, +0.39e-6_wp, &
-63.53e-6_wp, +0.02e-6_wp, &
-11.75e-6_wp, -0.01e-6_wp, &
-11.21e-6_wp, -0.01e-6_wp, &
+4.57e-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, ns0])
! Sine and cosine coefficients for t^1
real(wp), dimension( 2, ns1 ), parameter :: ss1 = reshape([ &
-0.07e-6_wp, +3.57e-6_wp, &
+1.71e-6_wp, -0.03e-6_wp, &
0.00e-6_wp, +0.48e-6_wp ], [2, ns1])
! Sine and cosine coefficients for t^2
real(wp), dimension( 2, ns2 ), parameter :: ss2 = reshape([ &
+743.53e-6_wp, -0.17e-6_wp, &
+56.91e-6_wp, +0.06e-6_wp, &
+9.84e-6_wp, -0.01e-6_wp, &
-8.85e-6_wp, +0.01e-6_wp, &
-6.38e-6_wp, -0.05e-6_wp, &
-3.07e-6_wp, 0.00e-6_wp, &
+2.23e-6_wp, 0.00e-6_wp, &
+1.67e-6_wp, 0.00e-6_wp, &
+1.30e-6_wp, 0.00e-6_wp, &
+0.93e-6_wp, 0.00e-6_wp, &
+0.68e-6_wp, 0.00e-6_wp, &
-0.55e-6_wp, 0.00e-6_wp, &
+0.53e-6_wp, 0.00e-6_wp, &
-0.27e-6_wp, 0.00e-6_wp, &
-0.27e-6_wp, 0.00e-6_wp, &
-0.26e-6_wp, 0.00e-6_wp, &
-0.25e-6_wp, 0.00e-6_wp, &
+0.22e-6_wp, 0.00e-6_wp, &
-0.21e-6_wp, 0.00e-6_wp, &
+0.20e-6_wp, 0.00e-6_wp, &
+0.17e-6_wp, 0.00e-6_wp, &
+0.13e-6_wp, 0.00e-6_wp, &
-0.13e-6_wp, 0.00e-6_wp, &
-0.12e-6_wp, 0.00e-6_wp, &
-0.11e-6_wp, 0.00e-6_wp ], [2, ns2])
! Sine and cosine coefficients for t^3
real(wp), dimension( 2, ns3 ), parameter :: ss3 = reshape([ &
+0.30e-6_wp, -23.51e-6_wp, &
-0.03e-6_wp, -1.39e-6_wp, &
-0.01e-6_wp, -0.24e-6_wp, &
0.00e-6_wp, +0.22e-6_wp ], [2, ns3])
! Sine and cosine coefficients for t^4
real(wp), dimension( 2, ns4 ), parameter :: ss4 = reshape([ &
-0.26e-6_wp, -0.01e-6_wp ], [2, ns4])
! 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 s.
s0 = sp(1)
s1 = sp(2)
s2 = sp(3)
s3 = sp(4)
s4 = sp(5)
s5 = sp(6)
do i = ns0,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ks0(j,i),wp)*fa(j)
end do
s0 = s0 + ( ss0(1,i)*sin(a) + ss0(2,i)*cos(a) )
end do
do i = ns1,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ks1(j,i),wp)*fa(j)
end do
s1 = s1 + ( ss1(1,i)*sin(a) + ss1(2,i)*cos(a) )
end do
do i = ns2,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ks2(j,i),wp)*fa(j)
end do
s2 = s2 + ( ss2(1,i)*sin(a) + ss2(2,i)*cos(a) )
end do
do i = ns3,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ks3(j,i),wp)*fa(j)
end do
s3 = s3 + ( ss3(1,i)*sin(a) + ss3(2,i)*cos(a) )
end do
do i = ns4,1,-1
a = 0.0_wp
do j=1,8
a = a + real(ks4(j,i),wp)*fa(j)
end do
s4 = s4 + ( ss4(1,i)*sin(a) + ss4(2,i)*cos(a) )
end do
s = ( s0 + &
( s1 + &
( s2 + &
( s3 + &
( s4 + &
s5 * t ) * t ) * t ) * t ) * t ) * das2r - x*y/2.0_wp
end function S00