astro_module.f90 Source File

!********************************************************************************
!>
!  Modern Fortran implementations of standard models used in fundamental astronomy
!
!### Notes
!
!  This library is based on the IAU SOFA library.
!  The routines have been changed in the following ways:
!
!  * Conversion from Fixed-form (FORTRAN 77) to Free-form (Fortran 2008) format.
!  * Removal of the "iau_" prefix on all routines.
!  * All routines were combined into this module.
!  * moved headers before code in prep for FORD syntax.
!  * replaced DOUBLE PRECISION with REAL(WP)
!  * replaced old style PARAMETER and DATA declarations
!  * eliminate line numbers (replace with do...end do, replaced some with exit statements)
!  * replace DBLE(...) with real(...,wp)
!  * add INTENT to all arguments
!  * make all routines PURE
!  * get rid of the "Called:" blocks in the headers
!  * added RESULT() to functions.
!  * Work in progress
!    * replace anint and nint
!    * moved duplicated parameter declarations to the top of the module
!    * changed DATA statements to PARAMETERs
!    * need to eliminate a lot of documentation duplication in various routines.
!    * need to provide a way to specify user-defined [[DAT]] routine for leap seconds
!
!### Original SOFA Copyright Notice
!
!  Copyright (C) 2019
!  Standards Of Fundamental Astronomy Board
!  of the International Astronomical Union.
!
!  =====================
!  SOFA Software License
!  =====================
!
!  NOTICE TO USER:
!
!  BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING SIX TERMS AND
!  CONDITIONS WHICH APPLY TO ITS USE.
!
!  1. The Software is owned by the IAU SOFA Board ("SOFA").
!
!  2. Permission is granted to anyone to use the SOFA software for any
!     purpose, including commercial applications, free of charge and
!     without payment of royalties, subject to the conditions and
!     restrictions listed below.
!
!  3. You (the user) may copy and distribute SOFA source code to others,
!     and use and adapt its code and algorithms in your own software,
!     on a world-wide, royalty-free basis.  That portion of your
!     distribution that does not consist of intact and unchanged copies
!     of SOFA source code files is a "derived work" that must comply
!     with the following requirements:
!
!     a) Your work shall be marked or carry a statement that it
!        (i) uses routines and computations derived by you from
!        software provided by SOFA under license to you; and
!        (ii) does not itself constitute software provided by and/or
!        endorsed by SOFA.
!
!     b) The source code of your derived work must contain descriptions
!        of how the derived work is based upon, contains and/or differs
!        from the original SOFA software.
!
!     c) The names of all routines in your derived work shall not
!        include the prefix "iau" or "sofa" or trivial modifications
!        thereof such as changes of case.
!
!     d) The origin of the SOFA components of your derived work must
!        not be misrepresented;  you must not claim that you wrote the
!        original software, nor file a patent application for SOFA
!        software or algorithms embedded in the SOFA software.
!
!     e) These requirements must be reproduced intact in any source
!        distribution and shall apply to anyone to whom you have
!        granted a further right to modify the source code of your
!        derived work.
!
!     Note that, as originally distributed, the SOFA software is
!     intended to be a definitive implementation of the IAU standards,
!     and consequently third-party modifications are discouraged.  All
!     variations, no matter how minor, must be explicitly marked as
!     such, as explained above.
!
!  4. You shall not cause the SOFA software to be brought into
!     disrepute, either by misuse, or use for inappropriate tasks, or
!     by inappropriate modification.
!
!  5. The SOFA software is provided "as is" and SOFA makes no warranty
!     as to its use or performance.   SOFA does not and cannot warrant
!     the performance or results which the user may obtain by using the
!     SOFA software.  SOFA makes no warranties, express or implied, as
!     to non-infringement of third party rights, merchantability, or
!     fitness for any particular purpose.  In no event will SOFA be
!     liable to the user for any consequential, incidental, or special
!     damages, including any lost profits or lost savings, even if a
!     SOFA representative has been advised of such damages, or for any
!     claim by any third party.
!
!  6. The provision of any version of the SOFA software under the terms
!     and conditions specified herein does not imply that future
!     versions will also be made available under the same terms and
!     conditions.
!
!  In any published work or commercial product which uses the SOFA
!  software directly, acknowledgement (see www.iausofa.org) is
!  appreciated.
!
!  Correspondence concerning SOFA software should be addressed as
!  follows:
!
!      By email:  sofa@ukho.gov.uk
!      By post:   IAU SOFA Center
!                 HM Nautical Almanac Office
!                 UK Hydrographic Office
!                 Admiralty Way, Taunton
!                 Somerset, TA1 2DN
!                 United Kingdom
!
!********************************************************************************
    module astro_module

    use iso_fortran_env, only: wp => real64

    implicit none

    public

    real(wp),parameter,private :: cmps  = 299792458.0_wp                    !! Speed of light (m/s)
    real(wp),parameter,private :: d2pi  = 6.283185307179586476925287_wp     !! 2Pi
    real(wp),parameter,private :: d2s   = 86400.0_wp                        !! Days to seconds
    real(wp),parameter,private :: das2r = 4.848136811095359935899141e-6_wp  !! Arcseconds to radians
    real(wp),parameter,private :: dj00  = 2451545.0_wp                      !! Reference epoch (J2000.0), JD
    real(wp),parameter,private :: djc   = 36525.0_wp                        !! Days per Julian century
    real(wp),parameter,private :: djy   = 365.25_wp                         !! Days per Julian year
    real(wp),parameter,private :: dpi   = 3.141592653589793238462643_wp     !! Pi
    real(wp),parameter,private :: ds2r  = 7.272205216643039903848712e-5_wp  !! Seconds of time to radians

    contains
!********************************************************************************

!***********************************************************************
!>
!  Decompose radians into degrees, arcminutes, arcseconds, fraction.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. NDP is interpreted as follows:
!```
!     NDP         resolution
!      :      ...0000 00 00
!     -7         1000 00 00
!     -6          100 00 00
!     -5           10 00 00
!     -4            1 00 00
!     -3            0 10 00
!     -2            0 01 00
!     -1            0 00 10
!      0            0 00 01
!      1            0 00 00.1
!      2            0 00 00.01
!      3            0 00 00.001
!      :            0 00 00.000...
!```
!  2. The largest positive useful value for NDP is determined by the
!     size of ANGLE, the format of REAL(WP) floating-point
!     numbers on the target platform, and the risk of overflowing
!     IDMSF(4).  On a typical platform, for ANGLE up to 2pi, the
!     available floating-point precision might correspond to NDP=12.
!     However, the practical limit is typically NDP=9, set by the
!     capacity of a 32-bit IDMSF(4).
!
!  3. The absolute value of ANGLE may exceed 2pi.  In cases where it
!     does not, it is up to the caller to test for and handle the
!     case where ANGLE is very nearly 2pi and rounds up to 360 degrees,
!     by testing for IDMSF(1)=360 and setting IDMSF(1-4) to zero.
!
!### History
!  * IAU SOFA revision: 2007 December 3

    subroutine A2AF ( ndp, angle, sign, idmsf )

    implicit none

    integer,intent(in) :: ndp !! resolution (Note 1)
    real(wp),intent(in) :: angle !! angle in radians
    character(len=*),intent(out) :: sign !! '+' or '-'
    integer,dimension(4),intent(out) :: idmsf !! degrees, arcminutes, arcseconds, fraction

    !  Hours to degrees * radians to turns
    real(wp),parameter :: f = 15.0_wp/d2pi

    !  Scale then use days to h,m,s routine.
    call D2TF ( ndp, angle*f, sign, idmsf )

    end subroutine A2AF
!***********************************************************************

!***********************************************************************
!>
!  Decompose radians into hours, minutes, seconds, fraction.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. NDP is interpreted as follows:
!```
!     NDP         resolution
!      :      ...0000 00 00
!     -7         1000 00 00
!     -6          100 00 00
!     -5           10 00 00
!     -4            1 00 00
!     -3            0 10 00
!     -2            0 01 00
!     -1            0 00 10
!      0            0 00 01
!      1            0 00 00.1
!      2            0 00 00.01
!      3            0 00 00.001
!      :            0 00 00.000...
!```
!  2. The largest useful value for NDP is determined by the size
!     of ANGLE, the format of REAL(WP) floating-point numbers
!     on the target platform, and the risk of overflowing IHMSF(4).
!     On a typical platform, for ANGLE up to 2pi, the available
!     floating-point precision might correspond to NDP=12.  However,
!     the practical limit is typically NDP=9, set by the capacity of
!     a 32-bit IHMSF(4).
!
!  3. The absolute value of ANGLE may exceed 2pi.  In cases where it
!     does not, it is up to the caller to test for and handle the
!     case where ANGLE is very nearly 2pi and rounds up to 24 hours,
!     by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine A2TF ( ndp, angle, sign, ihmsf )

    implicit none

    integer,intent(in) :: ndp !! resolution (Note 1)
    real(wp),intent(in):: angle !! angle in radians
    character(len=*),intent(out) :: sign !! '+' or '-'
    integer,dimension(4),intent(out) :: ihmsf !! hours, minutes, seconds, fraction

    !  Scale then use days to h,m,s routine.
    call D2TF ( ndp, angle/d2pi, sign, ihmsf )

    end subroutine A2TF
!***********************************************************************

!***********************************************************************
!>
!  Apply aberration to transform natural direction into proper
!  direction.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The algorithm is based on Expr. (7.40) in the Explanatory
!     Supplement (Urban & Seidelmann 2013), but with the following
!     changes:
!
!     *  Rigorous rather than approximate normalization is applied.
!
!     *  The gravitational potential term from Expr. (7) in
!        Klioner (2003) is added, taking into account only the Sun's
!        contribution.  This has a maximum effect of about
!        0.4 microarcsecond.
!
!  2. In almost all cases, the maximum accuracy will be limited by the
!     supplied velocity.  For example, if the SOFA EPV00 routine is
!     used, errors of up to 5 microarcseconds could occur.
!
!### References
!
!  * Urban, S. & Seidelmann, P. K. (eds), Explanatory Supplement to
!    the Astronomical Almanac, 3rd ed., University Science Books
!    (2013).
!
!  * Klioner, Sergei A., "A practical relativistic model for micro-
!    arcsecond astrometry in space", Astr. J. 125, 1580-1597 (2003).
!
!### History
!  * IAU SOFA revision:  2013 August 31

    subroutine AB ( pnat, v, s, bm1, ppr )

    implicit none

    real(wp),dimension(3),intent(in) :: pnat !! natural direction to the source (unit vector)
    real(wp),dimension(3),intent(in) :: v !! observer barycentric velocity in units of c
    real(wp),intent(in) :: s !! distance between the Sun and the observer (au)
    real(wp),intent(in) :: bm1 !! sqrt(1-|v|^2): reciprocal of Lorenz factor
    real(wp),dimension(3),intent(out) :: ppr !! proper direction to source (unit vector)

    !  Schwarzschild radius of the Sun (au)
    !  = 2 * 1.32712440041e20 / (2.99792458e8)^2 / 1.49597870700e11
    real(wp),parameter :: srs = 1.97412574336e-08_wp

    integer :: i
    real(wp) :: pdv, w1, w2, r2, w, p(3), r

    call PDP ( pnat, v, pdv )
    w1 = 1.0_wp + pdv/(1.0_wp+bm1)
    w2 = srs / s
    r2 = 0.0_wp
    do i=1,3
       w = pnat(i)*bm1 + w1*v(i) + w2*(v(i)-pdv*pnat(i))
       p(i) = w
       r2 = r2 + w*w
    end do
    r = sqrt ( r2 )
    do i=1,3
       ppr(i) = p(i) / r
    end do

    end subroutine AB
!***********************************************************************

!***********************************************************************
!>
!  Horizon to equatorial coordinates:  transform azimuth and altitude
!  to hour angle and declination.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  All the arguments are angles in radians.
!
!  2.  The sign convention for azimuth is north zero, east +pi/2.
!
!  3.  HA is returned in the range +/-pi.  Declination is returned in
!      the range +/-pi/2.
!
!  4.  The latitude PHI is pi/2 minus the angle between the Earth's
!      rotation axis and the adopted zenith.  In many applications it
!      will be sufficient to use the published geodetic latitude of the
!      site.  In very precise (sub-arcsecond) applications, PHI can be
!      corrected for polar motion.
!
!  5.  The azimuth AZ must be with respect to the rotational north pole,
!      as opposed to the ITRS pole, and an azimuth with respect to north
!      on a map of the Earth's surface will need to be adjusted for
!      polar motion if sub-arcsecond accuracy is required.
!
!  6.  Should the user wish to work with respect to the astronomical
!      zenith rather than the geodetic zenith, PHI will need to be
!      adjusted for deflection of the vertical (often tens of
!      arcseconds), and the zero point of HA will also be affected.
!
!  7.  The transformation is the same as Ve = Ry(phi-pi/2)*Rz(pi)*Vh,
!      where Ve and Vh are lefthanded unit vectors in the (ha,dec) and
!      (az,el) systems respectively and Rz and Ry are rotations about
!      first the z-axis and then the y-axis.  (n.b. Rz(pi) simply
!      reverses the signs of the x and y components.)  For efficiency,
!      the algorithm is written out rather than calling other utility
!      functions.  For applications that require even greater
!      efficiency, additional savings are possible if constant terms
!      such as functions of latitude are computed once and for all.
!
!  8.  Again for efficiency, no range checking of arguments is carried
!      out.
!
!  Last revision:   2018 January 2
!
    subroutine AE2HD (az, el, phi, ha, dec)

    implicit none

    real(wp),intent(in) :: az !! azimuth
    real(wp),intent(in) :: el !! elevation
    real(wp),intent(in) :: phi !! observatory latitude
    real(wp),intent(out) :: ha !! hour angle
    real(wp),intent(out) :: dec !! declination

    real(wp) :: sa, ca, se, ce, sp, cp, x, y, z, r

    !  Useful trig functions.
    sa = sin(az)
    ca = cos(az)
    se = sin(el)
    ce = cos(el)
    sp = sin(phi)
    cp = cos(phi)

    !  Az,Alt unit vector.
    x = - ca*ce*sp + se*cp
    y = - sa*ce
    z = ca*ce*cp + se*sp

    !  To spherical.
    r = sqrt(x*x + y*y)
    if ( r==0.0_wp ) then
       ha = 0.0_wp
    else
       ha = atan2(y,x)
    end if
    dec = atan2(z,r)

    end subroutine AE2HD
!***********************************************************************

!***********************************************************************
!>
!  Convert degrees, arcminutes, arcseconds to radians.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  If the s argument is a string, only the leftmost character is
!      used and no warning status is provided.
!
!  2.  The result is computed even if any of the range checks fail.
!
!  3.  Negative IDEG, IAMIN and/or ASEC produce a warning status, but
!      the absolute value is used in the conversion.
!
!  4.  If there are multiple errors, the status value reflects only the
!      first, the smallest taking precedence.
!
!### History
!  * IAU SOFA revision: 2013 December 2

    subroutine AF2A ( s, ideg, iamin, asec, rad, j )

    implicit none

    character(len=1),intent(in) :: s !! sign:  '-' = negative, otherwise positive
    integer,intent(in) :: ideg !! degrees
    integer,intent(in) :: iamin !! arcminutes
    real(wp),intent(in) :: asec !! arcseconds
    real(wp),intent(out) :: rad !! angle in radians
    integer,intent(out) :: j !! status:
                             !! 0 = OK
                             !! 1 = IDEG outside range 0-359
                             !! 2 = IAMIN outside range 0-59
                             !! 3 = ASEC outside range 0-59.999...

    real(wp) :: w

    !  Preset the status.
    j = 0

    !  Validate arcseconds, arcminutes, degrees.
    if ( asec<0.0_wp .or. asec>=60.0_wp ) j=3
    if ( iamin<0 .or. iamin>59 ) j=2
    if ( ideg<0 .or. ideg>359 ) j=1

    !  Compute the angle.
    w = ( 60.0_wp * ( 60.0_wp * real( abs(ideg), wp ) + &
                          real( abs(iamin), wp ) ) + &
                          abs(asec) ) * das2r

    !  Apply the sign.
    if ( s == '-' ) w = -w

    !  Return the result.
    rad = w

    end subroutine AF2A
!***********************************************************************

!***********************************************************************
!>
!  Normalize angle into the range 0 <= A < 2pi.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 December 15

    function ANP ( a ) result(w)

    implicit none

    real(wp),intent(in) :: a !! angle (radians)
    real(wp) :: w !! angle in range 0-2pi

    w = mod(a,d2pi)
    if ( w < 0.0_wp ) w = w + d2pi

    end function ANP
!***********************************************************************

!***********************************************************************
!>
!  Normalize angle into the range -pi <= A < +pi.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    function ANPM ( a ) result(w)

    implicit none

    real(wp),intent(in) :: a !! angle (radians)
    real(wp) :: w !! angle in range +/-pi

    w = mod(a,d2pi)
    if ( abs(w) >= dpi ) w = w - sign(d2pi,a)

    end function ANPM
!***********************************************************************

!***********************************************************************
!>
!  For a geocentric observer, prepare star-independent astrometry
!  parameters for transformations between ICRS and GCRS coordinates.
!  The Earth ephemeris is supplied by the caller.
!
!  The parameters produced by this routine are required in the parallax,
!  light deflection and aberration parts of the astrometric
!  transformation chain.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. All the vectors are with respect to BCRS axes.
!
!  3. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  4. The context array ASTROM produced by this routine is used by
!     ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APCG ( date1, date2, ebpv, ehp, astrom )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(3,2),intent(in) :: ebpv !! Earth barycentric position/velocity (au, au/day)
    real(wp),dimension(3),intent(in) :: ehp !! Earth heliocentric position (au)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      PM time interval (SSB, Julian years)
                                                   !! (2-4)    SSB to observer (vector, au)
                                                   !! (5-7)    Sun to observer (unit vector)
                                                   !! (8)      distance from Sun to observer (au)
                                                   !! (9-11)   v: barycentric observer velocity (vector, c)
                                                   !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                   !! (13-21)  bias-precession-nutation matrix
                                                   !! (22)     unchanged
                                                   !! (23)     unchanged
                                                   !! (24)     unchanged
                                                   !! (25)     unchanged
                                                   !! (26)     unchanged
                                                   !! (27)     unchanged
                                                   !! (28)     unchanged
                                                   !! (29)     unchanged
                                                   !! (30)     unchanged

    real(wp) :: pv(3,2)

    !  Geocentric observer.
    call ZPV ( pv )

    !  Compute the star-independent astrometry parameters.
    call APCS ( date1, date2, pv, ebpv, ehp, astrom )

    end subroutine APCG
!***********************************************************************

!***********************************************************************
!>
!  For a geocentric observer, prepare star-independent astrometry
!  parameters for transformations between ICRS and GCRS coordinates.
!  The caller supplies the date, and SOFA models are used to predict
!  the Earth ephemeris.
!
!  The parameters produced by this routine are required in the
!  parallax, light deflection and aberration parts of the astrometric
!  transformation chain.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. All the vectors are with respect to BCRS axes.
!
!  3. In cases where the caller wishes to supply his own Earth
!     ephemeris, the routine APCG can be used instead of the present
!     routine.
!
!  4. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  5. The context array ASTROM produced by this routine is used by
!     ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APCG13 ( date1, date2, astrom )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      PM time interval (SSB, Julian years)
                                                   !! (2-4)    SSB to observer (vector, au)
                                                   !! (5-7)    Sun to observer (unit vector)
                                                   !! (8)      distance from Sun to observer (au)
                                                   !! (9-11)   v: barycentric observer velocity (vector, c)
                                                   !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                   !! (13-21)  bias-precession-nutation matrix
                                                   !! (22)     unchanged
                                                   !! (23)     unchanged
                                                   !! (24)     unchanged
                                                   !! (25)     unchanged
                                                   !! (26)     unchanged
                                                   !! (27)     unchanged
                                                   !! (28)     unchanged
                                                   !! (29)     unchanged
                                                   !! (30)     unchanged

    integer :: j
    real(wp) :: ehpv(3,2), ebpv(3,2)

    !  Earth barycentric & heliocentric position/velocity (au, au/d).
    call EPV00 ( date1, date2, ehpv, ebpv, j )

    !  Compute the star-independent astrometry parameters.
    call APCG ( date1, date2, ebpv, ehpv, astrom )

    end subroutine APCG13
!***********************************************************************

!***********************************************************************
!>
!  For a terrestrial observer, prepare star-independent astrometry
!  parameters for transformations between ICRS and geocentric CIRS
!  coordinates.  The Earth ephemeris and CIP/CIO are supplied by the
!  caller.
!
!  The parameters produced by this routine are required in the parallax,
!  light deflection, aberration, and bias-precession-nutation parts of
!  the astrometric transformation chain.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. All the vectors are with respect to BCRS axes.
!
!  3. In cases where the caller does not wish to provide the Earth
!     ephemeris and CIP/CIO, the routine APCI13 can be used instead
!     of the present routine.  This computes the required quantities
!     using other SOFA routines.
!
!  4. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  5. The context array ASTROM produced by this routine is used by
!     ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APCI ( date1, date2, ebpv, ehp, x, y, s, astrom )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(3,2),intent(in) :: ebpv !! Earth barycentric position/velocity (au, au/day)
    real(wp),dimension(3),intent(in) :: ehp !! Earth heliocentric position (au)
    real(wp),intent(in) :: x !! CIP X (component of unit vector)
    real(wp),intent(in) :: y !! CIP Y (component of unit vector)
    real(wp),intent(in) :: s !! the CIO locator s (radians)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      PM time interval (SSB, Julian years)
                                                   !! (2-4)    SSB to observer (vector, au)
                                                   !! (5-7)    Sun to observer (unit vector)
                                                   !! (8)      distance from Sun to observer (au)
                                                   !! (9-11)   v: barycentric observer velocity (vector, c)
                                                   !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                   !! (13-21)  bias-precession-nutation matrix
                                                   !! (22)     unchanged
                                                   !! (23)     unchanged
                                                   !! (24)     unchanged
                                                   !! (25)     unchanged
                                                   !! (26)     unchanged
                                                   !! (27)     unchanged
                                                   !! (28)     unchanged
                                                   !! (29)     unchanged
                                                   !! (30)     unchanged

    !  Star-independent astrometry parameters for geocenter.
    call APCG ( date1, date2, ebpv, ehp, astrom )

    !  CIO based BPN matrix.
    call C2IXYS ( x, y, s, astrom(13) )

    end subroutine APCI
!***********************************************************************

!***********************************************************************
!>
!  For a terrestrial observer, prepare star-independent astrometry
!  parameters for transformations between ICRS and geocentric CIRS
!  coordinates.  The caller supplies the date, and SOFA models are
!  used to predict the Earth ephemeris and CIP/CIO.
!
!  The parameters produced by this routine are required in the parallax,
!  light deflection, aberration, and bias-precession-nutation parts of
!  the astrometric transformation chain.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. All the vectors are with respect to BCRS axes.
!
!  3. In cases where the caller wishes to supply his own Earth
!     ephemeris and CIP/CIO, the routine APCI can be used instead of
!     the present routine.
!
!  4. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  5. The context array ASTROM produced by this routine is used by
!     ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APCI13 ( date1, date2, astrom, eo )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      PM time interval (SSB, Julian years)
                                                   !! (2-4)    SSB to observer (vector, au)
                                                   !! (5-7)    Sun to observer (unit vector)
                                                   !! (8)      distance from Sun to observer (au)
                                                   !! (9-11)   v: barycentric observer velocity (vector, c)
                                                   !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                   !! (13-21)  bias-precession-nutation matrix
                                                   !! (22)     unchanged
                                                   !! (23)     unchanged
                                                   !! (24)     unchanged
                                                   !! (25)     unchanged
                                                   !! (26)     unchanged
                                                   !! (27)     unchanged
                                                   !! (28)     unchanged
                                                   !! (29)     unchanged
                                                   !! (30)     unchanged
    real(wp),intent(out) :: eo !! equation of the origins (ERA-GST)

    integer :: j
    real(wp) :: pvh(3,2), pvb(3,2), r(3,3), x, y, s

    !  Earth barycentric & heliocentric position/velocity (au, au/d).
    call EPV00 ( date1, date2, pvh, pvb, j )

    !  Form the equinox based BPN matrix, IAU 2006/2000A.
    call PNM06A ( date1, date2, r )

    !  Extract CIP X,Y.
    call BPN2XY ( r, x, y )

    !  Obtain CIO locator s.
    s = S06 ( date1, date2, x, y )

    !  Compute the star-independent astrometry parameters.
    call APCI ( date1, date2, pvb, pvh, x, y, s, astrom )

    !  Equation of the origins.
    eo = EORS ( r, s )

    end subroutine APCI13
!***********************************************************************

!***********************************************************************
!>
!  For a terrestrial observer, prepare star-independent astrometry
!  parameters for transformations between ICRS and observed coordinates.
!  The caller supplies the Earth ephemeris, the Earth rotation
!  information and the refraction constants as well as the site
!  coordinates.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. The vectors EB, EH, and all the ASTROM vectors, are with respect
!     to BCRS axes.
!
!  3. The geographical coordinates are with respect to the WGS84
!     reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN
!     CONVENTION:  the longitude required by the present routine is
!     right-handed, i.e. east-positive, in accordance with geographical
!     convention.
!
!  4. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions), measured along the
!     meridians 0 and 90 deg west respectively.  SP is the TIO locator
!     s', in radians, which positions the Terrestrial Intermediate
!     Origin on the equator.  For many applications, XP, YP and
!     (especially) SP can be set to zero.
!
!     Internally, the polar motion is stored in a form rotated onto the
!     local meridian.
!
!  5. The refraction constants REFA and REFB are for use in a
!     dZ = A*tan(Z)+B*tan^3(Z) model, where Z is the observed
!     (i.e. refracted) zenith distance and dZ is the amount of
!     refraction.
!
!  6. It is advisable to take great care with units, as even unlikely
!     values of the input parameters are accepted and processed in
!     accordance with the models used.
!
!  7. In cases where the caller does not wish to provide the Earth
!     Ephemeris, the Earth rotation information and refraction
!     constants, the routine APCO13 can be used instead of the
!     present routine.  This starts from UTC and weather readings etc.
!     and computes suitable values using other SOFA routines.
!
!  8. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  9. The context array ASTROM produced by this routine is used by
!     ATIOQ, ATOIQ, ATCIQ*, and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APCO ( date1, date2, ebpv, ehp, x, y, s, &
                      theta, elong, phi, hm, xp, yp, sp, &
                      refa, refb, astrom )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(3,2),intent(in) :: ebpv !! Earth barycentric pos/vel (au, au/day, Note 2)
    real(wp),dimension(3),intent(in) :: ehp !! Earth heliocentric position (au, Note 2)
    real(wp),intent(in) :: x !! CIP X (component of unit vector)
    real(wp),intent(in) :: y !! CIP Y (component of unit vector)
    real(wp),intent(in) :: s !! the CIO locator s (radians)
    real(wp),intent(in) :: theta !! Earth rotation angle (radians)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 3)
    real(wp),intent(in) :: phi !! latitude (geodetic, radians, Note 3)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic, Note 3)
    real(wp),intent(in) :: xp !! polar motion coordinate (radians, Note 4)
    real(wp),intent(in) :: yp !! polar motion coordinate (radians, Note 4)
    real(wp),intent(in) :: sp !! the TIO locator s' (radians, Note 4)
    real(wp),intent(in) :: refa !! refraction constant A (radians, Note 5)
    real(wp),intent(in) :: refb !! refraction constant B (radians, Note 5)
    real(wp),dimension(30),intent(out) :: astrom !! star-independent astrometry parameters:
                                                 !!
                                                 !! (1)      PM time interval (SSB, Julian years)
                                                 !! (2-4)    SSB to observer (vector, au)
                                                 !! (5-7)    Sun to observer (unit vector)
                                                 !! (8)      distance from Sun to observer (au)
                                                 !! (9-11)   v: barycentric observer velocity (vector, c)
                                                 !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                 !! (13-21)  bias-precession-nutation matrix
                                                 !! (22)     longitude + s' (radians)
                                                 !! (23)     polar motion xp wrt local meridian (radians)
                                                 !! (24)     polar motion yp wrt local meridian (radians)
                                                 !! (25)     sine of geodetic latitude
                                                 !! (26)     cosine of geodetic latitude
                                                 !! (27)     magnitude of diurnal aberration vector
                                                 !! (28)     "local" Earth rotation angle (radians)
                                                 !! (29)     refraction constant A (radians)
                                                 !! (30)     refraction constant B (radians)

    real(wp) :: sl, cl, r(3,3), pvc(3,2), pv(3,2)

    !  Longitude with adjustment for TIO locator s'.
    astrom(22) = elong + sp

    !  Polar motion, rotated onto the local meridian.
    sl = sin(astrom(22))
    cl = cos(astrom(22))
    astrom(23) = xp*cl - yp*sl
    astrom(24) = xp*sl + yp*cl

    !  Functions of latitude.
    astrom(25) = sin(phi)
    astrom(26) = cos(phi)

    !  Refraction constants.
    astrom(29) = refa
    astrom(30) = refb

    !  Local Earth rotation angle.
    call APER ( theta, astrom )

    !  Disable the (redundant) diurnal aberration step.
    astrom(27) = 0.0_wp

    !  CIO based BPN matrix.
    call C2IXYS ( x, y, s, r )

    !  Observer's geocentric position and velocity (m, m/s, CIRS).
    call PVTOB ( elong, phi, hm, xp, yp, sp, theta, pvc )

    !  Rotate into GCRS.
    call TRXPV ( r, pvc, pv )

    !  ICRS <-> GCRS parameters.
    call APCS ( date1, date2, pv, ebpv, ehp, astrom )

    !  Store the CIO based BPN matrix.
    call CR ( r, astrom(13) )

    end subroutine APCO
!***********************************************************************

!***********************************************************************
!>
!  For a terrestrial observer, prepare star-independent astrometry
!  parameters for transformations between ICRS and observed coordinates.
!  The caller supplies UTC, site coordinates, ambient air conditions and
!  observing wavelength, and SOFA models are used to obtain the Earth
!  ephemeris, CIP/CIO and refraction constants.
!
!  The parameters produced by this routine are required in the parallax,
!  light deflection, aberration, and bias-precession-nutation parts of
!  the ICRS/CIRS transformations.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!      convenient way between the two arguments, for example where UTC1
!      is the Julian Day Number and UTC2 is the fraction of a day.
!
!      However, JD cannot unambiguously represent UTC during a leap
!      second unless special measures are taken.  The convention in the
!      present routine is that the JD day represents UTC days whether
!      the length is 86399, 86400 or 86401 SI seconds.
!
!      Applications should use the routine DTF2D to convert from
!      calendar date and time of day into 2-part quasi Julian Date, as
!      it implements the leap-second-ambiguity convention just
!      described.
!
!  2.  The warning status "dubious year" flags UTCs that predate the
!      introduction of the time scale or that are too far in the
!      future to be trusted.  See DAT for further details.
!
!  3.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
!      one second at the end of each positive UTC leap second,
!      introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
!      practice is under review, and in the future UT1-UTC may grow
!      essentially without limit.
!
!  4.  The geographical coordinates are with respect to the WGS84
!      reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!      longitude required by the present routine is east-positive
!      (i.e. right-handed), in accordance with geographical convention.
!
!  5.  The polar motion XP,YP can be obtained from IERS bulletins.  The
!      values are the coordinates (in radians) of the Celestial
!      Intermediate Pole with respect to the International Terrestrial
!      Reference System (see IERS Conventions 2003), measured along the
!      meridians 0 and 90 deg west respectively.  For many applications,
!      XP and YP can be set to zero.
!
!      Internally, the polar motion is stored in a form rotated onto
!      the local meridian.
!
!  6.  If hm, the height above the ellipsoid of the observing station
!      in meters, is not known but phpa, the pressure in hPa (=mB), is
!      available, an adequate estimate of hm can be obtained from the
!      expression
!
!            hm = -29.3 * tsl * log ( phpa / 1013.25 );
!
!      where tsl is the approximate sea-level air temperature in K
!      (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
!      52).  Similarly, if the pressure phpa is not known, it can be
!      estimated from the height of the observing station, hm, as
!      follows:
!
!            phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );
!
!      Note, however, that the refraction is nearly proportional to
!      the pressure and that an accurate phpa value is important for
!      precise work.
!
!  7.  The argument WL specifies the observing wavelength in
!      micrometers.  The transition from optical to radio is assumed to
!      occur at 100 micrometers (about 3000 GHz).
!
!  8.  It is advisable to take great care with units, as even unlikely
!      values of the input parameters are accepted and processed in
!      accordance with the models used.
!
!  9.  In cases where the caller wishes to supply his own Earth
!      ephemeris, Earth rotation information and refraction constants,
!      the routine APCO can be used instead of the present routine.
!
!  10. This is one of several routines that inserts into the ASTROM
!      array star-independent parameters needed for the chain of
!      astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!      The various routines support different classes of observer and
!      portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!      Those with names ending in "13" use contemporary SOFA models to
!      compute the various ephemerides.  The others accept ephemerides
!      supplied by the caller.
!
!      The transformation from ICRS to GCRS covers space motion,
!      parallax, light deflection, and aberration.  From GCRS to CIRS
!      comprises frame bias and precession-nutation.  From CIRS to
!      observed takes account of Earth rotation, polar motion, diurnal
!      aberration and parallax (unless subsumed into the ICRS <-> GCRS
!      transformation), and atmospheric refraction.
!
!  11. The context array ASTROM produced by this routine is used by
!      ATIOQ, ATOIQ, ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2013 December 5

    subroutine APCO13 ( utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                        phpa, tc, rh, wl, astrom, eo, j )

    implicit none

    real(wp),intent(in) :: utc1 !! UTC as a 2-part...
    real(wp),intent(in) :: utc2 !! ...quasi Julian Date (Notes 1,2)
    real(wp),intent(in) :: dut1 !! UT1-UTC (seconds, Note 3)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 4)
    real(wp),intent(in) :: phi !! latitude (geodetic, radians, Note 4)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic, Notes 4,6)
    real(wp),intent(in) :: xp !! polar motion coordinate (radians, Note 5)
    real(wp),intent(in) :: yp !! polar motion coordinate (radians, Note 5)
    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = mB, Note 6)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers, Note 7)
    real(wp),dimension(30),intent(out) :: astrom !! star-independent astrometry parameters:
                                                 !!
                                                 !! (1)      PM time interval (SSB, Julian years)
                                                 !! (2-4)    SSB to observer (vector, au)
                                                 !! (5-7)    Sun to observer (unit vector)
                                                 !! (8)      distance from Sun to observer (au)
                                                 !! (9-11)   v: barycentric observer velocity (vector, c)
                                                 !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                 !! (13-21)  bias-precession-nutation matrix
                                                 !! (22)     longitude + s' (radians)
                                                 !! (23)     polar motion xp wrt local meridian (radians)
                                                 !! (24)     polar motion yp wrt local meridian (radians)
                                                 !! (25)     sine of geodetic latitude
                                                 !! (26)     cosine of geodetic latitude
                                                 !! (27)     magnitude of diurnal aberration vector
                                                 !! (28)     "local" Earth rotation angle (radians)
                                                 !! (29)     refraction constant A (radians)
                                                 !! (30)     refraction constant B (radians)
    real(wp),intent(out) :: eo !! equation of the origins (ERA-GST)
    integer,intent(out) :: j !! status: +1 = dubious year (Note 2)
                             !!  0 = OK
                             !! -1 = unacceptable date

    integer :: js, jw
    real(wp) :: tai1, tai2, tt1, tt2, ut11, ut12, &
                ehpv(3,2), ebpv(3,2), r(3,3), x, y, s, theta, &
                sp, refa, refb

    !  UTC to other time scales.
    call UTCTAI ( utc1, utc2, tai1, tai2, js )
    if ( js>=0 ) then

      call TAITT ( tai1, tai2, tt1, tt2, js )
      call UTCUT1 ( utc1, utc2, dut1, ut11, ut12, js )
      if ( js>=0 ) then

        !  Earth barycentric & heliocentric position/velocity (au, au/d).
        call EPV00 ( tt1, tt2, ehpv, ebpv, jw )

        !  Form the equinox based BPN matrix, IAU 2006/2000A.
        call PNM06A ( tt1, tt2, r )

        !  Extract CIP X,Y.
        call BPN2XY ( r, x, y )

        !  Obtain CIO locator s.
        s = S06 ( tt1, tt2, x, y )

        !  Earth rotation angle.
        theta = ERA00 ( ut11, ut12 )

        !  TIO locator s'.
        sp = SP00 ( tt1, tt2 )

        !  Refraction constants A and B.
        call REFCO ( phpa, tc, rh, wl, refa, refb )

        !  Compute the star-independent astrometry parameters.
        call APCO ( tt1, tt2, ebpv, ehpv, x, y, s, theta, &
                        elong, phi, hm, xp, yp, sp, refa, refb, &
                        astrom )

        !  Equation of the origins.
        eo = EORS ( r, s )

      end if

    end if

    !  Return the status.
    j = js

    end subroutine APCO13
!***********************************************************************

!***********************************************************************
!>
!  For an observer whose geocentric position and velocity are known,
!  prepare star-independent astrometry parameters for transformations
!  between ICRS and GCRS.  The Earth ephemeris is supplied by the
!  caller.
!
!  The parameters produced by this routine are required in the space
!  motion, parallax, light deflection and aberration parts of the
!  astrometric transformation chain.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. All the vectors are with respect to BCRS axes.
!
!  3. Providing separate arguments for (i) the observer's geocentric
!     position and velocity and (ii) the Earth ephemeris is done for
!     convenience in the geocentric, terrestrial and Earth orbit cases.
!     For deep space applications it maybe more convenient to specify
!     zero geocentric position and velocity and to supply the
!     observer's position and velocity information directly instead of
!     with respect to the Earth.  However, note the different units:
!     m and m/s for the geocentric vectors, au and au/day for the
!     heliocentric and barycentric vectors.
!
!  4. In cases where the caller does not wish to provide the Earth
!     ephemeris, the routine APCS13 can be used instead of the
!     present routine.  This computes the Earth ephemeris using the
!     SOFA routine EPV00.
!
!  5. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  6. The context array ASTROM produced by this routine is used by
!     ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 16

    subroutine APCS ( date1, date2, pv, ebpv, ehp, astrom )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(3,2),intent(in) :: pv !! observer's geocentric pos/vel (m, m/s)
    real(wp),dimension(3,2),intent(in) :: ebpv !! Earth barycentric position/velocity (au, au/day)
    real(wp),dimension(3),intent(in) :: ehp !! Earth heliocentric position (au)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      PM time interval (SSB, Julian years)
                                                   !! (2-4)    SSB to observer (vector, au)
                                                   !! (5-7)    Sun to observer (unit vector)
                                                   !! (8)      distance from Sun to observer (au)
                                                   !! (9-11)   v: barycentric observer velocity (vector, c)
                                                   !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                   !! (13-21)  bias-precession-nutation matrix
                                                   !! (22)     unchanged
                                                   !! (23)     unchanged
                                                   !! (24)     unchanged
                                                   !! (25)     unchanged
                                                   !! (26)     unchanged
                                                   !! (27)     unchanged
                                                   !! (28)     unchanged
                                                   !! (29)     unchanged
                                                   !! (30)     unchanged

    !  Astronomical unit (m, IAU 2012)
    real(wp),parameter :: aum = 149597870.7d3

    !  Light time for 1 au (s)
    real(wp),parameter :: ault = aum/cmps

    !  au/d to m/s
    real(wp),parameter :: audms = aum/d2s

    !  Light time for 1 au (day)
    real(wp),parameter :: cr = ault/d2s

    integer :: i
    real(wp) :: dp, dv, pb(3), vb(3), ph(3), v2, w

    !  Time since reference epoch, years (for proper motion calculation).
    astrom(1) = ( ( date1 - dj00 ) + date2 ) / djy

    !  Adjust Earth ephemeris to observer.
    do i=1,3
       dp = pv(i,1) / aum
       dv = pv(i,2) / audms
       pb(i) = ebpv(i,1) + dp
       vb(i) = ebpv(i,2) + dv
       ph(i) = ehp(i) + dp
    end do

    !  Barycentric position of observer (au).
    call CP ( pb, astrom(2) )

    !  Heliocentric direction and distance (unit vector and au).
    call PN ( ph, astrom(8), astrom(5) )

    !  Barycentric vel. in units of c, and reciprocal of Lorenz factor.
    v2 = 0.0_wp
    do i=1,3
       w = vb(i) * cr
       astrom(8+i) = w
       v2 = v2 + w*w
    end do
    astrom(12) = sqrt ( 1.0_wp - v2 )

    !  Reset the NPB matrix.
    call IR ( astrom(13) )

    end subroutine APCS
!***********************************************************************

!***********************************************************************
!>
!  For an observer whose geocentric position and velocity are known,
!  prepare star-independent astrometry parameters for transformations
!  between ICRS and GCRS.  The Earth ephemeris is from SOFA models.
!
!  The parameters produced by this routine are required in the space
!  motion, parallax, light deflection and aberration parts of the
!  astrometric transformation chain.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. All the vectors are with respect to BCRS axes.
!
!  3. The observer's position and velocity PV are geocentric but with
!     respect to BCRS axes, and in units of m and m/s.  No assumptions
!     are made about proximity to the Earth, and the routine can be
!     used for deep space applications as well as Earth orbit and
!     terrestrial.
!
!  4. In cases where the caller wishes to supply his own Earth
!     ephemeris, the routine APCS can be used instead of the present
!     routine.
!
!  5. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  6. The context array ASTROM produced by this routine is used by
!     ATCIQ* and ATICQ*.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APCS13 ( date1, date2, pv, astrom )

    implicit none

    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),dimension(3,2),intent(in) :: pv !! observer's geocentric pos/vel (Note 3)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      PM time interval (SSB, Julian years)
                                                   !! (2-4)    SSB to observer (vector, au)
                                                   !! (5-7)    Sun to observer (unit vector)
                                                   !! (8)      distance from Sun to observer (au)
                                                   !! (9-11)   v: barycentric observer velocity (vector, c)
                                                   !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                   !! (13-21)  bias-precession-nutation matrix
                                                   !! (22)     unchanged
                                                   !! (23)     unchanged
                                                   !! (24)     unchanged
                                                   !! (25)     unchanged
                                                   !! (26)     unchanged
                                                   !! (27)     unchanged
                                                   !! (28)     unchanged
                                                   !! (29)     unchanged
                                                   !! (30)     unchanged

    integer :: j
    real(wp) :: ehpv(3,2), ebpv(3,2)

    !  Earth barycentric & heliocentric position/velocity (au, au/d).
    call EPV00 ( date1, date2, ehpv, ebpv, j )

    !  Compute the star-independent astrometry parameters.
    call APCS ( date1, date2, pv, ebpv, ehpv, astrom )

    end subroutine APCS13
!***********************************************************************

!***********************************************************************
!>
!  In the star-independent astrometry parameters, update only the
!  Earth rotation angle, supplied by the caller explicitly.
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine exists to enable sidereal-tracking applications to
!     avoid wasteful recomputation of the bulk of the astrometry
!     parameters:  only the Earth rotation is updated.
!
!  2. For targets expressed as equinox based positions, such as
!     classical geocentric apparent (RA,Dec), the supplied THETA can be
!     Greenwich apparent sidereal time rather than Earth rotation
!     angle.
!
!  3. The routine APER13 can be used instead of the present routine,
!     and starts from UT1 rather than ERA itself.
!
!  4. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!### History
!  * IAU SOFA revision:  2013 September 25

    subroutine APER ( theta, astrom )

    implicit none

    real(wp),intent(in) :: theta !! Earth rotation angle (radians, Note 2)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !! * In: astrom(22): longitude + s' (radians)
                                                   !! * Out: astrom(28): "local" Earth rotation angle (radians)

    astrom(28) = theta + astrom(22)

    end subroutine APER
!***********************************************************************

!***********************************************************************
!>
!  In the star-independent astrometry parameters, update only the
!  Earth rotation angle.  The caller provides UT1 (n.b. not UTC).
!
!  Status:  support routine.
!
!### Notes
!
!  1. The UT1 date (n.b. not UTC) UT11+UT12 is a Julian Date,
!     apportioned in any convenient way between the arguments UT11 and
!     UT12.  For example, JD(UT1)=2450123.7 could be expressed in any
!     of these ways, among others:
!
!            UT11           UT12
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  The date & time method is
!     best matched to the algorithm used:  maximum precision is
!     delivered when the UT11 argument is for 0hrs UT1 on the day in
!     question and the UT12 argument lies in the range 0 to 1, or vice
!     versa.
!
!  2. If the caller wishes to provide the Earth rotation angle itself,
!     the routine APER can be used instead.  One use of this
!     technique is to substitute Greenwich apparent sidereal time and
!     thereby to support equinox based transformations directly.
!
!  3. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine APER13 ( ut11, ut12, astrom )

    implicit none

    real(wp),intent(in) :: ut11 !! UT1 as a 2-part...
    real(wp),intent(in) :: ut12 !! ...Julian Date (Note 1)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !! * In: astrom(22): longitude + s' (radians)
                                                   !! * Out: astrom(28): "local" Earth rotation angle (radians)

    call APER ( ERA00 ( ut11, ut12 ), astrom )

    end subroutine APER13
!***********************************************************************

!***********************************************************************
!>
!  For a terrestrial observer, prepare star-independent astrometry
!  parameters for transformations between CIRS and observed coordinates.
!  The caller supplies the Earth orientation information and the
!  refraction constants as well as the site coordinates.
!
!  Status:  support routine.
!
!### Notes
!
!  1. SP, the TIO locator s', is a tiny quantity needed only by the most
!     precise applications.  It can either be set to zero or predicted
!     using the SOFA routine SP00.
!
!  2. The geographical coordinates are with respect to the WGS84
!     reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!     longitude required by the present routine is east-positive
!     (i.e. right-handed), in accordance with geographical convention.
!
!  3. The polar motion XP,YP can be obtained from IERS bulletins.  The
!     values are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians 0 and 90 deg west respectively.  For many applications,
!     XP and YP can be set to zero.
!
!     Internally, the polar motion is stored in a form rotated onto the
!     local meridian.
!
!  4. The refraction constants REFA and REFB are for use in a
!     dZ = A*tan(Z)+B*tan^3(Z) model, where Z is the observed
!     (i.e. refracted) zenith distance and dZ is the amount of
!     refraction.
!
!  5. It is advisable to take great care with units, as even unlikely
!     values of the input parameters are accepted and processed in
!     accordance with the models used.
!
!  6. In cases where the caller does not wish to provide the Earth
!     rotation information and refraction constants, the routine
!     APIO13 can be used instead of the present routine.  This
!     starts from UTC and weather readings etc. and computes suitable
!     values using other SOFA routines.
!
!  7. This is one of several routines that inserts into the ASTROM
!     array star-independent parameters needed for the chain of
!     astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!     The various routines support different classes of observer and
!     portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!     Those with names ending in "13" use contemporary SOFA models to
!     compute the various ephemerides.  The others accept ephemerides
!     supplied by the caller.
!
!     The transformation from ICRS to GCRS covers space motion,
!     parallax, light deflection, and aberration.  From GCRS to CIRS
!     comprises frame bias and precession-nutation.  From CIRS to
!     observed takes account of Earth rotation, polar motion, diurnal
!     aberration and parallax (unless subsumed into the ICRS <-> GCRS
!     transformation), and atmospheric refraction.
!
!  8. The context array ASTROM produced by this routine is used by
!     ATIOQ and ATOIQ.
!
!### History
!  * IAU SOFA revision:  2013 September 25

    subroutine APIO ( sp, theta, elong, phi, hm, xp, yp, &
                      refa, refb, astrom )

    implicit none

    real(wp),intent(in) :: sp !! the TIO locator s' (radians, Note 1)
    real(wp),intent(in) :: theta !! Earth rotation angle (radians)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 2)
    real(wp),intent(in) :: phi !! geodetic latitude (radians, Note 2)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic Note 2)
    real(wp),intent(in) :: xp !! polar motion coordinate (radians, Note 3)
    real(wp),intent(in) :: yp !! polar motion coordinate (radians, Note 3)
    real(wp),intent(in) :: refa !! refraction constant A (radians, Note 4)
    real(wp),intent(in) :: refb !! refraction constant B (radians, Note 4)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      unchanged
                                                   !! (2-4)    unchanged
                                                   !! (5-7)    unchanged
                                                   !! (8)      unchanged
                                                   !! (9-11)   unchanged
                                                   !! (12)     unchanged
                                                   !! (13-21)  unchanged
                                                   !! (22)     longitude + s' (radians)
                                                   !! (23)     polar motion xp wrt local meridian (radians)
                                                   !! (24)     polar motion yp wrt local meridian (radians)
                                                   !! (25)     sine of geodetic latitude
                                                   !! (26)     cosine of geodetic latitude
                                                   !! (27)     magnitude of diurnal aberration vector
                                                   !! (28)     "local" Earth rotation angle (radians)
                                                   !! (29)     refraction constant A (radians)
                                                   !! (30)     refraction constant B (radians)

    real(wp) :: sl, cl, pv(3,2)

    !  Longitude with adjustment for TIO locator s'.
    astrom(22) = elong + sp

    !  Polar motion, rotated onto the local meridian.
    sl = sin(astrom(22))
    cl = cos(astrom(22))
    astrom(23) = xp*cl - yp*sl
    astrom(24) = xp*sl + yp*cl

    !  Functions of latitude.
    astrom(25) = sin(phi)
    astrom(26) = cos(phi)

    !  Observer's geocentric position and velocity (m, m/s, CIRS).
    call PVTOB ( elong, phi, hm, xp, yp, sp, theta, pv )

    !  Magnitude of diurnal aberration vector.
    astrom(27) = sqrt ( pv(1,2)*pv(1,2) + pv(2,2)*pv(2,2) ) / cmps

    !  Refraction constants.
    astrom(29) = refa
    astrom(30) = refb

    !  Local Earth rotation angle.
    call APER ( theta, astrom )

    end subroutine APIO
!***********************************************************************

!***********************************************************************
!>
!  For a terrestrial observer, prepare star-independent astrometry
!  parameters for transformations between CIRS and observed coordinates.
!  The caller supplies UTC, site coordinates, ambient air conditions and
!  observing wavelength.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!      convenient way between the two arguments, for example where UTC1
!      is the Julian Day Number and UTC2 is the fraction of a day.
!
!      However, JD cannot unambiguously represent UTC during a leap
!      second unless special measures are taken.  The convention in the
!      present routine is that the JD day represents UTC days whether
!      the length is 86399, 86400 or 86401 SI seconds.
!
!      Applications should use the routine DTF2D to convert from
!      calendar date and time of day into 2-part quasi Julian Date, as
!      it implements the leap-second-ambiguity convention just
!      described.
!
!  2.  The warning status "dubious year" flags UTCs that predate the
!      introduction of the time scale or that are too far in the future
!      to be trusted.  See DAT for further details.
!
!  3.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
!      one second at the end of each positive UTC leap second,
!      introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
!      practice is under review, and in the future UT1-UTC may grow
!      essentially without limit.
!
!  4.  The geographical coordinates are with respect to the WGS84
!      reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!      longitude required by the present routine is east-positive
!      (i.e. right-handed), in accordance with geographical convention.
!
!  5.  The polar motion XP,YP can be obtained from IERS bulletins.  The
!      values are the coordinates (in radians) of the Celestial
!      Intermediate Pole with respect to the International Terrestrial
!      Reference System (see IERS Conventions 2003), measured along the
!      meridians 0 and 90 deg west respectively.  For many applications,
!      XP and YP can be set to zero.
!
!      Internally, the polar motion is stored in a form rotated onto
!      the local meridian.
!
!  6.  If hm, the height above the ellipsoid of the observing station
!      in meters, is not known but phpa, the pressure in hPa (=mB), is
!      available, an adequate estimate of hm can be obtained from the
!      expression
!
!            hm = -29.3 * tsl * log ( phpa / 1013.25 );
!
!      where tsl is the approximate sea-level air temperature in K
!      (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
!      52).  Similarly, if the pressure phpa is not known, it can be
!      estimated from the height of the observing station, hm, as
!      follows:
!
!            phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );
!
!      Note, however, that the refraction is nearly proportional to the
!      pressure and that an accurate phpa value is important for
!      precise work.
!
!  7.  The argument WL specifies the observing wavelength in
!      micrometers.  The transition from optical to radio is assumed to
!      occur at 100 micrometers (about 3000 GHz).
!
!  8.  It is advisable to take great care with units, as even unlikely
!      values of the input parameters are accepted and processed in
!      accordance with the models used.
!
!  9.  In cases where the caller wishes to supply his own Earth
!      rotation information and refraction constants, the routine
!      APC can be used instead of the present routine.
!
!  10. This is one of several routines that inserts into the ASTROM
!      array star-independent parameters needed for the chain of
!      astrometric transformations ICRS <-> GCRS <-> CIRS <-> observed.
!
!      The various routines support different classes of observer and
!      portions of the transformation chain:
!
!            routines           observer        transformation
!
!        APCG APCG13    geocentric      ICRS <-> GCRS
!        APCI APCI13    terrestrial     ICRS <-> CIRS
!        APCO APCO13    terrestrial     ICRS <-> observed
!        APCS APCS13    space           ICRS <-> GCRS
!        APER APER13    terrestrial     update Earth rotation
!        APIO APIO13    terrestrial     CIRS <-> observed
!
!      Those with names ending in "13" use contemporary SOFA models to
!      compute the various ephemerides.  The others accept ephemerides
!      supplied by the caller.
!
!      The transformation from ICRS to GCRS covers space motion,
!      parallax, light deflection, and aberration.  From GCRS to CIRS
!      comprises frame bias and precession-nutation.  From CIRS to
!      observed takes account of Earth rotation, polar motion, diurnal
!      aberration and parallax (unless subsumed into the ICRS <-> GCRS
!      transformation), and atmospheric refraction.
!
!  11. The context array ASTROM produced by this routine is used by
!      ATIOQ and ATOIQ.
!
!### History
!  * IAU SOFA revision:  2013 September 25

    subroutine APIO13 ( utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                        phpa, tc, rh, wl, astrom, j )

    implicit none

    real(wp),intent(in) :: utc1 !! UTC as a 2-part...
    real(wp),intent(in) :: utc2 !! ...quasi Julian Date (Notes 1,2)
    real(wp),intent(in) :: dut1 !! UT1-UTC (seconds)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 3)
    real(wp),intent(in) :: phi !! geodetic latitude (radians, Note 3)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic Notes 4,6)
    real(wp),intent(in) :: xp !! polar motion x-coordinate (radians, Note 5)
    real(wp),intent(in) :: yp !! polar motion x-coordinate (radians, Note 5)
    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = mB, Note 6)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers, Note 7)
    real(wp),dimension(30),intent(inout) :: astrom !! star-independent astrometry parameters:
                                                   !!
                                                   !! (1)      unchanged
                                                   !! (2-4)    unchanged
                                                   !! (5-7)    unchanged
                                                   !! (8)      unchanged
                                                   !! (9-11)   unchanged
                                                   !! (12)     unchanged
                                                   !! (13-21)  unchanged
                                                   !! (22)     longitude + s' (radians)
                                                   !! (23)     polar motion xp wrt local meridian (radians)
                                                   !! (24)     polar motion yp wrt local meridian (radians)
                                                   !! (25)     sine of geodetic latitude
                                                   !! (26)     cosine of geodetic latitude
                                                   !! (27)     magnitude of diurnal aberration vector
                                                   !! (28)     "local" Earth rotation angle (radians)
                                                   !! (29)     refraction constant A (radians)
                                                   !! (30)     refraction constant B (radians)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 2)
                             !! *  0 = OK
                             !! * -1 = unacceptable date

    integer :: js
    real(wp) :: tai1, tai2, tt1, tt2, ut11, ut12, sp, theta, &
                refa, refb

    !  UTC to other time scales.
    call UTCTAI ( utc1, utc2, tai1, tai2, js )
    call TAITT ( tai1, tai2, tt1, tt2, js )
    call UTCUT1 ( utc1, utc2, dut1, ut11, ut12, js )

    !  Abort if error.
    if ( js>=0 ) then

      !  TIO locator s'.
      sp = SP00 ( tt1, tt2 )

      !  Earth rotation angle.
      theta = ERA00 ( ut11, ut12 )

      !  Refraction constants A and B.
      call REFCO ( phpa, tc, rh, wl, refa, refb )

      !  CIRS <-> observed astrometry parameters.
      call APIO ( sp, theta, elong, phi, hm, xp, yp, refa, refb, &
                      astrom )

    end if

    !  Return the status.
    j = js

    end subroutine APIO13
!***********************************************************************

!***********************************************************************
!>
!  Transform ICRS star data, epoch J2000.0, to CIRS.
!
!  Status:  support routine.
!
!### Notes
!
!  1. Star data for an epoch other than J2000.0 (for example from the
!     Hipparcos catalog, which has an epoch of J1991.25) will require a
!     preliminary call to PMSAFE before use.
!
!  2. The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.
!
!  3. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  4. The available accuracy is better than 1 milliarcsecond, limited
!     mainly by the precession-nutation model that is used, namely
!     IAU 2000A/2006.  Very close to solar system bodies, additional
!     errors of up to several milliarcseconds can occur because of
!     unmodeled light deflection;  however, the Sun's contribution is
!     taken into account, to first order.  The accuracy limitations of
!     the SOFA routine EPV00 (used to compute Earth position and
!     velocity) can contribute aberration errors of up to
!     5 microarcseconds.  Light deflection at the Sun's limb is
!     uncertain at the 0.4 mas level.
!
!  5. Should the transformation to (equinox based) apparent place be
!     required rather than (CIO based) intermediate place, subtract the
!     equation of the origins from the returned right ascension:
!     RA = RI - EO. (The ANP routine can then be applied, as
!     required, to keep the result in the conventional 0-2pi range.)
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine ATCI13 ( rc, dc, pr, pd, px, rv, date1, date2, &
                        ri, di, eo )

    implicit none

    real(wp),intent(in) :: rc !! ICRS right ascension at J2000.0 (radians, Note 1)
    real(wp),intent(in) :: dc !! ICRS declination at J2000.0 (radians, Note 1)
    real(wp),intent(in) :: pr !! RA proper motion (radians/year; Note 2)
    real(wp),intent(in) :: pd !! Dec proper motion (radians/year)
    real(wp),intent(in) :: px !! parallax (arcsec)
    real(wp),intent(in) :: rv !! radial velocity (km/s, +ve if receding)
    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 3)
    real(wp),intent(out) :: ri !! CIRS geocentric RA (radians)
    real(wp),intent(out) :: di !! CIRS geocentric Dec (radians)
    real(wp),intent(out) :: eo !! equation of the origins (ERA-GST, Note 5)

    !  Star-independent astrometry parameters
    real(wp) :: astrom(30)

    !  The transformation parameters.
    call APCI13 ( date1, date2, astrom, eo )

    !  ICRS (epoch J2000.0) to CIRS.
    call ATCIQ ( rc, dc, pr, pd, px, rv, astrom, ri, di )

    end subroutine ATCI13
!***********************************************************************

!***********************************************************************
!>
!  Quick ICRS, epoch J2000.0, to CIRS transformation, given precomputed
!  star-independent astrometry parameters.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are to be transformed for one date.  The
!  star-independent parameters can be obtained by calling one of the
!  routines APCI[13], APCG[13], APCO[13] or APCS[13].
!
!  If the parallax and proper motions are zero the ATCIQZ routine
!  can be used instead.
!
!  Status:  support routine.
!
!### Notes
!
!  1. All the vectors are with respect to BCRS axes.
!
!  2. Star data for an epoch other than J2000.0 (for example from the
!     Hipparcos catalog, which has an epoch of J1991.25) will require a
!     preliminary call to PMSAFE before use.
!
!  3. The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.
!
!### History
!  * IAU SOFA revision:  2013 August 25

    subroutine ATCIQ ( rc, dc, pr, pd, px, rv, astrom, ri, di )

    implicit none

    real(wp),intent(in) :: rc !! ICRS RA at J2000.0 (radians)
    real(wp),intent(in) :: dc !! ICRS Dec at J2000.0 (radians)
    real(wp),intent(in) :: pr !! RA proper motion (radians/year; Note 3)
    real(wp),intent(in) :: pd !! Dec proper motion (radians/year)
    real(wp),intent(in) :: px !! parallax (arcsec)
    real(wp),intent(in) :: rv !! radial velocity (km/s, +ve if receding)
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    real(wp),intent(out) :: ri !! CIRS RA (radians)
    real(wp),intent(out) :: di !! CIRS Dec (radians)

    real(wp) :: pco(3), pnat(3), ppr(3), pi(3), w

    !  Proper motion and parallax, giving BCRS coordinate direction.
    call PMPX ( rc, dc, pr, pd, px, rv, astrom(1), astrom(2), &
                    pco )

    !  Light deflection by the Sun, giving BCRS natural direction.
    call LDSUN ( pco, astrom(5), astrom(8), pnat )

    !  Aberration, giving GCRS proper direction.
    call AB (pnat, astrom(9), astrom(8), astrom(12), ppr )

    !  Bias-precession-nutation, giving CIRS proper direction.
    call RXP ( astrom(13), ppr, pi )

    !  CIRS RA,Dec.
    call C2S ( pi, w, di )
    ri = ANP ( w )

    end subroutine ATCIQ
!***********************************************************************

!***********************************************************************
!>
!  Quick ICRS, epoch J2000.0, to CIRS transformation, given precomputed
!  star-independent astrometry parameters plus a list of light-
!  deflecting bodies.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are to be transformed for one date.  The
!  star-independent parameters can be obtained by calling one of the
!  routines APCI[13], APCG[13], APCO[13] or APCS[13].
!
!  If the only light-deflecting body to be taken into account is the
!  Sun, the ATCIQ routine can be used instead.  If in addition the
!  parallax and proper motions are zero, the ATCIQZ routine can be
!  used.
!
!  Status:  support routine.
!
!### Notes
!
!  1. Star data for an epoch other than J2000.0 (for example from the
!     Hipparcos catalog, which has an epoch of J1991.25) will require a
!     preliminary call to PMSAFE before use.
!
!  2. The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.
!
!  3. The array B contains N entries, one for each body to be
!     considered.  If N = 0, no gravitational light deflection will be
!     applied, not even for the Sun.
!
!  4. The array B should include an entry for the Sun as well as for any
!     planet or other body to be taken into account.  The entries should
!     be in the order in which the light passes the body.
!
!  5. In the entry in the B array for body I, the mass parameter B(1,I)
!     can, as required, be adjusted in order to allow for such effects
!     as quadrupole field.
!
!  6. The deflection limiter parameter B(2,I) is phi^2/2, where phi is
!     the angular separation (in radians) between star and body at which
!     limiting is applied.  As phi shrinks below the chosen threshold,
!     the deflection is artificially reduced, reaching zero for phi = 0.
!     Example values suitable for a terrestrial observer, together with
!     masses, are as follows:
!
!        body I     B(1,I)         B(2,I)
!
!        Sun        1D0            6D-6
!        Jupiter    0.00095435D0   3D-9
!        Saturn     0.00028574D0   3D-10
!
!  7. For efficiency, validation of the B array is omitted.  The
!     supplied masses must be greater than zero, the position and
!     velocity vectors must be right, and the deflection limiter
!     greater than zero.
!
!### History
!  * IAU SOFA revision:  2013 September 30

    subroutine ATCIQN ( rc, dc, pr, pd, px, rv, astrom, n, b, &
                        ri, di )

    implicit none

    real(wp),intent(in) :: rc !! ICRS RA at J2000.0 (radians, Note 1)
    real(wp),intent(in) :: dc !! ICRS Dec at J2000.0 (radians, Note 1)
    real(wp),intent(in) :: pr !! RA proper motion (radians/year; Note 2)
    real(wp),intent(in) :: pd !! Dec proper motion (radians/year)
    real(wp),intent(in) :: px !! parallax (arcsec)
    real(wp),intent(in) :: rv !! radial velocity (km/s, +ve if receding)
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    integer,intent(in) :: n !! number of bodies (Note 3)
    real(wp),dimension(8,n),intent(in) :: b !! data for each of the NB bodies (Notes 3,4):
                                            !! (1,I)    mass of the body (solar masses, Note 5)
                                            !! (2,I)    deflection limiter (Note 6)
                                            !! (3-5,I)  barycentric position of the body (au)
                                            !! (6-8,I)  barycentric velocity of the body (au/day)
    real(wp),intent(out) :: ri !!  CIRS RA (radians)
    real(wp),intent(out) :: di !!  CIRS Dec (radians)

    real(wp) :: pco(3), pnat(3), ppr(3), pi(3), w

    !  Proper motion and parallax, giving BCRS coordinate direction.
    call PMPX ( rc, dc, pr, pd, px, rv, astrom(1), astrom(2), &
                pco )

    !  Light deflection, giving BCRS natural direction.
    call LDN ( n, b, astrom(2), pco, pnat )

    !  Aberration, giving GCRS proper direction.
    call AB (pnat, astrom(9), astrom(8), astrom(12), ppr )

    !  Bias-precession-nutation, giving CIRS proper direction.
    call RXP ( astrom(13), ppr, pi )

    !  CIRS RA,Dec.
    call C2S ( pi, w, di )
    ri = ANP ( w )

    end subroutine ATCIQN
!***********************************************************************

!***********************************************************************
!>
!  Quick ICRS to CIRS transformation, given precomputed star-independent
!  astrometry parameters, and assuming zero parallax and proper motion.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are to be transformed for one date.  The
!  star-independent parameters can be obtained by calling one of the
!  routines APCI[13], APCG[13], APCO[13] or APCS[13].
!
!  The corresponding routine for the case of non-zero parallax and
!  proper motion is ATCIQ.
!
!  Status:  support routine.
!
!### Note
!
!  All the vectors are with respect to BCRS axes.
!
!### References
!
!  * Urban, S. & Seidelmann, P. K. (eds), Explanatory Supplement to
!    the Astronomical Almanac, 3rd ed., University Science Books
!    (2013).
!
!  * Klioner, Sergei A., "A practical relativistic model for micro-
!    arcsecond astrometry in space", Astr. J. 125, 1580-1597 (2003).
!
!### History
!  * IAU SOFA revision:  2013 August 31

    subroutine ATCIQZ ( rc, dc, astrom, ri, di )

    implicit none

    real(wp),intent(in) :: rc !! ICRS astrometric RA (radians)
    real(wp),intent(in) :: dc !! ICRS astrometric Dec (radians)
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    real(wp),intent(out) :: ri !! CIRS RA (radians)
    real(wp),intent(out) :: di !! CIRS Dec (radians)

    real(wp) :: pco(3), pnat(3), ppr(3), pi(3), w

    !  BCRS coordinate direction (unit vector).
    call S2C ( rc, dc, pco )

    !  Light deflection by the Sun, giving BCRS natural direction.
    call LDSUN ( pco, astrom(5), astrom(8), pnat )

    !  Aberration, giving GCRS proper direction.
    call AB ( pnat, astrom(9), astrom(8), astrom(12), ppr )

    !  Bias-precession-nutation, giving CIRS proper direction.
    call RXP ( astrom(13), ppr, pi )

    !  CIRS RA,Dec.
    call C2S ( pi, w, di )
    ri = ANP ( w )

    end subroutine ATCIQZ
!***********************************************************************

!***********************************************************************
!>
!  ICRS RA,Dec to observed place.  The caller supplies UTC, site
!  coordinates, ambient air conditions and observing wavelength.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  Star data for an epoch other than J2000.0 (for example from the
!      Hipparcos catalog, which has an epoch of J1991.25) will require
!      a preliminary call to PMSAFE before use.
!
!  2.  The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.
!
!  3.  UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!      convenient way between the two arguments, for example where UTC1
!      is the Julian Day Number and UTC2 is the fraction of a day.
!
!      However, JD cannot unambiguously represent UTC during a leap
!      second unless special measures are taken.  The convention in the
!      present routine is that the JD day represents UTC days whether
!      the length is 86399, 86400 or 86401 SI seconds.
!
!      Applications should use the routine DTF2D to convert from
!      calendar date and time of day into 2-part quasi Julian Date, as
!      it implements the leap-second-ambiguity convention just
!      described.
!
!  4.  The warning status "dubious year" flags UTCs that predate the
!      introduction of the time scale or that are too far in the
!      future to be trusted.  See DAT for further details.
!
!  5.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
!      one second at the end of each positive UTC leap second,
!      introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
!      practice is under review, and in the future UT1-UTC may grow
!      essentially without limit.
!
!  6.  The geographical coordinates are with respect to the WGS84
!      reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!      longitude required by the present routine is east-positive
!      (i.e. right-handed), in accordance with geographical convention.
!
!  7.  The polar motion XP,YP can be obtained from IERS bulletins.  The
!      values are the coordinates (in radians) of the Celestial
!      Intermediate Pole with respect to the International Terrestrial
!      Reference System (see IERS Conventions 2003), measured along the
!      meridians 0 and 90 deg west respectively.  For many applications,
!      XP and YP can be set to zero.
!
!  8.  If hm, the height above the ellipsoid of the observing station
!      in meters, is not known but phpa, the pressure in hPa (=mB),
!      is available, an adequate estimate of hm can be obtained from
!      the expression
!
!            hm = -29.3 * tsl * log ( phpa / 1013.25 );
!
!      where tsl is the approximate sea-level air temperature in K
!      (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
!      52).  Similarly, if the pressure phpa is not known, it can be
!      estimated from the height of the observing station, hm, as
!      follows:
!
!            phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );
!
!      Note, however, that the refraction is nearly proportional to
!      the pressure and that an accurate phpa value is important for
!      precise work.
!
!  9.  The argument WL specifies the observing wavelength in
!      micrometers.  The transition from optical to radio is assumed to
!      occur at 100 micrometers (about 3000 GHz).
!
!  10. The accuracy of the result is limited by the corrections for
!      refraction, which use a simple A*tan(z) + B*tan^3(z) model.
!      Providing the meteorological parameters are known accurately and
!      there are no gross local effects, the predicted observed
!      coordinates should be within 0.05 arcsec (optical) or 1 arcsec
!      (radio) for a zenith distance of less than 70 degrees, better
!      than 30 arcsec (optical or radio) at 85 degrees and better than
!      20 arcmin (optical) or 30 arcmin (radio) at the horizon.
!
!      Without refraction, the complementary routines ATCO13 and
!      ATOC13 are self-consistent to better than 1 microarcsecond
!      all over the celestial sphere.  With refraction included,
!      consistency falls off at high zenith distances, but is still
!      better than 0.05 arcsec at 85 degrees.
!
!  11. "Observed" Az,ZD means the position that would be seen by a
!      perfect geodetically aligned theodolite.  (Zenith distance is
!      used rather than altitude in order to reflect the fact that no
!      allowance is made for depression of the horizon.)  This is
!      related to the observed HA,Dec via the standard rotation, using
!      the geodetic latitude (corrected for polar motion), while the
!      observed HA and RA are related simply through the Earth rotation
!      angle and the site longitude.  "Observed" RA,Dec or HA,Dec thus
!      means the position that would be seen by a perfect equatorial
!      with its polar axis aligned to the Earth's axis of rotation.
!
!  12. It is advisable to take great care with units, as even unlikely
!      values of the input parameters are accepted and processed in
!      accordance with the models used.
!
!### History
!  * IAU SOFA revision:  2016 February 2

    subroutine ATCO13 ( rc, dc, pr, pd, px, rv, &
                        utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                        phpa, tc, rh, wl, &
                        aob, zob, hob, dob, rob, eo, j )

    implicit none

    real(wp),intent(in) :: rc !! ICRS right ascension at J2000.0 (radians, Note 1)
    real(wp),intent(in) :: dc !! ICRS declination at J2000.0 (radians, Note 1)
    real(wp),intent(in) :: pr !! RA proper motion (radians/year; Note 2)
    real(wp),intent(in) :: pd !! Dec proper motion (radians/year)
    real(wp),intent(in) :: px !! parallax (arcsec)
    real(wp),intent(in) :: rv !! radial velocity (km/s, +ve if receding)
    real(wp),intent(in) :: utc1 !! UTC as a 2-part...
    real(wp),intent(in) :: utc2 !! ...quasi Julian Date (Notes 3-4)
    real(wp),intent(in) :: dut1 !! UT1-UTC (seconds, Note 5)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 6)
    real(wp),intent(in) :: phi !! latitude (geodetic, radians, Note 6)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic, Notes 6,8)
    real(wp),intent(in) :: xp !! polar motion coordinate (radians, Note 7)
    real(wp),intent(in) :: yp !! polar motion coordinate (radians, Note 7)
    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = mB, Note 8)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers, Note 9)
    real(wp),intent(out) :: aob !! observed azimuth (radians: N=0,E=90)
    real(wp),intent(out) :: zob !! observed zenith distance (radians)
    real(wp),intent(out) :: hob !! observed hour angle (radians)
    real(wp),intent(out) :: dob !! observed declination (radians)
    real(wp),intent(out) :: rob !! observed right ascension (CIO-based, radians)
    real(wp),intent(out) :: eo !! equation of the origins (ERA-GST)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 4)
                             !! *  0 = OK
                             !! * -1 = unacceptable date

    integer :: js
    real(wp) :: astrom(30)
    real(wp) :: ri, di

    !  Star-independent astrometry parameters.
    call APCO13 ( utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                  phpa, tc, rh, wl, astrom, eo, js )
    if ( js>=0 ) then

      !  Transform ICRS to CIRS.
      call ATCIQ ( rc, dc, pr, pd, px, rv, astrom, ri, di )

      !  Transform CIRS to observed.
      call ATIOQ ( ri, di, astrom, aob, zob, hob, dob, rob )

    end if

    !  Return OK/warning status.
    j = js

    end subroutine ATCO13
!***********************************************************************

!***********************************************************************
!>
!  Transform star RA,Dec from geocentric CIRS to ICRS astrometric.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.  For most
!     applications of this routine the choice will not be at all
!     critical.
!
!     TT can be used instead of TDB without any significant impact on
!     accuracy.
!
!  2. Iterative techniques are used for the aberration and light
!     deflection corrections so that the routines ATIC13 (or
!     ATICQ) and ATCI13 (or ATCIQ) are accurate inverses;
!     even at the edge of the Sun's disk the discrepancy is only about
!     1 nanoarcsecond.
!
!  3. The available accuracy is better than 1 milliarcsecond, limited
!     mainly by the precession-nutation model that is used, namely
!     IAU 2000A/2006.  Very close to solar system bodies, additional
!     errors of up to several milliarcseconds can occur because of
!     unmodeled light deflection;  however, the Sun's contribution is
!     taken into account, to first order.  The accuracy limitations of
!     the SOFA routine EPV00 (used to compute Earth position and
!     velocity) can contribute aberration errors of up to
!     5 microarcseconds.  Light deflection at the Sun's limb is
!     uncertain at the 0.4 mas level.
!
!  4. Should the transformation to (equinox based) J2000.0 mean place
!     be required rather than (CIO based) ICRS coordinates, subtract the
!     equation of the origins from the returned right ascension:
!     RA = RI - EO.  (The ANP routine can then be applied, as
!     required, to keep the result in the conventional 0-2pi range.)
!
!### History
!  * IAU SOFA revision:  2017 March 12

    subroutine ATIC13 ( ri, di, date1, date2, rc, dc, eo )

    implicit none

    real(wp),intent(in) :: ri !! CIRS geocentric RA (radians)
    real(wp),intent(in) :: di !! CIRS geocentric Dec (radians)
    real(wp),intent(in) :: date1 !! TDB as a 2-part...
    real(wp),intent(in) :: date2 !! ...Julian Date (Note 1)
    real(wp),intent(out) :: rc !! ICRS astrometric RA (radians)
    real(wp),intent(out) :: dc !! ICRS astrometric Dec (radians)
    real(wp),intent(out) :: eo !! equation of the origins (ERA-GST, Note 4)

    !  Star-independent astrometry parameters
    real(wp) :: astrom(30)

    !  Star-independent astrometry parameters.
    call APCI13 ( date1, date2, astrom, eo )

    !  CIRS to ICRS astrometric
    call ATICQ ( ri, di, astrom, rc, dc )

    end subroutine ATIC13
!***********************************************************************

!***********************************************************************
!>
!  Quick CIRS RA,Dec to ICRS astrometric place, given the star-
!  independent astrometry parameters.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are all to be transformed for one date.
!  The star-independent astrometry parameters can be obtained by
!  calling one of the routines APCI[13], APCG[13], APCO[13]
!  or APCS[13].
!
!  Status:  support routine.
!
!### Notes
!
!  1. Only the Sun is taken into account in the light deflection
!     correction.
!
!  2. Iterative techniques are used for the aberration and light
!     deflection corrections so that the routines ATIC13 (or
!     ATICQ) and ATCI13 (or ATCIQ) are accurate inverses;
!     even at the edge of the Sun's disk the discrepancy is only about
!     1 nanoarcsecond.
!
!### History
!  * IAU SOFA revision:  2013 August 3

    subroutine ATICQ ( ri, di, astrom, rc, dc )

    implicit none

    real(wp),intent(in) :: ri !! CIRS RA (radians)
    real(wp),intent(in) :: di !! CIRS Dec (radians)
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    real(wp),intent(out) :: rc !! ICRS astrometric RA (radians)
    real(wp),intent(out) :: dc !! ICRS astrometric Dec (radians)

    integer :: j, i
    real(wp) :: pi(3), ppr(3), pnat(3), pco(3), w, d(3), &
                before(3), r2, r, after(3)

    !  CIRS RA,Dec to Cartesian.
    call S2C ( ri, di, pi )

    !  Bias-precession-nutation, giving GCRS proper direction.
    call TRXP ( astrom(13), pi, ppr )

    !  Aberration, giving GCRS natural direction.
    call ZP ( d )
    do j=1,2
       r2 = 0.0_wp
       do i=1,3
          w = ppr(i) - d(i)
          before(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          before(i) = before(i) / r
       end do
       call AB ( before, astrom(9), astrom(8), astrom(12), after )
       r2 = 0.0_wp
       do i=1,3
          d(i) = after(i) - before(i)
          w = ppr(i) - d(i)
          pnat(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          pnat(i) = pnat(i) / r
       end do
    end do

    !  Light deflection by the Sun, giving BCRS coordinate direction.
    call ZP ( d )
    do j=1,5
       r2 = 0.0_wp
       do i=1,3
          w = pnat(i) - d(i)
          before(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          before(i) = before(i) / r
       end do
       call LDSUN ( before, astrom(5), astrom(8), after )
       r2 = 0.0_wp
       do i=1,3
          d(i) = after(i) - before(i)
          w = pnat(i) - d(i)
          pco(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          pco(i) = pco(i) / r
       end do
    end do

    !  ICRS astrometric RA,Dec.
    call C2S ( pco, w, dc )
    rc = ANP ( w )

    end subroutine ATICQ
!***********************************************************************

!***********************************************************************
!>
!  Quick CIRS to ICRS astrometric place transformation, given the
!  star-independent astrometry parameters plus a list of light-
!  deflecting bodies.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are all to be transformed for one date.
!  The star-independent astrometry parameters can be obtained by
!  calling one of the routines APCI[13], APCG[13], APCO[13]
!  or APCS[13].
!
!  If the only light-deflecting body to be taken into account is the
!  Sun, the ATICQ routine can be used instead.
!
!  Status:  support routine.
!
!### Notes
!
!  1. Iterative techniques are used for the aberration and light
!     deflection corrections so that the routines ATICQN and
!     ATCIQN are accurate inverses; even at the edge of the Sun's
!     disk the discrepancy is only about 1 nanoarcsecond.
!
!  2. If the only light-deflecting body to be taken into account is the
!     Sun, the ATICQ routine can be used instead.
!
!  3. The array B contains N entries, one for each body to be
!     considered.  If N = 0, no gravitational light deflection will be
!     applied, not even for the Sun.
!
!  4. The array B should include an entry for the Sun as well as for any
!     planet or other body to be taken into account.  The entries should
!     be in the order in which the light passes the body.
!
!  5. In the entry in the B array for body I, the mass parameter B(1,I)
!     can, as required, be adjusted in order to allow for such effects
!     as quadrupole field.
!
!  6. The deflection limiter parameter B(2,I) is phi^2/2, where phi is
!     the angular separation (in radians) between star and body at which
!     limiting is applied.  As phi shrinks below the chosen threshold,
!     the deflection is artificially reduced, reaching zero for phi = 0.
!     Example values suitable for a terrestrial observer, together with
!     masses, are as follows:
!
!        body I     B(1,I)         B(2,I)
!
!        Sun        1D0            6D-6
!        Jupiter    0.00095435D0   3D-9
!        Saturn     0.00028574D0   3D-10
!
!  7. For efficiency, validation of the contents of the B array is
!     omitted.  The supplied masses must be greater than zero, the
!     position and velocity vectors must be right, and the deflection
!     limiter greater than zero.
!
!### History
!  * IAU SOFA revision:  2013 September 30

    subroutine ATICQN ( ri, di, astrom, n, b, rc, dc )

    implicit none

    real(wp),intent(in) :: ri !! CIRS RA (radians)
    real(wp),intent(in) :: di !! CIRS Dec (radians)
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    integer,intent(in) :: n !! number of bodies (Note 3)
    real(wp),dimension(8,n),intent(in) :: b !! data for each of the NB bodies (Notes 3,4):
                                            !! (1,I)    mass of the body (solar masses, Note 5)
                                            !! (2,I)    deflection limiter (Note 6)
                                            !! (3-5,I)  barycentric position of the body (au)
                                            !! (6-8,I)  barycentric velocity of the body (au/day)
    real(wp),intent(out) :: rc !! ICRS astrometric RA (radians)
    real(wp),intent(out) :: dc !! ICRS astrometric Dec (radians)

    integer :: j, i
    real(wp) :: pi(3), ppr(3), pnat(3), pco(3), w, d(3), &
                before(3), r2, r, after(3)

    !  CIRS RA,Dec to Cartesian.
    call S2C ( ri, di, pi )

    !  Bias-precession-nutation, giving GCRS proper direction.
    call TRXP ( astrom(13), pi, ppr )

    !  Aberration, giving GCRS natural direction.
    call ZP ( d )
    do j=1,2
       r2 = 0.0_wp
       do i=1,3
          w = ppr(i) - d(i)
          before(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          before(i) = before(i) / r
       end do
       call AB ( before, astrom(9), astrom(8), astrom(12), after )
       r2 = 0.0_wp
       do i=1,3
          d(i) = after(i) - before(i)
          w = ppr(i) - d(i)
          pnat(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          pnat(i) = pnat(i) / r
       end do
    end do

    !  Light deflection, giving BCRS coordinate direction.
    call ZP ( d )
    do j=1,5
       r2 = 0.0_wp
       do i=1,3
          w = pnat(i) - d(i)
          before(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          before(i) = before(i) / r
       end do
       call LDN ( n, b, astrom(2), before, after )
       r2 = 0.0_wp
       do i=1,3
          d(i) = after(i) - before(i)
          w = pnat(i) - d(i)
          pco(i) = w
          r2 = r2 + w*w
       end do
       r = sqrt ( r2 )
       do i=1,3
          pco(i) = pco(i) / r
       end do
    end do

    !  ICRS astrometric RA,Dec.
    call C2S ( pco, w, dc )
    rc = ANP ( w )

    end subroutine ATICQN
!***********************************************************************

!***********************************************************************
!>
!  CIRS RA,Dec to observed place.  The caller supplies UTC, site
!  coordinates, ambient air conditions and observing wavelength.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!      convenient way between the two arguments, for example where UTC1
!      is the Julian Day Number and UTC2 is the fraction of a day.
!
!      However, JD cannot unambiguously represent UTC during a leap
!      second unless special measures are taken.  The convention in the
!      present routine is that the JD day represents UTC days whether
!      the length is 86399, 86400 or 86401 SI seconds.
!
!      Applications should use the routine DTF2D to convert from
!      calendar date and time of day into 2-part quasi Julian Date, as
!      it implements the leap-second-ambiguity convention just
!      described.
!
!  2.  The warning status "dubious year" flags UTCs that predate the
!      introduction of the time scale or that are too far in the
!      future to be trusted.  See DAT for further details.
!
!  3.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
!      one second at the end of each positive UTC leap second,
!      introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
!      practice is under review, and in the future UT1-UTC may grow
!      essentially without limit.
!
!  4.  The geographical coordinates are with respect to the WGS84
!      reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!      longitude required by the present routine is east-positive
!      (i.e. right-handed), in accordance with geographical convention.
!
!  5.  The polar motion XP,YP can be obtained from IERS bulletins.  The
!      values are the coordinates (in radians) of the Celestial
!      Intermediate Pole with respect to the International Terrestrial
!      Reference System (see IERS Conventions 2003), measured along the
!      meridians 0 and 90 deg west respectively.  For many applications,
!      XP and YP can be set to zero.
!
!  6.  If hm, the height above the ellipsoid of the observing station
!      in meters, is not known but phpa, the pressure in hPa (=mB), is
!      available, an adequate estimate of hm can be obtained from the
!      expression
!
!            hm = -29.3 * tsl * log ( phpa / 1013.25 );
!
!      where tsl is the approximate sea-level air temperature in K
!      (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
!      52).  Similarly, if the pressure phpa is not known, it can be
!      estimated from the height of the observing station, hm, as
!      follows:
!
!            phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );
!
!      Note, however, that the refraction is nearly proportional to
!      the pressure and that an accurate phpa value is important for
!      precise work.
!
!  7.  The argument WL specifies the observing wavelength in
!      micrometers.  The transition from optical to radio is assumed to
!      occur at 100 micrometers (about 3000 GHz).
!
!  8.  "Observed" Az,ZD means the position that would be seen by a
!      perfect geodetically aligned theodolite.  (Zenith distance is
!      used rather than altitude in order to reflect the fact that no
!      allowance is made for depression of the horizon.)  This is
!      related to the observed HA,Dec via the standard rotation, using
!      the geodetic latitude (corrected for polar motion), while the
!      observed HA and RA are related simply through the Earth rotation
!      angle and the site longitude.  "Observed" RA,Dec or HA,Dec thus
!      means the position that would be seen by a perfect equatorial
!      with its polar axis aligned to the Earth's axis of rotation.
!
!  9.  The accuracy of the result is limited by the corrections for
!      refraction, which use a simple A*tan(z) + B*tan^3(z) model.
!      Providing the meteorological parameters are known accurately and
!      there are no gross local effects, the predicted astrometric
!      coordinates should be within 0.05 arcsec (optical) or 1 arcsec
!      (radio) for a zenith distance of less than 70 degrees, better
!      than 30 arcsec (optical or radio) at 85 degrees and better
!      than 20 arcmin (optical) or 30 arcmin (radio) at the horizon.
!
!  10. The complementary routines ATIO13 and ATOI13 are self-
!      consistent to better than 1 microarcsecond all over the
!      celestial sphere.
!
!  11. It is advisable to take great care with units, as even unlikely
!      values of the input parameters are accepted and processed in
!      accordance with the models used.
!
!### History
!  * IAU SOFA revision:  2016 February 2

    subroutine ATIO13 ( ri, di, utc1, utc2, dut1, &
                        elong, phi, hm, xp, yp, phpa, tc, rh, wl, &
                        aob, zob, hob, dob, rob, j )

    implicit none

    real(wp),intent(in) :: ri !! CIRS right ascension (CIO-based, radians)
    real(wp),intent(in) :: di !! CIRS declination (radians)
    real(wp),intent(in) :: utc1 !! UTC as a 2-part...
    real(wp),intent(in) :: utc2 !! ...quasi Julian Date (Notes 1,2)
    real(wp),intent(in) :: dut1 !! UT1-UTC (seconds, Note 3)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 4)
    real(wp),intent(in) :: phi !! geodetic latitude (radians, Note 4)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic Notes 4,6)
    real(wp),intent(in) :: xp !! polar motion coordinates (radians, Note 5)
    real(wp),intent(in) :: yp !! polar motion coordinates (radians, Note 5)
    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = mB, Note 6)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers, Note 7)
    real(wp),intent(out) :: aob !! observed azimuth (radians: N=0,E=90)
    real(wp),intent(out) :: zob !! observed zenith distance (radians)
    real(wp),intent(out) :: hob !! observed hour angle (radians)
    real(wp),intent(out) :: dob !! observed declination (radians)
    real(wp),intent(out) :: rob !! observed right ascension (CIO-based, radians)
    integer,intent(out) :: j !! status: +1 = dubious year (Note 2)
                             !!  0 = OK
                             !! -1 = unacceptable date

    integer :: js
    real(wp) :: astrom(30)

    !  Star-independent astrometry parameters for CIRS->observed.
    call APIO13 ( utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                  phpa, tc, rh, wl, astrom, js )

    !  Abort if bad UTC.
    if ( js>=0 ) then

      !  Transform CIRS to observed.
      call ATIOQ ( ri, di, astrom, aob, zob, hob, dob, rob )

    end if

    !  Return OK/warning status.
    j = js

    end subroutine ATIO13
!***********************************************************************

!***********************************************************************
!>
!  Quick CIRS to observed place transformation.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are all to be transformed for one date.
!  The star-independent astrometry parameters can be obtained by
!  calling APIO[13] or APCO[13].
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine returns zenith distance rather than altitude in
!     order to reflect the fact that no allowance is made for
!     depression of the horizon.
!
!  2. The accuracy of the result is limited by the corrections for
!     refraction, which use a simple A*tan(z) + B*tan^3(z) model.
!     Providing the meteorological parameters are known accurately and
!     there are no gross local effects, the predicted observed
!     coordinates should be within 0.05 arcsec (optical) or 1 arcsec
!     (radio) for a zenith distance of less than 70 degrees, better
!     than 30 arcsec (optical or radio) at 85 degrees and better than
!     20 arcmin (optical) or 30 arcmin (radio) at the horizon.
!
!     Without refraction, the complementary routines ATIOQ and
!     ATOIQ are self-consistent to better than 1 microarcsecond all
!     over the celestial sphere.  With refraction included, consistency
!     falls off at high zenith distances, but is still better than
!     0.05 arcsec at 85 degrees.
!
!  3. It is advisable to take great care with units, as even unlikely
!     values of the input parameters are accepted and processed in
!     accordance with the models used.
!
!  4. The CIRS RA,Dec is obtained from a star catalog mean place by
!     allowing for space motion, parallax, the Sun's gravitational lens
!     effect, annual aberration and precession-nutation.  For star
!     positions in the ICRS, these effects can be applied by means of
!     the ATCI13 (etc.) routines.  Starting from classical "mean
!     place" systems, additional transformations will be needed first.
!
!  5. "Observed" Az,El means the position that would be seen by a
!     perfect geodetically aligned theodolite.  This is obtained from
!     the CIRS RA,Dec by allowing for Earth orientation and diurnal
!     aberration, rotating from equator to horizon coordinates, and then
!     adjusting for refraction.  The HA,Dec is obtained by rotating back
!     into equatorial coordinates, and is the position that would be
!     seen by a perfect equatorial with its polar axis aligned to the
!     Earth's axis of rotation.  Finally, the RA is obtained by
!     subtracting the HA from the local ERA.
!
!  6. The star-independent CIRS-to-observed-place parameters in ASTROM
!     may be computed with APIO[13] or APCO[13].  If nothing has
!     changed significantly except the time, APER[13] may be used
!     to perform the requisite adjustment to the ASTROM array.
!
!### History
!  * IAU SOFA revision:  2017 July 10

    subroutine ATIOQ ( ri, di, astrom, aob, zob, hob, dob, rob )

    implicit none

    real(wp),intent(in) :: ri !! CIRS right ascension
    real(wp),intent(in) :: di !! CIRS declination
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    real(wp),intent(out) :: aob !! observed azimuth (radians: N=0,E=90)
    real(wp),intent(out) :: zob !! observed zenith distance (radians)
    real(wp),intent(out) :: hob !! observed hour angle (radians)
    real(wp),intent(out) :: dob !! observed declination (CIO-based, radians)
    real(wp),intent(out) :: rob !! observed right ascension (CIO-based, radians)

    !  Minimum sine and cosine of altitude for refraction purposes
    real(wp),parameter :: selmin = 0.05_wp
    real(wp),parameter :: celmin = 1.0e-6_wp

    real(wp) :: v(3), x, y, z, xhd, yhd, zhd, f, &
                xhdt, yhdt, zhdt, xaet, yaet, zaet, azobs, &
                r, tz, w, del, cosdel, xaeo, yaeo, zaeo, &
                zdobs, hmobs, dcobs, raobs

    !  CIRS RA,Dec to Cartesian -HA,Dec.
    call S2C ( ri-astrom(28), di, v )
    x = v(1)
    y = v(2)
    z = v(3)

    !  Polar motion.
    xhd = x + astrom(23)*z
    yhd = y - astrom(24)*z
    zhd = z - astrom(23)*x + astrom(24)*y

    !  Diurnal aberration.
    f = ( 1.0_wp - astrom(27)*yhd )
    xhdt = f * xhd
    yhdt = f * ( yhd + astrom(27) )
    zhdt = f * zhd

    !  Cartesian -HA,Dec to Cartesian Az,El (S=0,E=90).
    xaet = astrom(25)*xhdt - astrom(26)*zhdt
    yaet = yhdt
    zaet = astrom(26)*xhdt + astrom(25)*zhdt

    !  Azimuth (N=0,E=90).
    if ( xaet/=0.0_wp .or. yaet/=0.0_wp ) then
       azobs = atan2 ( yaet, -xaet )
    else
       azobs = 0.0_wp
    end if

    !  ----------
    !  Refraction
    !  ----------

    !  Cosine and sine of altitude, with precautions.
    r = max ( sqrt ( xaet*xaet + yaet*yaet ), celmin)
    z = max ( zaet, selmin )

    !  A*tan(z)+B*tan^3(z) model, with Newton-Raphson correction.
    tz = r/z
    w = astrom(30)*tz*tz
    del = ( astrom(29) + w ) * tz / &
          ( 1.0_wp + ( astrom(29) + 3.0_wp*w ) / ( z*z ) )

    !  Apply the change, giving observed vector.
    cosdel = 1.0_wp - del*del/2.0_wp
    f = cosdel - del*z/r
    xaeo = xaet*f
    yaeo = yaet*f
    zaeo = cosdel*zaet + del*r

    !  Observed ZD.
    zdobs = atan2 ( sqrt ( xaeo*xaeo + yaeo*yaeo ), zaeo )

    !  Az/El vector to HA,Dec vector (both right-handed).
    v(1) = astrom(25)*xaeo + astrom(26)*zaeo
    v(2) = yaeo
    v(3) = - astrom(26)*xaeo + astrom(25)*zaeo

    !  To spherical -HA,Dec.
    call C2S ( v, hmobs, dcobs )

    !  Right ascension (with respect to CIO).
    raobs = astrom(28) + hmobs

    !  Return the results.
    aob = ANP(azobs)
    zob = zdobs
    hob = -hmobs
    dob = dcobs
    rob = ANP(raobs)

    end subroutine ATIOQ
!***********************************************************************

!***********************************************************************
!>
!  Observed place at a groundbased site to to ICRS astrometric RA,Dec.
!  The caller supplies UTC, site coordinates, ambient air conditions
!  and observing wavelength.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  "Observed" Az,ZD means the position that would be seen by a
!      perfect geodetically aligned theodolite.  (Zenith distance is
!      used rather than altitude in order to reflect the fact that no
!      allowance is made for depression of the horizon.)  This is
!      related to the observed HA,Dec via the standard rotation, using
!      the geodetic latitude (corrected for polar motion), while the
!      observed HA and RA are related simply through the Earth rotation
!      angle and the site longitude.  "Observed" RA,Dec or HA,Dec thus
!      means the position that would be seen by a perfect equatorial
!      with its polar axis aligned to the Earth's axis of rotation.
!
!  2.  Only the first character of the TYPE argument is significant.
!      'R' or 'r' indicates that OB1 and OB2 are the observed right
!      ascension and declination;  'H' or 'h' indicates that they are
!      hour angle (west +ve) and declination;  anything else ('A' or
!      'a' is recommended) indicates that OB1 and OB2 are azimuth
!      (north zero, east 90 deg) and zenith distance.
!
!  3.  UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!      convenient way between the two arguments, for example where UTC1
!      is the Julian Day Number and UTC2 is the fraction of a day.
!
!      However, JD cannot unambiguously represent UTC during a leap
!      second unless special measures are taken.  The convention in the
!      present routine is that the JD day represents UTC days whether
!      the length is 86399, 86400 or 86401 SI seconds.
!
!      Applications should use the routine DTF2D to convert from
!      calendar date and time of day into 2-part quasi Julian Date, as
!      it implements the leap-second-ambiguity convention just
!      described.
!
!  4.  The warning status "dubious year" flags UTCs that predate the
!      introduction of the time scale or that are too far in the
!      future to be trusted.  See DAT for further details.
!
!  5.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
!      one second at the end of each positive UTC leap second,
!      introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
!      practice is under review, and in the future UT1-UTC may grow
!      essentially without limit.
!
!  6.  The geographical coordinates are with respect to the WGS84
!      reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!      longitude required by the present routine is east-positive
!      (i.e. right-handed), in accordance with geographical convention.
!
!  7.  The polar motion XP,YP can be obtained from IERS bulletins.  The
!      values are the coordinates (in radians) of the Celestial
!      Intermediate Pole with respect to the International Terrestrial
!      Reference System (see IERS Conventions 2003), measured along the
!      meridians 0 and 90 deg west respectively.  For many applications,
!      XP and YP can be set to zero.
!
!  8.  If hm, the height above the ellipsoid of the observing station
!      in meters, is not known but phpa, the pressure in hPa (=mB), is
!      available, an adequate estimate of hm can be obtained from the
!      expression
!
!            hm = -29.3 * tsl * log ( phpa / 1013.25 );
!
!      where tsl is the approximate sea-level air temperature in K
!      (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
!      52).  Similarly, if the pressure phpa is not known, it can be
!      estimated from the height of the observing station, hm, as
!      follows:
!
!            phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );
!
!      Note, however, that the refraction is nearly proportional to
!      the pressure and that an accurate phpa value is important for
!      precise work.
!
!  9.  The argument WL specifies the observing wavelength in
!      micrometers.  The transition from optical to radio is assumed to
!      occur at 100 micrometers (about 3000 GHz).
!
!  10. The accuracy of the result is limited by the corrections for
!      refraction, which use a simple A*tan(z) + B*tan^3(z) model.
!      Providing the meteorological parameters are known accurately and
!      there are no gross local effects, the predicted astrometric
!      coordinates should be within 0.05 arcsec (optical) or 1 arcsec
!      (radio) for a zenith distance of less than 70 degrees, better
!      than 30 arcsec (optical or radio) at 85 degrees and better
!      than 20 arcmin (optical) or 30 arcmin (radio) at the horizon.
!
!      Without refraction, the complementary routines ATCO13 and
!      ATOC13 are self-consistent to better than 1 microarcsecond
!      all over the celestial sphere.  With refraction included,
!      consistency falls off at high zenith distances, but is still
!      better than 0.05 arcsec at 85 degrees.
!
!  11. It is advisable to take great care with units, as even unlikely
!      values of the input parameters are accepted and processed in
!      accordance with the models used.
!
!### History
!  * IAU SOFA revision:  2013 August 3

    subroutine ATOC13 ( type, ob1, ob2, utc1, utc2, dut1, &
                        elong, phi, hm, xp, yp, phpa, tc, rh, wl, &
                        rc, dc, j )

    implicit none

    character(len=*),intent(in) :: type !! type of coordinates - 'R', 'H' or 'A' (Notes 1,2)
    real(wp),intent(in) :: ob1 !! observed Az, HA or RA (radians; Az is N=0,E=90)
    real(wp),intent(in) :: ob2 !! observed ZD or Dec (radians)
    real(wp),intent(in) :: utc1 !! UTC as a 2-part...
    real(wp),intent(in) :: utc2 !! ...quasi Julian Date (Notes 3,4)
    real(wp),intent(in) :: dut1 !! UT1-UTC (seconds, Note 5)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 6)
    real(wp),intent(in) :: phi !! geodetic latitude (radians, Note 6)
    real(wp),intent(in) :: hm !! height above ellipsoid (m, geodetic Notes 6,8)
    real(wp),intent(in) :: xp !! polar motion coordinates (radians, Note 7)
    real(wp),intent(in) :: yp !! polar motion coordinates (radians, Note 7)
    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = mB, Note 8)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers, Note 9)
    real(wp),intent(out) :: rc !! ICRS astrometric RA (radians)
    real(wp),intent(out) :: dc !! ICRS astrometric Dec (radians)
    integer,intent(out) :: j !! status: +1 = dubious year (Note 4)
                             !!  0 = OK
                             !! -1 = unacceptable date

    integer :: js
    real(wp) :: astrom(30), eo, ri, di

    !  Star-independent astrometry parameters.
    call APCO13 ( utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                  phpa, tc, rh, wl, astrom, eo, js )

    !  Abort if bad UTC.
    if ( js>=0 ) then

      !  Transform observed to CIRS.
      call ATOIQ ( type, ob1, ob2, astrom, ri, di )

      !  Transform CIRS to ICRS.
      call ATICQ ( ri, di, astrom, rc, dc )

    end if

    !  Return OK/warning status.
    j = js

    end subroutine ATOC13
!***********************************************************************

!***********************************************************************
!>
!  Observed place to CIRS.  The caller supplies UTC, site coordinates,
!  ambient air conditions and observing wavelength.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  "Observed" Az,ZD means the position that would be seen by a
!      perfect geodetically aligned theodolite.  (Zenith distance is
!      used rather than altitude in order to reflect the fact that no
!      allowance is made for depression of the horizon.)  This is
!      related to the observed HA,Dec via the standard rotation, using
!      the geodetic latitude (corrected for polar motion), while the
!      observed HA and RA are related simply through the Earth rotation
!      angle and the site longitude.  "Observed" RA,Dec or HA,Dec thus
!      means the position that would be seen by a perfect equatorial
!      with its polar axis aligned to the Earth's axis of rotation.
!
!  2.  Only the first character of the TYPE argument is significant.
!      'R' or 'r' indicates that OB1 and OB2 are the observed right
!      ascension and declination;  'H' or 'h' indicates that they are
!      hour angle (west +ve) and declination;  anything else ('A' or
!      'a' is recommended) indicates that OB1 and OB2 are azimuth
!      (north zero, east 90 deg) and zenith distance.
!
!  3.  UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!      convenient way between the two arguments, for example where UTC1
!      is the Julian Day Number and UTC2 is the fraction of a day.
!
!      However, JD cannot unambiguously represent UTC during a leap
!      second unless special measures are taken.  The convention in the
!      present routine is that the JD day represents UTC days whether
!      the length is 86399, 86400 or 86401 SI seconds.
!
!      Applications should use the routine DTF2D to convert from
!      calendar date and time of day into 2-part quasi Julian Date, as
!      it implements the leap-second-ambiguity convention just
!      described.
!
!  4.  The warning status "dubious year" flags UTCs that predate the
!      introduction of the time scale or that are too far in the
!      future to be trusted.  See DAT for further details.
!
!  5.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
!      one second at the end of each positive UTC leap second,
!      introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
!      practice is under review, and in the future UT1-UTC may grow
!      essentially without limit.
!
!  6.  The geographical coordinates are with respect to the WGS84
!      reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
!      longitude required by the present routine is east-positive
!      (i.e. right-handed), in accordance with geographical convention.
!
!  7.  The polar motion XP,YP can be obtained from IERS bulletins.  The
!      values are the coordinates (in radians) of the Celestial
!      Intermediate Pole with respect to the International Terrestrial
!      Reference System (see IERS Conventions 2003), measured along the
!      meridians 0 and 90 deg west respectively.  For many applications,
!      XP and YP can be set to zero.
!
!  8.  If hm, the height above the ellipsoid of the observing station
!      in meters, is not known but phpa, the pressure in hPa (=mB), is
!      available, an adequate estimate of hm can be obtained from the
!      expression
!
!            hm = -29.3 * tsl * log ( phpa / 1013.25 );
!
!      where tsl is the approximate sea-level air temperature in K
!      (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
!      52).  Similarly, if the pressure phpa is not known, it can be
!      estimated from the height of the observing station, hm, as
!      follows:
!
!            phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );
!
!      Note, however, that the refraction is nearly proportional to
!      the pressure and that an accurate phpa value is important for
!      precise work.
!
!  9.  The argument WL specifies the observing wavelength in
!      micrometers.  The transition from optical to radio is assumed to
!      occur at 100 micrometers (about 3000 GHz).
!
!  10. The accuracy of the result is limited by the corrections for
!      refraction, which use a simple A*tan(z) + B*tan^3(z) model.
!      Providing the meteorological parameters are known accurately and
!      there are no gross local effects, the predicted astrometric
!      coordinates should be within 0.05 arcsec (optical) or 1 arcsec
!      (radio) for a zenith distance of less than 70 degrees, better
!      than 30 arcsec (optical or radio) at 85 degrees and better
!      than 20 arcmin (optical) or 30 arcmin (radio) at the horizon.
!
!      Without refraction, the complementary routines ATIO13 and
!      ATOI13 are self-consistent to better than 1 microarcsecond
!      all over the celestial sphere.  With refraction included,
!      consistency falls off at high zenith distances, but is still
!      better than 0.05 arcsec at 85 degrees.
!
!  11. It is advisable to take great care with units, as even unlikely
!      values of the input parameters are accepted and processed in
!      accordance with the models used.
!
!### History
!  * IAU SOFA revision:  2013 July 6

    subroutine ATOI13 ( type, ob1, ob2, utc1, utc2, dut1, &
                        elong, phi, hm, xp, yp, phpa, tc, rh, wl, &
                        ri, di, j )

    implicit none

    character(len=*),intent(in) :: type !! type of coordinates - 'R', 'H' or 'A' (Notes 1,2)
    real(wp),intent(in) :: ob1 !! observed Az, HA or RA (radians; Az is N=0,E=90)
    real(wp),intent(in) :: ob2 !! observed ZD or Dec (radians)
    real(wp),intent(in) :: utc1 !! UTC as a 2-part...
    real(wp),intent(in) :: utc2 !! ...quasi Julian Date (Notes 3,4)
    real(wp),intent(in) :: dut1 !! UT1-UTC (seconds, Note 5)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 6)
    real(wp),intent(in) :: phi !! geodetic latitude (radians, Note 6)
    real(wp),intent(in) :: hm !! height above the ellipsoid (meters, Notes 6,8)
    real(wp),intent(in) :: xp !! polar motion coordinates (radians, Note 7)
    real(wp),intent(in) :: yp !! polar motion coordinates (radians, Note 7)
    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = mB, Note 8)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers, Note 9)
    real(wp),intent(out) :: ri !! CIRS right ascension (CIO-based, radians)
    real(wp),intent(out) :: di !! CIRS declination (radians)
    integer,intent(out) :: j !! status: +1 = dubious year (Note 2)
                             !!  0 = OK
                             !! -1 = unacceptable date

    integer :: js
    real(wp) :: astrom(30)

    !  Star-independent astrometry parameters for CIRS->observed.
    call APIO13 ( utc1, utc2, dut1, elong, phi, hm, xp, yp, &
                  phpa, tc, rh, wl, astrom, js )

    !  Abort if bad UTC.
    if ( js>=0 ) then

      !  Transform observed to CIRS.
      call ATOIQ ( type, ob1, ob2, astrom, ri, di )

    end if

    !  Return OK/warning status.
    j = js

    end subroutine ATOI13
!***********************************************************************

!***********************************************************************
!>
!  Quick observed place to CIRS, given the star-independent astrometry
!  parameters.
!
!  Use of this routine is appropriate when efficiency is important and
!  where many star positions are all to be transformed for one date.
!  The star-independent astrometry parameters can be obtained by calling
!  APIO[13] or APCO[13].
!
!  Status:  support routine.
!
!### Notes
!
!  1. "Observed" Az,El means the position that would be seen by a
!     perfect geodetically aligned theodolite.  This is related to the
!     observed HA,Dec via the standard rotation, using the geodetic
!     latitude (corrected for polar motion), while the observed HA and
!     RA are related simply through the Earth rotation angle and the
!     site longitude.  "Observed" RA,Dec or HA,Dec thus means the
!     position that would be seen by a perfect equatorial with its polar
!     axis aligned to the Earth's axis of rotation.  By removing from
!     the observed place the effects of atmospheric refraction and
!     diurnal aberration, the CIRS RA,Dec is obtained.
!
!  2. Only the first character of the type argument is significant.
!     'R' or 'r' indicates that OB1 and OB2 are the observed right
!     ascension and declination;  'H' or 'h' indicates that they are
!     hour angle (west +ve) and declination;  anything else ('A' or
!     'a' is recommended) indicates that OB1 and OB2 are azimuth (north
!     zero, east 90 deg) and zenith distance.  (Zenith distance is used
!     rather than altitude in order to reflect the fact that no
!     allowance is made for depression of the horizon.)
!
!  3. The accuracy of the result is limited by the corrections for
!     refraction, which use a simple A*tan(z) + B*tan^3(z) model.
!     Providing the meteorological parameters are known accurately and
!     there are no gross local effects, the predicted observed
!     coordinates should be within 0D05 arcsec (optical) or 1 arcsec
!     (radio) for a zenith distance of less than 70 degrees, better
!     than 30 arcsec (optical or radio) at 85 degrees and better than
!     20 arcmin (optical) or 30 arcmin (radio) at the horizon.
!
!     Without refraction, the complementary routines ATIOQ and
!     ATOIQ are self-consistent to better than 1 microarcsecond all
!     over the celestial sphere.  With refraction included, consistency
!     falls off at high zenith distances, but is still better than
!     0.05 arcsec at 85 degrees.
!
!  4. It is advisable to take great care with units, as even unlikely
!     values of the input parameters are accepted and processed in
!     accordance with the models used.
!
!  5. The star-independent astrometry parameters in ASTROM may be
!     computed with APIO13 (or APIO).  If nothing has changed
!     significantly except the time, APER13 (or APER) may be
!     used to perform the requisite adjustment to the ASTROM array.
!
!### History
!  * IAU SOFA revision:  2013 August 3

    subroutine ATOIQ ( type, ob1, ob2, astrom, ri, di )

    implicit none

    character(len=*),intent(in) :: type !! type of coordinates: 'R', 'H' or 'A' (Note 2)
    real(wp),intent(in) :: ob1 !! observed Az, HA or RA (radians; Az is N=0,E=90)
    real(wp),intent(in) :: ob2 !! observed ZD or Dec (radians)
    real(wp),dimension(30),intent(in) :: astrom !! star-independent astrometry parameters:
                                                !! (1)      PM time interval (SSB, Julian years)
                                                !! (2-4)    SSB to observer (vector, au)
                                                !! (5-7)    Sun to observer (unit vector)
                                                !! (8)      distance from Sun to observer (au)
                                                !! (9-11)   v: barycentric observer velocity (vector, c)
                                                !! (12)     sqrt(1-|v|^2): reciprocal of Lorenz factor
                                                !! (13-21)  bias-precession-nutation matrix
                                                !! (22)     longitude + s' (radians)
                                                !! (23)     polar motion xp wrt local meridian (radians)
                                                !! (24)     polar motion yp wrt local meridian (radians)
                                                !! (25)     sine of geodetic latitude
                                                !! (26)     cosine of geodetic latitude
                                                !! (27)     magnitude of diurnal aberration vector
                                                !! (28)     "local" Earth rotation angle (radians)
                                                !! (29)     refraction constant A (radians)
                                                !! (30)     refraction constant B (radians)
    real(wp),intent(out) :: ri !! CIRS right ascension (CIO-based, radians)
    real(wp),intent(out) :: di !! CIRS declination (radians)

    character(len=1) :: c
    real(wp) :: c1, c2, sphi, cphi, ce, xaeo, yaeo, zaeo, v(3), &
                xmhdo, ymhdo, zmhdo, az, sz, zdo, refa, refb, &
                tz, dref, zdt, xaet, yaet, zaet, &
                xmhda, ymhda, zmhda, f, xhd, yhd, zhd, &
                xpl, ypl, w, hma

    !  Coordinate type.
    c = type(:1)

    !  Coordinates.
    c1 = ob1
    c2 = ob2

    !  Sin, cos of latitude.
    sphi = astrom(25)
    cphi = astrom(26)

    !  Standardize coordinate type.
    if ( c=='r' .or. c=='R' ) then
       c = 'R'
    else if ( c=='h' .or. c=='H' ) then
       c = 'H'
    else
       c = 'A'
    end if

    !  If Az,ZD, convert to Cartesian (S=0,E=90).
    if ( c=='A' ) then
       ce = sin(c2)
       xaeo = - cos(c1) * ce
       yaeo = sin(c1) * ce
       zaeo = cos(c2)
    else

       !  If RA,Dec, convert to HA,Dec.
       if ( c=='R' ) c1 = astrom(28) - c1

       !  To Cartesian -HA,DeC.
       call S2C ( -c1, c2, v )
       xmhdo = v(1)
       ymhdo = v(2)
       zmhdo = v(3)

       !  To Cartesian Az,El (S=0,E=90).
       xaeo = sphi*xmhdo - cphi*zmhdo
       yaeo = ymhdo
       zaeo = cphi*xmhdo + sphi*zmhdo
    end if

    !  Azimuth (S=0,E=90).
    if ( xaeo/=0.0_wp .or. yaeo/=0.0_wp ) then
       az = atan2(yaeo,xaeo)
    else
       az = 0.0_wp
    end if

    !  Sine of observed ZD, and observed ZD.
    sz = sqrt ( xaeo*xaeo + yaeo*yaeo )
    zdo = atan2 ( sz, zaeo )

    !
    ! Refraction
    ! ----------

    !  Fast algorithm using two constant model.
    refa = astrom(29)
    refb = astrom(30)
    tz = sz / zaeo
    dref = ( refa + refb*tz*tz ) * tz
    zdt = zdo + dref

    !  To Cartesian Az,ZD.
    ce = sin(zdt)
    xaet = cos(az) * ce
    yaet = sin(az) * ce
    zaet = cos(zdt)

    !  Cartesian Az,ZD to Cartesian -HA,DeC.
    xmhda = sphi*xaet + cphi*zaet
    ymhda = yaet
    zmhda = - cphi*xaet + sphi*zaet

    !  Diurnal aberration.
    f = ( 1.0_wp + astrom(27)*ymhda )
    xhd = f * xmhda
    yhd = f * ( ymhda - astrom(27) )
    zhd = f * zmhda

    !  Polar motion.
    xpl = astrom(23)
    ypl = astrom(24)
    w = xpl*xhd - ypl*yhd + zhd
    v(1) = xhd - xpl*w
    v(2) = yhd + ypl*w
    v(3) = w - ( xpl*xpl + ypl*ypl ) * zhd

    !  To spherical -HA,DeC.
    call C2S ( v, hma, di )

    !  Right ascension.
    ri = ANP ( astrom(28) + hma )

    end subroutine ATOIQ
!***********************************************************************

!***********************************************************************
!>
!  Frame bias components of IAU 2000 precession-nutation models (part of
!  MHB2000 with additions).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The frame bias corrections in longitude and obliquity (radians)
!     are required in order to correct for the offset between the GCRS
!     pole and the J2000.0 mean pole.  They define, with respect to the
!     GCRS frame, a J2000.0 mean pole that is consistent with the rest
!     of the IAU 2000A precession-nutation model.
!
!  2. In addition to the displacement of the pole, the complete
!     description of the frame bias requires also an offset in right
!     ascension.  This is not part of the IAU 2000A model, and is from
!     Chapront et al. (2002).  It is returned in radians.
!
!  3. This is a supplemented implementation of one aspect of the IAU
!     2000A nutation model, formally adopted by the IAU General Assembly
!     in 2000, namely MHB2000 (Mathews et al. 2002).
!
!### References
!
!  * Chapront, J., Chapront-Touze, M. & Francou, G., Astron.Astrophys.,
!    387, 700, 2002.
!
!  * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation
!    and precession   New nutation series for nonrigid Earth and
!    insights into the Earth's interior", J.Geophys.Res., 107, B4,
!    2002.  The MHB2000 code itself was obtained on 9th September 2002
!    from ftp://maia.usno.navy.mil/conv2000/chapter5/IAU2000A.
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine BI00 ( dpsibi, depsbi, dra )

    implicit none

    real(wp),intent(out) :: dpsibi !! longitude correction
    real(wp),intent(out) :: depsbi !! obliquity correction
    real(wp),intent(out) :: dra !! the ICRS RA of the J2000.0 mean equinox

    !  The frame bias corrections in longitude and obliquity
    real(wp),parameter :: dpbias = -0.041775_wp * das2r
    real(wp),parameter :: debias = -0.0068192_wp * das2r

    !  The ICRS RA of the J2000.0 equinox (Chapront et al., 2002)
    real(wp),parameter :: dra0 = -0.0146_wp * das2r

    !  Return the results (which are fixed).
    dpsibi = dpbias
    depsbi = debias
    dra = dra0

    end subroutine BI00
!***********************************************************************

!***********************************************************************
!>
!  Frame bias and precession, IAU 2000.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix RB transforms vectors from GCRS to mean J2000.0 by
!     applying frame bias.
!
!  3. The matrix RP transforms vectors from J2000.0 mean equator and
!     equinox to mean equator and equinox of date by applying
!     precession.
!
!  4. The matrix RBP transforms vectors from GCRS to mean equator and
!     equinox of date by applying frame bias then precession.  It is the
!     product RP x RB.
!
!### Reference
!
!  * 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.
!
!### History
!  * IAU SOFA revision: 2013 August 21

    subroutine BP00 ( date1, date2, rb, rp, rbp )

    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),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 2)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 3)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 4)

    !  J2000.0 obliquity (Lieske et al. 1977)
    real(wp),parameter :: eps0 = 84381.448_wp * das2r

    real(wp) :: t, dpsibi, depsbi, dra0, psia77, oma77, chia, &
                dpsipr, depspr, psia, oma, rbw(3,3)

    !  Interval between fundamental epoch J2000.0 and current date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Frame bias.
    call BI00 ( dpsibi, depsbi, dra0 )

    !  Precession angles (Lieske et al. 1977)
    psia77 =        ( 5038.7784_wp + &
                    (   -1.07259_wp + &
                    (   -0.001147_wp ) * t ) * t ) * t * das2r
    oma77  = eps0 + ( &
                    (    0.05127_wp + &
                    (   -0.007726_wp ) * t ) * t ) * t * das2r
    chia   =        (   10.5526_wp + &
                    (   -2.38064_wp + &
                    (   -0.001125_wp ) * t ) * t ) * t * das2r

    !  Apply IAU 2000 precession corrections.
    call PR00 ( date1, date2, dpsipr, depspr )
    psia = psia77 + dpsipr
    oma  = oma77  + depspr

    !  Frame bias matrix: GCRS to J2000.0.
    call IR ( rbw )
    call RZ ( dra0, rbw )
    call RY ( dpsibi*sin(eps0), rbw )
    call RX ( -depsbi, rbw )
    call CR ( rbw, rb )

    !  Precession matrix: J2000.0 to mean of date.
    call IR ( rp )
    call RX ( eps0, rp )
    call RZ ( -psia, rp )
    call RX ( -oma, rp )
    call RZ ( chia, rp )

    !  Bias-precession matrix: GCRS to mean of date.
    call RXR ( rp, rbw, rbp )

    end subroutine BP00
!***********************************************************************

!***********************************************************************
!>
!  Frame bias and precession, IAU 2006.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix RB transforms vectors from GCRS to mean J2000.0 by
!     applying frame bias.
!
!  3. The matrix RP transforms vectors from mean J2000.0 to mean of date
!     by applying precession.
!
!  4. The matrix RBP transforms vectors from GCRS to mean of date by
!     applying frame bias then precession.  It is the product RP x RB.
!
!### References
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2013 August 21

    subroutine BP06 ( date1, date2, rb, rp, rbp )

    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),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 2)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 3)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 4)

    !  JD for MJD 0
    real(wp),parameter :: djm0 = 2400000.5_wp

    !  Reference epoch (J2000.0), MJD
    real(wp),parameter :: djm00 = 51544.5_wp

    real(wp) :: gamb, phib, psib, epsa, rbpw(3,3), rbt(3,3)

    !  B matrix.
    call PFW06 ( djm0, djm00, gamb, phib, psib, epsa )
    call FW2M ( gamb, phib, psib, epsa, rb )

    !  PxB matrix (temporary).
    call PMAT06 ( date1, date2, rbpw )

    !  P matrix.
    call TR ( rb, rbt )
    call RXR ( rbpw, rbt, rp )

    !  PxB matrix.
    call CR ( rbpw, rbp )

    end subroutine BP06
!***********************************************************************

!***********************************************************************
!>
!  Extract from the bias-precession-nutation matrix the X,Y coordinates
!  of the Celestial Intermediate Pole.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The matrix RBPN transforms vectors from GCRS to true equator (and
!     CIO or equinox) of date, and therefore the Celestial Intermediate
!     Pole unit vector is the bottom row of the matrix.
!
!  2. X,Y are components of the Celestial Intermediate Pole unit vector
!     in the Geocentric Celestial Reference System.
!
!### Reference
!
!  * 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.
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine BPN2XY ( rbpn, x, y )

    implicit none

    real(wp),dimension(3,3),intent(in) :: rbpn !! celestial-to-true matrix (Note 1)
    real(wp),intent(out) :: x !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: y !! Celestial Intermediate Pole (Note 2)

    !  Extract the X,Y coordinates.
    x = rbpn(3,1)
    y = rbpn(3,2)

    end subroutine BPN2XY
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial-to-intermediate matrix for a given date using the
!  IAU 2000A precession-nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix RC2I is the first stage in the transformation from
!     celestial to terrestrial coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!  3. A faster, but slightly less accurate result (about 1 mas), can be
!     obtained by using instead the C2I00B routine.
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine C2I00A ( date1, date2, rc2i )

    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),dimension(3,3),intent(out) :: rc2i !! celestial-to-intermediate matrix (Note 2)

    real(wp) :: rbpn(3,3)

    !  Obtain the celestial-to-true matrix (IAU 2000A).
    call PNM00A ( date1, date2, rbpn )

    !  Form the celestial-to-intermediate matrix.
    call C2IBPN ( date1, date2, rbpn, rc2i )

    end subroutine C2I00A
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial-to-intermediate matrix for a given date using the
!  IAU 2000B precession-nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix RC2I is the first stage in the transformation from
!     celestial to terrestrial coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!  3. The present routine is faster, but slightly less accurate (about
!     1 mas), than the C2I00A routine.
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine C2I00B ( date1, date2, rc2i )

    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),dimension(3,3),intent(out) :: rc2i !! celestial-to-intermediate matrix (Note 2)

    real(wp) :: rbpn(3,3)

    !  Obtain the celestial-to-true matrix (IAU 2000B).
    call PNM00B ( date1, date2, rbpn )

    !  Form the celestial-to-intermediate matrix.
    call C2IBPN ( date1, date2, rbpn, rc2i )

    end subroutine C2I00B
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial-to-intermediate matrix for a given date using the
!  IAU 2006 precession and IAU 2000A nutation models.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix RC2I is the first stage in the transformation from
!     celestial to terrestrial coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2007 May 11

    subroutine C2I06A ( date1, date2, rc2i )

    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),dimension(3,3),intent(out) :: rc2i !! celestial-to-intermediate matrix (Note 2)

    real(wp) :: rbpn(3,3), x, y, s

    !  Obtain the celestial-to-true matrix (IAU 2006/2000A).
    call PNM06A ( date1, date2, rbpn )

    !  Extract the X,Y coordinates.
    call BPN2XY ( rbpn, x, y )

    !  Obtain the CIO locator.
    s = S06 ( date1, date2, x, y )

    !  Form the celestial-to-intermediate matrix.
    call C2IXYS ( x, y, s, rc2i )

    end subroutine C2I06A
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial-to-intermediate matrix for a given date given
!  the bias-precession-nutation matrix.  IAU 2000.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix RBPN transforms vectors from GCRS to true equator (and
!     CIO or equinox) of date.  Only the CIP (bottom row) is used.
!
!  3. The matrix RC2I is the first stage in the transformation from
!     celestial to terrestrial coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!  4. Although its name does not include "00", this routine is in fact
!     specific to the IAU 2000 models.
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine C2IBPN ( date1, date2, rbpn, rc2i )

    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),dimension(3,3),intent(in) :: rbpn !! celestial-to-true matrix (Note 2)
    real(wp),dimension(3,3),intent(out) :: rc2i !! celestial-to-intermediate matrix (Note 3)

    real(wp) :: x, y

    !  Extract the X,Y coordinates.
    call BPN2XY ( rbpn, x, y )

    !  Form the celestial-to-intermediate matrix (n.b. IAU 2000 specific).
    call C2IXY ( date1, date2, x, y, rc2i )

    end subroutine C2IBPN
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to intermediate-frame-of-date matrix for a given
!  date when the CIP X,Y coordinates are known.  IAU 2000.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The Celestial Intermediate Pole coordinates are the x,y components
!     of the unit vector in the Geocentric Celestial Reference System.
!
!  3. The matrix RC2I is the first stage in the transformation from
!     celestial to terrestrial coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!  4. Although its name does not include "00", this routine is in fact
!     specific to the IAU 2000 models.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2007 June 1

    subroutine C2IXY ( date1, date2, x, y, rc2i )

    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 !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(in) :: y !! Celestial Intermediate Pole (Note 2)
    real(wp),dimension(3,3),intent(out) :: rc2i !! celestial-to-intermediate matrix (Note 3)

    !  Compute s and then the matrix.
    call C2IXYS ( x, y, S00 ( date1, date2, x, y ), rc2i )

    end subroutine C2IXY
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to intermediate-frame-of-date matrix given the CIP
!  X,Y and the CIO locator s.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The Celestial Intermediate Pole coordinates are the x,y components
!     of the unit vector in the Geocentric Celestial Reference System.
!
!  2. The CIO locator s (in radians) positions the Celestial
!     Intermediate Origin on the equator of the CIP.
!
!  3. The matrix RC2I is the first stage in the transformation from
!     celestial to terrestrial coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2014 November 7

    subroutine C2IXYS ( x, y, s, rc2i )

    implicit none

    real(wp),intent(in) :: x !! Celestial Intermediate Pole (Note 1)
    real(wp),intent(in) :: y !! Celestial Intermediate Pole (Note 1)
    real(wp),intent(in) :: s !! the CIO locator s (Note 2)
    real(wp),dimension(3,3),intent(out) :: rc2i !! celestial-to-intermediate matrix (Note 3)

    real(wp) :: r2, e, d

    !  Obtain the spherical angles E and d.
    r2 = x*x+y*y
    if ( r2>0.0_wp ) then
       e = atan2 ( y, x )
    else
       e = 0.0_wp
    end if
    d = atan ( sqrt ( r2 / (1.0_wp-r2) ) )

    !  Form the matrix.
    call IR ( rc2i )
    call RZ ( e, rc2i )
    call RY ( d, rc2i )
    call RZ ( -(e+s), rc2i )

    end subroutine C2IXYS
!***********************************************************************

!***********************************************************************
!>
!  P-vector to spherical coordinates.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. P can have any magnitude; only its direction is used.
!
!  2. If P is null, zero THETA and PHI are returned.
!
!  3. At either pole, zero THETA is returned.
!
!### History
!  * IAU SOFA revision: 2007 April 11

    subroutine C2S ( p, theta, phi )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),intent(out) :: theta !! longitude angle (radians)
    real(wp),intent(out) :: phi !! latitude angle (radians)

    real(wp) :: x, y, z, d2

    x = p(1)
    y = p(2)
    z = p(3)
    d2 = x*x + y*y

    if ( d2 == 0.0_wp ) then
       theta = 0.0_wp
    else
       theta = atan2(y,x)
    end if

    if ( z == 0.0_wp ) then
       phi = 0.0_wp
    else
       phi = atan2(z,sqrt(d2))
    end if

    end subroutine C2S
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to terrestrial matrix given the date, the UT1 and
!  the polar motion, using the IAU 2000A nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT and UT1 dates TTA+TTB and UTA+UTB are Julian Dates,
!     apportioned in any convenient way between the arguments UTA and
!     UTB.  For example, JD(UT1)=2450123.7 could be expressed in any of
!     these ways, among others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  In the case of UTA,UTB, the
!     date & time method is best matched to the Earth rotation angle
!     algorithm used:  maximum accuracy (or, at least, minimum noise) is
!     delivered when the UTA argument is for 0hrs UT1 on the day in
!     question and the UTB argument lies in the range 0 to 1, or vice
!     versa.
!
!  2. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians to 0 and 90 deg west respectively.
!
!  3. The matrix RC2T transforms from celestial to terrestrial
!     coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), RC2I is the
!     celestial-to-intermediate matrix, ERA is the Earth rotation angle
!     and RPOM is the polar motion matrix.
!
!  4. A faster, but slightly less accurate result (about 1 mas), can be
!     obtained by using instead the C2T00B routine.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 April 1

    subroutine C2T00A ( tta, ttb, uta, utb, xp, yp, rc2t )

    implicit none

    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 2)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 2)
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix (Note 3)

    real(wp) :: rc2i(3,3), era, sp, rpom(3,3)

    !  Form the celestial-to-intermediate matrix for this TT (IAU 2000A).
    call C2I00A ( tta, ttb, rc2i )

    !  Predict the Earth rotation angle for this UT1.
    era = ERA00 ( uta, utb )

    !  Estimate s'.
    sp = SP00 ( tta, ttb )

    !  Form the polar motion matrix.
    call POM00 ( xp, yp, sp, rpom )

    !  Combine to form the celestial-to-terrestrial matrix.
    call C2TCIO ( rc2i, era, rpom, rc2t )

    end subroutine C2T00A
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to terrestrial matrix given the date, the UT1 and
!  the polar motion, using the IAU 2000B nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT and UT1 dates TTA+TTB and UTA+UTB are Julian Dates,
!     apportioned in any convenient way between the arguments UTA and
!     UTB.  For example, JD(UT1)=2450123.7 could be expressed in any of
!     these ways, among others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  In the case of UTA,UTB, the
!     date & time method is best matched to the Earth rotation angle
!     algorithm used:  maximum accuracy (or, at least, minimum noise) is
!     delivered when the UTA argument is for 0hrs UT1 on the day in
!     question and the UTB argument lies in the range 0 to 1, or vice
!     versa.
!
!  2. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians to 0 and 90 deg west respectively.
!
!  3. The matrix RC2T transforms from celestial to terrestrial
!     coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), RC2I is the
!     celestial-to-intermediate matrix, ERA is the Earth rotation angle
!     and RPOM is the polar motion matrix.
!
!  4. The present routine is faster, but slightly less accurate (about
!     1 mas), than the C2T00A routine.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 April 1

    subroutine C2T00B ( tta, ttb, uta, utb, xp, yp, rc2t )

    implicit none

    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 2)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 2)
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix (Note 3)

    real(wp) :: rc2i(3,3), era, rpom(3,3)

    !  Form the celestial-to-intermediate matrix for this TT (IAU 2000B).
    call C2I00B ( tta, ttb, rc2i )

    !  Predict the Earth rotation angle for this UT1.
    era = ERA00 ( uta, utb )

    !  Form the polar motion matrix (neglecting s').
    call POM00 ( xp, yp, 0.0_wp, rpom )

    !  Combine to form the celestial-to-terrestrial matrix.
    call C2TCIO ( rc2i, era, rpom, rc2t )

    end subroutine C2T00B
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to terrestrial matrix given the date, the UT1 and
!  the polar motion, using the IAU 2006 precession and IAU 2000A
!  nutation models.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT and UT1 dates TTA+TTB and UTA+UTB are Julian Dates,
!     apportioned in any convenient way between the arguments UTA and
!     UTB.  For example, JD(UT1)=2450123.7 could be expressed in any of
!     these ways, among others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  In the case of UTA,UTB, the
!     date & time method is best matched to the Earth rotation angle
!     algorithm used:  maximum accuracy (or, at least, minimum noise) is
!     delivered when the UTA argument is for 0hrs UT1 on the day in
!     question and the UTB argument lies in the range 0 to 1, or vice
!     versa.
!
!  2. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians to 0 and 90 deg west respectively.
!
!  3. The matrix RC2T transforms from celestial to terrestrial
!     coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), RC2I is the
!     celestial-to-intermediate matrix, ERA is the Earth rotation angle
!     and RPOM is the polar motion matrix.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!### History
!  * IAU SOFA revision: 2009 April 1

    subroutine C2T06A ( tta, ttb, uta, utb, xp, yp, rc2t )

    implicit none

    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 2)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 2)
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix (Note 3)

    real(wp) :: rc2i(3,3), era, sp, rpom(3,3)

    !  Form the celestial-to-intermediate matrix for this TT.
    call C2I06A ( tta, ttb, rc2i )

    !  Predict the Earth rotation angle for this UT1.
    era = ERA00 ( uta, utb )

    !  Estimate s'.
    sp = SP00 ( tta, ttb )

    !  Form the polar motion matrix.
    call POM00 ( xp, yp, sp, rpom )

    !  Combine to form the celestial-to-terrestrial matrix.
    call C2TCIO ( rc2i, era, rpom, rc2t )

    end subroutine C2T06A
!***********************************************************************

!***********************************************************************
!>
!  Assemble the celestial to terrestrial matrix from CIO-based
!  components (the celestial-to-intermediate matrix, the Earth Rotation
!  Angle and the polar motion matrix).
!
!  Status:  obsolete routine.
!
!### Notes
!
!  1. The name of the present routine, C2TCEO, reflects the original
!     name of the celestial intermediate origin (CIO), which before the
!     adoption of IAU 2006 Resolution 2 was called the "celestial
!     ephemeris origin" (CEO).
!
!  2. When the name change from CEO to CIO occurred, a new SOFA routine
!     called C2TCIO was introduced as the successor to the existing
!     C2TCEO.  The present routine is merely a front end to the new
!     one.
!
!  3. The present routine is included in the SOFA collection only to
!     support existing applications.  It should not be used in new
!     applications.
!
!### History
!  * IAU SOFA revision: 2007 May 9

    subroutine C2TCEO ( rc2i, era, rpom, rc2t )

    implicit none

    real(wp),dimension(3,3),intent(in) :: rc2i !! celestial-to-intermediate matrix
    real(wp),intent(in) :: era !! Earth rotation angle
    real(wp),dimension(3,3),intent(in) :: rpom !! polar-motion matrix
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix

    !  Call the renamed routine.
    call C2TCIO ( rc2i, era, rpom, rc2t )

    end subroutine C2TCEO
!***********************************************************************

!***********************************************************************
!>
!  Assemble the celestial to terrestrial matrix from CIO-based
!  components (the celestial-to-intermediate matrix, the Earth Rotation
!  Angle and the polar motion matrix).
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine constructs the rotation matrix that transforms
!     vectors in the celestial system into vectors in the terrestrial
!     system.  It does so starting from precomputed components, namely
!     the matrix which rotates from celestial coordinates to the
!     intermediate frame, the Earth rotation angle and the polar motion
!     matrix.  One use of the present routine is when generating a
!     series of celestial-to-terrestrial matrices where only the Earth
!     Rotation Angle changes, avoiding the considerable overhead of
!     recomputing the precession-nutation more often than necessary to
!     achieve given accuracy objectives.
!
!  2. The relationship between the arguments is as follows:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003).
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!### History
!  * IAU SOFA revision: 2013 August 24

    subroutine C2TCIO ( rc2i, era, rpom, rc2t )

    implicit none

    real(wp),dimension(3,3),intent(in) :: rc2i !! celestial-to-intermediate matrix
    real(wp),intent(in) :: era !! Earth rotation angle (radians)
    real(wp),dimension(3,3),intent(in) :: rpom !! polar-motion matrix
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix

    real(wp) :: r(3,3)

    !  Construct the matrix.
    call CR ( rc2i, r )
    call RZ ( era, r )
    call RXR ( rpom, r, rc2t )

    end subroutine C2TCIO
!***********************************************************************

!***********************************************************************
!>
!  Assemble the celestial to terrestrial matrix from equinox-based
!  components (the celestial-to-true matrix, the Greenwich Apparent
!  Sidereal Time and the polar motion matrix).
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine constructs the rotation matrix that transforms
!     vectors in the celestial system into vectors in the terrestrial
!     system.  It does so starting from precomputed components, namely
!     the matrix which rotates from celestial coordinates to the
!     true equator and equinox of date, the Greenwich Apparent Sidereal
!     Time and the polar motion matrix.  One use of the present routine
!     is when generating a series of celestial-to-terrestrial matrices
!     where only the Sidereal Time changes, avoiding the considerable
!     overhead of recomputing the precession-nutation more often than
!     necessary to achieve given accuracy objectives.
!
!  2. The relationship between the arguments is as follows:
!
!        [TRS]  =  RPOM * R_3(GST) * RBPN * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003).
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2013 August 24

    subroutine C2TEQX ( rbpn, gst, rpom, rc2t )

    implicit none

    real(wp),dimension(3,3),intent(in) :: rbpn !! celestial-to-true matrix
    real(wp),intent(in) :: gst !! Greenwich (apparent) Sidereal Time (radians)
    real(wp),dimension(3,3),intent(in) :: rpom !! polar-motion matrix
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix (Note 2)

    real(wp) :: r(3,3)

    !  Construct the matrix.
    call CR ( rbpn, r )
    call RZ ( gst, r )
    call RXR ( rpom, r, rc2t )

    end subroutine C2TEQX
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to terrestrial matrix given the date, the UT1, the
!  nutation and the polar motion.  IAU 2000.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT and UT1 dates TTA+TTB and UTA+UTB are Julian Dates,
!     apportioned in any convenient way between the arguments UTA and
!     UTB.  For example, JD(UT1)=2450123.7 could be expressed in any of
!     these ways, among others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  In the case of UTA,UTB, the
!     date & time method is best matched to the Earth rotation angle
!     algorithm used:  maximum accuracy (or, at least, minimum noise) is
!     delivered when the UTA argument is for 0hrs UT1 on the day in
!     question and the UTB argument lies in the range 0 to 1, or vice
!     versa.
!
!  2. The caller is responsible for providing the nutation components;
!     they are in longitude and obliquity, in radians and are with
!     respect to the equinox and ecliptic of date.  For high-accuracy
!     applications, free core nutation should be included as well as
!     any other relevant corrections to the position of the CIP.
!
!  3. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians to 0 and 90 deg west respectively.
!
!  4. The matrix RC2T transforms from celestial to terrestrial
!     coordinates:
!
!        [TRS]  =  RPOM * R_3(GST) * RBPN * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), RBPN is the
!     bias-precession-nutation matrix, GST is the Greenwich (apparent)
!     Sidereal Time and RPOM is the polar motion matrix.
!
!  5. Although its name does not include "00", this routine is in fact
!     specific to the IAU 2000 models.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 April 1

    subroutine C2TPE ( tta, ttb, uta, utb, dpsi, deps, xp, yp, &
                       rc2t )

    implicit none

    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: dpsi !! nutation (Note 2)
    real(wp),intent(in) :: deps !! nutation (Note 2)
    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 3)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 3)
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix (Note 4)

    real(wp) :: epsa, rb(3,3), rp(3,3), rbp(3,3), rn(3,3), &
                rbpn(3,3), gmst, ee, sp, rpom(3,3)

    !  Form the celestial-to-true matrix for this TT.
    call PN00 ( tta, ttb, dpsi, deps, &
                    epsa, rb, rp, rbp, rn, rbpn )

    !  Predict the Greenwich Mean Sidereal Time for this UT1 and TT.
    gmst = GMST00 ( uta, utb, tta, ttb )

    !  Predict the equation of the equinoxes given TT and nutation.
    ee = EE00 ( tta, ttb, epsa, dpsi)

    !  Estimate s'.
    sp = SP00 ( tta, ttb)

    !  Form the polar motion matrix.
    call POM00 ( xp, yp, sp, rpom )

    !  Combine to form the celestial-to-terrestrial matrix.
    call C2TEQX ( rbpn, gmst+ee, rpom, rc2t )

    end subroutine C2TPE
!***********************************************************************

!***********************************************************************
!>
!  Form the celestial to terrestrial matrix given the date, the UT1, the
!  CIP coordinates and the polar motion.  IAU 2000.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT and UT1 dates TTA+TTB and UTA+UTB are Julian Dates,
!     apportioned in any convenient way between the arguments UTA and
!     UTB.  For example, JD(UT1)=2450123.7 could be expressed in any of
!     these ways, among others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  In the case of UTA,UTB, the
!     date & time method is best matched to the Earth rotation angle
!     algorithm used:  maximum accuracy (or, at least, minimum noise) is
!     delivered when the UTA argument is for 0hrs UT1 on the day in
!     question and the UTB argument lies in the range 0 to 1, or vice
!     versa.
!
!  2. The Celestial Intermediate Pole coordinates are the x,y components
!     of the unit vector in the Geocentric Celestial Reference System.
!
!  3. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians to 0 and 90 deg west respectively.
!
!  4. The matrix RC2T transforms from celestial to terrestrial
!     coordinates:
!
!        [TRS]  =  RPOM * R_3(ERA) * RC2I * [CRS]
!
!               =  RC2T * [CRS]
!
!     where [CRS] is a vector in the Geocentric Celestial Reference
!     System and [TRS] is a vector in the International Terrestrial
!     Reference System (see IERS Conventions 2003), ERA is the Earth
!     Rotation Angle and RPOM is the polar motion matrix.
!
!  5. Although its name does not include "00", this routine is in fact
!     specific to the IAU 2000 models.
!
! Reference:
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 April 1

    subroutine C2TXY ( tta, ttb, uta, utb, x, y, xp, yp, rc2t )

    implicit none

    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: x !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(in) :: y !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 3)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 3)
    real(wp),dimension(3,3),intent(out) :: rc2t !! celestial-to-terrestrial matrix (Note 4)

    real(wp) :: rc2i(3,3), era, sp, rpom(3,3)

    !  Form the celestial-to-intermediate matrix for this TT.
    call C2IXY ( tta, ttb, x, y, rc2i )

    !  Predict the Earth rotation angle for this UT1.
    era = ERA00 ( uta, utb )

    !  Estimate s'.
    sp = SP00 ( tta, ttb )

    !  Form the polar motion matrix.
    call POM00 ( xp, yp, sp, rpom )

    !  Combine to form the celestial-to-terrestrial matrix.
    call C2TCIO ( rc2i, era, rpom, rc2t )

    end subroutine C2TXY
!***********************************************************************

!***********************************************************************
!>
!  Gregorian Calendar to Julian Date.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The algorithm used is valid from -4800 March 1, but this
!     implementation rejects dates before -4799 January 1.
!
!  2. The Julian Date is returned in two pieces, in the usual SOFA
!     manner, which is designed to preserve time resolution.  The
!     Julian Date is available as a single number by adding DJM0 and
!     DJM.
!
!  3. In early eras the conversion is from the "Proleptic Gregorian
!     Calendar";  no account is taken of the date(s) of adoption of
!     the Gregorian Calendar, nor is the AD/BC numbering convention
!     observed.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 12.92 (p604).
!
!### History
!  * IAU SOFA revision: 2014 November 7

    subroutine CAL2JD ( iy, im, id, djm0, djm, j )

    implicit none

    integer,intent(in) :: iy !! year in Gregorian calendar (Note 1)
    integer,intent(in) :: im !! month in Gregorian calendar (Note 1)
    integer,intent(in) :: id !! day in Gregorian calendar (Note 1)
    real(wp),intent(out) :: djm0 !! MJD zero-point: always 2400000.5
    real(wp),intent(out) :: djm !! Modified Julian Date for 0 hrs
    integer,intent(out) :: j !! status:
                             !! *  0 = OK
                             !! * -1 = bad year   (Note 3: JD not computed)
                             !! * -2 = bad month  (JD not computed)
                             !! * -3 = bad day    (JD computed)

    integer :: ndays, my, iypmy

    !  Earliest year allowed (4800BC)
    integer,parameter :: iymin = -4799

    !  Month lengths in days
    integer,dimension(12),parameter :: mtab = [31,28,31,30,31,30,31,31,30,31,30,31]

    !  Preset status.
    j = 0

    !  Validate year.
    if ( iy<iymin ) then
       j = -1
    else

       !  Validate month.
       if ( im>=1 .and. im<=12 ) then

          !  Days in current month.
          ndays = mtab(im)

          !  Allow for leap year.
          if ( im == 2 ) then
             if ( mod(iy,4) == 0 ) ndays = 29
             if ( mod(iy,100)==0 .and. &
                  mod(iy,400)/=0 ) ndays = 28
          end if

          !  Validate day.
          if ( id<1 .or. id>ndays ) j = -3

          !  Result.
          my = ( im - 14 ) / 12
          iypmy = iy + my
          djm0 = 2400000.5_wp
          djm = real( ( 1461 * ( iypmy + 4800 ) ) / 4 &
                    + (  367 * ( im-2 - 12*my ) ) / 12 &
                    - (    3 * ( ( iypmy + 4900 ) / 100 ) ) / 4 &
                    + id - 2432076, wp)

          !  Bad month
       else
          j = -2
       end if
    end if

    end subroutine CAL2JD
!***********************************************************************

!***********************************************************************
!>
!  Copy a p-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine CP ( p, c )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! p-vector to be copied
    real(wp),dimension(3),intent(out) :: c !! copy

    integer :: i

    do i=1,3
       c(i) = p(i)
    end do

    end subroutine CP
!***********************************************************************

!***********************************************************************
!>
!  Copy a position/velocity vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine CPV ( pv, c )

    implicit none

    real(wp),dimension(3,2),intent(in) :: pv !! position/velocity vector to be copied
    real(wp),dimension(3,2),intent(out) :: c !! copy

    call CP ( pv(1,1), c(1,1) )
    call CP ( pv(1,2), c(1,2) )

    end subroutine CPV
!***********************************************************************

!***********************************************************************
!>
!  Copy an r-matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine CR ( r, c )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! r-matrix to be copied
    real(wp),dimension(3,3),intent(out) :: c !! copy

    integer :: i

    do i=1,3
       call CP ( r(1,i), c(1,i) )
    end do

    end subroutine CR
!***********************************************************************

!***********************************************************************
!>
!  Format for output a 2-part Julian Date (or in the case of UTC a
!  quasi-JD form that includes special provision for leap seconds).
!
!  Status:  support routine.
!
!### Notes
!
!  1. SCALE identifies the time scale.  Only the value 'UTC' (in upper
!     case) is significant, and enables handling of leap seconds (see
!     Note 4).
!
!  2. NDP is the number of decimal places in the seconds field, and can
!     have negative as well as positive values, such as:
!
!     NDP         resolution
!     -4            1 00 00
!     -3            0 10 00
!     -2            0 01 00
!     -1            0 00 10
!      0            0 00 01
!      1            0 00 00.1
!      2            0 00 00.01
!      3            0 00 00.001
!
!     The limits are platform dependent, but a safe range is -5 to +9.
!
!  3. D1+D2 is Julian Date, apportioned in any convenient way between
!     the two arguments, for example where D1 is the Julian Day Number
!     and D2 is the fraction of a day.  In the case of UTC, where the
!     use of JD is problematical, special conventions apply:  see the
!     next note.
!
!  4. JD cannot unambiguously represent UTC during a leap second unless
!     special measures are taken.  The SOFA internal convention is that
!     the quasi-JD day represents UTC days whether the length is 86399,
!     86400 or 86401 SI seconds.  In the 1960-1972 era there were
!     smaller jumps (in either direction) each time the linear UTC(TAI)
!     expression was changed, and these "mini-leaps" are also included
!     in the SOFA convention.
!
!  5. The warning status "dubious year" flags UTCs that predate the
!     introduction of the time scale or that are too far in the future
!     to be trusted.  See DAT for further details.
!
!  6. For calendar conventions and limitations, see CAL2JD.
!
!### History
!  * IAU SOFA revision: 2014 February 15

    subroutine D2DTF ( scale, ndp, d1, d2, iy, im, id, ihmsf, j )

    implicit none

    character(len=*),intent(in) :: scale !! time scale ID (Note 1)
    integer,intent(in) :: ndp !! resolution (Note 2)
    real(wp),intent(in) :: d1 !! time as a 2-part Julian Date (Notes 3,4)
    real(wp),intent(in) :: d2 !! time as a 2-part Julian Date (Notes 3,4)
    integer,intent(out) :: iy !! year in Gregorian calendar (Note 5)
    integer,intent(out) :: im !! month in Gregorian calendar (Note 5)
    integer,intent(out) :: id !! day in Gregorian calendar (Note 5)
    integer,dimension(4),intent(out) :: ihmsf !! hours, minutes, seconds, fraction (Note 1)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 5)
                             !! *  0 = OK
                             !! * -1 = unacceptable date (Note 6)

    logical :: leap
    character(len=1) :: s
    integer :: iy1, im1, id1, js, iy2, im2, id2, ihmsf1(4), i
    real(wp) :: a1, b1, fd, dat0, dat12, w, dat24, dleap

    main : block

      !  The two-part JD.
      a1 = d1
      b1 = d2

      !  Provisional calendar date.
      call JD2CAL ( a1, b1, iy1, im1, id1, fd, js )
      if ( js/=0 ) exit main

      !  Is this a leap second day?
      leap = .false.
      if ( scale=='UTC' ) then

        !  TAI-UTC at 0h today.
        call DAT ( iy1, im1, id1, 0.0_wp, dat0, js )
        if ( js<0 ) exit main

        !  TAI-UTC at 12h today (to detect drift).
        call DAT ( iy1, im1, id1, 0.5_wp, dat12, js )
        if ( js<0 ) exit main

        !  TAI-UTC at 0h tomorrow (to detect jumps).
        call JD2CAL ( a1+1.5_wp, b1-fd, iy2, im2, id2, w, js )
        if ( js/=0 ) exit main
        call DAT ( iy2, im2, id2, 0.0_wp, dat24, js )
        if ( js<0 ) exit main

        !  Any sudden change in TAI-UTC (seconds).
        dleap = dat24 - ( 2.0_wp * dat12 - dat0 )

        !  If leap second day, scale the fraction of a day into SI.
        leap = dleap/=0.0_wp
        if ( leap ) fd = fd + fd*dleap/d2s

      end if

      !  Provisional time of day.
      call D2TF ( ndp, fd, s, ihmsf1 )

      !  Has the (rounded) time gone past 24h?
      if ( ihmsf1(1)>23 ) then

        !  Yes.  We probably need tomorrow's calendar date.
        call JD2CAL ( a1+1.5_wp, b1-fd, iy2, im2, id2, w, js )
        if ( js<0 ) exit main

        !  Is today a leap second day?
        if ( .not. leap ) then

            !  No.  Use 0h tomorrow.
            iy1 = iy2
            im1 = im2
            id1 = id2
            ihmsf1(1) = 0
            ihmsf1(2) = 0
            ihmsf1(3) = 0

        else

            !  Yes.  Are we past the leap second itself?
            if ( ihmsf1(3)>0 ) then

              !  Yes.  Use tomorrow but allow for the leap second.
              iy1 = iy2
              im1 = im2
              id1 = id2
              ihmsf1(1) = 0
              ihmsf1(2) = 0
              ihmsf1(3) = 0

            else

              !  No.  Use 23 59 60... today.
              ihmsf1(1) = 23
              ihmsf1(2) = 59
              ihmsf1(3) = 60
            end if

            !  If rounding to 10s or coarser always go up to new day.
            if ( ndp<0 .and. ihmsf1(3)==60 ) then
              iy1 = iy2
              im1 = im2
              id1 = id2
              ihmsf1(1) = 0
              ihmsf1(2) = 0
              ihmsf1(3) = 0
            end if
        end if
      end if

      !  Results.
      iy = iy1
      im = im1
      id = id1
      do i=1,4
        ihmsf(i) = ihmsf1(i)
      end do

    end block main

    !  Status.
    j = js

    end subroutine D2DTF
!***********************************************************************

!***********************************************************************
!>
!  Decompose days to hours, minutes, seconds, fraction.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. NDP is interpreted as follows:
!```
!     NDP         resolution
!      :      ...0000 00 00
!     -7         1000 00 00
!     -6          100 00 00
!     -5           10 00 00
!     -4            1 00 00
!     -3            0 10 00
!     -2            0 01 00
!     -1            0 00 10
!      0            0 00 01
!      1            0 00 00.1
!      2            0 00 00.01
!      3            0 00 00.001
!      :            0 00 00.000...
!```
!  2. The largest positive useful value for NDP is determined by the
!     size of DAYS, the format of REAL(WP) floating-point
!     numbers on the target platform, and the risk of overflowing
!     IHMSF(4).  On a typical platform, for DAYS up to 1D0, the
!     available floating-point precision might correspond to NDP=12.
!     However, the practical limit is typically NDP=9, set by the
!     capacity of a 32-bit IHMSF(4).
!
!  3. The absolute value of DAYS may exceed 1D0.  In cases where it
!     does not, it is up to the caller to test for and handle the
!     case where DAYS is very nearly 1D0 and rounds up to 24 hours,
!     by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero.
!
!### History
!  * IAU SOFA revision: 2005 August 26

    subroutine D2TF ( ndp, days, sign, ihmsf )

    implicit none

    integer,intent(in) :: ndp !! resolution (Note 1)
    real(wp),intent(in) :: days !! interval in days
    character(len=*),intent(out) :: sign !! '+' or '-'
    integer,dimension(4),intent(out) :: ihmsf !! hours, minutes, seconds, fraction

    integer :: nrs, n
    real(wp) :: rs, rm, rh, a, ah, am, as, af

    !  Handle sign.
    if ( days >= 0.0_wp ) then
       sign = '+'
    else
       sign = '-'
    end if

    !  Interval in seconds.
    a = d2s * abs(days)

    !  Pre-round if resolution coarser than 1 second (then pretend NDP=1).
    if ( ndp < 0 ) then
       nrs = 1
       do n=1,-ndp
          if ( n==2 .or. n==4 ) then
             nrs = nrs * 6
          else
             nrs = nrs * 10
          end if
       end do
       rs = real(nrs, wp)
       a = rs * anint(a/rs)
    end if

    !  Express the unit of each field in resolution units.
    nrs = 1
    do n=1,ndp
       nrs = nrs * 10
    end do
    rs = real(nrs, wp)
    rm = rs * 60.0_wp
    rh = rm * 60.0_wp

    !  Round the interval and express in resolution units.
    a = anint(rs*a)

    !  Break into fields.
    ah = aint(a/rh)
    a = a - ah*rh
    am = aint(a/rm)
    a = a - am*rm
    as = aint(a/rs)
    af = a - as*rs

    !  Return results.
    ihmsf(1) = nint(ah)
    ihmsf(2) = nint(am)
    ihmsf(3) = nint(as)
    ihmsf(4) = nint(af)

    end subroutine D2TF
!***********************************************************************

!***********************************************************************
!>
!  For a given UTC date, calculate Delta(AT) = TAI-UTC.
!
!     :------------------------------------------:
!     :                                          :
!     :                 IMPORTANT                :
!     :                                          :
!     :  A new version of this routine must be   :
!     :  produced whenever a new leap second is  :
!     :  announced.  There are five items to     :
!     :  change on each such occasion:           :
!     :                                          :
!     :  1) The parameter NDAT must be           :
!     :     increased by 1.                      :
!     :                                          :
!     :  2) The set of DATA statements that      :
!     :     initialize the arrays IDAT and       :
!     :     DATS must be extended by one line.   :
!     :                                          :
!     :  3) The parameter IYV must be set to     :
!     :     the current year.                    :
!     :                                          :
!     :  4) The "Latest leap second" comment     :
!     :     below must be set to the new leap    :
!     :     second date.                         :
!     :                                          :
!     :  5) The "This revision" comment, later,  :
!     :     must be set to the current date.     :
!     :                                          :
!     :  Change (3) must also be carried out     :
!     :  whenever the routine is re-issued,      :
!     :  even if no leap seconds have been       :
!     :  added.                                  :
!     :                                          :
!     :  Latest leap second:  2016 December 31   :
!     :                                          :
!     :__________________________________________:
!
!  Status:  user-replaceable support routine.
!
!### Notes
!
!  1. UTC began at 1960 January 1.0 (JD 2436934.5) and it is improper
!     to call the routine with an earlier date.  If this is attempted,
!     zero is returned together with a warning status.
!
!     Because leap seconds cannot, in principle, be predicted in
!     advance, a reliable check for dates beyond the valid range is
!     impossible.  To guard against gross errors, a year five or more
!     after the release year of the present routine (see parameter IYV)
!     is considered dubious.  In this case a warning status is returned
!     but the result is computed in the normal way.
!
!     For both too-early and too-late years, the warning status is J=+1.
!     This is distinct from the error status J=-1, which signifies a
!     year so early that JD could not be computed.
!
!  2. If the specified date is for a day which ends with a leap second,
!     the TAI-UTC value returned is for the period leading up to the
!     leap second.  If the date is for a day which begins as a leap
!     second ends, the TAI-UTC returned is for the period following the
!     leap second.
!
!  3. The day number must be in the normal calendar range, for example
!     1 through 30 for April.  The "almanac" convention of allowing
!     such dates as January 0 and December 32 is not supported in this
!     routine, in order to avoid confusion near leap seconds.
!
!  4. The fraction of day is used only for dates before the introduction
!     of leap seconds, the first of which occurred at the end of 1971.
!     It is tested for validity (0 to 1 is the valid range) even if not
!     used;  if invalid, zero is used and status J=-4 is returned.  For
!     many applications, setting FD to zero is acceptable;  the
!     resulting error is always less than 3 ms (and occurs only
!     pre-1972).
!
!  5. The status value returned in the case where there are multiple
!     errors refers to the first error detected.  For example, if the
!     month and day are 13 and 32 respectively, J=-2 (bad month) will be
!     returned.  The "internal error" status refers to a case that is
!     impossible but causes some compilers to issue a warning.
!
!  6. In cases where a valid result is not available, zero is returned.
!
!### References
!
!  1. For dates from 1961 January 1 onwards, the expressions from the
!     file ftp://maia.usno.navy.mil/ser7/tai-utc.dat are used.
!
!  2. The 5ms timestep at 1961 January 1 is taken from 2.58.1 (p87) of
!     the 1992 Explanatory Supplement.
!
!### History
!  * IAU SOFA revision: 2019 July 5

    subroutine DAT ( iy, im, id, fd, deltat, j )

    implicit none

    integer,intent(in) :: iy !! UTC:  year (Notes 1 and 2)
    integer,intent(in) :: im !! UTC:  month (Note 2)
    integer,intent(in) :: id !! UTC:  day (Notes 2 and 3)
    real(wp),intent(in) :: fd !! UTC:  fraction of day (Note 4)
    real(wp),intent(out) :: deltat !! TAI minus UTC, seconds
    integer,intent(out) :: j !! status (Note 5):
                             !!
                             !!  *  1 = dubious year (Note 1)
                             !!  *  0 = OK
                             !!  * -1 = bad year
                             !!  * -2 = bad month
                             !!  * -3 = bad day (Note 3)
                             !!  * -4 = bad fraction (Note 4)
                             !!  * -5 = internal error (Note 5)

    !  Release year for this version of DAT
    integer,parameter :: iyv = 2019

    !  Number of Delta(AT) changes (increase by 1 for each new leap second)
    integer,parameter :: ndat = 42

    !  Number of Delta(AT) expressions before leap seconds were introduced
    integer,parameter :: nera1 = 14

    !  Dates (year, month) on which new Delta(AT) came into force
    integer,dimension(2,ndat),parameter :: idat = reshape([ 1960,  1, &
                                                            1961,  1, &
                                                            1961,  8, &
                                                            1962,  1, &
                                                            1963, 11, &
                                                            1964,  1, &
                                                            1964,  4, &
                                                            1964,  9, &
                                                            1965,  1, &
                                                            1965,  3, &
                                                            1965,  7, &
                                                            1965,  9, &
                                                            1966,  1, &
                                                            1968,  2, &
                                                            1972,  1, &
                                                            1972,  7, &
                                                            1973,  1, &
                                                            1974,  1, &
                                                            1975,  1, &
                                                            1976,  1, &
                                                            1977,  1, &
                                                            1978,  1, &
                                                            1979,  1, &
                                                            1980,  1, &
                                                            1981,  7, &
                                                            1982,  7, &
                                                            1983,  7, &
                                                            1985,  7, &
                                                            1988,  1, &
                                                            1990,  1, &
                                                            1991,  1, &
                                                            1992,  7, &
                                                            1993,  7, &
                                                            1994,  7, &
                                                            1996,  1, &
                                                            1997,  7, &
                                                            1999,  1, &
                                                            2006,  1, &
                                                            2009,  1, &
                                                            2012,  7, &
                                                            2015,  7, &
                                                            2017,  1], [2,ndat])

    !  New Delta(AT) which came into force on the given dates
    real(wp),dimension(ndat),parameter :: dats = [1.4178180_wp,&
                                                  1.4228180_wp,&
                                                  1.3728180_wp,&
                                                  1.8458580_wp,&
                                                  1.9458580_wp,&
                                                  3.2401300_wp,&
                                                  3.3401300_wp,&
                                                  3.4401300_wp,&
                                                  3.5401300_wp,&
                                                  3.6401300_wp,&
                                                  3.7401300_wp,&
                                                  3.8401300_wp,&
                                                  4.3131700_wp,&
                                                  4.2131700_wp,&
                                                  10.0_wp,&
                                                  11.0_wp,&
                                                  12.0_wp,&
                                                  13.0_wp,&
                                                  14.0_wp,&
                                                  15.0_wp,&
                                                  16.0_wp,&
                                                  17.0_wp,&
                                                  18.0_wp,&
                                                  19.0_wp,&
                                                  20.0_wp,&
                                                  21.0_wp,&
                                                  22.0_wp,&
                                                  23.0_wp,&
                                                  24.0_wp,&
                                                  25.0_wp,&
                                                  26.0_wp,&
                                                  27.0_wp,&
                                                  28.0_wp,&
                                                  29.0_wp,&
                                                  30.0_wp,&
                                                  31.0_wp,&
                                                  32.0_wp,&
                                                  33.0_wp,&
                                                  34.0_wp,&
                                                  35.0_wp,&
                                                  36.0_wp,&
                                                  37.0_wp]

    !  Reference dates (MJD) and drift rates (s/day), pre leap seconds
    real(wp),dimension(2,nera1),parameter :: drift = reshape([37300.0_wp, 0.001296_wp, &
                                                              37300.0_wp, 0.001296_wp, &
                                                              37300.0_wp, 0.001296_wp, &
                                                              37665.0_wp, 0.0011232_wp, &
                                                              37665.0_wp, 0.0011232_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              38761.0_wp, 0.001296_wp, &
                                                              39126.0_wp, 0.002592_wp, &
                                                              39126.0_wp, 0.002592_wp ], [2,nera1])

    !  Miscellaneous local variables
    logical :: more
    integer :: js, m, n, is
    real(wp) :: da, djm0, djm

    main : block

      !  Initialize the result to zero and the status to OK.
      da = 0.0_wp
      js = 0

      !  If invalid fraction of a day, set error status and give up.
      if ( fd<0.0_wp .or. fd>1.0_wp ) then
        js = -4
        exit main
      end if

      !  Convert the date into an MJD.
      call CAL2JD ( iy, im, id, djm0, djm, js )

      !  If invalid year, month, or day, give up.
      if ( js < 0 ) exit main

      !  If pre-UTC year, set warning status and give up.
      if ( iy < idat(1,1) ) then
        js = 1
        exit main
      end if

      !  If suspiciously late year, set warning status but proceed.
      if ( iy > iyv+5 ) js = 1

      !  Combine year and month.
      m = 12*iy+im

      !  Find the most recent table entry.
      is = 0
      more = .true.
      do n=ndat,1,-1
        if ( more ) then
            is = n
            more = m < ( 12*idat(1,n) + idat(2,n) )
        end if
      end do

      !  Prevent underflow warnings.
      if ( is < 1 ) then
        js = -5
        exit main
      end if

      !  Get the Delta(AT).
      da = dats(is)

      !  If pre-1972, adjust for drift.
      if ( is <= nera1 ) da = da + &
                                ( djm + fd - drift(1,is) ) * drift(2,is)

    end block main

    !  Return the Delta(AT) value and the status.
    deltat = da
    j = js

    end subroutine DAT
!***********************************************************************

!***********************************************************************
!>
!  An approximation to TDB-TT, the difference between barycentric
!  dynamical time and terrestrial time, for an observer on the Earth.
!
!  The different time scales - proper, coordinate and realized - are
!  related to each other:
!
!            TAI             <-  physically realized
!             :
!          offset            <-  observed (nominally +32.184s)
!             :
!            TT              <-  terrestrial time
!             :
!    rate adjustment (L_G)   <-  definition of TT
!             :
!            TCG             <-  time scale for GCRS
!             :
!      "periodic" terms      <-  DTDB is an implementation
!             :
!    rate adjustment (L_C)   <-  function of solar-system ephemeris
!             :
!            TCB             <-  time scale for BCRS
!             :
!    rate adjustment (-L_B)  <-  definition of TDB
!             :
!            TDB             <-  TCB scaled to track TT
!             :
!      "periodic" terms      <-  -DTDB is an approximation
!             :
!            TT              <-  terrestrial time
!
!  Adopted values for the various constants can be found in the IERS
!  Conventions (McCarthy & Petit 2003).
!
!  Status:  support routine.
!
!### Notes
!
!  1. The date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the arguments DATE1 and DATE2.  For
!     example, JD(TDB)=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.
!
!     Although the date is, formally, barycentric dynamical time (TDB),
!     the terrestrial dynamical time (TT) can be used with no practical
!     effect on the accuracy of the prediction.
!
!  2. TT can be regarded as a coordinate time that is realized as an
!     offset of 32.184s from International Atomic Time, TAI.  TT is a
!     specific linear transformation of geocentric coordinate time TCG,
!     which is the time scale for the Geocentric Celestial Reference
!     System, GCRS.
!
!  3. TDB is a coordinate time, and is a specific linear transformation
!     of barycentric coordinate time TCB, which is the time scale for
!     the Barycentric Celestial Reference System, BCRS.
!
!  4. The difference TCG-TCB depends on the masses and positions of the
!     bodies of the solar system and the velocity of the Earth.  It is
!     dominated by a rate difference, the residual being of a periodic
!     character.  The latter, which is modeled by the present routine,
!     comprises a main (annual) sinusoidal term of amplitude
!     approximately 0.00166 seconds, plus planetary terms up to about
!     20 microseconds, and lunar and diurnal terms up to 2 microseconds.
!     These effects come from the changing transverse Doppler effect
!     and gravitational red-shift as the observer (on the Earth's
!     surface) experiences variations in speed (with respect to the
!     BCRS) and gravitational potential.
!
!  5. TDB can be regarded as the same as TCB but with a rate adjustment
!     to keep it close to TT, which is convenient for many applications.
!     The history of successive attempts to define TDB is set out in
!     Resolution 3 adopted by the IAU General Assembly in 2006, which
!     defines a fixed TDB(TCB) transformation that is consistent with
!     contemporary solar-system ephemerides.  Future ephemerides will
!     imply slightly changed transformations between TCG and TCB, which
!     could introduce a linear drift between TDB and TT;  however, any
!     such drift is unlikely to exceed 1 nanosecond per century.
!
!  6. The geocentric TDB-TT model used in the present routine is that of
!     Fairhead & Bretagnon (1990), in its full form.  It was originally
!     supplied by Fairhead (private communications with P.T.Wallace,
!     1990) as a Fortran subroutine.  The present routine contains an
!     adaptation of the Fairhead code.  The numerical results are
!     essentially unaffected by the changes, the differences with
!     respect to the Fairhead & Bretagnon original being at the 1D-20 s
!     level.
!
!     The topocentric part of the model is from Moyer (1981) and
!     Murray (1983), with fundamental arguments adapted from
!     Simon et al. 1994.  It is an approximation to the expression
!     ( v / c ) . ( r / c ), where v is the barycentric velocity of
!     the Earth, r is the geocentric position of the observer and
!     c is the speed of light.
!
!     By supplying zeroes for U and V, the topocentric part of the
!     model can be nullified, and the routine will return the Fairhead
!     & Bretagnon result alone.
!
!  7. During the interval 1950-2050, the absolute accuracy is better
!     than +/- 3 nanoseconds relative to time ephemerides obtained by
!     direct numerical integrations based on the JPL DE405 solar system
!     ephemeris.
!
!  8. It must be stressed that the present routine is merely a model,
!     and that numerical integration of solar-system ephemerides is the
!     definitive method for predicting the relationship between TCG and
!     TCB and hence between TT and TDB.
!
!### References
!
!  * Fairhead, L., & Bretagnon, P., Astron.Astrophys., 229, 240-247
!     (1990).
!
!  * IAU 2006 Resolution 3.
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Moyer, T.D., Cel.Mech., 23, 33 (1981).
!
!  * Murray, C.A., Vectorial Astrometry, Adam Hilger (1983).
!
!  * Seidelmann, P.K. et al., Explanatory Supplement to the
!    Astronomical Almanac, Chapter 2, University Science Books (1992).
!
!  * Simon, J.L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G. & Laskar, J., Astron.Astrophys., 282, 663-683 (1994).
!
!### History
!  * IAU SOFA revision: 2010 July 29

    function DTDB ( date1, date2, ut, elong, u, v ) result(TDB_minus_TT)

    implicit none

    real(wp),intent(in) :: date1 !! date, TDB (Notes 1-3)
    real(wp),intent(in) :: date2 !! date, TDB (Notes 1-3)
    real(wp),intent(in) :: ut !! universal time (UT1, fraction of one day)
    real(wp),intent(in) :: elong !! longitude (east positive, radians)
    real(wp),intent(in) :: u !! distance from Earth spin axis (km)
    real(wp),intent(in) :: v !! distance north of equatorial plane (km)
    real(wp) :: TDB_minus_TT !! TDB-TT (seconds)

    !  Degrees to radians
    real(wp),parameter :: dd2r = 1.745329251994329576923691e-2_wp

    !  Days per Julian millennium
    real(wp),parameter :: djm = 365250.0_wp

    real(wp) :: t, tsol, w, elsun, emsun, d, elj, els, &
                wt, w0, w1, w2, w3, w4, wf, wj
    integer :: j

    !
    !  =====================
    !  Fairhead et al. model
    !  =====================
    !
    !  787 sets of three coefficients.
    !
    !  Each set is amplitude (microseconds)
    !              frequency (radians per Julian millennium since J2000.0),
    !              phase (radians).
    !
    !  Sets   1-474 are the T**0 terms,
    !   "   475-679  "   "  T**1   "
    !   "   680-764  "   "  T**2   "
    !   "   765-784  "   "  T**3   "
    !   "   785-787  "   "  T**4   "  .
    !
    !real(wp) :: fairhd(3,787)
    !integer :: i,j
    real(wp),dimension(3,787),parameter :: fairhd = reshape([ &
     1656.674564e-6_wp,    6283.075849991_wp, 6.240054195_wp, &
       22.417471e-6_wp,    5753.384884897_wp, 4.296977442_wp, &
       13.839792e-6_wp,   12566.151699983_wp, 6.196904410_wp, &
        4.770086e-6_wp,     529.690965095_wp, 0.444401603_wp, &
        4.676740e-6_wp,    6069.776754553_wp, 4.021195093_wp, &
        2.256707e-6_wp,     213.299095438_wp, 5.543113262_wp, &
        1.694205e-6_wp,      -3.523118349_wp, 5.025132748_wp, &
        1.554905e-6_wp,   77713.771467920_wp, 5.198467090_wp, &
        1.276839e-6_wp,    7860.419392439_wp, 5.988822341_wp, &
        1.193379e-6_wp,    5223.693919802_wp, 3.649823730_wp, &
        1.115322e-6_wp,    3930.209696220_wp, 1.422745069_wp, &
        0.794185e-6_wp,   11506.769769794_wp, 2.322313077_wp, &
        0.447061e-6_wp,      26.298319800_wp, 3.615796498_wp, &
        0.435206e-6_wp,    -398.149003408_wp, 4.349338347_wp, &
        0.600309e-6_wp,    1577.343542448_wp, 2.678271909_wp, &
        0.496817e-6_wp,    6208.294251424_wp, 5.696701824_wp, &
        0.486306e-6_wp,    5884.926846583_wp, 0.520007179_wp, &
        0.432392e-6_wp,      74.781598567_wp, 2.435898309_wp, &
        0.468597e-6_wp,    6244.942814354_wp, 5.866398759_wp, &
        0.375510e-6_wp,    5507.553238667_wp, 4.103476804_wp, &
        0.243085e-6_wp,    -775.522611324_wp, 3.651837925_wp, &
        0.173435e-6_wp,   18849.227549974_wp, 6.153743485_wp, &
        0.230685e-6_wp,    5856.477659115_wp, 4.773852582_wp, &
        0.203747e-6_wp,   12036.460734888_wp, 4.333987818_wp, &
        0.143935e-6_wp,    -796.298006816_wp, 5.957517795_wp, &
        0.159080e-6_wp,   10977.078804699_wp, 1.890075226_wp, &
        0.119979e-6_wp,      38.133035638_wp, 4.551585768_wp, &
        0.118971e-6_wp,    5486.777843175_wp, 1.914547226_wp, &
        0.116120e-6_wp,    1059.381930189_wp, 0.873504123_wp, &
        0.137927e-6_wp,   11790.629088659_wp, 1.135934669_wp, &
        0.098358e-6_wp,    2544.314419883_wp, 0.092793886_wp, &
        0.101868e-6_wp,   -5573.142801634_wp, 5.984503847_wp, &
        0.080164e-6_wp,     206.185548437_wp, 2.095377709_wp, &
        0.079645e-6_wp,    4694.002954708_wp, 2.949233637_wp, &
        0.062617e-6_wp,      20.775395492_wp, 2.654394814_wp, &
        0.075019e-6_wp,    2942.463423292_wp, 4.980931759_wp, &
        0.064397e-6_wp,    5746.271337896_wp, 1.280308748_wp, &
        0.063814e-6_wp,    5760.498431898_wp, 4.167901731_wp, &
        0.048042e-6_wp,    2146.165416475_wp, 1.495846011_wp, &
        0.048373e-6_wp,     155.420399434_wp, 2.251573730_wp, &
        0.058844e-6_wp,     426.598190876_wp, 4.839650148_wp, &
        0.046551e-6_wp,      -0.980321068_wp, 0.921573539_wp, &
        0.054139e-6_wp,   17260.154654690_wp, 3.411091093_wp, &
        0.042411e-6_wp,    6275.962302991_wp, 2.869567043_wp, &
        0.040184e-6_wp,      -7.113547001_wp, 3.565975565_wp, &
        0.036564e-6_wp,    5088.628839767_wp, 3.324679049_wp, &
        0.040759e-6_wp,   12352.852604545_wp, 3.981496998_wp, &
        0.036507e-6_wp,     801.820931124_wp, 6.248866009_wp, &
        0.036955e-6_wp,    3154.687084896_wp, 5.071801441_wp, &
        0.042732e-6_wp,     632.783739313_wp, 5.720622217_wp, &
        0.042560e-6_wp,  161000.685737473_wp, 1.270837679_wp, &
        0.040480e-6_wp,   15720.838784878_wp, 2.546610123_wp, &
        0.028244e-6_wp,   -6286.598968340_wp, 5.069663519_wp, &
        0.033477e-6_wp,    6062.663207553_wp, 4.144987272_wp, &
        0.034867e-6_wp,     522.577418094_wp, 5.210064075_wp, &
        0.032438e-6_wp,    6076.890301554_wp, 0.749317412_wp, &
        0.030215e-6_wp,    7084.896781115_wp, 3.389610345_wp, &
        0.029247e-6_wp,  -71430.695617928_wp, 4.183178762_wp, &
        0.033529e-6_wp,    9437.762934887_wp, 2.404714239_wp, &
        0.032423e-6_wp,    8827.390269875_wp, 5.541473556_wp, &
        0.027567e-6_wp,    6279.552731642_wp, 5.040846034_wp, &
        0.029862e-6_wp,   12139.553509107_wp, 1.770181024_wp, &
        0.022509e-6_wp,   10447.387839604_wp, 1.460726241_wp, &
        0.020937e-6_wp,    8429.241266467_wp, 0.652303414_wp, &
        0.020322e-6_wp,     419.484643875_wp, 3.735430632_wp, &
        0.024816e-6_wp,   -1194.447010225_wp, 1.087136918_wp, &
        0.025196e-6_wp,    1748.016413067_wp, 2.901883301_wp, &
        0.021691e-6_wp,   14143.495242431_wp, 5.952658009_wp, &
        0.017673e-6_wp,    6812.766815086_wp, 3.186129845_wp, &
        0.022567e-6_wp,    6133.512652857_wp, 3.307984806_wp, &
        0.016155e-6_wp,   10213.285546211_wp, 1.331103168_wp, &
        0.014751e-6_wp,    1349.867409659_wp, 4.308933301_wp, &
        0.015949e-6_wp,    -220.412642439_wp, 4.005298270_wp, &
        0.015974e-6_wp,   -2352.866153772_wp, 6.145309371_wp, &
        0.014223e-6_wp,   17789.845619785_wp, 2.104551349_wp, &
        0.017806e-6_wp,      73.297125859_wp, 3.475975097_wp, &
        0.013671e-6_wp,    -536.804512095_wp, 5.971672571_wp, &
        0.011942e-6_wp,    8031.092263058_wp, 2.053414715_wp, &
        0.014318e-6_wp,   16730.463689596_wp, 3.016058075_wp, &
        0.012462e-6_wp,     103.092774219_wp, 1.737438797_wp, &
        0.010962e-6_wp,       3.590428652_wp, 2.196567739_wp, &
        0.015078e-6_wp,   19651.048481098_wp, 3.969480770_wp, &
        0.010396e-6_wp,     951.718406251_wp, 5.717799605_wp, &
        0.011707e-6_wp,   -4705.732307544_wp, 2.654125618_wp, &
        0.010453e-6_wp,    5863.591206116_wp, 1.913704550_wp, &
        0.012420e-6_wp,    4690.479836359_wp, 4.734090399_wp, &
        0.011847e-6_wp,    5643.178563677_wp, 5.489005403_wp, &
        0.008610e-6_wp,    3340.612426700_wp, 3.661698944_wp, &
        0.011622e-6_wp,    5120.601145584_wp, 4.863931876_wp, &
        0.010825e-6_wp,     553.569402842_wp, 0.842715011_wp, &
        0.008666e-6_wp,    -135.065080035_wp, 3.293406547_wp, &
        0.009963e-6_wp,     149.563197135_wp, 4.870690598_wp, &
        0.009858e-6_wp,    6309.374169791_wp, 1.061816410_wp, &
        0.007959e-6_wp,     316.391869657_wp, 2.465042647_wp, &
        0.010099e-6_wp,     283.859318865_wp, 1.942176992_wp, &
        0.007147e-6_wp,    -242.728603974_wp, 3.661486981_wp, &
        0.007505e-6_wp,    5230.807466803_wp, 4.920937029_wp, &
        0.008323e-6_wp,   11769.853693166_wp, 1.229392026_wp, &
        0.007490e-6_wp,   -6256.777530192_wp, 3.658444681_wp, &
        0.009370e-6_wp,  149854.400134205_wp, 0.673880395_wp, &
        0.007117e-6_wp,      38.027672636_wp, 5.294249518_wp, &
        0.007857e-6_wp,   12168.002696575_wp, 0.525733528_wp, &
        0.007019e-6_wp,    6206.809778716_wp, 0.837688810_wp, &
        0.006056e-6_wp,     955.599741609_wp, 4.194535082_wp, &
        0.008107e-6_wp,   13367.972631107_wp, 3.793235253_wp, &
        0.006731e-6_wp,    5650.292110678_wp, 5.639906583_wp, &
        0.007332e-6_wp,      36.648562930_wp, 0.114858677_wp, &
        0.006366e-6_wp,    4164.311989613_wp, 2.262081818_wp, &
        0.006858e-6_wp,    5216.580372801_wp, 0.642063318_wp, &
        0.006919e-6_wp,    6681.224853400_wp, 6.018501522_wp, &
        0.006826e-6_wp,    7632.943259650_wp, 3.458654112_wp, &
        0.005308e-6_wp,   -1592.596013633_wp, 2.500382359_wp, &
        0.005096e-6_wp,   11371.704689758_wp, 2.547107806_wp, &
        0.004841e-6_wp,    5333.900241022_wp, 0.437078094_wp, &
        0.005582e-6_wp,    5966.683980335_wp, 2.246174308_wp, &
        0.006304e-6_wp,   11926.254413669_wp, 2.512929171_wp, &
        0.006603e-6_wp,   23581.258177318_wp, 5.393136889_wp, &
        0.005123e-6_wp,      -1.484472708_wp, 2.999641028_wp, &
        0.004648e-6_wp,    1589.072895284_wp, 1.275847090_wp, &
        0.005119e-6_wp,    6438.496249426_wp, 1.486539246_wp, &
        0.004521e-6_wp,    4292.330832950_wp, 6.140635794_wp, &
        0.005680e-6_wp,   23013.539539587_wp, 4.557814849_wp, &
        0.005488e-6_wp,      -3.455808046_wp, 0.090675389_wp, &
        0.004193e-6_wp,    7234.794256242_wp, 4.869091389_wp, &
        0.003742e-6_wp,    7238.675591600_wp, 4.691976180_wp, &
        0.004148e-6_wp,    -110.206321219_wp, 3.016173439_wp, &
        0.004553e-6_wp,   11499.656222793_wp, 5.554998314_wp, &
        0.004892e-6_wp,    5436.993015240_wp, 1.475415597_wp, &
        0.004044e-6_wp,    4732.030627343_wp, 1.398784824_wp, &
        0.004164e-6_wp,   12491.370101415_wp, 5.650931916_wp, &
        0.004349e-6_wp,   11513.883316794_wp, 2.181745369_wp, &
        0.003919e-6_wp,   12528.018664345_wp, 5.823319737_wp, &
        0.003129e-6_wp,    6836.645252834_wp, 0.003844094_wp, &
        0.004080e-6_wp,   -7058.598461315_wp, 3.690360123_wp, &
        0.003270e-6_wp,      76.266071276_wp, 1.517189902_wp, &
        0.002954e-6_wp,    6283.143160294_wp, 4.447203799_wp, &
        0.002872e-6_wp,      28.449187468_wp, 1.158692983_wp, &
        0.002881e-6_wp,     735.876513532_wp, 0.349250250_wp, &
        0.003279e-6_wp,    5849.364112115_wp, 4.893384368_wp, &
        0.003625e-6_wp,    6209.778724132_wp, 1.473760578_wp, &
        0.003074e-6_wp,     949.175608970_wp, 5.185878737_wp, &
        0.002775e-6_wp,    9917.696874510_wp, 1.030026325_wp, &
        0.002646e-6_wp,   10973.555686350_wp, 3.918259169_wp, &
        0.002575e-6_wp,   25132.303399966_wp, 6.109659023_wp, &
        0.003500e-6_wp,     263.083923373_wp, 1.892100742_wp, &
        0.002740e-6_wp,   18319.536584880_wp, 4.320519510_wp, &
        0.002464e-6_wp,     202.253395174_wp, 4.698203059_wp, &
        0.002409e-6_wp,       2.542797281_wp, 5.325009315_wp, &
        0.003354e-6_wp,  -90955.551694697_wp, 1.942656623_wp, &
        0.002296e-6_wp,    6496.374945429_wp, 5.061810696_wp, &
        0.003002e-6_wp,    6172.869528772_wp, 2.797822767_wp, &
        0.003202e-6_wp,   27511.467873537_wp, 0.531673101_wp, &
        0.002954e-6_wp,   -6283.008539689_wp, 4.533471191_wp, &
        0.002353e-6_wp,     639.897286314_wp, 3.734548088_wp, &
        0.002401e-6_wp,   16200.772724501_wp, 2.605547070_wp, &
        0.003053e-6_wp,  233141.314403759_wp, 3.029030662_wp, &
        0.003024e-6_wp,   83286.914269554_wp, 2.355556099_wp, &
        0.002863e-6_wp,   17298.182327326_wp, 5.240963796_wp, &
        0.002103e-6_wp,   -7079.373856808_wp, 5.756641637_wp, &
        0.002303e-6_wp,   83996.847317911_wp, 2.013686814_wp, &
        0.002303e-6_wp,   18073.704938650_wp, 1.089100410_wp, &
        0.002381e-6_wp,      63.735898303_wp, 0.759188178_wp, &
        0.002493e-6_wp,    6386.168624210_wp, 0.645026535_wp, &
        0.002366e-6_wp,       3.932153263_wp, 6.215885448_wp, &
        0.002169e-6_wp,   11015.106477335_wp, 4.845297676_wp, &
        0.002397e-6_wp,    6243.458341645_wp, 3.809290043_wp, &
        0.002183e-6_wp,    1162.474704408_wp, 6.179611691_wp, &
        0.002353e-6_wp,    6246.427287062_wp, 4.781719760_wp, &
        0.002199e-6_wp,    -245.831646229_wp, 5.956152284_wp, &
        0.001729e-6_wp,    3894.181829542_wp, 1.264976635_wp, &
        0.001896e-6_wp,   -3128.388765096_wp, 4.914231596_wp, &
        0.002085e-6_wp,      35.164090221_wp, 1.405158503_wp, &
        0.002024e-6_wp,   14712.317116458_wp, 2.752035928_wp, &
        0.001737e-6_wp,    6290.189396992_wp, 5.280820144_wp, &
        0.002229e-6_wp,     491.557929457_wp, 1.571007057_wp, &
        0.001602e-6_wp,   14314.168113050_wp, 4.203664806_wp, &
        0.002186e-6_wp,     454.909366527_wp, 1.402101526_wp, &
        0.001897e-6_wp,   22483.848574493_wp, 4.167932508_wp, &
        0.001825e-6_wp,   -3738.761430108_wp, 0.545828785_wp, &
        0.001894e-6_wp,    1052.268383188_wp, 5.817167450_wp, &
        0.001421e-6_wp,      20.355319399_wp, 2.419886601_wp, &
        0.001408e-6_wp,   10984.192351700_wp, 2.732084787_wp, &
        0.001847e-6_wp,   10873.986030480_wp, 2.903477885_wp, &
        0.001391e-6_wp,   -8635.942003763_wp, 0.593891500_wp, &
        0.001388e-6_wp,      -7.046236698_wp, 1.166145902_wp, &
        0.001810e-6_wp,  -88860.057071188_wp, 0.487355242_wp, &
        0.001288e-6_wp,   -1990.745017041_wp, 3.913022880_wp, &
        0.001297e-6_wp,   23543.230504682_wp, 3.063805171_wp, &
        0.001335e-6_wp,    -266.607041722_wp, 3.995764039_wp, &
        0.001376e-6_wp,   10969.965257698_wp, 5.152914309_wp, &
        0.001745e-6_wp,  244287.600007027_wp, 3.626395673_wp, &
        0.001649e-6_wp,   31441.677569757_wp, 1.952049260_wp, &
        0.001416e-6_wp,    9225.539273283_wp, 4.996408389_wp, &
        0.001238e-6_wp,    4804.209275927_wp, 5.503379738_wp, &
        0.001472e-6_wp,    4590.910180489_wp, 4.164913291_wp, &
        0.001169e-6_wp,    6040.347246017_wp, 5.841719038_wp, &
        0.001039e-6_wp,    5540.085789459_wp, 2.769753519_wp, &
        0.001004e-6_wp,    -170.672870619_wp, 0.755008103_wp, &
        0.001284e-6_wp,   10575.406682942_wp, 5.306538209_wp, &
        0.001278e-6_wp,      71.812653151_wp, 4.713486491_wp, &
        0.001321e-6_wp,   18209.330263660_wp, 2.624866359_wp, &
        0.001297e-6_wp,   21228.392023546_wp, 0.382603541_wp, &
        0.000954e-6_wp,    6282.095528923_wp, 0.882213514_wp, &
        0.001145e-6_wp,    6058.731054289_wp, 1.169483931_wp, &
        0.000979e-6_wp,    5547.199336460_wp, 5.448375984_wp, &
        0.000987e-6_wp,   -6262.300454499_wp, 2.656486959_wp, &
        0.001070e-6_wp, -154717.609887482_wp, 1.827624012_wp, &
        0.000991e-6_wp,    4701.116501708_wp, 4.387001801_wp, &
        0.001155e-6_wp,     -14.227094002_wp, 3.042700750_wp, &
        0.001176e-6_wp,     277.034993741_wp, 3.335519004_wp, &
        0.000890e-6_wp,   13916.019109642_wp, 5.601498297_wp, &
        0.000884e-6_wp,   -1551.045222648_wp, 1.088831705_wp, &
        0.000876e-6_wp,    5017.508371365_wp, 3.969902609_wp, &
        0.000806e-6_wp,   15110.466119866_wp, 5.142876744_wp, &
        0.000773e-6_wp,   -4136.910433516_wp, 0.022067765_wp, &
        0.001077e-6_wp,     175.166059800_wp, 1.844913056_wp, &
        0.000954e-6_wp,   -6284.056171060_wp, 0.968480906_wp, &
        0.000737e-6_wp,    5326.786694021_wp, 4.923831588_wp, &
        0.000845e-6_wp,    -433.711737877_wp, 4.749245231_wp, &
        0.000819e-6_wp,    8662.240323563_wp, 5.991247817_wp, &
        0.000852e-6_wp,     199.072001436_wp, 2.189604979_wp, &
        0.000723e-6_wp,   17256.631536341_wp, 6.068719637_wp, &
        0.000940e-6_wp,    6037.244203762_wp, 6.197428148_wp, &
        0.000885e-6_wp,   11712.955318231_wp, 3.280414875_wp, &
        0.000706e-6_wp,   12559.038152982_wp, 2.824848947_wp, &
        0.000732e-6_wp,    2379.164473572_wp, 2.501813417_wp, &
        0.000764e-6_wp,   -6127.655450557_wp, 2.236346329_wp, &
        0.000908e-6_wp,     131.541961686_wp, 2.521257490_wp, &
        0.000907e-6_wp,   35371.887265976_wp, 3.370195967_wp, &
        0.000673e-6_wp,    1066.495477190_wp, 3.876512374_wp, &
        0.000814e-6_wp,   17654.780539750_wp, 4.627122566_wp, &
        0.000630e-6_wp,      36.027866677_wp, 0.156368499_wp, &
        0.000798e-6_wp,     515.463871093_wp, 5.151962502_wp, &
        0.000798e-6_wp,     148.078724426_wp, 5.909225055_wp, &
        0.000806e-6_wp,     309.278322656_wp, 6.054064447_wp, &
        0.000607e-6_wp,     -39.617508346_wp, 2.839021623_wp, &
        0.000601e-6_wp,     412.371096874_wp, 3.984225404_wp, &
        0.000646e-6_wp,   11403.676995575_wp, 3.852959484_wp, &
        0.000704e-6_wp,   13521.751441591_wp, 2.300991267_wp, &
        0.000603e-6_wp,  -65147.619767937_wp, 4.140083146_wp, &
        0.000609e-6_wp,   10177.257679534_wp, 0.437122327_wp, &
        0.000631e-6_wp,    5767.611978898_wp, 4.026532329_wp, &
        0.000576e-6_wp,   11087.285125918_wp, 4.760293101_wp, &
        0.000674e-6_wp,   14945.316173554_wp, 6.270510511_wp, &
        0.000726e-6_wp,    5429.879468239_wp, 6.039606892_wp, &
        0.000710e-6_wp,   28766.924424484_wp, 5.672617711_wp, &
        0.000647e-6_wp,   11856.218651625_wp, 3.397132627_wp, &
        0.000678e-6_wp,   -5481.254918868_wp, 6.249666675_wp, &
        0.000618e-6_wp,   22003.914634870_wp, 2.466427018_wp, &
        0.000738e-6_wp,    6134.997125565_wp, 2.242668890_wp, &
        0.000660e-6_wp,     625.670192312_wp, 5.864091907_wp, &
        0.000694e-6_wp,    3496.032826134_wp, 2.668309141_wp, &
        0.000531e-6_wp,    6489.261398429_wp, 1.681888780_wp, &
        0.000611e-6_wp, -143571.324284214_wp, 2.424978312_wp, &
        0.000575e-6_wp,   12043.574281889_wp, 4.216492400_wp, &
        0.000553e-6_wp,   12416.588502848_wp, 4.772158039_wp, &
        0.000689e-6_wp,    4686.889407707_wp, 6.224271088_wp, &
        0.000495e-6_wp,    7342.457780181_wp, 3.817285811_wp, &
        0.000567e-6_wp,    3634.621024518_wp, 1.649264690_wp, &
        0.000515e-6_wp,   18635.928454536_wp, 3.945345892_wp, &
        0.000486e-6_wp,    -323.505416657_wp, 4.061673868_wp, &
        0.000662e-6_wp,   25158.601719765_wp, 1.794058369_wp, &
        0.000509e-6_wp,     846.082834751_wp, 3.053874588_wp, &
        0.000472e-6_wp,  -12569.674818332_wp, 5.112133338_wp, &
        0.000461e-6_wp,    6179.983075773_wp, 0.513669325_wp, &
        0.000641e-6_wp,   83467.156352816_wp, 3.210727723_wp, &
        0.000520e-6_wp,   10344.295065386_wp, 2.445597761_wp, &
        0.000493e-6_wp,   18422.629359098_wp, 1.676939306_wp, &
        0.000478e-6_wp,    1265.567478626_wp, 5.487314569_wp, &
        0.000472e-6_wp,     -18.159247265_wp, 1.999707589_wp, &
        0.000559e-6_wp,   11190.377900137_wp, 5.783236356_wp, &
        0.000494e-6_wp,    9623.688276691_wp, 3.022645053_wp, &
        0.000463e-6_wp,    5739.157790895_wp, 1.411223013_wp, &
        0.000432e-6_wp,   16858.482532933_wp, 1.179256434_wp, &
        0.000574e-6_wp,   72140.628666286_wp, 1.758191830_wp, &
        0.000484e-6_wp,   17267.268201691_wp, 3.290589143_wp, &
        0.000550e-6_wp,    4907.302050146_wp, 0.864024298_wp, &
        0.000399e-6_wp,      14.977853527_wp, 2.094441910_wp, &
        0.000491e-6_wp,     224.344795702_wp, 0.878372791_wp, &
        0.000432e-6_wp,   20426.571092422_wp, 6.003829241_wp, &
        0.000481e-6_wp,    5749.452731634_wp, 4.309591964_wp, &
        0.000480e-6_wp,    5757.317038160_wp, 1.142348571_wp, &
        0.000485e-6_wp,    6702.560493867_wp, 0.210580917_wp, &
        0.000426e-6_wp,    6055.549660552_wp, 4.274476529_wp, &
        0.000480e-6_wp,    5959.570433334_wp, 5.031351030_wp, &
        0.000466e-6_wp,   12562.628581634_wp, 4.959581597_wp, &
        0.000520e-6_wp,   39302.096962196_wp, 4.788002889_wp, &
        0.000458e-6_wp,   12132.439962106_wp, 1.880103788_wp, &
        0.000470e-6_wp,   12029.347187887_wp, 1.405611197_wp, &
        0.000416e-6_wp,   -7477.522860216_wp, 1.082356330_wp, &
        0.000449e-6_wp,   11609.862544012_wp, 4.179989585_wp, &
        0.000465e-6_wp,   17253.041107690_wp, 0.353496295_wp, &
        0.000362e-6_wp,   -4535.059436924_wp, 1.583849576_wp, &
        0.000383e-6_wp,   21954.157609398_wp, 3.747376371_wp, &
        0.000389e-6_wp,      17.252277143_wp, 1.395753179_wp, &
        0.000331e-6_wp,   18052.929543158_wp, 0.566790582_wp, &
        0.000430e-6_wp,   13517.870106233_wp, 0.685827538_wp, &
        0.000368e-6_wp,   -5756.908003246_wp, 0.731374317_wp, &
        0.000330e-6_wp,   10557.594160824_wp, 3.710043680_wp, &
        0.000332e-6_wp,   20199.094959633_wp, 1.652901407_wp, &
        0.000384e-6_wp,   11933.367960670_wp, 5.827781531_wp, &
        0.000387e-6_wp,   10454.501386605_wp, 2.541182564_wp, &
        0.000325e-6_wp,   15671.081759407_wp, 2.178850542_wp, &
        0.000318e-6_wp,     138.517496871_wp, 2.253253037_wp, &
        0.000305e-6_wp,    9388.005909415_wp, 0.578340206_wp, &
        0.000352e-6_wp,    5749.861766548_wp, 3.000297967_wp, &
        0.000311e-6_wp,    6915.859589305_wp, 1.693574249_wp, &
        0.000297e-6_wp,   24072.921469776_wp, 1.997249392_wp, &
        0.000363e-6_wp,    -640.877607382_wp, 5.071820966_wp, &
        0.000323e-6_wp,   12592.450019783_wp, 1.072262823_wp, &
        0.000341e-6_wp,   12146.667056108_wp, 4.700657997_wp, &
        0.000290e-6_wp,    9779.108676125_wp, 1.812320441_wp, &
        0.000342e-6_wp,    6132.028180148_wp, 4.322238614_wp, &
        0.000329e-6_wp,    6268.848755990_wp, 3.033827743_wp, &
        0.000374e-6_wp,   17996.031168222_wp, 3.388716544_wp, &
        0.000285e-6_wp,    -533.214083444_wp, 4.687313233_wp, &
        0.000338e-6_wp,    6065.844601290_wp, 0.877776108_wp, &
        0.000276e-6_wp,      24.298513841_wp, 0.770299429_wp, &
        0.000336e-6_wp,   -2388.894020449_wp, 5.353796034_wp, &
        0.000290e-6_wp,    3097.883822726_wp, 4.075291557_wp, &
        0.000318e-6_wp,     709.933048357_wp, 5.941207518_wp, &
        0.000271e-6_wp,   13095.842665077_wp, 3.208912203_wp, &
        0.000331e-6_wp,    6073.708907816_wp, 4.007881169_wp, &
        0.000292e-6_wp,     742.990060533_wp, 2.714333592_wp, &
        0.000362e-6_wp,   29088.811415985_wp, 3.215977013_wp, &
        0.000280e-6_wp,   12359.966151546_wp, 0.710872502_wp, &
        0.000267e-6_wp,   10440.274292604_wp, 4.730108488_wp, &
        0.000262e-6_wp,     838.969287750_wp, 1.327720272_wp, &
        0.000250e-6_wp,   16496.361396202_wp, 0.898769761_wp, &
        0.000325e-6_wp,   20597.243963041_wp, 0.180044365_wp, &
        0.000268e-6_wp,    6148.010769956_wp, 5.152666276_wp, &
        0.000284e-6_wp,    5636.065016677_wp, 5.655385808_wp, &
        0.000301e-6_wp,    6080.822454817_wp, 2.135396205_wp, &
        0.000294e-6_wp,    -377.373607916_wp, 3.708784168_wp, &
        0.000236e-6_wp,    2118.763860378_wp, 1.733578756_wp, &
        0.000234e-6_wp,    5867.523359379_wp, 5.575209112_wp, &
        0.000268e-6_wp, -226858.238553767_wp, 0.069432392_wp, &
        0.000265e-6_wp,  167283.761587465_wp, 4.369302826_wp, &
        0.000280e-6_wp,   28237.233459389_wp, 5.304829118_wp, &
        0.000292e-6_wp,   12345.739057544_wp, 4.096094132_wp, &
        0.000223e-6_wp,   19800.945956225_wp, 3.069327406_wp, &
        0.000301e-6_wp,   43232.306658416_wp, 6.205311188_wp, &
        0.000264e-6_wp,   18875.525869774_wp, 1.417263408_wp, &
        0.000304e-6_wp,   -1823.175188677_wp, 3.409035232_wp, &
        0.000301e-6_wp,     109.945688789_wp, 0.510922054_wp, &
        0.000260e-6_wp,     813.550283960_wp, 2.389438934_wp, &
        0.000299e-6_wp,  316428.228673312_wp, 5.384595078_wp, &
        0.000211e-6_wp,    5756.566278634_wp, 3.789392838_wp, &
        0.000209e-6_wp,    5750.203491159_wp, 1.661943545_wp, &
        0.000240e-6_wp,   12489.885628707_wp, 5.684549045_wp, &
        0.000216e-6_wp,    6303.851245484_wp, 3.862942261_wp, &
        0.000203e-6_wp,    1581.959348283_wp, 5.549853589_wp, &
        0.000200e-6_wp,    5642.198242609_wp, 1.016115785_wp, &
        0.000197e-6_wp,     -70.849445304_wp, 4.690702525_wp, &
        0.000227e-6_wp,    6287.008003254_wp, 2.911891613_wp, &
        0.000197e-6_wp,     533.623118358_wp, 1.048982898_wp, &
        0.000205e-6_wp,   -6279.485421340_wp, 1.829362730_wp, &
        0.000209e-6_wp,  -10988.808157535_wp, 2.636140084_wp, &
        0.000208e-6_wp,    -227.526189440_wp, 4.127883842_wp, &
        0.000191e-6_wp,     415.552490612_wp, 4.401165650_wp, &
        0.000190e-6_wp,   29296.615389579_wp, 4.175658539_wp, &
        0.000264e-6_wp,   66567.485864652_wp, 4.601102551_wp, &
        0.000256e-6_wp,   -3646.350377354_wp, 0.506364778_wp, &
        0.000188e-6_wp,   13119.721102825_wp, 2.032195842_wp, &
        0.000185e-6_wp,    -209.366942175_wp, 4.694756586_wp, &
        0.000198e-6_wp,   25934.124331089_wp, 3.832703118_wp, &
        0.000195e-6_wp,    4061.219215394_wp, 3.308463427_wp, &
        0.000234e-6_wp,    5113.487598583_wp, 1.716090661_wp, &
        0.000188e-6_wp,    1478.866574064_wp, 5.686865780_wp, &
        0.000222e-6_wp,   11823.161639450_wp, 1.942386641_wp, &
        0.000181e-6_wp,   10770.893256262_wp, 1.999482059_wp, &
        0.000171e-6_wp,    6546.159773364_wp, 1.182807992_wp, &
        0.000206e-6_wp,      70.328180442_wp, 5.934076062_wp, &
        0.000169e-6_wp,   20995.392966449_wp, 2.169080622_wp, &
        0.000191e-6_wp,   10660.686935042_wp, 5.405515999_wp, &
        0.000228e-6_wp,   33019.021112205_wp, 4.656985514_wp, &
        0.000184e-6_wp,   -4933.208440333_wp, 3.327476868_wp, &
        0.000220e-6_wp,    -135.625325010_wp, 1.765430262_wp, &
        0.000166e-6_wp,   23141.558382925_wp, 3.454132746_wp, &
        0.000191e-6_wp,    6144.558353121_wp, 5.020393445_wp, &
        0.000180e-6_wp,    6084.003848555_wp, 0.602182191_wp, &
        0.000163e-6_wp,   17782.732072784_wp, 4.960593133_wp, &
        0.000225e-6_wp,   16460.333529525_wp, 2.596451817_wp, &
        0.000222e-6_wp,    5905.702242076_wp, 3.731990323_wp, &
        0.000204e-6_wp,     227.476132789_wp, 5.636192701_wp, &
        0.000159e-6_wp,   16737.577236597_wp, 3.600691544_wp, &
        0.000200e-6_wp,    6805.653268085_wp, 0.868220961_wp, &
        0.000187e-6_wp,   11919.140866668_wp, 2.629456641_wp, &
        0.000161e-6_wp,     127.471796607_wp, 2.862574720_wp, &
        0.000205e-6_wp,    6286.666278643_wp, 1.742882331_wp, &
        0.000189e-6_wp,     153.778810485_wp, 4.812372643_wp, &
        0.000168e-6_wp,   16723.350142595_wp, 0.027860588_wp, &
        0.000149e-6_wp,   11720.068865232_wp, 0.659721876_wp, &
        0.000189e-6_wp,    5237.921013804_wp, 5.245313000_wp, &
        0.000143e-6_wp,    6709.674040867_wp, 4.317625647_wp, &
        0.000146e-6_wp,    4487.817406270_wp, 4.815297007_wp, &
        0.000144e-6_wp,    -664.756045130_wp, 5.381366880_wp, &
        0.000175e-6_wp,    5127.714692584_wp, 4.728443327_wp, &
        0.000162e-6_wp,    6254.626662524_wp, 1.435132069_wp, &
        0.000187e-6_wp,   47162.516354635_wp, 1.354371923_wp, &
        0.000146e-6_wp,   11080.171578918_wp, 3.369695406_wp, &
        0.000180e-6_wp,    -348.924420448_wp, 2.490902145_wp, &
        0.000148e-6_wp,     151.047669843_wp, 3.799109588_wp, &
        0.000157e-6_wp,    6197.248551160_wp, 1.284375887_wp, &
        0.000167e-6_wp,     146.594251718_wp, 0.759969109_wp, &
        0.000133e-6_wp,   -5331.357443741_wp, 5.409701889_wp, &
        0.000154e-6_wp,      95.979227218_wp, 3.366890614_wp, &
        0.000148e-6_wp,   -6418.140930027_wp, 3.384104996_wp, &
        0.000128e-6_wp,   -6525.804453965_wp, 3.803419985_wp, &
        0.000130e-6_wp,   11293.470674356_wp, 0.939039445_wp, &
        0.000152e-6_wp,   -5729.506447149_wp, 0.734117523_wp, &
        0.000138e-6_wp,     210.117701700_wp, 2.564216078_wp, &
        0.000123e-6_wp,    6066.595360816_wp, 4.517099537_wp, &
        0.000140e-6_wp,   18451.078546566_wp, 0.642049130_wp, &
        0.000126e-6_wp,   11300.584221356_wp, 3.485280663_wp, &
        0.000119e-6_wp,   10027.903195729_wp, 3.217431161_wp, &
        0.000151e-6_wp,    4274.518310832_wp, 4.404359108_wp, &
        0.000117e-6_wp,    6072.958148291_wp, 0.366324650_wp, &
        0.000165e-6_wp,   -7668.637425143_wp, 4.298212528_wp, &
        0.000117e-6_wp,   -6245.048177356_wp, 5.379518958_wp, &
        0.000130e-6_wp,   -5888.449964932_wp, 4.527681115_wp, &
        0.000121e-6_wp,    -543.918059096_wp, 6.109429504_wp, &
        0.000162e-6_wp,    9683.594581116_wp, 5.720092446_wp, &
        0.000141e-6_wp,    6219.339951688_wp, 0.679068671_wp, &
        0.000118e-6_wp,   22743.409379516_wp, 4.881123092_wp, &
        0.000129e-6_wp,    1692.165669502_wp, 0.351407289_wp, &
        0.000126e-6_wp,    5657.405657679_wp, 5.146592349_wp, &
        0.000114e-6_wp,     728.762966531_wp, 0.520791814_wp, &
        0.000120e-6_wp,      52.596639600_wp, 0.948516300_wp, &
        0.000115e-6_wp,      65.220371012_wp, 3.504914846_wp, &
        0.000126e-6_wp,    5881.403728234_wp, 5.577502482_wp, &
        0.000158e-6_wp,  163096.180360983_wp, 2.957128968_wp, &
        0.000134e-6_wp,   12341.806904281_wp, 2.598576764_wp, &
        0.000151e-6_wp,   16627.370915377_wp, 3.985702050_wp, &
        0.000109e-6_wp,    1368.660252845_wp, 0.014730471_wp, &
        0.000131e-6_wp,    6211.263196841_wp, 0.085077024_wp, &
        0.000146e-6_wp,    5792.741760812_wp, 0.708426604_wp, &
        0.000146e-6_wp,     -77.750543984_wp, 3.121576600_wp, &
        0.000107e-6_wp,    5341.013788022_wp, 0.288231904_wp, &
        0.000138e-6_wp,    6281.591377283_wp, 2.797450317_wp, &
        0.000113e-6_wp,   -6277.552925684_wp, 2.788904128_wp, &
        0.000115e-6_wp,    -525.758811831_wp, 5.895222200_wp, &
        0.000138e-6_wp,    6016.468808270_wp, 6.096188999_wp, &
        0.000139e-6_wp,   23539.707386333_wp, 2.028195445_wp, &
        0.000146e-6_wp,   -4176.041342449_wp, 4.660008502_wp, &
        0.000107e-6_wp,   16062.184526117_wp, 4.066520001_wp, &
        0.000142e-6_wp,   83783.548222473_wp, 2.936315115_wp, &
        0.000128e-6_wp,    9380.959672717_wp, 3.223844306_wp, &
        0.000135e-6_wp,    6205.325306007_wp, 1.638054048_wp, &
        0.000101e-6_wp,    2699.734819318_wp, 5.481603249_wp, &
        0.000104e-6_wp,    -568.821874027_wp, 2.205734493_wp, &
        0.000103e-6_wp,    6321.103522627_wp, 2.440421099_wp, &
        0.000119e-6_wp,    6321.208885629_wp, 2.547496264_wp, &
        0.000138e-6_wp,    1975.492545856_wp, 2.314608466_wp, &
        0.000121e-6_wp,     137.033024162_wp, 4.539108237_wp, &
        0.000123e-6_wp,   19402.796952817_wp, 4.538074405_wp, &
        0.000119e-6_wp,   22805.735565994_wp, 2.869040566_wp, &
        0.000133e-6_wp,   64471.991241142_wp, 6.056405489_wp, &
        0.000129e-6_wp,     -85.827298831_wp, 2.540635083_wp, &
        0.000131e-6_wp,   13613.804277336_wp, 4.005732868_wp, &
        0.000104e-6_wp,    9814.604100291_wp, 1.959967212_wp, &
        0.000112e-6_wp,   16097.679950283_wp, 3.589026260_wp, &
        0.000123e-6_wp,    2107.034507542_wp, 1.728627253_wp, &
        0.000121e-6_wp,   36949.230808424_wp, 6.072332087_wp, &
        0.000108e-6_wp,  -12539.853380183_wp, 3.716133846_wp, &
        0.000113e-6_wp,   -7875.671863624_wp, 2.725771122_wp, &
        0.000109e-6_wp,    4171.425536614_wp, 4.033338079_wp, &
        0.000101e-6_wp,    6247.911759770_wp, 3.441347021_wp, &
        0.000113e-6_wp,    7330.728427345_wp, 0.656372122_wp, &
        0.000113e-6_wp,   51092.726050855_wp, 2.791483066_wp, &
        0.000106e-6_wp,    5621.842923210_wp, 1.815323326_wp, &
        0.000101e-6_wp,     111.430161497_wp, 5.711033677_wp, &
        0.000103e-6_wp,     909.818733055_wp, 2.812745443_wp, &
        0.000101e-6_wp,    1790.642637886_wp, 1.965746028_wp, &
      102.156724e-6_wp,    6283.075849991_wp, 4.249032005_wp, &     !  T
        1.706807e-6_wp,   12566.151699983_wp, 4.205904248_wp, &
        0.269668e-6_wp,     213.299095438_wp, 3.400290479_wp, &
        0.265919e-6_wp,     529.690965095_wp, 5.836047367_wp, &
        0.210568e-6_wp,      -3.523118349_wp, 6.262738348_wp, &
        0.077996e-6_wp,    5223.693919802_wp, 4.670344204_wp, &
        0.054764e-6_wp,    1577.343542448_wp, 4.534800170_wp, &
        0.059146e-6_wp,      26.298319800_wp, 1.083044735_wp, &
        0.034420e-6_wp,    -398.149003408_wp, 5.980077351_wp, &
        0.032088e-6_wp,   18849.227549974_wp, 4.162913471_wp, &
        0.033595e-6_wp,    5507.553238667_wp, 5.980162321_wp, &
        0.029198e-6_wp,    5856.477659115_wp, 0.623811863_wp, &
        0.027764e-6_wp,     155.420399434_wp, 3.745318113_wp, &
        0.025190e-6_wp,    5746.271337896_wp, 2.980330535_wp, &
        0.022997e-6_wp,    -796.298006816_wp, 1.174411803_wp, &
        0.024976e-6_wp,    5760.498431898_wp, 2.467913690_wp, &
        0.021774e-6_wp,     206.185548437_wp, 3.854787540_wp, &
        0.017925e-6_wp,    -775.522611324_wp, 1.092065955_wp, &
        0.013794e-6_wp,     426.598190876_wp, 2.699831988_wp, &
        0.013276e-6_wp,    6062.663207553_wp, 5.845801920_wp, &
        0.011774e-6_wp,   12036.460734888_wp, 2.292832062_wp, &
        0.012869e-6_wp,    6076.890301554_wp, 5.333425680_wp, &
        0.012152e-6_wp,    1059.381930189_wp, 6.222874454_wp, &
        0.011081e-6_wp,      -7.113547001_wp, 5.154724984_wp, &
        0.010143e-6_wp,    4694.002954708_wp, 4.044013795_wp, &
        0.009357e-6_wp,    5486.777843175_wp, 3.416081409_wp, &
        0.010084e-6_wp,     522.577418094_wp, 0.749320262_wp, &
        0.008587e-6_wp,   10977.078804699_wp, 2.777152598_wp, &
        0.008628e-6_wp,    6275.962302991_wp, 4.562060226_wp, &
        0.008158e-6_wp,    -220.412642439_wp, 5.806891533_wp, &
        0.007746e-6_wp,    2544.314419883_wp, 1.603197066_wp, &
        0.007670e-6_wp,    2146.165416475_wp, 3.000200440_wp, &
        0.007098e-6_wp,      74.781598567_wp, 0.443725817_wp, &
        0.006180e-6_wp,    -536.804512095_wp, 1.302642751_wp, &
        0.005818e-6_wp,    5088.628839767_wp, 4.827723531_wp, &
        0.004945e-6_wp,   -6286.598968340_wp, 0.268305170_wp, &
        0.004774e-6_wp,    1349.867409659_wp, 5.808636673_wp, &
        0.004687e-6_wp,    -242.728603974_wp, 5.154890570_wp, &
        0.006089e-6_wp,    1748.016413067_wp, 4.403765209_wp, &
        0.005975e-6_wp,   -1194.447010225_wp, 2.583472591_wp, &
        0.004229e-6_wp,     951.718406251_wp, 0.931172179_wp, &
        0.005264e-6_wp,     553.569402842_wp, 2.336107252_wp, &
        0.003049e-6_wp,    5643.178563677_wp, 1.362634430_wp, &
        0.002974e-6_wp,    6812.766815086_wp, 1.583012668_wp, &
        0.003403e-6_wp,   -2352.866153772_wp, 2.552189886_wp, &
        0.003030e-6_wp,     419.484643875_wp, 5.286473844_wp, &
        0.003210e-6_wp,      -7.046236698_wp, 1.863796539_wp, &
        0.003058e-6_wp,    9437.762934887_wp, 4.226420633_wp, &
        0.002589e-6_wp,   12352.852604545_wp, 1.991935820_wp, &
        0.002927e-6_wp,    5216.580372801_wp, 2.319951253_wp, &
        0.002425e-6_wp,    5230.807466803_wp, 3.084752833_wp, &
        0.002656e-6_wp,    3154.687084896_wp, 2.487447866_wp, &
        0.002445e-6_wp,   10447.387839604_wp, 2.347139160_wp, &
        0.002990e-6_wp,    4690.479836359_wp, 6.235872050_wp, &
        0.002890e-6_wp,    5863.591206116_wp, 0.095197563_wp, &
        0.002498e-6_wp,    6438.496249426_wp, 2.994779800_wp, &
        0.001889e-6_wp,    8031.092263058_wp, 3.569003717_wp, &
        0.002567e-6_wp,     801.820931124_wp, 3.425611498_wp, &
        0.001803e-6_wp,  -71430.695617928_wp, 2.192295512_wp, &
        0.001782e-6_wp,       3.932153263_wp, 5.180433689_wp, &
        0.001694e-6_wp,   -4705.732307544_wp, 4.641779174_wp, &
        0.001704e-6_wp,   -1592.596013633_wp, 3.997097652_wp, &
        0.001735e-6_wp,    5849.364112115_wp, 0.417558428_wp, &
        0.001643e-6_wp,    8429.241266467_wp, 2.180619584_wp, &
        0.001680e-6_wp,      38.133035638_wp, 4.164529426_wp, &
        0.002045e-6_wp,    7084.896781115_wp, 0.526323854_wp, &
        0.001458e-6_wp,    4292.330832950_wp, 1.356098141_wp, &
        0.001437e-6_wp,      20.355319399_wp, 3.895439360_wp, &
        0.001738e-6_wp,    6279.552731642_wp, 0.087484036_wp, &
        0.001367e-6_wp,   14143.495242431_wp, 3.987576591_wp, &
        0.001344e-6_wp,    7234.794256242_wp, 0.090454338_wp, &
        0.001438e-6_wp,   11499.656222793_wp, 0.974387904_wp, &
        0.001257e-6_wp,    6836.645252834_wp, 1.509069366_wp, &
        0.001358e-6_wp,   11513.883316794_wp, 0.495572260_wp, &
        0.001628e-6_wp,    7632.943259650_wp, 4.968445721_wp, &
        0.001169e-6_wp,     103.092774219_wp, 2.838496795_wp, &
        0.001162e-6_wp,    4164.311989613_wp, 3.408387778_wp, &
        0.001092e-6_wp,    6069.776754553_wp, 3.617942651_wp, &
        0.001008e-6_wp,   17789.845619785_wp, 0.286350174_wp, &
        0.001008e-6_wp,     639.897286314_wp, 1.610762073_wp, &
        0.000918e-6_wp,   10213.285546211_wp, 5.532798067_wp, &
        0.001011e-6_wp,   -6256.777530192_wp, 0.661826484_wp, &
        0.000753e-6_wp,   16730.463689596_wp, 3.905030235_wp, &
        0.000737e-6_wp,   11926.254413669_wp, 4.641956361_wp, &
        0.000694e-6_wp,    3340.612426700_wp, 2.111120332_wp, &
        0.000701e-6_wp,    3894.181829542_wp, 2.760823491_wp, &
        0.000689e-6_wp,    -135.065080035_wp, 4.768800780_wp, &
        0.000700e-6_wp,   13367.972631107_wp, 5.760439898_wp, &
        0.000664e-6_wp,    6040.347246017_wp, 1.051215840_wp, &
        0.000654e-6_wp,    5650.292110678_wp, 4.911332503_wp, &
        0.000788e-6_wp,    6681.224853400_wp, 4.699648011_wp, &
        0.000628e-6_wp,    5333.900241022_wp, 5.024608847_wp, &
        0.000755e-6_wp,    -110.206321219_wp, 4.370971253_wp, &
        0.000628e-6_wp,    6290.189396992_wp, 3.660478857_wp, &
        0.000635e-6_wp,   25132.303399966_wp, 4.121051532_wp, &
        0.000534e-6_wp,    5966.683980335_wp, 1.173284524_wp, &
        0.000543e-6_wp,    -433.711737877_wp, 0.345585464_wp, &
        0.000517e-6_wp,   -1990.745017041_wp, 5.414571768_wp, &
        0.000504e-6_wp,    5767.611978898_wp, 2.328281115_wp, &
        0.000485e-6_wp,    5753.384884897_wp, 1.685874771_wp, &
        0.000463e-6_wp,    7860.419392439_wp, 5.297703006_wp, &
        0.000604e-6_wp,     515.463871093_wp, 0.591998446_wp, &
        0.000443e-6_wp,   12168.002696575_wp, 4.830881244_wp, &
        0.000570e-6_wp,     199.072001436_wp, 3.899190272_wp, &
        0.000465e-6_wp,   10969.965257698_wp, 0.476681802_wp, &
        0.000424e-6_wp,   -7079.373856808_wp, 1.112242763_wp, &
        0.000427e-6_wp,     735.876513532_wp, 1.994214480_wp, &
        0.000478e-6_wp,   -6127.655450557_wp, 3.778025483_wp, &
        0.000414e-6_wp,   10973.555686350_wp, 5.441088327_wp, &
        0.000512e-6_wp,    1589.072895284_wp, 0.107123853_wp, &
        0.000378e-6_wp,   10984.192351700_wp, 0.915087231_wp, &
        0.000402e-6_wp,   11371.704689758_wp, 4.107281715_wp, &
        0.000453e-6_wp,    9917.696874510_wp, 1.917490952_wp, &
        0.000395e-6_wp,     149.563197135_wp, 2.763124165_wp, &
        0.000371e-6_wp,    5739.157790895_wp, 3.112111866_wp, &
        0.000350e-6_wp,   11790.629088659_wp, 0.440639857_wp, &
        0.000356e-6_wp,    6133.512652857_wp, 5.444568842_wp, &
        0.000344e-6_wp,     412.371096874_wp, 5.676832684_wp, &
        0.000383e-6_wp,     955.599741609_wp, 5.559734846_wp, &
        0.000333e-6_wp,    6496.374945429_wp, 0.261537984_wp, &
        0.000340e-6_wp,    6055.549660552_wp, 5.975534987_wp, &
        0.000334e-6_wp,    1066.495477190_wp, 2.335063907_wp, &
        0.000399e-6_wp,   11506.769769794_wp, 5.321230910_wp, &
        0.000314e-6_wp,   18319.536584880_wp, 2.313312404_wp, &
        0.000424e-6_wp,    1052.268383188_wp, 1.211961766_wp, &
        0.000307e-6_wp,      63.735898303_wp, 3.169551388_wp, &
        0.000329e-6_wp,      29.821438149_wp, 6.106912080_wp, &
        0.000357e-6_wp,    6309.374169791_wp, 4.223760346_wp, &
        0.000312e-6_wp,   -3738.761430108_wp, 2.180556645_wp, &
        0.000301e-6_wp,     309.278322656_wp, 1.499984572_wp, &
        0.000268e-6_wp,   12043.574281889_wp, 2.447520648_wp, &
        0.000257e-6_wp,   12491.370101415_wp, 3.662331761_wp, &
        0.000290e-6_wp,     625.670192312_wp, 1.272834584_wp, &
        0.000256e-6_wp,    5429.879468239_wp, 1.913426912_wp, &
        0.000339e-6_wp,    3496.032826134_wp, 4.165930011_wp, &
        0.000283e-6_wp,    3930.209696220_wp, 4.325565754_wp, &
        0.000241e-6_wp,   12528.018664345_wp, 3.832324536_wp, &
        0.000304e-6_wp,    4686.889407707_wp, 1.612348468_wp, &
        0.000259e-6_wp,   16200.772724501_wp, 3.470173146_wp, &
        0.000238e-6_wp,   12139.553509107_wp, 1.147977842_wp, &
        0.000236e-6_wp,    6172.869528772_wp, 3.776271728_wp, &
        0.000296e-6_wp,   -7058.598461315_wp, 0.460368852_wp, &
        0.000306e-6_wp,   10575.406682942_wp, 0.554749016_wp, &
        0.000251e-6_wp,   17298.182327326_wp, 0.834332510_wp, &
        0.000290e-6_wp,    4732.030627343_wp, 4.759564091_wp, &
        0.000261e-6_wp,    5884.926846583_wp, 0.298259862_wp, &
        0.000249e-6_wp,    5547.199336460_wp, 3.749366406_wp, &
        0.000213e-6_wp,   11712.955318231_wp, 5.415666119_wp, &
        0.000223e-6_wp,    4701.116501708_wp, 2.703203558_wp, &
        0.000268e-6_wp,    -640.877607382_wp, 0.283670793_wp, &
        0.000209e-6_wp,    5636.065016677_wp, 1.238477199_wp, &
        0.000193e-6_wp,   10177.257679534_wp, 1.943251340_wp, &
        0.000182e-6_wp,    6283.143160294_wp, 2.456157599_wp, &
        0.000184e-6_wp,    -227.526189440_wp, 5.888038582_wp, &
        0.000182e-6_wp,   -6283.008539689_wp, 0.241332086_wp, &
        0.000228e-6_wp,   -6284.056171060_wp, 2.657323816_wp, &
        0.000166e-6_wp,    7238.675591600_wp, 5.930629110_wp, &
        0.000167e-6_wp,    3097.883822726_wp, 5.570955333_wp, &
        0.000159e-6_wp,    -323.505416657_wp, 5.786670700_wp, &
        0.000154e-6_wp,   -4136.910433516_wp, 1.517805532_wp, &
        0.000176e-6_wp,   12029.347187887_wp, 3.139266834_wp, &
        0.000167e-6_wp,   12132.439962106_wp, 3.556352289_wp, &
        0.000153e-6_wp,     202.253395174_wp, 1.463313961_wp, &
        0.000157e-6_wp,   17267.268201691_wp, 1.586837396_wp, &
        0.000142e-6_wp,   83996.847317911_wp, 0.022670115_wp, &
        0.000152e-6_wp,   17260.154654690_wp, 0.708528947_wp, &
        0.000144e-6_wp,    6084.003848555_wp, 5.187075177_wp, &
        0.000135e-6_wp,    5756.566278634_wp, 1.993229262_wp, &
        0.000134e-6_wp,    5750.203491159_wp, 3.457197134_wp, &
        0.000144e-6_wp,    5326.786694021_wp, 6.066193291_wp, &
        0.000160e-6_wp,   11015.106477335_wp, 1.710431974_wp, &
        0.000133e-6_wp,    3634.621024518_wp, 2.836451652_wp, &
        0.000134e-6_wp,   18073.704938650_wp, 5.453106665_wp, &
        0.000134e-6_wp,    1162.474704408_wp, 5.326898811_wp, &
        0.000128e-6_wp,    5642.198242609_wp, 2.511652591_wp, &
        0.000160e-6_wp,     632.783739313_wp, 5.628785365_wp, &
        0.000132e-6_wp,   13916.019109642_wp, 0.819294053_wp, &
        0.000122e-6_wp,   14314.168113050_wp, 5.677408071_wp, &
        0.000125e-6_wp,   12359.966151546_wp, 5.251984735_wp, &
        0.000121e-6_wp,    5749.452731634_wp, 2.210924603_wp, &
        0.000136e-6_wp,    -245.831646229_wp, 1.646502367_wp, &
        0.000120e-6_wp,    5757.317038160_wp, 3.240883049_wp, &
        0.000134e-6_wp,   12146.667056108_wp, 3.059480037_wp, &
        0.000137e-6_wp,    6206.809778716_wp, 1.867105418_wp, &
        0.000141e-6_wp,   17253.041107690_wp, 2.069217456_wp, &
        0.000129e-6_wp,   -7477.522860216_wp, 2.781469314_wp, &
        0.000116e-6_wp,    5540.085789459_wp, 4.281176991_wp, &
        0.000116e-6_wp,    9779.108676125_wp, 3.320925381_wp, &
        0.000129e-6_wp,    5237.921013804_wp, 3.497704076_wp, &
        0.000113e-6_wp,    5959.570433334_wp, 0.983210840_wp, &
        0.000122e-6_wp,    6282.095528923_wp, 2.674938860_wp, &
        0.000140e-6_wp,     -11.045700264_wp, 4.957936982_wp, &
        0.000108e-6_wp,   23543.230504682_wp, 1.390113589_wp, &
        0.000106e-6_wp,  -12569.674818332_wp, 0.429631317_wp, &
        0.000110e-6_wp,    -266.607041722_wp, 5.501340197_wp, &
        0.000115e-6_wp,   12559.038152982_wp, 4.691456618_wp, &
        0.000134e-6_wp,   -2388.894020449_wp, 0.577313584_wp, &
        0.000109e-6_wp,   10440.274292604_wp, 6.218148717_wp, &
        0.000102e-6_wp,    -543.918059096_wp, 1.477842615_wp, &
        0.000108e-6_wp,   21228.392023546_wp, 2.237753948_wp, &
        0.000101e-6_wp,   -4535.059436924_wp, 3.100492232_wp, &
        0.000103e-6_wp,      76.266071276_wp, 5.594294322_wp, &
        0.000104e-6_wp,     949.175608970_wp, 5.674287810_wp, &
        0.000101e-6_wp,   13517.870106233_wp, 2.196632348_wp, &
        0.000100e-6_wp,   11933.367960670_wp, 4.056084160_wp, &
        4.322990e-6_wp,    6283.075849991_wp, 2.642893748_wp, &    !  T^2
        0.406495e-6_wp,       0.000000000_wp, 4.712388980_wp, &
        0.122605e-6_wp,   12566.151699983_wp, 2.438140634_wp, &
        0.019476e-6_wp,     213.299095438_wp, 1.642186981_wp, &
        0.016916e-6_wp,     529.690965095_wp, 4.510959344_wp, &
        0.013374e-6_wp,      -3.523118349_wp, 1.502210314_wp, &
        0.008042e-6_wp,      26.298319800_wp, 0.478549024_wp, &
        0.007824e-6_wp,     155.420399434_wp, 5.254710405_wp, &
        0.004894e-6_wp,    5746.271337896_wp, 4.683210850_wp, &
        0.004875e-6_wp,    5760.498431898_wp, 0.759507698_wp, &
        0.004416e-6_wp,    5223.693919802_wp, 6.028853166_wp, &
        0.004088e-6_wp,      -7.113547001_wp, 0.060926389_wp, &
        0.004433e-6_wp,   77713.771467920_wp, 3.627734103_wp, &
        0.003277e-6_wp,   18849.227549974_wp, 2.327912542_wp, &
        0.002703e-6_wp,    6062.663207553_wp, 1.271941729_wp, &
        0.003435e-6_wp,    -775.522611324_wp, 0.747446224_wp, &
        0.002618e-6_wp,    6076.890301554_wp, 3.633715689_wp, &
        0.003146e-6_wp,     206.185548437_wp, 5.647874613_wp, &
        0.002544e-6_wp,    1577.343542448_wp, 6.232904270_wp, &
        0.002218e-6_wp,    -220.412642439_wp, 1.309509946_wp, &
        0.002197e-6_wp,    5856.477659115_wp, 2.407212349_wp, &
        0.002897e-6_wp,    5753.384884897_wp, 5.863842246_wp, &
        0.001766e-6_wp,     426.598190876_wp, 0.754113147_wp, &
        0.001738e-6_wp,    -796.298006816_wp, 2.714942671_wp, &
        0.001695e-6_wp,     522.577418094_wp, 2.629369842_wp, &
        0.001584e-6_wp,    5507.553238667_wp, 1.341138229_wp, &
        0.001503e-6_wp,    -242.728603974_wp, 0.377699736_wp, &
        0.001552e-6_wp,    -536.804512095_wp, 2.904684667_wp, &
        0.001370e-6_wp,    -398.149003408_wp, 1.265599125_wp, &
        0.001889e-6_wp,   -5573.142801634_wp, 4.413514859_wp, &
        0.001722e-6_wp,    6069.776754553_wp, 2.445966339_wp, &
        0.001124e-6_wp,    1059.381930189_wp, 5.041799657_wp, &
        0.001258e-6_wp,     553.569402842_wp, 3.849557278_wp, &
        0.000831e-6_wp,     951.718406251_wp, 2.471094709_wp, &
        0.000767e-6_wp,    4694.002954708_wp, 5.363125422_wp, &
        0.000756e-6_wp,    1349.867409659_wp, 1.046195744_wp, &
        0.000775e-6_wp,     -11.045700264_wp, 0.245548001_wp, &
        0.000597e-6_wp,    2146.165416475_wp, 4.543268798_wp, &
        0.000568e-6_wp,    5216.580372801_wp, 4.178853144_wp, &
        0.000711e-6_wp,    1748.016413067_wp, 5.934271972_wp, &
        0.000499e-6_wp,   12036.460734888_wp, 0.624434410_wp, &
        0.000671e-6_wp,   -1194.447010225_wp, 4.136047594_wp, &
        0.000488e-6_wp,    5849.364112115_wp, 2.209679987_wp, &
        0.000621e-6_wp,    6438.496249426_wp, 4.518860804_wp, &
        0.000495e-6_wp,   -6286.598968340_wp, 1.868201275_wp, &
        0.000456e-6_wp,    5230.807466803_wp, 1.271231591_wp, &
        0.000451e-6_wp,    5088.628839767_wp, 0.084060889_wp, &
        0.000435e-6_wp,    5643.178563677_wp, 3.324456609_wp, &
        0.000387e-6_wp,   10977.078804699_wp, 4.052488477_wp, &
        0.000547e-6_wp,  161000.685737473_wp, 2.841633844_wp, &
        0.000522e-6_wp,    3154.687084896_wp, 2.171979966_wp, &
        0.000375e-6_wp,    5486.777843175_wp, 4.983027306_wp, &
        0.000421e-6_wp,    5863.591206116_wp, 4.546432249_wp, &
        0.000439e-6_wp,    7084.896781115_wp, 0.522967921_wp, &
        0.000309e-6_wp,    2544.314419883_wp, 3.172606705_wp, &
        0.000347e-6_wp,    4690.479836359_wp, 1.479586566_wp, &
        0.000317e-6_wp,     801.820931124_wp, 3.553088096_wp, &
        0.000262e-6_wp,     419.484643875_wp, 0.606635550_wp, &
        0.000248e-6_wp,    6836.645252834_wp, 3.014082064_wp, &
        0.000245e-6_wp,   -1592.596013633_wp, 5.519526220_wp, &
        0.000225e-6_wp,    4292.330832950_wp, 2.877956536_wp, &
        0.000214e-6_wp,    7234.794256242_wp, 1.605227587_wp, &
        0.000205e-6_wp,    5767.611978898_wp, 0.625804796_wp, &
        0.000180e-6_wp,   10447.387839604_wp, 3.499954526_wp, &
        0.000229e-6_wp,     199.072001436_wp, 5.632304604_wp, &
        0.000214e-6_wp,     639.897286314_wp, 5.960227667_wp, &
        0.000175e-6_wp,    -433.711737877_wp, 2.162417992_wp, &
        0.000209e-6_wp,     515.463871093_wp, 2.322150893_wp, &
        0.000173e-6_wp,    6040.347246017_wp, 2.556183691_wp, &
        0.000184e-6_wp,    6309.374169791_wp, 4.732296790_wp, &
        0.000227e-6_wp,  149854.400134205_wp, 5.385812217_wp, &
        0.000154e-6_wp,    8031.092263058_wp, 5.120720920_wp, &
        0.000151e-6_wp,    5739.157790895_wp, 4.815000443_wp, &
        0.000197e-6_wp,    7632.943259650_wp, 0.222827271_wp, &
        0.000197e-6_wp,      74.781598567_wp, 3.910456770_wp, &
        0.000138e-6_wp,    6055.549660552_wp, 1.397484253_wp, &
        0.000149e-6_wp,   -6127.655450557_wp, 5.333727496_wp, &
        0.000137e-6_wp,    3894.181829542_wp, 4.281749907_wp, &
        0.000135e-6_wp,    9437.762934887_wp, 5.979971885_wp, &
        0.000139e-6_wp,   -2352.866153772_wp, 4.715630782_wp, &
        0.000142e-6_wp,    6812.766815086_wp, 0.513330157_wp, &
        0.000120e-6_wp,   -4705.732307544_wp, 0.194160689_wp, &
        0.000131e-6_wp,  -71430.695617928_wp, 0.000379226_wp, &
        0.000124e-6_wp,    6279.552731642_wp, 2.122264908_wp, &
        0.000108e-6_wp,   -6256.777530192_wp, 0.883445696_wp, &
        0.143388e-6_wp,    6283.075849991_wp, 1.131453581_wp, &    !  T^3
        0.006671e-6_wp,   12566.151699983_wp, 0.775148887_wp, &
        0.001480e-6_wp,     155.420399434_wp, 0.480016880_wp, &
        0.000934e-6_wp,     213.299095438_wp, 6.144453084_wp, &
        0.000795e-6_wp,     529.690965095_wp, 2.941595619_wp, &
        0.000673e-6_wp,    5746.271337896_wp, 0.120415406_wp, &
        0.000672e-6_wp,    5760.498431898_wp, 5.317009738_wp, &
        0.000389e-6_wp,    -220.412642439_wp, 3.090323467_wp, &
        0.000373e-6_wp,    6062.663207553_wp, 3.003551964_wp, &
        0.000360e-6_wp,    6076.890301554_wp, 1.918913041_wp, &
        0.000316e-6_wp,     -21.340641002_wp, 5.545798121_wp, &
        0.000315e-6_wp,    -242.728603974_wp, 1.884932563_wp, &
        0.000278e-6_wp,     206.185548437_wp, 1.266254859_wp, &
        0.000238e-6_wp,    -536.804512095_wp, 4.532664830_wp, &
        0.000185e-6_wp,     522.577418094_wp, 4.578313856_wp, &
        0.000245e-6_wp,   18849.227549974_wp, 0.587467082_wp, &
        0.000180e-6_wp,     426.598190876_wp, 5.151178553_wp, &
        0.000200e-6_wp,     553.569402842_wp, 5.355983739_wp, &
        0.000141e-6_wp,    5223.693919802_wp, 1.336556009_wp, &
        0.000104e-6_wp,    5856.477659115_wp, 4.239842759_wp, &
        0.003826e-6_wp,    6283.075849991_wp, 5.705257275_wp, &    !  T^4
        0.000303e-6_wp,   12566.151699983_wp, 5.407132842_wp, &
        0.000209e-6_wp,     155.420399434_wp, 1.989815753_wp ], [3,787])

    !  Time since J2000.0 in Julian millennia.
    t = ( ( date1-dj00 ) + date2 ) / djm

    !  =================
    !  Topocentric terms
    !  =================

    !  Convert UT to local solar time in radians.
    tsol = mod(ut,1.0_wp) * d2pi + elong

    !  FUNDAMENTAL ARGUMENTS:  Simon et al. 1994.

    !  Combine time argument (millennia) with deg/arcsec factor.
    w = t / 3600.0_wp

    !  Sun Mean Longitude.
    elsun = mod(280.46645683_wp + 1296027711.03429_wp * w, 360.0_wp) * dd2r

    !  Sun Mean Anomaly.
    emsun = mod(357.52910918_wp + 1295965810.481_wp * w, 360.0_wp) * dd2r

    !  Mean Elongation of Moon from Sun.
    d = mod(297.85019547_wp + 16029616012.090_wp * w, 360.0_wp) * dd2r

    !  Mean Longitude of Jupiter.
    elj = mod(34.35151874_wp + 109306899.89453_wp * w, 360.0_wp) * dd2r

    !  Mean Longitude of Saturn.
    els = mod(50.07744430_wp + 44046398.47038_wp * w, 360.0_wp) * dd2r

    !  TOPOCENTRIC TERMS:  Moyer 1981 and Murray 1983.
    wt =  + 0.00029e-10_wp * u * sin(tsol + elsun - els) &
          + 0.00100e-10_wp * u * sin(tsol - 2.0_wp*emsun) &
          + 0.00133e-10_wp * u * sin(tsol - d) &
          + 0.00133e-10_wp * u * sin(tsol + elsun - elj) &
          - 0.00229e-10_wp * u * sin(tsol + 2.0_wp*elsun + emsun) &
          - 0.0220e-10_wp * v * cos(elsun + emsun) &
          + 0.05312e-10_wp * u * sin(tsol - emsun) &
          - 0.13677e-10_wp * u * sin(tsol + 2.0_wp*elsun) &
          - 1.3184e-10_wp * v * cos(elsun) &
          + 3.17679e-10_wp * u * sin(tsol)

    !  =====================
    !  Fairhead et al. model
    !  =====================

    !  T**0
    w0 = 0.0_wp
    do j=474,1,-1
       w0 = w0 + fairhd(1,j) * sin(fairhd(2,j)*t + fairhd(3,j))
    end do

    !  T**1
    w1 = 0.0_wp
    do j=679,475,-1
       w1 = w1 + fairhd(1,j) * sin(fairhd(2,j)*t + fairhd(3,j))
    end do

    !  T**2
    w2 = 0.0_wp
    do j=764,680,-1
       w2 = w2 + fairhd(1,j) * sin(fairhd(2,j)*t + fairhd(3,j))
    end do

    !  T**3
    w3 = 0.0_wp
    do j=784,765,-1
       w3 = w3 + fairhd(1,j) * sin(fairhd(2,j)*t + fairhd(3,j))
    end do

    !  T**4
    w4 = 0.0_wp
    do j=787,785,-1
       w4 = w4 + fairhd(1,j) * sin(fairhd(2,j)*t + fairhd(3,j))
    end do

    !  Multiply by powers of T and combine.
    wf = t * ( t * ( t * ( t * w4 + w3 ) + w2 ) + w1 ) + w0

    !  Adjustments to use JPL planetary masses instead of IAU.
    wj =   0.00065e-6_wp * sin(6069.776754_wp*t + 4.021194_wp) + &
           0.00033e-6_wp * sin( 213.299095_wp*t + 5.543132_wp) + &
        ( -0.00196e-6_wp * sin(6208.294251_wp*t + 5.696701_wp) ) + &
        ( -0.00173e-6_wp * sin(  74.781599_wp*t + 2.435900_wp) ) + &
           0.03638e-6_wp * t * t

    !  ============
    !  Final result
    !  ============

    !  TDB-TT in seconds.
    TDB_minus_TT = wt + wf + wj

    end function DTDB
!***********************************************************************

!***********************************************************************
!>
!  Encode date and time fields into 2-part Julian Date (or in the case
!  of UTC a quasi-JD form that includes special provision for leap
!  seconds).
!
!  Status:  support routine.
!
!### Notes
!
!  1. SCALE identifies the time scale.  Only the value 'UTC' (in upper
!     case) is significant, and enables handling of leap seconds (see
!     Note 4).
!
!  2. For calendar conventions and limitations, see CAL2JD.
!
!  3. The sum of the results, D1+D2, is Julian Date, where normally D1
!     is the Julian Day Number and D2 is the fraction of a day.  In the
!     case of UTC, where the use of JD is problematical, special
!     conventions apply:  see the next note.
!
!  4. JD cannot unambiguously represent UTC during a leap second unless
!     special measures are taken.  The SOFA internal convention is that
!     the quasi-JD day represents UTC days whether the length is 86399,
!     86400 or 86401 SI seconds.  In the 1960-1972 era there were
!     smaller jumps (in either direction) each time the linear UTC(TAI)
!     expression was changed, and these "mini-leaps" are also included
!     in the SOFA convention.
!
!  5. The warning status "time is after end of day" usually means that
!     the SEC argument is greater than 60D0.  However, in a day ending
!     in a leap second the limit changes to 61D0 (or 59D0 in the case of
!     a negative leap second).
!
!  6. The warning status "dubious year" flags UTCs that predate the
!     introduction of the time scale or that are too far in the future
!     to be trusted.  See DAT for further details.
!
!  7. Only in the case of continuous and regular time scales (TAI, TT,
!     TCG, TCB and TDB) is the result D1+D2 a Julian Date, strictly
!     speaking.  In the other cases (UT1 and UTC) the result must be
!     used with circumspection;  in particular the difference between
!     two such results cannot be interpreted as a precise time
!     interval.
!
!### History
!  * IAU SOFA revision: 2013 July 26

    subroutine DTF2D ( scale, iy, im, id, ihr, imn, sec, &
                       d1, d2, j )

    implicit none

    character(len=*),intent(in) :: scale !! time scale ID (Note 1)
    integer,intent(in) :: iy !! year in Gregorian calendar (Note 2)
    integer,intent(in) :: im !! month in Gregorian calendar (Note 2)
    integer,intent(in) :: id !! day in Gregorian calendar (Note 2)
    integer,intent(in) :: ihr !! hour
    integer,intent(in) :: imn !! minute
    real(wp),intent(in) :: sec !! seconds
    real(wp),intent(out) :: d1 !! 2-part Julian Date (Notes 3,4)
    real(wp),intent(out) :: d2 !! 2-part Julian Date (Notes 3,4)
    integer,intent(out) :: j !! status:
                             !! * +3 = both of next two
                             !! * +2 = time is after end of day (Note 5)
                             !! * +1 = dubious year (Note 6)
                             !! *  0 = OK
                             !! * -1 = bad year
                             !! * -2 = bad month
                             !! * -3 = bad day
                             !! * -4 = bad hour
                             !! * -5 = bad minute
                             !! * -6 = bad second (<0)

    integer :: js, iy2, im2, id2
    real(wp) :: dj, w, day, seclim, dat0, dat12, dat24, &
                dleap, time

    main : block

      !  Today's Julian Day Number.
      call CAL2JD ( iy, im, id, dj, w, js )
      if ( js/=0 ) exit main
      dj = dj + w

      !  Day length and final minute length in seconds (provisional).
      day = d2s
      seclim = 60.0_wp

      !  Deal with the UTC leap second case.
      if ( scale=='UTC' ) then

        !  TAI-UTC at 0h today.
        call DAT ( iy, im, id, 0.0_wp, dat0, js )
        if ( js<0 ) exit main

        !  TAI-UTC at 12h today (to detect drift).
        call DAT ( iy, im, id, 0.5_wp, dat12, js )
        if ( js<0 ) exit main

        !  TAI-UTC at 0h tomorrow (to detect jumps).
        call JD2CAL ( dj, 1.5_wp, iy2, im2, id2, w, js )
        if ( js/=0 ) exit main
        call DAT ( iy2, im2, id2, 0.0_wp, dat24, js )
        if ( js<0 ) exit main

        !  Any sudden change in TAI-UTC between today and tomorrow.
        dleap = dat24 - ( 2.0_wp * dat12 - dat0 )

        !  If leap second day, correct the day and final minute lengths.
        day = day + dleap
        if ( ihr==23 .and. imn==59 ) seclim = seclim + dleap

        !  End of UTC-specific actions.
      end if

      !  Validate the time.
      if ( ihr>=0 .and. ihr<=23 ) then
        if ( imn>=0 .and. imn<=59 ) then
            if ( sec>=0.0_wp ) then
              if ( sec>=seclim ) then
                  js = js + 2
              end if
            else
              js = -6
            end if
        else
            js = -5
        end if
      else
        js = -4
      end if
      if ( js<0 ) exit main

      !  The time in days.
      time = (60.0_wp*real(60*ihr+imn, wp)+sec) / day

      !  Return the date and time.
      d1 = dj
      d2 = time

    end block main

    !  Return the status.
    j = js

    end subroutine DTF2D
!***********************************************************************

!***********************************************************************
!>
!  Transformation from ecliptic coordinates (mean equinox and ecliptic
!  of date) to ICRS RA,Dec, using the IAU 2006 precession model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. No assumptions are made about whether the coordinates represent
!     starlight and embody astrometric effects such as parallax or
!     aberration.
!
!  3. The transformation is approximately that from ecliptic longitude
!     and latitude (mean equinox and ecliptic of date) to mean J2000.0
!     right ascension and declination, with only frame bias (always less
!     than 25 mas) to disturb this classical picture.
!
!### History
!  * IAU SOFA revision: 2016 February 9

    subroutine ECEQ06 ( date1, date2, dl, db, dr, dd )

    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) :: dl !! ecliptic longitude and latitude (radians)
    real(wp),intent(in) :: db !! ecliptic longitude and latitude (radians)
    real(wp),intent(out) :: dr !! ICRS right ascension and declination (radians)
    real(wp),intent(out) :: dd !! ICRS right ascension and declination (radians)

    real(wp) :: rm(3,3), v1(3), v2(3), a, b

    !  Spherical to Cartesian.
    call S2C ( dl, db, v1 )

    !  Rotation matrix, ICRS equatorial to ecliptic.
    call ECM06 ( date1, date2, rm )

    !  The transformation from ecliptic to ICRS.
    call TRXP ( rm, v1, v2 )

    !  Cartesian to spherical.
    call C2S ( v2, a, b )

    !  Express in conventional ranges.
    dr = ANP ( a )
    dd = ANPM ( b )

    end subroutine ECEQ06
!***********************************************************************

!***********************************************************************
!>
!  ICRS equatorial to ecliptic rotation matrix, IAU 2006.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix is in the sense
!
!        E_ep = RM x P_ICRS,
!
!     where P_ICRS is a vector with respect to ICRS right ascension
!     and declination axes and E_ep is the same vector with respect to
!     the (inertial) ecliptic and equinox of date.
!
!  3. P_ICRS is a free vector, merely a direction, typically of unit
!     magnitude, and not bound to any particular spatial origin, such as
!     the Earth, Sun or SSB.  No assumptions are made about whether it
!     represents starlight and embodies astrometric effects such as
!     parallax or aberration.  The transformation is approximately that
!     between mean J2000.0 right ascension and declination and ecliptic
!     longitude and latitude, with only frame bias (always less than
!     25 mas) to disturb this classical picture.
!
!### History
!  * IAU SOFA revision: 2015 December 11

    subroutine ECM06 ( date1, date2, rm )

    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),dimension(3,3),intent(out) :: rm !! ICRS to ecliptic rotation matrix

    real(wp) :: ob, bp(3,3), e(3,3)

    !  Obliquity, IAU 2006.
    ob = OBL06 ( date1, date2 )

    !  Precession-bias matrix, IAU 2006.
    call PMAT06 ( date1, date2, bp )

    !  Equatorial of date to ecliptic matrix.
    call IR ( e )
    call RX ( ob, e )

    !  ICRS to ecliptic coordinates rotation matrix, IAU 2006.
    call RXR ( e, bp, rm )

    end subroutine ECM06
!***********************************************************************

!***********************************************************************
!>
!  The equation of the equinoxes, compatible with IAU 2000 resolutions,
!  given the nutation in longitude and the mean obliquity.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The obliquity, in radians, is mean of date.
!
!  3. The result, which is in radians, operates in the following sense:
!
!        Greenwich apparent ST = GMST + equation of the equinoxes
!
!  4. The result is compatible with the IAU 2000 resolutions.  For
!     further details, see IERS Conventions 2003 and Capitaine et al.
!     (2002).
!
!### References
!
!  * Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to
!    implement the IAU 2000 definition of UT1", Astronomy &
!    Astrophysics, 406, 1135-1149 (2003)
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2006 November 13

    function EE00 ( date1, date2, epsa, dpsi ) 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),intent(in) :: epsa !! mean obliquity (Note 2)
    real(wp),intent(in) :: dpsi !! nutation in longitude (Note 3)
    real(wp) :: res !! equation of the equinoxes (Note 4)

    !  Equation of the equinoxes.
    res = dpsi * cos(epsa) + EECT00 ( date1, date2 )

    end function EE00
!***********************************************************************

!***********************************************************************
!>
!  Equation of the equinoxes, compatible with IAU 2000 resolutions.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The result, which is in radians, operates in the following sense:
!
!        Greenwich apparent ST = GMST + equation of the equinoxes
!
!  3. The result is compatible with the IAU 2000 resolutions.  For
!     further details, see IERS Conventions 2003 and Capitaine et al.
!     (2002).
!
!### References
!
!  * Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to
!    implement the IAU 2000 definition of UT1", Astronomy &
!    Astrophysics, 406, 1135-1149 (2003)
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2006 November 13

    function EE00A ( 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 !! equation of the equinoxes (Note 2)

    real(wp) :: dpsipr, depspr, epsa, dpsi, deps

    !  IAU 2000 precession-rate adjustments.
    call PR00 ( date1, date2, dpsipr, depspr )

    !  Mean obliquity, consistent with IAU 2000 precession-nutation.
    epsa = OBL80 ( date1, date2 ) + depspr

    !  Nutation in longitude.
    call NUT00A ( date1, date2, dpsi, deps )

    !  Equation of the equinoxes.
    res = EE00 ( date1, date2, epsa, dpsi )

    end function EE00A
!***********************************************************************

!***********************************************************************
!>
!  Equation of the equinoxes, compatible with IAU 2000 resolutions but
!  using the truncated nutation model IAU 2000B.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The result, which is in radians, operates in the following sense:
!
!        Greenwich apparent ST = GMST + equation of the equinoxes
!
!  3. The result is compatible with the IAU 2000 resolutions except that
!     accuracy has been compromised for the sake of speed.  For further
!     details, see McCarthy & Luzum (2001), IERS Conventions 2003 and
!     Capitaine et al. (2003).
!
!### References
!
!  * Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to
!    implement the IAU 2000 definition of UT1", Astronomy &
!    Astrophysics, 406, 1135-1149 (2003)
!
!  * McCarthy, D.D. & Luzum, B.J., "An abridged model of the
!    precession-nutation of the celestial pole", Celestial Mechanics &
!    Dynamical Astronomy, 85, 37-49 (2003)
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2006 November 13

    function EE00B ( 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 !! equation of the equinoxes (Note 2)

    real(wp) :: dpsipr, depspr, epsa, dpsi, deps

    !  IAU 2000 precession-rate adjustments.
    call PR00 ( date1, date2, dpsipr, depspr )

    !  Mean obliquity, consistent with IAU 2000 precession-nutation.
    epsa = OBL80 ( date1, date2 ) + depspr

    !  Nutation in longitude.
    call NUT00B ( date1, date2, dpsi, deps )

    !  Equation of the equinoxes.
    res = EE00 ( date1, date2, epsa, dpsi )

    end function EE00B
!***********************************************************************

!***********************************************************************
!>
!  Equation of the equinoxes, compatible with IAU 2000 resolutions and
!  IAU 2006/2000A precession-nutation.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The result, which is in radians, operates in the following sense:
!
!        Greenwich apparent ST = GMST + equation of the equinoxes
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!### History
!  * IAU SOFA revision: 2006 October 31

    function EE06A ( 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 !! equation of the equinoxes (Note 2)

    !  Equation of the equinoxes.
    res = ANPM ( GST06A ( 0.0_wp, 0.0_wp, date1, date2 ) - &
                 GMST06 ( 0.0_wp, 0.0_wp, date1, date2 ) )

    end function EE06A
!***********************************************************************

!***********************************************************************
!>
!  Equation of the equinoxes complementary terms, consistent with
!  IAU 2000 resolutions.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. 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).
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2017 October 23

    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
!***********************************************************************

!***********************************************************************
!>
!  Earth reference ellipsoids.
!
!  Status:  canonical.
!
!### Notes
!
!  1. The identifier N is a number that specifies the choice of
!     reference ellipsoid.  The following are supported:
!
!        N   ellipsoid
!
!        1    WGS84
!        2    GRS80
!        3    WGS72
!
!     The number N has no significance outside the SOFA software.
!
!  2. The ellipsoid parameters are returned in the form of equatorial
!     radius in meters (A) and flattening (F).  The latter is a number
!     around 0.00335, i.e. around 1/298.
!
!  3. For the case where an unsupported N value is supplied, zero A and
!     F are returned, as well as error status.
!
!### References
!
!  * Department of Defense World Geodetic System 1984, National Imagery
!    and Mapping Agency Technical Report 8350.2, Third Edition, p3-2.
!
!  * Moritz, H., Bull. Geodesique 66-2, 187 (1992).
!
!  * The Department of Defense World Geodetic System 1972, World
!    Geodetic System Committee, May 1974.
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    p220.
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine EFORM ( n, a, f, j )

    implicit none

    integer,intent(in) :: n !! ellipsoid identifier (Note 1)
    real(wp),intent(out) :: a !! equatorial radius (meters, Note 2)
    real(wp),intent(out) :: f !! flattening (Note 2)
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * -1 = illegal identifier (Note 3)

    !  Preset the status to OK
    j = 0

    !  Look up A and F for the specified reference ellipsoid.

    select case (n)
    case ( 1 )

       !  WGS84.
       a = 6378137.0_wp
       f = 1.0_wp / 298.257223563_wp

    case ( 2 )

       !  GRS80.
       a = 6378137.0_wp
       f = 1.0_wp / 298.257222101_wp

    case ( 3 )

       !  WGS72.
       a = 6378135.0_wp
       f = 1.0_wp / 298.26_wp

    case default

       !  Invalid identifier.
       a = 0.0_wp
       f = 0.0_wp
       j = -1

    end select

    end subroutine EFORM
!***********************************************************************

!***********************************************************************
!>
!  Equation of the origins, IAU 2006 precession and IAU 2000A nutation.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The equation of the origins is the distance between the true
!     equinox and the celestial intermediate origin and, equivalently,
!     the difference between Earth rotation angle and Greenwich
!     apparent sidereal time (ERA-GST).  It comprises the precession
!     (since J2000.0) in right ascension plus the equation of the
!     equinoxes (including the small correction terms).
!
!### References
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2007 February 13

    function EO06A ( 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 !! equation of the origins in radians

    real(wp) :: r(3,3), x, y, s
    !  Classical nutation x precession x bias matrix.
    call PNM06A ( date1, date2, r )

    !  Extract CIP coordinates.
    call BPN2XY ( r, x, y )

    !  The CIO locator, s.
    s = S06 ( date1, date2, x, y )

    !  Solve for the EO.
    res = EORS ( r, s )

    end function EO06A
!***********************************************************************

!***********************************************************************
!>
!  Equation of the origins, given the classical NPB matrix and the
!  quantity s.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  The equation of the origins is the distance between the true
!      equinox and the celestial intermediate origin and, equivalently,
!      the difference between Earth rotation angle and Greenwich
!      apparent sidereal time (ERA-GST).  It comprises the precession
!      (since J2000.0) in right ascension plus the equation of the
!      equinoxes (including the small correction terms).
!
!  2.  The algorithm is from Wallace & Capitaine (2006).
!
!### References
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2008 February 24

    function EORS ( rnpb, s ) result(res)

    implicit none

    real(wp),dimension(3,3),intent(in) :: rnpb !! classical nutation x precession x bias matrix
    real(wp),intent(in) :: s !! the quantity s (the CIO locator)
    real(wp) :: res !! the equation of the origins in radians.

    real(wp) :: x, ax, xs, ys, zs, p, q

    !  Evaluate Wallace & Capitaine (2006) expression (16).
    x = rnpb(3,1)
    ax = x / ( 1.0_wp + rnpb(3,3) )
    xs = 1.0_wp - ax*x
    ys = -ax*rnpb(3,2)
    zs = -x
    p = rnpb(1,1)*xs + rnpb(1,2)*ys + rnpb(1,3)*zs
    q = rnpb(2,1)*xs + rnpb(2,2)*ys + rnpb(2,3)*zs
    if ( p/=0.0_wp .or. q/=0.0_wp ) then
       res = s - atan2 ( q, p )
    else
       res = s
    end if

    end function EORS
!***********************************************************************

!***********************************************************************
!>
!  Julian Date to Besselian Epoch.
!
!  Status:  support routine.
!
!### Note
!
!  The Julian Date is supplied in two pieces, in the usual SOFA
!  manner, which is designed to preserve time resolution.  The
!  Julian Date is available as a single number by adding DJ1 and
!  DJ2.  The maximum resolution is achieved if DJ1 is 2451545D0
!  (J2000.0).
!
!### Reference
!
!  * Lieske, J.H., 1979, Astron.Astrophys. 73, 282.
!
!### History
!  * IAU SOFA revision: 2013 August 7

    function EPB ( dj1, dj2 ) result(res)

    implicit none

    real(wp),intent(in) :: dj1 !! Julian Date (see note)
    real(wp),intent(in) :: dj2 !! Julian Date (see note)
    real(wp) :: res !! the Besselian Epoch

    !  J2000.0 minus B1900.0 (2415019.81352) in days
    real(wp),parameter :: d1900 = 36524.68648_wp

    !  Length of tropical year B1900 (days)
    real(wp),parameter :: ty = 365.242198781_wp

    res = 1900.0_wp + ( ( dj1-dj00 ) + ( dj2+d1900 ) ) / ty

    end function EPB
!***********************************************************************

!***********************************************************************
!>
!  Besselian Epoch to Julian Date.
!
!  Status:  support routine.
!
!### Note
!
!     The Julian Date is returned in two pieces, in the usual SOFA
!     manner, which is designed to preserve time resolution.  The
!     Julian Date is available as a single number by adding DJM0 and
!     DJM.
!
!### Reference
!
!     Lieske, J.H., 1979, Astron.Astrophys. 73, 282.
!
!### History
!  * IAU SOFA revision: 2008 May 11

    subroutine EPB2JD ( epb, djm0, djm )

    implicit none

    real(wp),intent(in)  :: epb !! Besselian Epoch (e.g. 1957.3D0)
    real(wp),intent(out) :: djm0 !! MJD zero-point: always 2400000.5
    real(wp),intent(out) :: djm !! Modified Julian Date

    !  Length of tropical year B1900 (days)
    real(wp),parameter :: ty = 365.242198781_wp

    djm0 = 2400000.5_wp
    djm  = 15019.81352_wp + ( epb-1900.0_wp ) * ty

    end subroutine EPB2JD
!***********************************************************************

!***********************************************************************
!>
!  Julian Date to Julian Epoch.
!
!  Status:  support routine.
!
!### Note
!
!  The Julian Date is supplied in two pieces, in the usual SOFA
!  manner, which is designed to preserve time resolution.  The
!  Julian Date is available as a single number by adding DJ1 and
!  DJ2.  The maximum resolution is achieved if DJ1 is 2451545D0
!  (J2000.0).
!
!### Reference
!
!  * Lieske, J.H., 1979, Astron.Astrophys. 73, 282.
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function EPJ ( dj1, dj2 ) result(jd)

    implicit none

    real(wp),intent(in) :: dj1 !! Julian Date (see note)
    real(wp),intent(in) :: dj2 !! Julian Date (see note)
    real(wp) :: jd !! the Julian Epoch.

    jd = 2000.0_wp + ( ( dj1-dj00 ) + dj2 ) / djy

    end function EPJ
!***********************************************************************

!***********************************************************************
!>
!  Julian Epoch to Julian Date.
!
!  Status:  support routine.
!
!### Note
!
!  The Julian Date is returned in two pieces, in the usual SOFA
!  manner, which is designed to preserve time resolution.  The
!  Julian Date is available as a single number by adding DJM0 and
!  DJM.
!
!### Reference
!
!  * Lieske, J.H., 1979, Astron.Astrophys. 73, 282.
!
!### History
!  * IAU SOFA revision: 2008 May 11

    subroutine EPJ2JD ( epj, djm0, djm )

    implicit none

    real(wp),intent(in) :: epj !! Julian Epoch (e.g. 1996.8)
    real(wp),intent(out) :: djm0 !! MJD zero-point: always 2400000.5
    real(wp),intent(out) :: djm !! Modified Julian Date

    djm0 = 2400000.5_wp
    djm  = 51544.5_wp + ( epj-2000.0_wp ) * 365.25_wp

    end subroutine EPJ2JD
!***********************************************************************

!***********************************************************************
!>
!  Earth position and velocity, heliocentric and barycentric, with
!  respect to the Barycentric Celestial Reference System.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!     However, the accuracy of the result is more likely to be
!     limited by the algorithm itself than the way the epoch has been
!     expressed.
!
!  2. On return, the arrays PVH and PVB contain the following:
!
!        PVH(1,1)  x       }
!        PVH(2,1)  y       } heliocentric position, au
!        PVH(3,1)  z       }
!
!        PVH(1,2)  xdot    }
!        PVH(2,2)  ydot    } heliocentric velocity, au/d
!        PVH(3,2)  zdot    }
!
!        PVB(1,1)  x       }
!        PVB(2,1)  y       } barycentric position, au
!        PVB(3,1)  z       }
!
!        PVB(1,2)  xdot    }
!        PVB(2,2)  ydot    } barycentric velocity, au/d
!        PVB(3,2)  zdot    }
!
!     The vectors are with respect to the Barycentric Celestial
!     Reference System.  The time unit is one day in TDB.
!
!  3. The routine is a SIMPLIFIED SOLUTION from the planetary theory
!     VSOP2000 (X. Moisson, P. Bretagnon, 2001, Celes. Mechanics &
!     Dyn. Astron., 80, 3/4, 205-213) and is an adaptation of original
!     Fortran code supplied by P. Bretagnon (private comm., 2000).
!
!  4. Comparisons over the time span 1900-2100 with this simplified
!     solution and the JPL DE405 ephemeris give the following results:
!
!                                RMS    max
!           Heliocentric:
!              position error    3.7   11.2   km
!              velocity error    1.4    5.0   mm/s
!
!           Barycentric:
!              position error    4.6   13.4   km
!              velocity error    1.4    4.9   mm/s
!
!     Comparisons with the JPL DE406 ephemeris show that by 1800 and
!     2200 the position errors are approximately double their 1900-2100
!     size.  By 1500 and 2500 the deterioration is a factor of 10 and by
!     1000 and 3000 a factor of 60.  The velocity accuracy falls off at
!     about half that rate.
!
!### History
!  * IAU SOFA revision: 2017 March 16

    subroutine EPV00 ( date1, date2, pvh, pvb, jstat )

    implicit none

    real(wp),intent(in) :: date1 !! TDB date part A (Note 1)
    real(wp),intent(in) :: date2 !! TDB date part B (Note 1)
    real(wp),dimension(3,2),intent(out) :: pvh !!  heliocentric Earth position/velocity (au,au/day)
    real(wp),dimension(3,2),intent(out) :: pvb !!  barycentric Earth position/velocity (au,au/day)
    integer,intent(out) :: jstat !! status:
                                 !! * 0 = OK
                                 !! * +1 = warning: date outside 1900-2100 AD

    real(wp) :: t, t2, xyz, xyzd, a, b, c, ct, p, cp, &
                ph(3), vh(3), pb(3), vb(3), x, y, z
    integer :: i, j, k

    !
    !  Matrix elements for orienting the analytical model to DE405/ICRF.
    !
    !  The corresponding Euler angles are:
    !
    !                        d  '  "
    !    1st rotation    -  23 26 21.4091 about the x-axis  (obliquity)
    !    2nd rotation    +         0.0475 about the z-axis  (RA offset)
    !
    !  These were obtained empirically, by comparisons with DE405 over
    !  1900-2100.
    !
    real(wp),parameter :: am12 = +0.000000211284_wp
    real(wp),parameter :: am13 = -0.000000091603_wp
    real(wp),parameter :: am21 = -0.000000230286_wp
    real(wp),parameter :: am22 = +0.917482137087_wp
    real(wp),parameter :: am23 = -0.397776982902_wp
    real(wp),parameter :: am32 = +0.397776982902_wp
    real(wp),parameter :: am33 = +0.917482137087_wp

    !  ----------------------
    !  Ephemeris Coefficients
    !  ----------------------
    !
    !  The coefficients are stored in arrays of dimension (3,n,3).  There
    !  are separate sets of arrays for (i) the Sun to Earth vector and
    !  (ii) the Solar-System barycenter to Sun vector.  Each of these two
    !  sets contains separate arrays for the terms (n in number) in each
    !  power of time (in Julian years since J2000.0): T^0, T^1 and T^2.
    !  Within each array, all the Cartesian x-components, elements (i,j,1),
    !  appear first, followed by all the y-components, elements (i,j,2) and
    !  finally all the z-components, elements (i,j,3).  At the lowest level
    !  are groups of three coefficients.  The first coefficient in each
    !  group, element (1,j,k), is the amplitude of the term, the second,
    !  element (2,j,k), is the phase and the third, element (3,j,k), is the
    !  frequency.
    !
    !  The naming scheme is such that a block
    !
    !     REAL(WP) bn(3,Mbn,3)
    !
    !  applies to body b and time exponent n:
    !
    !    . b can be either E (Earth with respect to Sun) or S (Sun with
    !      respect to Solar-System Barycenter)
    !
    !    . n can be 0, 1 or 2, for T^0, T^1 or T^2
    !
    !  For example, array E2(3,ME2,3) contains the coefficients for
    !  the T^2 terms for the Sun-to-Earth vector.
    !
    !  There is no requirement for the X, Y and Z models for a particular
    !  block to use the same number of coefficients.  The number actually
    !  used is parameterized, the number of terms being used called NbnX,
    !  NbnY, and NbnZ respectively.  The parameter Mbn is the biggest of
    !  the three, and defines the array size.  Unused elements are not
    !  initialized and are never accessed.
    !

    integer, parameter :: ne0x = 501
    integer, parameter :: ne0y = 501
    integer, parameter :: ne0z = 137
    integer, parameter :: me0 = ne0x
    integer, parameter :: ne1x =  79
    integer, parameter :: ne1y =  80
    integer, parameter :: ne1z =  12
    integer, parameter :: me1 = ne1y
    integer, parameter :: ne2x =   5
    integer, parameter :: ne2y =   5
    integer, parameter :: ne2z =   3
    integer, parameter :: me2 = ne2x
    integer, parameter :: ns0x = 212
    integer, parameter :: ns0y = 213
    integer, parameter :: ns0z =  69
    integer, parameter :: ms0 = ns0y
    integer, parameter :: ns1x =  50
    integer, parameter :: ns1y =  50
    integer, parameter :: ns1z =  14
    integer, parameter :: ms1 = ns1x
    integer, parameter :: ns2x =   9
    integer, parameter :: ns2y =   9
    integer, parameter :: ns2z =   2
    integer, parameter :: ms2 = ns2x
    integer,dimension(3),parameter :: ne0 = [ ne0x, ne0y, ne0z ]
    integer,dimension(3),parameter :: ne1 = [ ne1x, ne1y, ne1z ]
    integer,dimension(3),parameter :: ne2 = [ ne2x, ne2y, ne2z ]
    integer,dimension(3),parameter :: ns0 = [ ns0x, ns0y, ns0z ]
    integer,dimension(3),parameter :: ns1 = [ ns1x, ns1y, ns1z ]
    integer,dimension(3),parameter :: ns2 = [ ns2x, ns2y, ns2z ]

    real(wp) :: e0(3,me0,3), e1(3,me1,3), e2(3,me2,3), &
                s0(3,ms0,3), s1(3,ms1,3), s2(3,ms2,3)

    !  Sun-to-Earth, T^0, X
    data ((e0(i,j,1),i=1,3),j=  1, 10) / &
      0.9998292878132e+00_wp, 0.1753485171504e+01_wp, 0.6283075850446e+01_wp, &
      0.8352579567414e-02_wp, 0.1710344404582e+01_wp, 0.1256615170089e+02_wp, &
      0.5611445335148e-02_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.1046664295572e-03_wp, 0.1667225416770e+01_wp, 0.1884922755134e+02_wp, &
      0.3110842534677e-04_wp, 0.6687513390251e+00_wp, 0.8399684731857e+02_wp, &
      0.2552413503550e-04_wp, 0.5830637358413e+00_wp, 0.5296909721118e+00_wp, &
      0.2137207845781e-04_wp, 0.1092330954011e+01_wp, 0.1577343543434e+01_wp, &
      0.1680240182951e-04_wp, 0.4955366134987e+00_wp, 0.6279552690824e+01_wp, &
      0.1679012370795e-04_wp, 0.6153014091901e+01_wp, 0.6286599010068e+01_wp, &
      0.1445526946777e-04_wp, 0.3472744100492e+01_wp, 0.2352866153506e+01_wp /
    data ((e0(i,j,1),i=1,3),j= 11, 20) / &
      0.1091038246184e-04_wp, 0.3689845786119e+01_wp, 0.5223693906222e+01_wp, &
      0.9344399733932e-05_wp, 0.6073934645672e+01_wp, 0.1203646072878e+02_wp, &
      0.8993182910652e-05_wp, 0.3175705249069e+01_wp, 0.1021328554739e+02_wp, &
      0.5665546034116e-05_wp, 0.2152484672246e+01_wp, 0.1059381944224e+01_wp, &
      0.6844146703035e-05_wp, 0.1306964099750e+01_wp, 0.5753384878334e+01_wp, &
      0.7346610905565e-05_wp, 0.4354980070466e+01_wp, 0.3981490189893e+00_wp, &
      0.6815396474414e-05_wp, 0.2218229211267e+01_wp, 0.4705732307012e+01_wp, &
      0.6112787253053e-05_wp, 0.5384788425458e+01_wp, 0.6812766822558e+01_wp, &
      0.4518120711239e-05_wp, 0.6087604012291e+01_wp, 0.5884926831456e+01_wp, &
      0.4521963430706e-05_wp, 0.1279424524906e+01_wp, 0.6256777527156e+01_wp /
    data ((e0(i,j,1),i=1,3),j= 21, 30) / &
      0.4497426764085e-05_wp, 0.5369129144266e+01_wp, 0.6309374173736e+01_wp, &
      0.4062190566959e-05_wp, 0.5436473303367e+00_wp, 0.6681224869435e+01_wp, &
      0.5412193480192e-05_wp, 0.7867838528395e+00_wp, 0.7755226100720e+00_wp, &
      0.5469839049386e-05_wp, 0.1461440311134e+01_wp, 0.1414349524433e+02_wp, &
      0.5205264083477e-05_wp, 0.4432944696116e+01_wp, 0.7860419393880e+01_wp, &
      0.2149759935455e-05_wp, 0.4502237496846e+01_wp, 0.1150676975667e+02_wp, &
      0.2279109618501e-05_wp, 0.1239441308815e+01_wp, 0.7058598460518e+01_wp, &
      0.2259282939683e-05_wp, 0.3272430985331e+01_wp, 0.4694002934110e+01_wp, &
      0.2558950271319e-05_wp, 0.2265471086404e+01_wp, 0.1216800268190e+02_wp, &
      0.2561581447555e-05_wp, 0.1454740653245e+01_wp, 0.7099330490126e+00_wp /
    data ((e0(i,j,1),i=1,3),j= 31, 40) / &
      0.1781441115440e-05_wp, 0.2962068630206e+01_wp, 0.7962980379786e+00_wp, &
      0.1612005874644e-05_wp, 0.1473255041006e+01_wp, 0.5486777812467e+01_wp, &
      0.1818630667105e-05_wp, 0.3743903293447e+00_wp, 0.6283008715021e+01_wp, &
      0.1818601377529e-05_wp, 0.6274174354554e+01_wp, 0.6283142985870e+01_wp, &
      0.1554475925257e-05_wp, 0.1624110906816e+01_wp, 0.2513230340178e+02_wp, &
      0.2090948029241e-05_wp, 0.5852052276256e+01_wp, 0.1179062909082e+02_wp, &
      0.2000176345460e-05_wp, 0.4072093298513e+01_wp, 0.1778984560711e+02_wp, &
      0.1289535917759e-05_wp, 0.5217019331069e+01_wp, 0.7079373888424e+01_wp, &
      0.1281135307881e-05_wp, 0.4802054538934e+01_wp, 0.3738761453707e+01_wp, &
      0.1518229005692e-05_wp, 0.8691914742502e+00_wp, 0.2132990797783e+00_wp /
    data ((e0(i,j,1),i=1,3),j= 41, 50) / &
      0.9450128579027e-06_wp, 0.4601859529950e+01_wp, 0.1097707878456e+02_wp, &
      0.7781119494996e-06_wp, 0.1844352816694e+01_wp, 0.8827390247185e+01_wp, &
      0.7733407759912e-06_wp, 0.3582790154750e+01_wp, 0.5507553240374e+01_wp, &
      0.7350644318120e-06_wp, 0.2695277788230e+01_wp, 0.1589072916335e+01_wp, &
      0.6535928827023e-06_wp, 0.3651327986142e+01_wp, 0.1176985366291e+02_wp, &
      0.6324624183656e-06_wp, 0.2241302375862e+01_wp, 0.6262300422539e+01_wp, &
      0.6298565300557e-06_wp, 0.4407122406081e+01_wp, 0.6303851278352e+01_wp, &
      0.8587037089179e-06_wp, 0.3024307223119e+01_wp, 0.1672837615881e+03_wp, &
      0.8299954491035e-06_wp, 0.6192539428237e+01_wp, 0.3340612434717e+01_wp, &
      0.6311263503401e-06_wp, 0.2014758795416e+01_wp, 0.7113454667900e-02_wp /
    data ((e0(i,j,1),i=1,3),j= 51, 60) / &
      0.6005646745452e-06_wp, 0.3399500503397e+01_wp, 0.4136910472696e+01_wp, &
      0.7917715109929e-06_wp, 0.2493386877837e+01_wp, 0.6069776770667e+01_wp, &
      0.7556958099685e-06_wp, 0.4159491740143e+01_wp, 0.6496374930224e+01_wp, &
      0.6773228244949e-06_wp, 0.4034162934230e+01_wp, 0.9437762937313e+01_wp, &
      0.5370708577847e-06_wp, 0.1562219163734e+01_wp, 0.1194447056968e+01_wp, &
      0.5710804266203e-06_wp, 0.2662730803386e+01_wp, 0.6282095334605e+01_wp, &
      0.5709824583726e-06_wp, 0.3985828430833e+01_wp, 0.6284056366286e+01_wp, &
      0.5143950896447e-06_wp, 0.1308144688689e+01_wp, 0.6290189305114e+01_wp, &
      0.5088010604546e-06_wp, 0.5352817214804e+01_wp, 0.6275962395778e+01_wp, &
      0.4960369085172e-06_wp, 0.2644267922349e+01_wp, 0.6127655567643e+01_wp /
    data ((e0(i,j,1),i=1,3),j= 61, 70) / &
      0.4803137891183e-06_wp, 0.4008844192080e+01_wp, 0.6438496133249e+01_wp, &
      0.5731747768225e-06_wp, 0.3794550174597e+01_wp, 0.3154687086868e+01_wp, &
      0.4735947960579e-06_wp, 0.6107118308982e+01_wp, 0.3128388763578e+01_wp, &
      0.4808348796625e-06_wp, 0.4771458618163e+01_wp, 0.8018209333619e+00_wp, &
      0.4115073743137e-06_wp, 0.3327111335159e+01_wp, 0.8429241228195e+01_wp, &
      0.5230575889287e-06_wp, 0.5305708551694e+01_wp, 0.1336797263425e+02_wp, &
      0.5133977889215e-06_wp, 0.5784230738814e+01_wp, 0.1235285262111e+02_wp, &
      0.5065815825327e-06_wp, 0.2052064793679e+01_wp, 0.1185621865188e+02_wp, &
      0.4339831593868e-06_wp, 0.3644994195830e+01_wp, 0.1726015463500e+02_wp, &
      0.3952928638953e-06_wp, 0.4930376436758e+01_wp, 0.5481254917084e+01_wp /
    data ((e0(i,j,1),i=1,3),j= 71, 80) / &
      0.4898498111942e-06_wp, 0.4542084219731e+00_wp, 0.9225539266174e+01_wp, &
      0.4757490209328e-06_wp, 0.3161126388878e+01_wp, 0.5856477690889e+01_wp, &
      0.4727701669749e-06_wp, 0.6214993845446e+00_wp, 0.2544314396739e+01_wp, &
      0.3800966681863e-06_wp, 0.3040132339297e+01_wp, 0.4265981595566e+00_wp, &
      0.3257301077939e-06_wp, 0.8064977360087e+00_wp, 0.3930209696940e+01_wp, &
      0.3255810528674e-06_wp, 0.1974147981034e+01_wp, 0.2146165377750e+01_wp, &
      0.3252029748187e-06_wp, 0.2845924913135e+01_wp, 0.4164311961999e+01_wp, &
      0.3255505635308e-06_wp, 0.3017900824120e+01_wp, 0.5088628793478e+01_wp, &
      0.2801345211990e-06_wp, 0.6109717793179e+01_wp, 0.1256967486051e+02_wp, &
      0.3688987740970e-06_wp, 0.2911550235289e+01_wp, 0.1807370494127e+02_wp /
    data ((e0(i,j,1),i=1,3),j= 81, 90) / &
      0.2475153429458e-06_wp, 0.2179146025856e+01_wp, 0.2629832328990e-01_wp, &
      0.3033457749150e-06_wp, 0.1994161050744e+01_wp, 0.4535059491685e+01_wp, &
      0.2186743763110e-06_wp, 0.5125687237936e+01_wp, 0.1137170464392e+02_wp, &
      0.2764777032774e-06_wp, 0.4822646860252e+00_wp, 0.1256262854127e+02_wp, &
      0.2199028768592e-06_wp, 0.4637633293831e+01_wp, 0.1255903824622e+02_wp, &
      0.2046482824760e-06_wp, 0.1467038733093e+01_wp, 0.7084896783808e+01_wp, &
      0.2611209147507e-06_wp, 0.3044718783485e+00_wp, 0.7143069561767e+02_wp, &
      0.2286079656818e-06_wp, 0.4764220356805e+01_wp, 0.8031092209206e+01_wp, &
      0.1855071202587e-06_wp, 0.3383637774428e+01_wp, 0.1748016358760e+01_wp, &
      0.2324669506784e-06_wp, 0.6189088449251e+01_wp, 0.1831953657923e+02_wp /
    data ((e0(i,j,1),i=1,3),j= 91,100) / &
      0.1709528015688e-06_wp, 0.5874966729774e+00_wp, 0.4933208510675e+01_wp, &
      0.2168156875828e-06_wp, 0.4302994009132e+01_wp, 0.1044738781244e+02_wp, &
      0.2106675556535e-06_wp, 0.3800475419891e+01_wp, 0.7477522907414e+01_wp, &
      0.1430213830465e-06_wp, 0.1294660846502e+01_wp, 0.2942463415728e+01_wp, &
      0.1388396901944e-06_wp, 0.4594797202114e+01_wp, 0.8635942003952e+01_wp, &
      0.1922258844190e-06_wp, 0.4943044543591e+00_wp, 0.1729818233119e+02_wp, &
      0.1888460058292e-06_wp, 0.2426943912028e+01_wp, 0.1561374759853e+03_wp, &
      0.1789449386107e-06_wp, 0.1582973303499e+00_wp, 0.1592596075957e+01_wp, &
      0.1360803685374e-06_wp, 0.5197240440504e+01_wp, 0.1309584267300e+02_wp, &
      0.1504038014709e-06_wp, 0.3120360916217e+01_wp, 0.1649636139783e+02_wp /
    data ((e0(i,j,1),i=1,3),j=101,110) / &
      0.1382769533389e-06_wp, 0.6164702888205e+01_wp, 0.7632943190217e+01_wp, &
      0.1438059769079e-06_wp, 0.1437423770979e+01_wp, 0.2042657109477e+02_wp, &
      0.1326303260037e-06_wp, 0.3609688799679e+01_wp, 0.1213955354133e+02_wp, &
      0.1159244950540e-06_wp, 0.5463018167225e+01_wp, 0.5331357529664e+01_wp, &
      0.1433118149136e-06_wp, 0.6028909912097e+01_wp, 0.7342457794669e+01_wp, &
      0.1234623148594e-06_wp, 0.3109645574997e+01_wp, 0.6279485555400e+01_wp, &
      0.1233949875344e-06_wp, 0.3539359332866e+01_wp, 0.6286666145492e+01_wp, &
      0.9927196061299e-07_wp, 0.1259321569772e+01_wp, 0.7234794171227e+01_wp, &
      0.1242302191316e-06_wp, 0.1065949392609e+01_wp, 0.1511046609763e+02_wp, &
      0.1098402195201e-06_wp, 0.2192508743837e+01_wp, 0.1098880815746e+02_wp /
    data ((e0(i,j,1),i=1,3),j=111,120) / &
      0.1158191395315e-06_wp, 0.4054411278650e+01_wp, 0.5729506548653e+01_wp, &
      0.9048475596241e-07_wp, 0.5429764748518e+01_wp, 0.9623688285163e+01_wp, &
      0.8889853269023e-07_wp, 0.5046586206575e+01_wp, 0.6148010737701e+01_wp, &
      0.1048694242164e-06_wp, 0.2628858030806e+01_wp, 0.6836645152238e+01_wp, &
      0.1112308378646e-06_wp, 0.4177292719907e+01_wp, 0.1572083878776e+02_wp, &
      0.8631729709901e-07_wp, 0.1601345232557e+01_wp, 0.6418140963190e+01_wp, &
      0.8527816951664e-07_wp, 0.2463888997513e+01_wp, 0.1471231707864e+02_wp, &
      0.7892139456991e-07_wp, 0.3154022088718e+01_wp, 0.2118763888447e+01_wp, &
      0.1051782905236e-06_wp, 0.4795035816088e+01_wp, 0.1349867339771e+01_wp, &
      0.1048219943164e-06_wp, 0.2952983395230e+01_wp, 0.5999216516294e+01_wp /
    data ((e0(i,j,1),i=1,3),j=121,130) / &
      0.7435760775143e-07_wp, 0.5420547991464e+01_wp, 0.6040347114260e+01_wp, &
      0.9869574106949e-07_wp, 0.3695646753667e+01_wp, 0.6566935184597e+01_wp, &
      0.9156886364226e-07_wp, 0.3922675306609e+01_wp, 0.5643178611111e+01_wp, &
      0.7006834356188e-07_wp, 0.1233968624861e+01_wp, 0.6525804586632e+01_wp, &
      0.9806170182601e-07_wp, 0.1919542280684e+01_wp, 0.2122839202813e+02_wp, &
      0.9052289673607e-07_wp, 0.4615902724369e+01_wp, 0.4690479774488e+01_wp, &
      0.7554200867893e-07_wp, 0.1236863719072e+01_wp, 0.1253985337760e+02_wp, &
      0.8215741286498e-07_wp, 0.3286800101559e+00_wp, 0.1097355562493e+02_wp, &
      0.7185178575397e-07_wp, 0.5880942158367e+01_wp, 0.6245048154254e+01_wp, &
      0.7130726476180e-07_wp, 0.7674871987661e+00_wp, 0.6321103546637e+01_wp /
    data ((e0(i,j,1),i=1,3),j=131,140) / &
      0.6650894461162e-07_wp, 0.6987129150116e+00_wp, 0.5327476111629e+01_wp, &
      0.7396888823688e-07_wp, 0.3576824794443e+01_wp, 0.5368044267797e+00_wp, &
      0.7420588884775e-07_wp, 0.5033615245369e+01_wp, 0.2354323048545e+02_wp, &
      0.6141181642908e-07_wp, 0.9449927045673e+00_wp, 0.1296430071988e+02_wp, &
      0.6373557924058e-07_wp, 0.6206342280341e+01_wp, 0.9517183207817e+00_wp, &
      0.6359474329261e-07_wp, 0.5036079095757e+01_wp, 0.1990745094947e+01_wp, &
      0.5740173582646e-07_wp, 0.6105106371350e+01_wp, 0.9555997388169e+00_wp, &
      0.7019864084602e-07_wp, 0.7237747359018e+00_wp, 0.5225775174439e+00_wp, &
      0.6398054487042e-07_wp, 0.3976367969666e+01_wp, 0.2407292145756e+02_wp, &
      0.7797092650498e-07_wp, 0.4305423910623e+01_wp, 0.2200391463820e+02_wp /
    data ((e0(i,j,1),i=1,3),j=141,150) / &
      0.6466760000900e-07_wp, 0.3500136825200e+01_wp, 0.5230807360890e+01_wp, &
      0.7529417043890e-07_wp, 0.3514779246100e+01_wp, 0.1842262939178e+02_wp, &
      0.6924571140892e-07_wp, 0.2743457928679e+01_wp, 0.1554202828031e+00_wp, &
      0.6220798650222e-07_wp, 0.2242598118209e+01_wp, 0.1845107853235e+02_wp, &
      0.5870209391853e-07_wp, 0.2332832707527e+01_wp, 0.6398972393349e+00_wp, &
      0.6263953473888e-07_wp, 0.2191105358956e+01_wp, 0.6277552955062e+01_wp, &
      0.6257781390012e-07_wp, 0.4457559396698e+01_wp, 0.6288598745829e+01_wp, &
      0.5697304945123e-07_wp, 0.3499234761404e+01_wp, 0.1551045220144e+01_wp, &
      0.6335438746791e-07_wp, 0.6441691079251e+00_wp, 0.5216580451554e+01_wp, &
      0.6377258441152e-07_wp, 0.2252599151092e+01_wp, 0.5650292065779e+01_wp /
    data ((e0(i,j,1),i=1,3),j=151,160) / &
      0.6484841818165e-07_wp, 0.1992812417646e+01_wp, 0.1030928125552e+00_wp, &
      0.4735551485250e-07_wp, 0.3744672082942e+01_wp, 0.1431416805965e+02_wp, &
      0.4628595996170e-07_wp, 0.1334226211745e+01_wp, 0.5535693017924e+00_wp, &
      0.6258152336933e-07_wp, 0.4395836159154e+01_wp, 0.2608790314060e+02_wp, &
      0.6196171366594e-07_wp, 0.2587043007997e+01_wp, 0.8467247584405e+02_wp, &
      0.6159556952126e-07_wp, 0.4782499769128e+01_wp, 0.2394243902548e+03_wp, &
      0.4987741172394e-07_wp, 0.7312257619924e+00_wp, 0.7771377146812e+02_wp, &
      0.5459280703142e-07_wp, 0.3001376372532e+01_wp, 0.6179983037890e+01_wp, &
      0.4863461189999e-07_wp, 0.3767222128541e+01_wp, 0.9027992316901e+02_wp, &
      0.5349912093158e-07_wp, 0.3663594450273e+01_wp, 0.6386168663001e+01_wp /
    data ((e0(i,j,1),i=1,3),j=161,170) / &
      0.5673725607806e-07_wp, 0.4331187919049e+01_wp, 0.6915859635113e+01_wp, &
      0.4745485060512e-07_wp, 0.5816195745518e+01_wp, 0.6282970628506e+01_wp, &
      0.4745379005326e-07_wp, 0.8323672435672e+00_wp, 0.6283181072386e+01_wp, &
      0.4049002796321e-07_wp, 0.3785023976293e+01_wp, 0.6254626709878e+01_wp, &
      0.4247084014515e-07_wp, 0.2378220728783e+01_wp, 0.7875671926403e+01_wp, &
      0.4026912363055e-07_wp, 0.2864103423269e+01_wp, 0.6311524991013e+01_wp, &
      0.4062935011774e-07_wp, 0.2415408595975e+01_wp, 0.3634620989887e+01_wp, &
      0.5347771048509e-07_wp, 0.3343479309801e+01_wp, 0.2515860172507e+02_wp, &
      0.4829494136505e-07_wp, 0.2821742398262e+01_wp, 0.5760498333002e+01_wp, &
      0.4342554404599e-07_wp, 0.5624662458712e+01_wp, 0.7238675589263e+01_wp /
    data ((e0(i,j,1),i=1,3),j=171,180) / &
      0.4021599184361e-07_wp, 0.5557250275009e+00_wp, 0.1101510648075e+02_wp, &
      0.4104900474558e-07_wp, 0.3296691780005e+01_wp, 0.6709674010002e+01_wp, &
      0.4376532905131e-07_wp, 0.3814443999443e+01_wp, 0.6805653367890e+01_wp, &
      0.3314590480650e-07_wp, 0.3560229189250e+01_wp, 0.1259245002418e+02_wp, &
      0.3232421839643e-07_wp, 0.5185389180568e+01_wp, 0.1066495398892e+01_wp, &
      0.3541176318876e-07_wp, 0.3921381909679e+01_wp, 0.9917696840332e+01_wp, &
      0.3689831242681e-07_wp, 0.4190658955386e+01_wp, 0.1192625446156e+02_wp, &
      0.3890605376774e-07_wp, 0.5546023371097e+01_wp, 0.7478166569050e-01_wp, &
      0.3038559339780e-07_wp, 0.6231032794494e+01_wp, 0.1256621883632e+02_wp, &
      0.3137083969782e-07_wp, 0.6207063419190e+01_wp, 0.4292330755499e+01_wp /
    data ((e0(i,j,1),i=1,3),j=181,190) / &
      0.4024004081854e-07_wp, 0.1195257375713e+01_wp, 0.1334167431096e+02_wp, &
      0.3300234879283e-07_wp, 0.1804694240998e+01_wp, 0.1057540660594e+02_wp, &
      0.3635399155575e-07_wp, 0.5597811343500e+01_wp, 0.6208294184755e+01_wp, &
      0.3032668691356e-07_wp, 0.3191059366530e+01_wp, 0.1805292951336e+02_wp, &
      0.2809652069058e-07_wp, 0.4094348032570e+01_wp, 0.3523159621801e-02_wp, &
      0.3696955383823e-07_wp, 0.5219282738794e+01_wp, 0.5966683958112e+01_wp, &
      0.3562894142503e-07_wp, 0.1037247544554e+01_wp, 0.6357857516136e+01_wp, &
      0.3510598524148e-07_wp, 0.1430020816116e+01_wp, 0.6599467742779e+01_wp, &
      0.3617736142953e-07_wp, 0.3002911403677e+01_wp, 0.6019991944201e+01_wp, &
      0.2624524910730e-07_wp, 0.2437046757292e+01_wp, 0.6702560555334e+01_wp /
    data ((e0(i,j,1),i=1,3),j=191,200) / &
      0.2535824204490e-07_wp, 0.1581594689647e+01_wp, 0.3141537925223e+02_wp, &
      0.3519787226257e-07_wp, 0.5379863121521e+01_wp, 0.2505706758577e+03_wp, &
      0.2578406709982e-07_wp, 0.4904222639329e+01_wp, 0.1673046366289e+02_wp, &
      0.3423887981473e-07_wp, 0.3646448997315e+01_wp, 0.6546159756691e+01_wp, &
      0.2776083886467e-07_wp, 0.3307829300144e+01_wp, 0.1272157198369e+02_wp, &
      0.3379592818379e-07_wp, 0.1747541251125e+01_wp, 0.1494531617769e+02_wp, &
      0.3050255426284e-07_wp, 0.1784689432607e-01_wp, 0.4732030630302e+01_wp, &
      0.2652378350236e-07_wp, 0.4420055276260e+01_wp, 0.5863591145557e+01_wp, &
      0.2374498173768e-07_wp, 0.3629773929208e+01_wp, 0.2388894113936e+01_wp, &
      0.2716451255140e-07_wp, 0.3079623706780e+01_wp, 0.1202934727411e+02_wp /
    data ((e0(i,j,1),i=1,3),j=201,210) / &
      0.3038583699229e-07_wp, 0.3312487903507e+00_wp, 0.1256608456547e+02_wp, &
      0.2220681228760e-07_wp, 0.5265520401774e+01_wp, 0.1336244973887e+02_wp, &
      0.3044156540912e-07_wp, 0.4766664081250e+01_wp, 0.2908881142201e+02_wp, &
      0.2731859923561e-07_wp, 0.5069146530691e+01_wp, 0.1391601904066e+02_wp, &
      0.2285603018171e-07_wp, 0.5954935112271e+01_wp, 0.6076890225335e+01_wp, &
      0.2025006454555e-07_wp, 0.4061789589267e+01_wp, 0.4701116388778e+01_wp, &
      0.2012597519804e-07_wp, 0.2485047705241e+01_wp, 0.6262720680387e+01_wp, &
      0.2003406962258e-07_wp, 0.4163779209320e+01_wp, 0.6303431020504e+01_wp, &
      0.2207863441371e-07_wp, 0.6923839133828e+00_wp, 0.6489261475556e+01_wp, &
      0.2481374305624e-07_wp, 0.5944173595676e+01_wp, 0.1204357418345e+02_wp /
    data ((e0(i,j,1),i=1,3),j=211,220) / &
      0.2130923288870e-07_wp, 0.4641013671967e+01_wp, 0.5746271423666e+01_wp, &
      0.2446370543391e-07_wp, 0.6125796518757e+01_wp, 0.1495633313810e+00_wp, &
      0.1932492759052e-07_wp, 0.2234572324504e+00_wp, 0.1352175143971e+02_wp, &
      0.2600122568049e-07_wp, 0.4281012405440e+01_wp, 0.4590910121555e+01_wp, &
      0.2431754047488e-07_wp, 0.1429943874870e+00_wp, 0.1162474756779e+01_wp, &
      0.1875902869209e-07_wp, 0.9781803816948e+00_wp, 0.6279194432410e+01_wp, &
      0.1874381139426e-07_wp, 0.5670368130173e+01_wp, 0.6286957268481e+01_wp, &
      0.2156696047173e-07_wp, 0.2008985006833e+01_wp, 0.1813929450232e+02_wp, &
      0.1965076182484e-07_wp, 0.2566186202453e+00_wp, 0.4686889479442e+01_wp, &
      0.2334816372359e-07_wp, 0.4408121891493e+01_wp, 0.1002183730415e+02_wp /
    data ((e0(i,j,1),i=1,3),j=221,230) / &
      0.1869937408802e-07_wp, 0.5272745038656e+01_wp, 0.2427287361862e+00_wp, &
      0.2436236460883e-07_wp, 0.4407720479029e+01_wp, 0.9514313292143e+02_wp, &
      0.1761365216611e-07_wp, 0.1943892315074e+00_wp, 0.1351787002167e+02_wp, &
      0.2156289480503e-07_wp, 0.1418570924545e+01_wp, 0.6037244212485e+01_wp, &
      0.2164748979255e-07_wp, 0.4724603439430e+01_wp, 0.2301353951334e+02_wp, &
      0.2222286670853e-07_wp, 0.2400266874598e+01_wp, 0.1266924451345e+02_wp, &
      0.2070901414929e-07_wp, 0.5230348028732e+01_wp, 0.6528907488406e+01_wp, &
      0.1792745177020e-07_wp, 0.2099190328945e+01_wp, 0.6819880277225e+01_wp, &
      0.1841802068445e-07_wp, 0.3467527844848e+00_wp, 0.6514761976723e+02_wp, &
      0.1578401631718e-07_wp, 0.7098642356340e+00_wp, 0.2077542790660e-01_wp /
    data ((e0(i,j,1),i=1,3),j=231,240) / &
      0.1561690152531e-07_wp, 0.5943349620372e+01_wp, 0.6272439236156e+01_wp, &
      0.1558591045463e-07_wp, 0.7040653478980e+00_wp, 0.6293712464735e+01_wp, &
      0.1737356469576e-07_wp, 0.4487064760345e+01_wp, 0.1765478049437e+02_wp, &
      0.1434755619991e-07_wp, 0.2993391570995e+01_wp, 0.1102062672231e+00_wp, &
      0.1482187806654e-07_wp, 0.2278049198251e+01_wp, 0.1052268489556e+01_wp, &
      0.1424812827089e-07_wp, 0.1682114725827e+01_wp, 0.1311972100268e+02_wp, &
      0.1380282448623e-07_wp, 0.3262668602579e+01_wp, 0.1017725758696e+02_wp, &
      0.1811481244566e-07_wp, 0.3187771221777e+01_wp, 0.1887552587463e+02_wp, &
      0.1504446185696e-07_wp, 0.5650162308647e+01_wp, 0.7626583626240e-01_wp, &
      0.1740776154137e-07_wp, 0.5487068607507e+01_wp, 0.1965104848470e+02_wp /
    data ((e0(i,j,1),i=1,3),j=241,250) / &
      0.1374339536251e-07_wp, 0.5745688172201e+01_wp, 0.6016468784579e+01_wp, &
      0.1761377477704e-07_wp, 0.5748060203659e+01_wp, 0.2593412433514e+02_wp, &
      0.1535138225795e-07_wp, 0.6226848505790e+01_wp, 0.9411464614024e+01_wp, &
      0.1788140543676e-07_wp, 0.6189318878563e+01_wp, 0.3301902111895e+02_wp, &
      0.1375002807996e-07_wp, 0.5371812884394e+01_wp, 0.6327837846670e+00_wp, &
      0.1242115758632e-07_wp, 0.1471687569712e+01_wp, 0.3894181736510e+01_wp, &
      0.1450977333938e-07_wp, 0.4143836662127e+01_wp, 0.1277945078067e+02_wp, &
      0.1297579575023e-07_wp, 0.9003477661957e+00_wp, 0.6549682916313e+01_wp, &
      0.1462667934821e-07_wp, 0.5760505536428e+01_wp, 0.1863592847156e+02_wp, &
      0.1381774374799e-07_wp, 0.1085471729463e+01_wp, 0.2379164476796e+01_wp /
    data ((e0(i,j,1),i=1,3),j=251,260) / &
      0.1682333169307e-07_wp, 0.5409870870133e+01_wp, 0.1620077269078e+02_wp, &
      0.1190812918837e-07_wp, 0.1397205174601e+01_wp, 0.1149965630200e+02_wp, &
      0.1221434762106e-07_wp, 0.9001804809095e+00_wp, 0.1257326515556e+02_wp, &
      0.1549934644860e-07_wp, 0.4262528275544e+01_wp, 0.1820933031200e+02_wp, &
      0.1252138953050e-07_wp, 0.1411642012027e+01_wp, 0.6993008899458e+01_wp, &
      0.1237078905387e-07_wp, 0.2844472403615e+01_wp, 0.2435678079171e+02_wp, &
      0.1446953389615e-07_wp, 0.5295835522223e+01_wp, 0.3813291813120e-01_wp, &
      0.1388446457170e-07_wp, 0.4969428135497e+01_wp, 0.2458316379602e+00_wp, &
      0.1019339179228e-07_wp, 0.2491369561806e+01_wp, 0.6112403035119e+01_wp, &
      0.1258880815343e-07_wp, 0.4679426248976e+01_wp, 0.5429879531333e+01_wp /
    data ((e0(i,j,1),i=1,3),j=261,270) / &
      0.1297768238261e-07_wp, 0.1074509953328e+01_wp, 0.1249137003520e+02_wp, &
      0.9913505718094e-08_wp, 0.4735097918224e+01_wp, 0.6247047890016e+01_wp, &
      0.9830453155969e-08_wp, 0.4158649187338e+01_wp, 0.6453748665772e+01_wp, &
      0.1192615865309e-07_wp, 0.3438208613699e+01_wp, 0.6290122169689e+01_wp, &
      0.9835874798277e-08_wp, 0.1913300781229e+01_wp, 0.6319103810876e+01_wp, &
      0.9639087569277e-08_wp, 0.9487683644125e+00_wp, 0.8273820945392e+01_wp, &
      0.1175716107001e-07_wp, 0.3228141664287e+01_wp, 0.6276029531202e+01_wp, &
      0.1018926508678e-07_wp, 0.2216607854300e+01_wp, 0.1254537627298e+02_wp, &
      0.9500087869225e-08_wp, 0.2625116459733e+01_wp, 0.1256517118505e+02_wp, &
      0.9664192916575e-08_wp, 0.5860562449214e+01_wp, 0.6259197520765e+01_wp /
    data ((e0(i,j,1),i=1,3),j=271,280) / &
      0.9612858712203e-08_wp, 0.7885682917381e+00_wp, 0.6306954180126e+01_wp, &
      0.1117645675413e-07_wp, 0.3932148831189e+01_wp, 0.1779695906178e+02_wp, &
      0.1158864052160e-07_wp, 0.9995605521691e+00_wp, 0.1778273215245e+02_wp, &
      0.9021043467028e-08_wp, 0.5263769742673e+01_wp, 0.6172869583223e+01_wp, &
      0.8836134773563e-08_wp, 0.1496843220365e+01_wp, 0.1692165728891e+01_wp, &
      0.1045872200691e-07_wp, 0.7009039517214e+00_wp, 0.2204125344462e+00_wp, &
      0.1211463487798e-07_wp, 0.4041544938511e+01_wp, 0.8257698122054e+02_wp, &
      0.8541990804094e-08_wp, 0.1447586692316e+01_wp, 0.6393282117669e+01_wp, &
      0.1038720703636e-07_wp, 0.4594249718112e+00_wp, 0.1550861511662e+02_wp, &
      0.1126722351445e-07_wp, 0.3925550579036e+01_wp, 0.2061856251104e+00_wp /
    data ((e0(i,j,1),i=1,3),j=281,290) / &
      0.8697373859631e-08_wp, 0.4411341856037e+01_wp, 0.9491756770005e+00_wp, &
      0.8869380028441e-08_wp, 0.2402659724813e+01_wp, 0.3903911373650e+01_wp, &
      0.9247014693258e-08_wp, 0.1401579743423e+01_wp, 0.6267823317922e+01_wp, &
      0.9205062930950e-08_wp, 0.5245978000814e+01_wp, 0.6298328382969e+01_wp, &
      0.8000745038049e-08_wp, 0.3590803356945e+01_wp, 0.2648454860559e+01_wp, &
      0.9168973650819e-08_wp, 0.2470150501679e+01_wp, 0.1498544001348e+03_wp, &
      0.1075444949238e-07_wp, 0.1328606161230e+01_wp, 0.3694923081589e+02_wp, &
      0.7817298525817e-08_wp, 0.6162256225998e+01_wp, 0.4804209201333e+01_wp, &
      0.9541469226356e-08_wp, 0.3942568967039e+01_wp, 0.1256713221673e+02_wp, &
      0.9821910122027e-08_wp, 0.2360246287233e+00_wp, 0.1140367694411e+02_wp /
    data ((e0(i,j,1),i=1,3),j=291,300) / &
      0.9897822023777e-08_wp, 0.4619805634280e+01_wp, 0.2280573557157e+02_wp, &
      0.7737289283765e-08_wp, 0.3784727847451e+01_wp, 0.7834121070590e+01_wp, &
      0.9260204034710e-08_wp, 0.2223352487601e+01_wp, 0.2787043132925e+01_wp, &
      0.7320252888486e-08_wp, 0.1288694636874e+01_wp, 0.6282655592598e+01_wp, &
      0.7319785780946e-08_wp, 0.5359869567774e+01_wp, 0.6283496108294e+01_wp, &
      0.7147219933778e-08_wp, 0.5516616675856e+01_wp, 0.1725663147538e+02_wp, &
      0.7946502829878e-08_wp, 0.2630459984567e+01_wp, 0.1241073141809e+02_wp, &
      0.9001711808932e-08_wp, 0.2849815827227e+01_wp, 0.6281591679874e+01_wp, &
      0.8994041507257e-08_wp, 0.3795244450750e+01_wp, 0.6284560021018e+01_wp, &
      0.8298582787358e-08_wp, 0.5236413127363e+00_wp, 0.1241658836951e+02_wp /
    data ((e0(i,j,1),i=1,3),j=301,310) / &
      0.8526596520710e-08_wp, 0.4794605424426e+01_wp, 0.1098419223922e+02_wp, &
      0.8209822103197e-08_wp, 0.1578752370328e+01_wp, 0.1096996532989e+02_wp, &
      0.6357049861094e-08_wp, 0.5708926113761e+01_wp, 0.1596186371003e+01_wp, &
      0.7370473179049e-08_wp, 0.3842402530241e+01_wp, 0.4061219149443e+01_wp, &
      0.7232154664726e-08_wp, 0.3067548981535e+01_wp, 0.1610006857377e+03_wp, &
      0.6328765494903e-08_wp, 0.1313930030069e+01_wp, 0.1193336791622e+02_wp, &
      0.8030064908595e-08_wp, 0.3488500408886e+01_wp, 0.8460828644453e+00_wp, &
      0.6275464259232e-08_wp, 0.1532061626198e+01_wp, 0.8531963191132e+00_wp, &
      0.7051897446325e-08_wp, 0.3285859929993e+01_wp, 0.5849364236221e+01_wp, &
      0.6161593705428e-08_wp, 0.1477341999464e+01_wp, 0.5573142801433e+01_wp /
    data ((e0(i,j,1),i=1,3),j=311,320) / &
      0.7754683957278e-08_wp, 0.1586118663096e+01_wp, 0.8662240327241e+01_wp, &
      0.5889928990701e-08_wp, 0.1304887868803e+01_wp, 0.1232342296471e+02_wp, &
      0.5705756047075e-08_wp, 0.4555333589350e+01_wp, 0.1258692712880e+02_wp, &
      0.5964178808332e-08_wp, 0.3001762842062e+01_wp, 0.5333900173445e+01_wp, &
      0.6712446027467e-08_wp, 0.4886780007595e+01_wp, 0.1171295538178e+02_wp, &
      0.5941809275464e-08_wp, 0.4701509603824e+01_wp, 0.9779108567966e+01_wp, &
      0.5466993627395e-08_wp, 0.4588357817278e+01_wp, 0.1884211409667e+02_wp, &
      0.6340512090980e-08_wp, 0.1164543038893e+01_wp, 0.5217580628120e+02_wp, &
      0.6325505710045e-08_wp, 0.3919171259645e+01_wp, 0.1041998632314e+02_wp, &
      0.6164789509685e-08_wp, 0.2143828253542e+01_wp, 0.6151533897323e+01_wp /
    data ((e0(i,j,1),i=1,3),j=321,330) / &
      0.5263330812430e-08_wp, 0.6066564434241e+01_wp, 0.1885275071096e+02_wp, &
      0.5597087780221e-08_wp, 0.2926316429472e+01_wp, 0.4337116142245e+00_wp, &
      0.5396556236817e-08_wp, 0.3244303591505e+01_wp, 0.6286362197481e+01_wp, &
      0.5396615148223e-08_wp, 0.3404304703662e+01_wp, 0.6279789503410e+01_wp, &
      0.7091832443341e-08_wp, 0.8532377803192e+00_wp, 0.4907302013889e+01_wp, &
      0.6572352589782e-08_wp, 0.4901966774419e+01_wp, 0.1176433076753e+02_wp, &
      0.5960236060795e-08_wp, 0.1874672315797e+01_wp, 0.1422690933580e-01_wp, &
      0.5125480043511e-08_wp, 0.3735726064334e+01_wp, 0.1245594543367e+02_wp, &
      0.5928241866410e-08_wp, 0.4502033899935e+01_wp, 0.6414617803568e+01_wp, &
      0.5249600357424e-08_wp, 0.4372334799878e+01_wp, 0.1151388321134e+02_wp /
    data ((e0(i,j,1),i=1,3),j=331,340) / &
      0.6059171276087e-08_wp, 0.2581617302908e+01_wp, 0.6062663316000e+01_wp, &
      0.5295235081662e-08_wp, 0.2974811513158e+01_wp, 0.3496032717521e+01_wp, &
      0.5820561875933e-08_wp, 0.1796073748244e+00_wp, 0.2838593341516e+00_wp, &
      0.4754696606440e-08_wp, 0.1981998136973e+01_wp, 0.3104930017775e+01_wp, &
      0.6385053548955e-08_wp, 0.2559174171605e+00_wp, 0.6133512519065e+01_wp, &
      0.6589828273941e-08_wp, 0.2750967106776e+01_wp, 0.4087944051283e+02_wp, &
      0.5383376567189e-08_wp, 0.6325947523578e+00_wp, 0.2248384854122e+02_wp, &
      0.5928941683538e-08_wp, 0.1672304519067e+01_wp, 0.1581959461667e+01_wp, &
      0.4816060709794e-08_wp, 0.3512566172575e+01_wp, 0.9388005868221e+01_wp, &
      0.6003381586512e-08_wp, 0.5610932219189e+01_wp, 0.5326786718777e+01_wp /
    data ((e0(i,j,1),i=1,3),j=341,350) / &
      0.5504225393105e-08_wp, 0.4037501131256e+01_wp, 0.6503488384892e+01_wp, &
      0.5353772620129e-08_wp, 0.6122774968240e+01_wp, 0.1735668374386e+03_wp, &
      0.5786253768544e-08_wp, 0.5527984999515e+01_wp, 0.1350651127443e+00_wp, &
      0.5065706702002e-08_wp, 0.9980765573624e+00_wp, 0.1248988586463e+02_wp, &
      0.5972838885276e-08_wp, 0.6044489493203e+01_wp, 0.2673594526851e+02_wp, &
      0.5323585877961e-08_wp, 0.3924265998147e+01_wp, 0.4171425416666e+01_wp, &
      0.5210772682858e-08_wp, 0.6220111376901e+01_wp, 0.2460261242967e+02_wp, &
      0.4726549040535e-08_wp, 0.3716043206862e+01_wp, 0.7232251527446e+01_wp, &
      0.6029425105059e-08_wp, 0.8548704071116e+00_wp, 0.3227113045244e+03_wp, &
      0.4481542826513e-08_wp, 0.1426925072829e+01_wp, 0.5547199253223e+01_wp /
    data ((e0(i,j,1),i=1,3),j=351,360) / &
      0.5836024505068e-08_wp, 0.7135651752625e-01_wp, 0.7285056171570e+02_wp, &
      0.4137046613272e-08_wp, 0.5330767643283e+01_wp, 0.1087398597200e+02_wp, &
      0.5171977473924e-08_wp, 0.4494262335353e+00_wp, 0.1884570439172e+02_wp, &
      0.5694429833732e-08_wp, 0.2952369582215e+01_wp, 0.9723862754494e+02_wp, &
      0.4009158925298e-08_wp, 0.3500003416535e+01_wp, 0.6244942932314e+01_wp, &
      0.4784939596873e-08_wp, 0.6196709413181e+01_wp, 0.2929661536378e+02_wp, &
      0.3983725022610e-08_wp, 0.5103690031897e+01_wp, 0.4274518229222e+01_wp, &
      0.3870535232462e-08_wp, 0.3187569587401e+01_wp, 0.6321208768577e+01_wp, &
      0.5140501213951e-08_wp, 0.1668924357457e+01_wp, 0.1232032006293e+02_wp, &
      0.3849034819355e-08_wp, 0.4445722510309e+01_wp, 0.1726726808967e+02_wp /
    data ((e0(i,j,1),i=1,3),j=361,370) / &
      0.4002383075060e-08_wp, 0.5226224152423e+01_wp, 0.7018952447668e+01_wp, &
      0.3890719543549e-08_wp, 0.4371166550274e+01_wp, 0.1491901785440e+02_wp, &
      0.4887084607881e-08_wp, 0.5973556689693e+01_wp, 0.1478866649112e+01_wp, &
      0.3739939287592e-08_wp, 0.2089084714600e+01_wp, 0.6922973089781e+01_wp, &
      0.5031925918209e-08_wp, 0.4658371936827e+01_wp, 0.1715706182245e+02_wp, &
      0.4387748764954e-08_wp, 0.4825580552819e+01_wp, 0.2331413144044e+03_wp, &
      0.4147398098865e-08_wp, 0.3739003524998e+01_wp, 0.1376059875786e+02_wp, &
      0.3719089993586e-08_wp, 0.1148941386536e+01_wp, 0.6297302759782e+01_wp, &
      0.3934238461056e-08_wp, 0.1559893008343e+01_wp, 0.7872148766781e+01_wp, &
      0.3672471375622e-08_wp, 0.5516145383612e+01_wp, 0.6268848941110e+01_wp /
    data ((e0(i,j,1),i=1,3),j=371,380) / &
      0.3768911277583e-08_wp, 0.6116053700563e+01_wp, 0.4157198507331e+01_wp, &
      0.4033388417295e-08_wp, 0.5076821746017e+01_wp, 0.1567108171867e+02_wp, &
      0.3764194617832e-08_wp, 0.8164676232075e+00_wp, 0.3185192151914e+01_wp, &
      0.4840628226284e-08_wp, 0.1360479453671e+01_wp, 0.1252801878276e+02_wp, &
      0.4949443923785e-08_wp, 0.2725622229926e+01_wp, 0.1617106187867e+03_wp, &
      0.4117393089971e-08_wp, 0.6054459628492e+00_wp, 0.5642198095270e+01_wp, &
      0.3925754020428e-08_wp, 0.8570462135210e+00_wp, 0.2139354194808e+02_wp, &
      0.3630551757923e-08_wp, 0.3552067338279e+01_wp, 0.6294805223347e+01_wp, &
      0.3627274802357e-08_wp, 0.3096565085313e+01_wp, 0.6271346477544e+01_wp, &
      0.3806143885093e-08_wp, 0.6367751709777e+00_wp, 0.1725304118033e+02_wp /
    data ((e0(i,j,1),i=1,3),j=381,390) / &
      0.4433254641565e-08_wp, 0.4848461503937e+01_wp, 0.7445550607224e+01_wp, &
      0.3712319846576e-08_wp, 0.1331950643655e+01_wp, 0.4194847048887e+00_wp, &
      0.3849847534783e-08_wp, 0.4958368297746e+00_wp, 0.9562891316684e+00_wp, &
      0.3483955430165e-08_wp, 0.2237215515707e+01_wp, 0.1161697602389e+02_wp, &
      0.3961912730982e-08_wp, 0.3332402188575e+01_wp, 0.2277943724828e+02_wp, &
      0.3419978244481e-08_wp, 0.5785600576016e+01_wp, 0.1362553364512e+02_wp, &
      0.3329417758177e-08_wp, 0.9812676559709e-01_wp, 0.1685848245639e+02_wp, &
      0.4207206893193e-08_wp, 0.9494780468236e+00_wp, 0.2986433403208e+02_wp, &
      0.3268548976410e-08_wp, 0.1739332095686e+00_wp, 0.5749861718712e+01_wp, &
      0.3321880082685e-08_wp, 0.1423354800666e+01_wp, 0.6279143387820e+01_wp /
    data ((e0(i,j,1),i=1,3),j=391,400) / &
      0.4503173010852e-08_wp, 0.2314972675293e+00_wp, 0.1385561574497e+01_wp, &
      0.4316599090954e-08_wp, 0.1012646782616e+00_wp, 0.4176041334900e+01_wp, &
      0.3283493323850e-08_wp, 0.5233306881265e+01_wp, 0.6287008313071e+01_wp, &
      0.3164033542343e-08_wp, 0.4005597257511e+01_wp, 0.2099539292909e+02_wp, &
      0.4159720956725e-08_wp, 0.5365676242020e+01_wp, 0.5905702259363e+01_wp, &
      0.3565176892217e-08_wp, 0.4284440620612e+01_wp, 0.3932462625300e-02_wp, &
      0.3514440950221e-08_wp, 0.4270562636575e+01_wp, 0.7335344340001e+01_wp, &
      0.3540596871909e-08_wp, 0.5953553201060e+01_wp, 0.1234573916645e+02_wp, &
      0.2960769905118e-08_wp, 0.1115180417718e+01_wp, 0.2670964694522e+02_wp, &
      0.2962213739684e-08_wp, 0.3863811918186e+01_wp, 0.6408777551755e+00_wp /
    data ((e0(i,j,1),i=1,3),j=401,410) / &
      0.3883556700251e-08_wp, 0.1268617928302e+01_wp, 0.6660449441528e+01_wp, &
      0.2919225516346e-08_wp, 0.4908605223265e+01_wp, 0.1375773836557e+01_wp, &
      0.3115158863370e-08_wp, 0.3744519976885e+01_wp, 0.3802769619140e-01_wp, &
      0.4099438144212e-08_wp, 0.4173244670532e+01_wp, 0.4480965020977e+02_wp, &
      0.2899531858964e-08_wp, 0.5910601428850e+01_wp, 0.2059724391010e+02_wp, &
      0.3289733429855e-08_wp, 0.2488050078239e+01_wp, 0.1081813534213e+02_wp, &
      0.3933075612875e-08_wp, 0.1122363652883e+01_wp, 0.3773735910827e+00_wp, &
      0.3021403764467e-08_wp, 0.4951973724904e+01_wp, 0.2982630633589e+02_wp, &
      0.2798598949757e-08_wp, 0.5117057845513e+01_wp, 0.1937891852345e+02_wp, &
      0.3397421302707e-08_wp, 0.6104159180476e+01_wp, 0.6923953605621e+01_wp /
    data ((e0(i,j,1),i=1,3),j=411,420) / &
      0.3720398002179e-08_wp, 0.1184933429829e+01_wp, 0.3066615496545e+02_wp, &
      0.3598484186267e-08_wp, 0.3505282086105e+01_wp, 0.6147450479709e+01_wp, &
      0.3694594027310e-08_wp, 0.2286651088141e+01_wp, 0.2636725487657e+01_wp, &
      0.2680444152969e-08_wp, 0.1871816775482e+00_wp, 0.6816289982179e+01_wp, &
      0.3497574865641e-08_wp, 0.3143251755431e+01_wp, 0.6418701221183e+01_wp, &
      0.3130274129494e-08_wp, 0.2462167316018e+01_wp, 0.1235996607578e+02_wp, &
      0.3241119069551e-08_wp, 0.4256374004686e+01_wp, 0.1652265972112e+02_wp, &
      0.2601960842061e-08_wp, 0.4970362941425e+01_wp, 0.1045450126711e+02_wp, &
      0.2690601527504e-08_wp, 0.2372657824898e+01_wp, 0.3163918923335e+00_wp, &
      0.2908688152664e-08_wp, 0.4232652627721e+01_wp, 0.2828699048865e+02_wp /
    data ((e0(i,j,1),i=1,3),j=421,430) / &
      0.3120456131875e-08_wp, 0.3925747001137e+00_wp, 0.2195415756911e+02_wp, &
      0.3148855423384e-08_wp, 0.3093478330445e+01_wp, 0.1172006883645e+02_wp, &
      0.3051044261017e-08_wp, 0.5560948248212e+01_wp, 0.6055599646783e+01_wp, &
      0.2826006876660e-08_wp, 0.5072790310072e+01_wp, 0.5120601093667e+01_wp, &
      0.3100034191711e-08_wp, 0.4998530231096e+01_wp, 0.1799603123222e+02_wp, &
      0.2398771640101e-08_wp, 0.2561739802176e+01_wp, 0.6255674361143e+01_wp, &
      0.2384002842728e-08_wp, 0.4087420284111e+01_wp, 0.6310477339748e+01_wp, &
      0.2842146517568e-08_wp, 0.2515048217955e+01_wp, 0.5469525544182e+01_wp, &
      0.2847674371340e-08_wp, 0.5235326497443e+01_wp, 0.1034429499989e+02_wp, &
      0.2903722140764e-08_wp, 0.1088200795797e+01_wp, 0.6510552054109e+01_wp /
    data ((e0(i,j,1),i=1,3),j=431,440) / &
      0.3187610710605e-08_wp, 0.4710624424816e+01_wp, 0.1693792562116e+03_wp, &
      0.3048869992813e-08_wp, 0.2857975896445e+00_wp, 0.8390110365991e+01_wp, &
      0.2860216950984e-08_wp, 0.2241619020815e+01_wp, 0.2243449970715e+00_wp, &
      0.2701117683113e-08_wp, 0.6651573305272e-01_wp, 0.6129297044991e+01_wp, &
      0.2509891590152e-08_wp, 0.1285135324585e+01_wp, 0.1044027435778e+02_wp, &
      0.2623200252223e-08_wp, 0.2981229834530e+00_wp, 0.6436854655901e+01_wp, &
      0.2622541669202e-08_wp, 0.6122470726189e+01_wp, 0.9380959548977e+01_wp, &
      0.2818435667099e-08_wp, 0.4251087148947e+01_wp, 0.5934151399930e+01_wp, &
      0.2365196797465e-08_wp, 0.3465070460790e+01_wp, 0.2470570524223e+02_wp, &
      0.2358704646143e-08_wp, 0.5791603815350e+01_wp, 0.8671969964381e+01_wp /
    data ((e0(i,j,1),i=1,3),j=441,450) / &
      0.2388299481390e-08_wp, 0.4142483772941e+01_wp, 0.7096626156709e+01_wp, &
      0.1996041217224e-08_wp, 0.2101901889496e+01_wp, 0.1727188400790e+02_wp, &
      0.2687593060336e-08_wp, 0.1526689456959e+01_wp, 0.7075506709219e+02_wp, &
      0.2618913670810e-08_wp, 0.2397684236095e+01_wp, 0.6632000300961e+01_wp, &
      0.2571523050364e-08_wp, 0.5751929456787e+00_wp, 0.6206810014183e+01_wp, &
      0.2582135006946e-08_wp, 0.5595464352926e+01_wp, 0.4873985990671e+02_wp, &
      0.2372530190361e-08_wp, 0.5092689490655e+01_wp, 0.1590676413561e+02_wp, &
      0.2357178484712e-08_wp, 0.4444363527851e+01_wp, 0.3097883698531e+01_wp, &
      0.2451590394723e-08_wp, 0.3108251687661e+01_wp, 0.6612329252343e+00_wp, &
      0.2370045949608e-08_wp, 0.2608133861079e+01_wp, 0.3459636466239e+02_wp /
    data ((e0(i,j,1),i=1,3),j=451,460) / &
      0.2268997267358e-08_wp, 0.3639717753384e+01_wp, 0.2844914056730e-01_wp, &
      0.1731432137906e-08_wp, 0.1741898445707e+00_wp, 0.2019909489111e+02_wp, &
      0.1629869741622e-08_wp, 0.3902225646724e+01_wp, 0.3035599730800e+02_wp, &
      0.2206215801974e-08_wp, 0.4971131250731e+01_wp, 0.6281667977667e+01_wp, &
      0.2205469554680e-08_wp, 0.1677462357110e+01_wp, 0.6284483723224e+01_wp, &
      0.2148792362509e-08_wp, 0.4236259604006e+01_wp, 0.1980482729015e+02_wp, &
      0.1873733657847e-08_wp, 0.5926814998687e+01_wp, 0.2876692439167e+02_wp, &
      0.2026573758959e-08_wp, 0.4349643351962e+01_wp, 0.2449240616245e+02_wp, &
      0.1807770325110e-08_wp, 0.5700940482701e+01_wp, 0.2045286941806e+02_wp, &
      0.1881174408581e-08_wp, 0.6601286363430e+00_wp, 0.2358125818164e+02_wp /
    data ((e0(i,j,1),i=1,3),j=461,470) / &
      0.1368023671690e-08_wp, 0.2211098592752e+01_wp, 0.2473415438279e+02_wp, &
      0.1720017916280e-08_wp, 0.4942488551129e+01_wp, 0.1679593901136e+03_wp, &
      0.1702427665131e-08_wp, 0.1452233856386e+01_wp, 0.3338575901272e+03_wp, &
      0.1414032510054e-08_wp, 0.5525357721439e+01_wp, 0.1624205518357e+03_wp, &
      0.1652626045364e-08_wp, 0.4108794283624e+01_wp, 0.8956999012000e+02_wp, &
      0.1642957769686e-08_wp, 0.7344335209984e+00_wp, 0.5267006960365e+02_wp, &
      0.1614952403624e-08_wp, 0.3541213951363e+01_wp, 0.3332657872986e+02_wp, &
      0.1535988291188e-08_wp, 0.4031094072151e+01_wp, 0.3852657435933e+02_wp, &
      0.1593193738177e-08_wp, 0.4185136203609e+01_wp, 0.2282781046519e+03_wp, &
      0.1074569126382e-08_wp, 0.1720485636868e+01_wp, 0.8397383534231e+02_wp /
    data ((e0(i,j,1),i=1,3),j=471,480) / &
      0.1074408214509e-08_wp, 0.2758613420318e+01_wp, 0.8401985929482e+02_wp, &
      0.9700199670465e-09_wp, 0.4216686842097e+01_wp, 0.7826370942180e+02_wp, &
      0.1258433517061e-08_wp, 0.2575068876639e+00_wp, 0.3115650189215e+03_wp, &
      0.1240303229539e-08_wp, 0.4800844956756e+00_wp, 0.1784300471910e+03_wp, &
      0.9018345948127e-09_wp, 0.3896756361552e+00_wp, 0.5886454391678e+02_wp, &
      0.1135301432805e-08_wp, 0.3700805023550e+00_wp, 0.7842370451713e+02_wp, &
      0.9215887951370e-09_wp, 0.4364579276638e+01_wp, 0.1014262087719e+03_wp, &
      0.1055401054147e-08_wp, 0.2156564222111e+01_wp, 0.5660027930059e+02_wp, &
      0.1008725979831e-08_wp, 0.5454015785234e+01_wp, 0.4245678405627e+02_wp, &
      0.7217398104321e-09_wp, 0.1597772562175e+01_wp, 0.2457074661053e+03_wp /
    data ((e0(i,j,1),i=1,3),j=481,490) / &
      0.6912033134447e-09_wp, 0.5824090621461e+01_wp, 0.1679936946371e+03_wp, &
      0.6833881523549e-09_wp, 0.3578778482835e+01_wp, 0.6053048899753e+02_wp, &
      0.4887304205142e-09_wp, 0.3724362812423e+01_wp, 0.9656299901946e+02_wp, &
      0.5173709754788e-09_wp, 0.5422427507933e+01_wp, 0.2442876000072e+03_wp, &
      0.4671353097145e-09_wp, 0.2396106924439e+01_wp, 0.1435713242844e+03_wp, &
      0.5652608439480e-09_wp, 0.2804028838685e+01_wp, 0.8365903305582e+02_wp, &
      0.5604061331253e-09_wp, 0.1638816006247e+01_wp, 0.8433466158131e+02_wp, &
      0.4712723365400e-09_wp, 0.8979003224474e+00_wp, 0.3164282286739e+03_wp, &
      0.4909967465112e-09_wp, 0.3210426725516e+01_wp, 0.4059982187939e+03_wp, &
      0.4771358267658e-09_wp, 0.5308027211629e+01_wp, 0.1805255418145e+03_wp /
    data ((e0(i,j,1),i=1,3),j=491,500) / &
      0.3943451445989e-09_wp, 0.2195145341074e+01_wp, 0.2568537517081e+03_wp, &
      0.3952109120244e-09_wp, 0.5081189491586e+01_wp, 0.2449975330562e+03_wp, &
      0.3788134594789e-09_wp, 0.4345171264441e+01_wp, 0.1568131045107e+03_wp, &
      0.3738330190479e-09_wp, 0.2613062847997e+01_wp, 0.3948519331910e+03_wp, &
      0.3099866678136e-09_wp, 0.2846760817689e+01_wp, 0.1547176098872e+03_wp, &
      0.2002962716768e-09_wp, 0.4921360989412e+01_wp, 0.2268582385539e+03_wp, &
      0.2198291338754e-09_wp, 0.1130360117454e+00_wp, 0.1658638954901e+03_wp, &
      0.1491958330784e-09_wp, 0.4228195232278e+01_wp, 0.2219950288015e+03_wp, &
      0.1475384076173e-09_wp, 0.3005721811604e+00_wp, 0.3052819430710e+03_wp, &
      0.1661626624624e-09_wp, 0.7830125621203e+00_wp, 0.2526661704812e+03_wp /
    data ((e0(i,j,1),i=1,3),j=501,ne0x) / &
      0.9015823460025e-10_wp, 0.3807792942715e+01_wp, 0.4171445043968e+03_wp /

    !  Sun-to-Earth, T^1, X
    data ((e1(i,j,1),i=1,3),j=  1, 10) / &
      0.1234046326004e-05_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.5150068824701e-06_wp, 0.6002664557501e+01_wp, 0.1256615170089e+02_wp, &
      0.1290743923245e-07_wp, 0.5959437664199e+01_wp, 0.1884922755134e+02_wp, &
      0.1068615564952e-07_wp, 0.2015529654209e+01_wp, 0.6283075850446e+01_wp, &
      0.2079619142538e-08_wp, 0.1732960531432e+01_wp, 0.6279552690824e+01_wp, &
      0.2078009243969e-08_wp, 0.4915604476996e+01_wp, 0.6286599010068e+01_wp, &
      0.6206330058856e-09_wp, 0.3616457953824e+00_wp, 0.4705732307012e+01_wp, &
      0.5989335313746e-09_wp, 0.3802607304474e+01_wp, 0.6256777527156e+01_wp, &
      0.5958495663840e-09_wp, 0.2845866560031e+01_wp, 0.6309374173736e+01_wp, &
      0.4866923261539e-09_wp, 0.5213203771824e+01_wp, 0.7755226100720e+00_wp /
    data ((e1(i,j,1),i=1,3),j= 11, 20) / &
      0.4267785823142e-09_wp, 0.4368189727818e+00_wp, 0.1059381944224e+01_wp, &
      0.4610675141648e-09_wp, 0.1837249181372e-01_wp, 0.7860419393880e+01_wp, &
      0.3626989993973e-09_wp, 0.2161590545326e+01_wp, 0.5753384878334e+01_wp, &
      0.3563071194389e-09_wp, 0.1452631954746e+01_wp, 0.5884926831456e+01_wp, &
      0.3557015642807e-09_wp, 0.4470593393054e+01_wp, 0.6812766822558e+01_wp, &
      0.3210412089122e-09_wp, 0.5195926078314e+01_wp, 0.6681224869435e+01_wp, &
      0.2875473577986e-09_wp, 0.5916256610193e+01_wp, 0.2513230340178e+02_wp, &
      0.2842913681629e-09_wp, 0.1149902426047e+01_wp, 0.6127655567643e+01_wp, &
      0.2751248215916e-09_wp, 0.5502088574662e+01_wp, 0.6438496133249e+01_wp, &
      0.2481432881127e-09_wp, 0.2921989846637e+01_wp, 0.5486777812467e+01_wp /
    data ((e1(i,j,1),i=1,3),j= 21, 30) / &
      0.2059885976560e-09_wp, 0.3718070376585e+01_wp, 0.7079373888424e+01_wp, &
      0.2015522342591e-09_wp, 0.5979395259740e+01_wp, 0.6290189305114e+01_wp, &
      0.1995364084253e-09_wp, 0.6772087985494e+00_wp, 0.6275962395778e+01_wp, &
      0.1957436436943e-09_wp, 0.2899210654665e+01_wp, 0.5507553240374e+01_wp, &
      0.1651609818948e-09_wp, 0.6228206482192e+01_wp, 0.1150676975667e+02_wp, &
      0.1822980550699e-09_wp, 0.1469348746179e+01_wp, 0.1179062909082e+02_wp, &
      0.1675223159760e-09_wp, 0.3813910555688e+01_wp, 0.7058598460518e+01_wp, &
      0.1706491764745e-09_wp, 0.3004380506684e+00_wp, 0.7113454667900e-02_wp, &
      0.1392952362615e-09_wp, 0.1440393973406e+01_wp, 0.7962980379786e+00_wp, &
      0.1209868266342e-09_wp, 0.4150425791727e+01_wp, 0.4694002934110e+01_wp /
    data ((e1(i,j,1),i=1,3),j= 31, 40) / &
      0.1009827202611e-09_wp, 0.3290040429843e+01_wp, 0.3738761453707e+01_wp, &
      0.1047261388602e-09_wp, 0.4229590090227e+01_wp, 0.6282095334605e+01_wp, &
      0.1047006652004e-09_wp, 0.2418967680575e+01_wp, 0.6284056366286e+01_wp, &
      0.9609993143095e-10_wp, 0.4627943659201e+01_wp, 0.6069776770667e+01_wp, &
      0.9590900593873e-10_wp, 0.1894393939924e+01_wp, 0.4136910472696e+01_wp, &
      0.9146249188071e-10_wp, 0.2010647519562e+01_wp, 0.6496374930224e+01_wp, &
      0.8545274480290e-10_wp, 0.5529846956226e-01_wp, 0.1194447056968e+01_wp, &
      0.8224377881194e-10_wp, 0.1254304102174e+01_wp, 0.1589072916335e+01_wp, &
      0.6183529510410e-10_wp, 0.3360862168815e+01_wp, 0.8827390247185e+01_wp, &
      0.6259255147141e-10_wp, 0.4755628243179e+01_wp, 0.8429241228195e+01_wp /
    data ((e1(i,j,1),i=1,3),j= 41, 50) / &
      0.5539291694151e-10_wp, 0.5371746955142e+01_wp, 0.4933208510675e+01_wp, &
      0.7328259466314e-10_wp, 0.4927699613906e+00_wp, 0.4535059491685e+01_wp, &
      0.6017835843560e-10_wp, 0.5776682001734e-01_wp, 0.1255903824622e+02_wp, &
      0.7079827775243e-10_wp, 0.4395059432251e+01_wp, 0.5088628793478e+01_wp, &
      0.5170358878213e-10_wp, 0.5154062619954e+01_wp, 0.1176985366291e+02_wp, &
      0.4872301838682e-10_wp, 0.6289611648973e+00_wp, 0.6040347114260e+01_wp, &
      0.5249869411058e-10_wp, 0.5617272046949e+01_wp, 0.3154687086868e+01_wp, &
      0.4716172354411e-10_wp, 0.3965901800877e+01_wp, 0.5331357529664e+01_wp, &
      0.4871214940964e-10_wp, 0.4627507050093e+01_wp, 0.1256967486051e+02_wp, &
      0.4598076850751e-10_wp, 0.6023631226459e+01_wp, 0.6525804586632e+01_wp /
    data ((e1(i,j,1),i=1,3),j= 51, 60) / &
      0.4562196089485e-10_wp, 0.4138562084068e+01_wp, 0.3930209696940e+01_wp, &
      0.4325493872224e-10_wp, 0.1330845906564e+01_wp, 0.7632943190217e+01_wp, &
      0.5673781176748e-10_wp, 0.2558752615657e+01_wp, 0.5729506548653e+01_wp, &
      0.3961436642503e-10_wp, 0.2728071734630e+01_wp, 0.7234794171227e+01_wp, &
      0.5101868209058e-10_wp, 0.4113444965144e+01_wp, 0.6836645152238e+01_wp, &
      0.5257043167676e-10_wp, 0.6195089830590e+01_wp, 0.8031092209206e+01_wp, &
      0.5076613989393e-10_wp, 0.2305124132918e+01_wp, 0.7477522907414e+01_wp, &
      0.3342169352778e-10_wp, 0.5415998155071e+01_wp, 0.1097707878456e+02_wp, &
      0.3545881983591e-10_wp, 0.3727160564574e+01_wp, 0.4164311961999e+01_wp, &
      0.3364063738599e-10_wp, 0.2901121049204e+00_wp, 0.1137170464392e+02_wp /
    data ((e1(i,j,1),i=1,3),j= 61, 70) / &
      0.3357039670776e-10_wp, 0.1652229354331e+01_wp, 0.5223693906222e+01_wp, &
      0.4307412268687e-10_wp, 0.4938909587445e+01_wp, 0.1592596075957e+01_wp, &
      0.3405769115435e-10_wp, 0.2408890766511e+01_wp, 0.3128388763578e+01_wp, &
      0.3001926198480e-10_wp, 0.4862239006386e+01_wp, 0.1748016358760e+01_wp, &
      0.2778264787325e-10_wp, 0.5241168661353e+01_wp, 0.7342457794669e+01_wp, &
      0.2676159480666e-10_wp, 0.3423593942199e+01_wp, 0.2146165377750e+01_wp, &
      0.2954273399939e-10_wp, 0.1881721265406e+01_wp, 0.5368044267797e+00_wp, &
      0.3309362888795e-10_wp, 0.1931525677349e+01_wp, 0.8018209333619e+00_wp, &
      0.2810283608438e-10_wp, 0.2414659495050e+01_wp, 0.5225775174439e+00_wp, &
      0.3378045637764e-10_wp, 0.4238019163430e+01_wp, 0.1554202828031e+00_wp /
    data ((e1(i,j,1),i=1,3),j= 71,ne1x) / &
      0.2558134979840e-10_wp, 0.1828225235805e+01_wp, 0.5230807360890e+01_wp, &
      0.2273755578447e-10_wp, 0.5858184283998e+01_wp, 0.7084896783808e+01_wp, &
      0.2294176037690e-10_wp, 0.4514589779057e+01_wp, 0.1726015463500e+02_wp, &
      0.2533506099435e-10_wp, 0.2355717851551e+01_wp, 0.5216580451554e+01_wp, &
      0.2716685375812e-10_wp, 0.2221003625100e+01_wp, 0.8635942003952e+01_wp, &
      0.2419043435198e-10_wp, 0.5955704951635e+01_wp, 0.4690479774488e+01_wp, &
      0.2521232544812e-10_wp, 0.1395676848521e+01_wp, 0.5481254917084e+01_wp, &
      0.2630195021491e-10_wp, 0.5727468918743e+01_wp, 0.2629832328990e-01_wp, &
      0.2548395840944e-10_wp, 0.2628351859400e-03_wp, 0.1349867339771e+01_wp /

    !  Sun-to-Earth, T^2, X
    data ((e2(i,j,1),i=1,3),j=  1,ne2x) / &
     -0.4143818297913e-10_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.2171497694435e-10_wp, 0.4398225628264e+01_wp, 0.1256615170089e+02_wp, &
      0.9845398442516e-11_wp, 0.2079720838384e+00_wp, 0.6283075850446e+01_wp, &
      0.9256833552682e-12_wp, 0.4191264694361e+01_wp, 0.1884922755134e+02_wp, &
      0.1022049384115e-12_wp, 0.5381133195658e+01_wp, 0.8399684731857e+02_wp /

    !  Sun-to-Earth, T^0, Y
    data ((e0(i,j,2),i=1,3),j=  1, 10) / &
      0.9998921098898e+00_wp, 0.1826583913846e+00_wp, 0.6283075850446e+01_wp, &
     -0.2442700893735e-01_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.8352929742915e-02_wp, 0.1395277998680e+00_wp, 0.1256615170089e+02_wp, &
      0.1046697300177e-03_wp, 0.9641423109763e-01_wp, 0.1884922755134e+02_wp, &
      0.3110841876663e-04_wp, 0.5381140401712e+01_wp, 0.8399684731857e+02_wp, &
      0.2570269094593e-04_wp, 0.5301016407128e+01_wp, 0.5296909721118e+00_wp, &
      0.2147389623610e-04_wp, 0.2662510869850e+01_wp, 0.1577343543434e+01_wp, &
      0.1680344384050e-04_wp, 0.5207904119704e+01_wp, 0.6279552690824e+01_wp, &
      0.1679117312193e-04_wp, 0.4582187486968e+01_wp, 0.6286599010068e+01_wp, &
      0.1440512068440e-04_wp, 0.1900688517726e+01_wp, 0.2352866153506e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 11, 20) / &
      0.1135139664999e-04_wp, 0.5273108538556e+01_wp, 0.5223693906222e+01_wp, &
      0.9345482571018e-05_wp, 0.4503047687738e+01_wp, 0.1203646072878e+02_wp, &
      0.9007418719568e-05_wp, 0.1605621059637e+01_wp, 0.1021328554739e+02_wp, &
      0.5671536712314e-05_wp, 0.5812849070861e+00_wp, 0.1059381944224e+01_wp, &
      0.7451401861666e-05_wp, 0.2807346794836e+01_wp, 0.3981490189893e+00_wp, &
      0.6393470057114e-05_wp, 0.6029224133855e+01_wp, 0.5753384878334e+01_wp, &
      0.6814275881697e-05_wp, 0.6472990145974e+00_wp, 0.4705732307012e+01_wp, &
      0.6113705628887e-05_wp, 0.3813843419700e+01_wp, 0.6812766822558e+01_wp, &
      0.4503851367273e-05_wp, 0.4527804370996e+01_wp, 0.5884926831456e+01_wp, &
      0.4522249141926e-05_wp, 0.5991783029224e+01_wp, 0.6256777527156e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 21, 30) / &
      0.4501794307018e-05_wp, 0.3798703844397e+01_wp, 0.6309374173736e+01_wp, &
      0.5514927480180e-05_wp, 0.3961257833388e+01_wp, 0.5507553240374e+01_wp, &
      0.4062862799995e-05_wp, 0.5256247296369e+01_wp, 0.6681224869435e+01_wp, &
      0.5414900429712e-05_wp, 0.5499032014097e+01_wp, 0.7755226100720e+00_wp, &
      0.5463153987424e-05_wp, 0.6173092454097e+01_wp, 0.1414349524433e+02_wp, &
      0.5071611859329e-05_wp, 0.2870244247651e+01_wp, 0.7860419393880e+01_wp, &
      0.2195112094455e-05_wp, 0.2952338617201e+01_wp, 0.1150676975667e+02_wp, &
      0.2279139233919e-05_wp, 0.5951775132933e+01_wp, 0.7058598460518e+01_wp, &
      0.2278386100876e-05_wp, 0.4845456398785e+01_wp, 0.4694002934110e+01_wp, &
      0.2559088003308e-05_wp, 0.6945321117311e+00_wp, 0.1216800268190e+02_wp /
    data ((e0(i,j,2),i=1,3),j= 31, 40) / &
      0.2561079286856e-05_wp, 0.6167224608301e+01_wp, 0.7099330490126e+00_wp, &
      0.1792755796387e-05_wp, 0.1400122509632e+01_wp, 0.7962980379786e+00_wp, &
      0.1818715656502e-05_wp, 0.4703347611830e+01_wp, 0.6283142985870e+01_wp, &
      0.1818744924791e-05_wp, 0.5086748900237e+01_wp, 0.6283008715021e+01_wp, &
      0.1554518791390e-05_wp, 0.5331008042713e-01_wp, 0.2513230340178e+02_wp, &
      0.2063265737239e-05_wp, 0.4283680484178e+01_wp, 0.1179062909082e+02_wp, &
      0.1497613520041e-05_wp, 0.6074207826073e+01_wp, 0.5486777812467e+01_wp, &
      0.2000617940427e-05_wp, 0.2501426281450e+01_wp, 0.1778984560711e+02_wp, &
      0.1289731195580e-05_wp, 0.3646340599536e+01_wp, 0.7079373888424e+01_wp, &
      0.1282657998934e-05_wp, 0.3232864804902e+01_wp, 0.3738761453707e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 41, 50) / &
      0.1528915968658e-05_wp, 0.5581433416669e+01_wp, 0.2132990797783e+00_wp, &
      0.1187304098432e-05_wp, 0.5453576453694e+01_wp, 0.9437762937313e+01_wp, &
      0.7842782928118e-06_wp, 0.2823953922273e+00_wp, 0.8827390247185e+01_wp, &
      0.7352892280868e-06_wp, 0.1124369580175e+01_wp, 0.1589072916335e+01_wp, &
      0.6570189360797e-06_wp, 0.2089154042840e+01_wp, 0.1176985366291e+02_wp, &
      0.6324967590410e-06_wp, 0.6704855581230e+00_wp, 0.6262300422539e+01_wp, &
      0.6298289872283e-06_wp, 0.2836414855840e+01_wp, 0.6303851278352e+01_wp, &
      0.6476686465855e-06_wp, 0.4852433866467e+00_wp, 0.7113454667900e-02_wp, &
      0.8587034651234e-06_wp, 0.1453511005668e+01_wp, 0.1672837615881e+03_wp, &
      0.8068948788113e-06_wp, 0.9224087798609e+00_wp, 0.6069776770667e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 51, 60) / &
      0.8353786011661e-06_wp, 0.4631707184895e+01_wp, 0.3340612434717e+01_wp, &
      0.6009324532132e-06_wp, 0.1829498827726e+01_wp, 0.4136910472696e+01_wp, &
      0.7558158559566e-06_wp, 0.2588596800317e+01_wp, 0.6496374930224e+01_wp, &
      0.5809279504503e-06_wp, 0.5516818853476e+00_wp, 0.1097707878456e+02_wp, &
      0.5374131950254e-06_wp, 0.6275674734960e+01_wp, 0.1194447056968e+01_wp, &
      0.5711160507326e-06_wp, 0.1091905956872e+01_wp, 0.6282095334605e+01_wp, &
      0.5710183170746e-06_wp, 0.2415001635090e+01_wp, 0.6284056366286e+01_wp, &
      0.5144373590610e-06_wp, 0.6020336443438e+01_wp, 0.6290189305114e+01_wp, &
      0.5103108927267e-06_wp, 0.3775634564605e+01_wp, 0.6275962395778e+01_wp, &
      0.4960654697891e-06_wp, 0.1073450946756e+01_wp, 0.6127655567643e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 61, 70) / &
      0.4786385689280e-06_wp, 0.2431178012310e+01_wp, 0.6438496133249e+01_wp, &
      0.6109911263665e-06_wp, 0.5343356157914e+01_wp, 0.3154687086868e+01_wp, &
      0.4839898944024e-06_wp, 0.5830833594047e-01_wp, 0.8018209333619e+00_wp, &
      0.4734822623919e-06_wp, 0.4536080134821e+01_wp, 0.3128388763578e+01_wp, &
      0.4834741473290e-06_wp, 0.2585090489754e+00_wp, 0.7084896783808e+01_wp, &
      0.5134858581156e-06_wp, 0.4213317172603e+01_wp, 0.1235285262111e+02_wp, &
      0.5064004264978e-06_wp, 0.4814418806478e+00_wp, 0.1185621865188e+02_wp, &
      0.3753476772761e-06_wp, 0.1599953399788e+01_wp, 0.8429241228195e+01_wp, &
      0.4935264014283e-06_wp, 0.2157417556873e+01_wp, 0.2544314396739e+01_wp, &
      0.3950929600897e-06_wp, 0.3359394184254e+01_wp, 0.5481254917084e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 71, 80) / &
      0.4895849789777e-06_wp, 0.5165704376558e+01_wp, 0.9225539266174e+01_wp, &
      0.4215241688886e-06_wp, 0.2065368800993e+01_wp, 0.1726015463500e+02_wp, &
      0.3796773731132e-06_wp, 0.1468606346612e+01_wp, 0.4265981595566e+00_wp, &
      0.3114178142515e-06_wp, 0.3615638079474e+01_wp, 0.2146165377750e+01_wp, &
      0.3260664220838e-06_wp, 0.4417134922435e+01_wp, 0.4164311961999e+01_wp, &
      0.3976996123008e-06_wp, 0.4700866883004e+01_wp, 0.5856477690889e+01_wp, &
      0.2801459672924e-06_wp, 0.4538902060922e+01_wp, 0.1256967486051e+02_wp, &
      0.3638931868861e-06_wp, 0.1334197991475e+01_wp, 0.1807370494127e+02_wp, &
      0.2487013269476e-06_wp, 0.3749275558275e+01_wp, 0.2629832328990e-01_wp, &
      0.3034165481994e-06_wp, 0.4236622030873e+00_wp, 0.4535059491685e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 81, 90) / &
      0.2676278825586e-06_wp, 0.5970848007811e+01_wp, 0.3930209696940e+01_wp, &
      0.2764903818918e-06_wp, 0.5194636754501e+01_wp, 0.1256262854127e+02_wp, &
      0.2485149930507e-06_wp, 0.1002434207846e+01_wp, 0.5088628793478e+01_wp, &
      0.2199305540941e-06_wp, 0.3066773098403e+01_wp, 0.1255903824622e+02_wp, &
      0.2571106500435e-06_wp, 0.7588312459063e+00_wp, 0.1336797263425e+02_wp, &
      0.2049751817158e-06_wp, 0.3444977434856e+01_wp, 0.1137170464392e+02_wp, &
      0.2599707296297e-06_wp, 0.1873128542205e+01_wp, 0.7143069561767e+02_wp, &
      0.1785018072217e-06_wp, 0.5015891306615e+01_wp, 0.1748016358760e+01_wp, &
      0.2324833891115e-06_wp, 0.4618271239730e+01_wp, 0.1831953657923e+02_wp, &
      0.1709711119545e-06_wp, 0.5300003455669e+01_wp, 0.4933208510675e+01_wp /
    data ((e0(i,j,2),i=1,3),j= 91,100) / &
      0.2107159351716e-06_wp, 0.2229819815115e+01_wp, 0.7477522907414e+01_wp, &
      0.1750333080295e-06_wp, 0.6161485880008e+01_wp, 0.1044738781244e+02_wp, &
      0.2000598210339e-06_wp, 0.2967357299999e+01_wp, 0.8031092209206e+01_wp, &
      0.1380920248681e-06_wp, 0.3027007923917e+01_wp, 0.8635942003952e+01_wp, &
      0.1412460470299e-06_wp, 0.6037597163798e+01_wp, 0.2942463415728e+01_wp, &
      0.1888459803001e-06_wp, 0.8561476243374e+00_wp, 0.1561374759853e+03_wp, &
      0.1788370542585e-06_wp, 0.4869736290209e+01_wp, 0.1592596075957e+01_wp, &
      0.1360893296167e-06_wp, 0.3626411886436e+01_wp, 0.1309584267300e+02_wp, &
      0.1506846530160e-06_wp, 0.1550975377427e+01_wp, 0.1649636139783e+02_wp, &
      0.1800913376176e-06_wp, 0.2075826033190e+01_wp, 0.1729818233119e+02_wp /
    data ((e0(i,j,2),i=1,3),j=101,110) / &
      0.1436261390649e-06_wp, 0.6148876420255e+01_wp, 0.2042657109477e+02_wp, &
      0.1220227114151e-06_wp, 0.4382583879906e+01_wp, 0.7632943190217e+01_wp, &
      0.1337883603592e-06_wp, 0.2036644327361e+01_wp, 0.1213955354133e+02_wp, &
      0.1159326650738e-06_wp, 0.3892276994687e+01_wp, 0.5331357529664e+01_wp, &
      0.1352853128569e-06_wp, 0.1447950649744e+01_wp, 0.1673046366289e+02_wp, &
      0.1433408296083e-06_wp, 0.4457854692961e+01_wp, 0.7342457794669e+01_wp, &
      0.1234701666518e-06_wp, 0.1538818147151e+01_wp, 0.6279485555400e+01_wp, &
      0.1234027192007e-06_wp, 0.1968523220760e+01_wp, 0.6286666145492e+01_wp, &
      0.1244024091797e-06_wp, 0.5779803499985e+01_wp, 0.1511046609763e+02_wp, &
      0.1097934945516e-06_wp, 0.6210975221388e+00_wp, 0.1098880815746e+02_wp /
    data ((e0(i,j,2),i=1,3),j=111,120) / &
      0.1254611329856e-06_wp, 0.2591963807998e+01_wp, 0.1572083878776e+02_wp, &
      0.1158247286784e-06_wp, 0.2483612812670e+01_wp, 0.5729506548653e+01_wp, &
      0.9039078252960e-07_wp, 0.3857554579796e+01_wp, 0.9623688285163e+01_wp, &
      0.9108024978836e-07_wp, 0.5826368512984e+01_wp, 0.7234794171227e+01_wp, &
      0.8887068108436e-07_wp, 0.3475694573987e+01_wp, 0.6148010737701e+01_wp, &
      0.8632374035438e-07_wp, 0.3059070488983e-01_wp, 0.6418140963190e+01_wp, &
      0.7893186992967e-07_wp, 0.1583194837728e+01_wp, 0.2118763888447e+01_wp, &
      0.8297650201172e-07_wp, 0.8519770534637e+00_wp, 0.1471231707864e+02_wp, &
      0.1019759578988e-06_wp, 0.1319598738732e+00_wp, 0.1349867339771e+01_wp, &
      0.1010037696236e-06_wp, 0.9937860115618e+00_wp, 0.6836645152238e+01_wp /
    data ((e0(i,j,2),i=1,3),j=121,130) / &
      0.1047727548266e-06_wp, 0.1382138405399e+01_wp, 0.5999216516294e+01_wp, &
      0.7351993881086e-07_wp, 0.3833397851735e+01_wp, 0.6040347114260e+01_wp, &
      0.9868771092341e-07_wp, 0.2124913814390e+01_wp, 0.6566935184597e+01_wp, &
      0.7007321959390e-07_wp, 0.5946305343763e+01_wp, 0.6525804586632e+01_wp, &
      0.6861411679709e-07_wp, 0.4574654977089e+01_wp, 0.7238675589263e+01_wp, &
      0.7554519809614e-07_wp, 0.5949232686844e+01_wp, 0.1253985337760e+02_wp, &
      0.9541880448335e-07_wp, 0.3495242990564e+01_wp, 0.2122839202813e+02_wp, &
      0.7185606722155e-07_wp, 0.4310113471661e+01_wp, 0.6245048154254e+01_wp, &
      0.7131360871710e-07_wp, 0.5480309323650e+01_wp, 0.6321103546637e+01_wp, &
      0.6651142021039e-07_wp, 0.5411097713654e+01_wp, 0.5327476111629e+01_wp /
    data ((e0(i,j,2),i=1,3),j=131,140) / &
      0.8538618213667e-07_wp, 0.1827849973951e+01_wp, 0.1101510648075e+02_wp, &
      0.8634954288044e-07_wp, 0.5443584943349e+01_wp, 0.5643178611111e+01_wp, &
      0.7449415051484e-07_wp, 0.2011535459060e+01_wp, 0.5368044267797e+00_wp, &
      0.7421047599169e-07_wp, 0.3464562529249e+01_wp, 0.2354323048545e+02_wp, &
      0.6140694354424e-07_wp, 0.5657556228815e+01_wp, 0.1296430071988e+02_wp, &
      0.6353525143033e-07_wp, 0.3463816593821e+01_wp, 0.1990745094947e+01_wp, &
      0.6221964013447e-07_wp, 0.1532259498697e+01_wp, 0.9517183207817e+00_wp, &
      0.5852480257244e-07_wp, 0.1375396598875e+01_wp, 0.9555997388169e+00_wp, &
      0.6398637498911e-07_wp, 0.2405645801972e+01_wp, 0.2407292145756e+02_wp, &
      0.7039744069878e-07_wp, 0.5397541799027e+01_wp, 0.5225775174439e+00_wp /
    data ((e0(i,j,2),i=1,3),j=141,150) / &
      0.6977997694382e-07_wp, 0.4762347105419e+01_wp, 0.1097355562493e+02_wp, &
      0.7460629558396e-07_wp, 0.2711944692164e+01_wp, 0.2200391463820e+02_wp, &
      0.5376577536101e-07_wp, 0.2352980430239e+01_wp, 0.1431416805965e+02_wp, &
      0.7530607893556e-07_wp, 0.1943940180699e+01_wp, 0.1842262939178e+02_wp, &
      0.6822928971605e-07_wp, 0.4337651846959e+01_wp, 0.1554202828031e+00_wp, &
      0.6220772380094e-07_wp, 0.6716871369278e+00_wp, 0.1845107853235e+02_wp, &
      0.6586950799043e-07_wp, 0.2229714460505e+01_wp, 0.5216580451554e+01_wp, &
      0.5873800565771e-07_wp, 0.7627013920580e+00_wp, 0.6398972393349e+00_wp, &
      0.6264346929745e-07_wp, 0.6202785478961e+00_wp, 0.6277552955062e+01_wp, &
      0.6257929115669e-07_wp, 0.2886775596668e+01_wp, 0.6288598745829e+01_wp /
    data ((e0(i,j,2),i=1,3),j=151,160) / &
      0.5343536033409e-07_wp, 0.1977241012051e+01_wp, 0.4690479774488e+01_wp, &
      0.5587849781714e-07_wp, 0.1922923484825e+01_wp, 0.1551045220144e+01_wp, &
      0.6905100845603e-07_wp, 0.3570757164631e+01_wp, 0.1030928125552e+00_wp, &
      0.6178957066649e-07_wp, 0.5197558947765e+01_wp, 0.5230807360890e+01_wp, &
      0.6187270224331e-07_wp, 0.8193497368922e+00_wp, 0.5650292065779e+01_wp, &
      0.5385664291426e-07_wp, 0.5406336665586e+01_wp, 0.7771377146812e+02_wp, &
      0.6329363917926e-07_wp, 0.2837760654536e+01_wp, 0.2608790314060e+02_wp, &
      0.4546018761604e-07_wp, 0.2933580297050e+01_wp, 0.5535693017924e+00_wp, &
      0.6196091049375e-07_wp, 0.4157871494377e+01_wp, 0.8467247584405e+02_wp, &
      0.6159555108218e-07_wp, 0.3211703561703e+01_wp, 0.2394243902548e+03_wp /
    data ((e0(i,j,2),i=1,3),j=161,170) / &
      0.4995340539317e-07_wp, 0.1459098102922e+01_wp, 0.4732030630302e+01_wp, &
      0.5457031243572e-07_wp, 0.1430457676136e+01_wp, 0.6179983037890e+01_wp, &
      0.4863461418397e-07_wp, 0.2196425916730e+01_wp, 0.9027992316901e+02_wp, &
      0.5342947626870e-07_wp, 0.2086612890268e+01_wp, 0.6386168663001e+01_wp, &
      0.5674296648439e-07_wp, 0.2760204966535e+01_wp, 0.6915859635113e+01_wp, &
      0.4745783120161e-07_wp, 0.4245368971862e+01_wp, 0.6282970628506e+01_wp, &
      0.4745676961198e-07_wp, 0.5544725787016e+01_wp, 0.6283181072386e+01_wp, &
      0.4049796869973e-07_wp, 0.2213984363586e+01_wp, 0.6254626709878e+01_wp, &
      0.4248333596940e-07_wp, 0.8075781952896e+00_wp, 0.7875671926403e+01_wp, &
      0.4027178070205e-07_wp, 0.1293268540378e+01_wp, 0.6311524991013e+01_wp /
    data ((e0(i,j,2),i=1,3),j=171,180) / &
      0.4066543943476e-07_wp, 0.3986141175804e+01_wp, 0.3634620989887e+01_wp, &
      0.4858863787880e-07_wp, 0.1276112738231e+01_wp, 0.5760498333002e+01_wp, &
      0.5277398263530e-07_wp, 0.4916111741527e+01_wp, 0.2515860172507e+02_wp, &
      0.4105635656559e-07_wp, 0.1725805864426e+01_wp, 0.6709674010002e+01_wp, &
      0.4376781925772e-07_wp, 0.2243642442106e+01_wp, 0.6805653367890e+01_wp, &
      0.3235827894693e-07_wp, 0.3614135118271e+01_wp, 0.1066495398892e+01_wp, &
      0.3073244740308e-07_wp, 0.2460873393460e+01_wp, 0.5863591145557e+01_wp, &
      0.3088609271373e-07_wp, 0.5678431771790e+01_wp, 0.9917696840332e+01_wp, &
      0.3393022279836e-07_wp, 0.3814017477291e+01_wp, 0.1391601904066e+02_wp, &
      0.3038686508802e-07_wp, 0.4660216229171e+01_wp, 0.1256621883632e+02_wp /
    data ((e0(i,j,2),i=1,3),j=181,190) / &
      0.4019677752497e-07_wp, 0.5906906243735e+01_wp, 0.1334167431096e+02_wp, &
      0.3288834998232e-07_wp, 0.9536146445882e+00_wp, 0.1620077269078e+02_wp, &
      0.3889973794631e-07_wp, 0.3942205097644e+01_wp, 0.7478166569050e-01_wp, &
      0.3050438987141e-07_wp, 0.1624810271286e+01_wp, 0.1805292951336e+02_wp, &
      0.3601142564638e-07_wp, 0.4030467142575e+01_wp, 0.6208294184755e+01_wp, &
      0.3689015557141e-07_wp, 0.3648878818694e+01_wp, 0.5966683958112e+01_wp, &
      0.3563471893565e-07_wp, 0.5749584017096e+01_wp, 0.6357857516136e+01_wp, &
      0.2776183170667e-07_wp, 0.2630124187070e+01_wp, 0.3523159621801e-02_wp, &
      0.2922350530341e-07_wp, 0.1790346403629e+01_wp, 0.1272157198369e+02_wp, &
      0.3511076917302e-07_wp, 0.6142198301611e+01_wp, 0.6599467742779e+01_wp /
    data ((e0(i,j,2),i=1,3),j=191,200) / &
      0.3619351007632e-07_wp, 0.1432421386492e+01_wp, 0.6019991944201e+01_wp, &
      0.2561254711098e-07_wp, 0.2302822475792e+01_wp, 0.1259245002418e+02_wp, &
      0.2626903942920e-07_wp, 0.8660470994571e+00_wp, 0.6702560555334e+01_wp, &
      0.2550187397083e-07_wp, 0.6069721995383e+01_wp, 0.1057540660594e+02_wp, &
      0.2535873526138e-07_wp, 0.1079020331795e-01_wp, 0.3141537925223e+02_wp, &
      0.3519786153847e-07_wp, 0.3809066902283e+01_wp, 0.2505706758577e+03_wp, &
      0.3424651492873e-07_wp, 0.2075435114417e+01_wp, 0.6546159756691e+01_wp, &
      0.2372676630861e-07_wp, 0.2057803120154e+01_wp, 0.2388894113936e+01_wp, &
      0.2710980779541e-07_wp, 0.1510068488010e+01_wp, 0.1202934727411e+02_wp, &
      0.3038710889704e-07_wp, 0.5043617528901e+01_wp, 0.1256608456547e+02_wp /
    data ((e0(i,j,2),i=1,3),j=201,210) / &
      0.2220364130585e-07_wp, 0.3694793218205e+01_wp, 0.1336244973887e+02_wp, &
      0.3025880825460e-07_wp, 0.5450618999049e-01_wp, 0.2908881142201e+02_wp, &
      0.2784493486864e-07_wp, 0.3381164084502e+01_wp, 0.1494531617769e+02_wp, &
      0.2294414142438e-07_wp, 0.4382309025210e+01_wp, 0.6076890225335e+01_wp, &
      0.2012723294724e-07_wp, 0.9142212256518e+00_wp, 0.6262720680387e+01_wp, &
      0.2036357831958e-07_wp, 0.5676172293154e+01_wp, 0.4701116388778e+01_wp, &
      0.2003474823288e-07_wp, 0.2592767977625e+01_wp, 0.6303431020504e+01_wp, &
      0.2207144900109e-07_wp, 0.5404976271180e+01_wp, 0.6489261475556e+01_wp, &
      0.2481664905135e-07_wp, 0.4373284587027e+01_wp, 0.1204357418345e+02_wp, &
      0.2674949182295e-07_wp, 0.5859182188482e+01_wp, 0.4590910121555e+01_wp /
    data ((e0(i,j,2),i=1,3),j=211,220) / &
      0.2450554720322e-07_wp, 0.4555381557451e+01_wp, 0.1495633313810e+00_wp, &
      0.2601975986457e-07_wp, 0.3933165584959e+01_wp, 0.1965104848470e+02_wp, &
      0.2199860022848e-07_wp, 0.5227977189087e+01_wp, 0.1351787002167e+02_wp, &
      0.2448121172316e-07_wp, 0.4858060353949e+01_wp, 0.1162474756779e+01_wp, &
      0.1876014864049e-07_wp, 0.5690546553605e+01_wp, 0.6279194432410e+01_wp, &
      0.1874513219396e-07_wp, 0.4099539297446e+01_wp, 0.6286957268481e+01_wp, &
      0.2156380842559e-07_wp, 0.4382594769913e+00_wp, 0.1813929450232e+02_wp, &
      0.1981691240061e-07_wp, 0.1829784152444e+01_wp, 0.4686889479442e+01_wp, &
      0.2329992648539e-07_wp, 0.2836254278973e+01_wp, 0.1002183730415e+02_wp, &
      0.1765184135302e-07_wp, 0.2803494925833e+01_wp, 0.4292330755499e+01_wp /
    data ((e0(i,j,2),i=1,3),j=221,230) / &
      0.2436368366085e-07_wp, 0.2836897959677e+01_wp, 0.9514313292143e+02_wp, &
      0.2164089203889e-07_wp, 0.6127522446024e+01_wp, 0.6037244212485e+01_wp, &
      0.1847755034221e-07_wp, 0.3683163635008e+01_wp, 0.2427287361862e+00_wp, &
      0.1674798769966e-07_wp, 0.3316993867246e+00_wp, 0.1311972100268e+02_wp, &
      0.2222542124356e-07_wp, 0.8294097805480e+00_wp, 0.1266924451345e+02_wp, &
      0.2071074505925e-07_wp, 0.3659492220261e+01_wp, 0.6528907488406e+01_wp, &
      0.1608224471835e-07_wp, 0.4774492067182e+01_wp, 0.1352175143971e+02_wp, &
      0.1857583439071e-07_wp, 0.2873120597682e+01_wp, 0.8662240327241e+01_wp, &
      0.1793018836159e-07_wp, 0.5282441177929e+00_wp, 0.6819880277225e+01_wp, &
      0.1575391221692e-07_wp, 0.1320789654258e+01_wp, 0.1102062672231e+00_wp /
    data ((e0(i,j,2),i=1,3),j=231,240) / &
      0.1840132009557e-07_wp, 0.1917110916256e+01_wp, 0.6514761976723e+02_wp, &
      0.1760917288281e-07_wp, 0.2972635937132e+01_wp, 0.5746271423666e+01_wp, &
      0.1561779518516e-07_wp, 0.4372569261981e+01_wp, 0.6272439236156e+01_wp, &
      0.1558687885205e-07_wp, 0.5416424926425e+01_wp, 0.6293712464735e+01_wp, &
      0.1951359382579e-07_wp, 0.3094448898752e+01_wp, 0.2301353951334e+02_wp, &
      0.1569144275614e-07_wp, 0.2802103689808e+01_wp, 0.1765478049437e+02_wp, &
      0.1479130389462e-07_wp, 0.2136435020467e+01_wp, 0.2077542790660e-01_wp, &
      0.1467828510764e-07_wp, 0.7072627435674e+00_wp, 0.1052268489556e+01_wp, &
      0.1627627337440e-07_wp, 0.3947607143237e+01_wp, 0.6327837846670e+00_wp, &
      0.1503498479758e-07_wp, 0.4079248909190e+01_wp, 0.7626583626240e-01_wp /
    data ((e0(i,j,2),i=1,3),j=241,250) / &
      0.1297967708237e-07_wp, 0.6269637122840e+01_wp, 0.1149965630200e+02_wp, &
      0.1374416896634e-07_wp, 0.4175657970702e+01_wp, 0.6016468784579e+01_wp, &
      0.1783812325219e-07_wp, 0.1476540547560e+01_wp, 0.3301902111895e+02_wp, &
      0.1525884228756e-07_wp, 0.4653477715241e+01_wp, 0.9411464614024e+01_wp, &
      0.1451067396763e-07_wp, 0.2573001128225e+01_wp, 0.1277945078067e+02_wp, &
      0.1297713111950e-07_wp, 0.5612799618771e+01_wp, 0.6549682916313e+01_wp, &
      0.1462784012820e-07_wp, 0.4189661623870e+01_wp, 0.1863592847156e+02_wp, &
      0.1384185980007e-07_wp, 0.2656915472196e+01_wp, 0.2379164476796e+01_wp, &
      0.1221497599801e-07_wp, 0.5612515760138e+01_wp, 0.1257326515556e+02_wp, &
      0.1560574525896e-07_wp, 0.4783414317919e+01_wp, 0.1887552587463e+02_wp /
    data ((e0(i,j,2),i=1,3),j=251,260) / &
      0.1544598372036e-07_wp, 0.2694431138063e+01_wp, 0.1820933031200e+02_wp, &
      0.1531678928696e-07_wp, 0.4105103489666e+01_wp, 0.2593412433514e+02_wp, &
      0.1349321503795e-07_wp, 0.3082437194015e+00_wp, 0.5120601093667e+01_wp, &
      0.1252030290917e-07_wp, 0.6124072334087e+01_wp, 0.6993008899458e+01_wp, &
      0.1459243816687e-07_wp, 0.3733103981697e+01_wp, 0.3813291813120e-01_wp, &
      0.1226103625262e-07_wp, 0.1267127706817e+01_wp, 0.2435678079171e+02_wp, &
      0.1019449641504e-07_wp, 0.4367790112269e+01_wp, 0.1725663147538e+02_wp, &
      0.1380789433607e-07_wp, 0.3387201768700e+01_wp, 0.2458316379602e+00_wp, &
      0.1019453421658e-07_wp, 0.9204143073737e+00_wp, 0.6112403035119e+01_wp, &
      0.1297929434405e-07_wp, 0.5786874896426e+01_wp, 0.1249137003520e+02_wp /
    data ((e0(i,j,2),i=1,3),j=261,270) / &
      0.9912677786097e-08_wp, 0.3164232870746e+01_wp, 0.6247047890016e+01_wp, &
      0.9829386098599e-08_wp, 0.2586762413351e+01_wp, 0.6453748665772e+01_wp, &
      0.1226807746104e-07_wp, 0.6239068436607e+01_wp, 0.5429879531333e+01_wp, &
      0.1192691755997e-07_wp, 0.1867380051424e+01_wp, 0.6290122169689e+01_wp, &
      0.9836499227081e-08_wp, 0.3424716293727e+00_wp, 0.6319103810876e+01_wp, &
      0.9642862564285e-08_wp, 0.5661372990657e+01_wp, 0.8273820945392e+01_wp, &
      0.1165184404862e-07_wp, 0.5768367239093e+01_wp, 0.1778273215245e+02_wp, &
      0.1175794418818e-07_wp, 0.1657351222943e+01_wp, 0.6276029531202e+01_wp, &
      0.1018948635601e-07_wp, 0.6458292350865e+00_wp, 0.1254537627298e+02_wp, &
      0.9500383606676e-08_wp, 0.1054306140741e+01_wp, 0.1256517118505e+02_wp /
    data ((e0(i,j,2),i=1,3),j=271,280) / &
      0.1227512202906e-07_wp, 0.2505278379114e+01_wp, 0.2248384854122e+02_wp, &
      0.9664792009993e-08_wp, 0.4289737277000e+01_wp, 0.6259197520765e+01_wp, &
      0.9613285666331e-08_wp, 0.5500597673141e+01_wp, 0.6306954180126e+01_wp, &
      0.1117906736211e-07_wp, 0.2361405953468e+01_wp, 0.1779695906178e+02_wp, &
      0.9611378640782e-08_wp, 0.2851310576269e+01_wp, 0.2061856251104e+00_wp, &
      0.8845354852370e-08_wp, 0.6208777705343e+01_wp, 0.1692165728891e+01_wp, &
      0.1054046966600e-07_wp, 0.5413091423934e+01_wp, 0.2204125344462e+00_wp, &
      0.1215539124483e-07_wp, 0.5613969479755e+01_wp, 0.8257698122054e+02_wp, &
      0.9932460955209e-08_wp, 0.1106124877015e+01_wp, 0.1017725758696e+02_wp, &
      0.8785804715043e-08_wp, 0.2869224476477e+01_wp, 0.9491756770005e+00_wp /
    data ((e0(i,j,2),i=1,3),j=281,290) / &
      0.8538084097562e-08_wp, 0.6159640899344e+01_wp, 0.6393282117669e+01_wp, &
      0.8648994369529e-08_wp, 0.1374901198784e+01_wp, 0.4804209201333e+01_wp, &
      0.1039063219067e-07_wp, 0.5171080641327e+01_wp, 0.1550861511662e+02_wp, &
      0.8867983926439e-08_wp, 0.8317320304902e+00_wp, 0.3903911373650e+01_wp, &
      0.8327495955244e-08_wp, 0.3605591969180e+01_wp, 0.6172869583223e+01_wp, &
      0.9243088356133e-08_wp, 0.6114299196843e+01_wp, 0.6267823317922e+01_wp, &
      0.9205657357835e-08_wp, 0.3675153683737e+01_wp, 0.6298328382969e+01_wp, &
      0.1033269714606e-07_wp, 0.3313328813024e+01_wp, 0.5573142801433e+01_wp, &
      0.8001706275552e-08_wp, 0.2019980960053e+01_wp, 0.2648454860559e+01_wp, &
      0.9171858254191e-08_wp, 0.8992015524177e+00_wp, 0.1498544001348e+03_wp /
    data ((e0(i,j,2),i=1,3),j=291,300) / &
      0.1075327150242e-07_wp, 0.2898669963648e+01_wp, 0.3694923081589e+02_wp, &
      0.9884866689828e-08_wp, 0.4946715904478e+01_wp, 0.1140367694411e+02_wp, &
      0.9541835576677e-08_wp, 0.2371787888469e+01_wp, 0.1256713221673e+02_wp, &
      0.7739903376237e-08_wp, 0.2213775190612e+01_wp, 0.7834121070590e+01_wp, &
      0.7311962684106e-08_wp, 0.3429378787739e+01_wp, 0.1192625446156e+02_wp, &
      0.9724904869624e-08_wp, 0.6195878564404e+01_wp, 0.2280573557157e+02_wp, &
      0.9251628983612e-08_wp, 0.6511509527390e+00_wp, 0.2787043132925e+01_wp, &
      0.7320763787842e-08_wp, 0.6001083639421e+01_wp, 0.6282655592598e+01_wp, &
      0.7320296650962e-08_wp, 0.3789073265087e+01_wp, 0.6283496108294e+01_wp, &
      0.7947032271039e-08_wp, 0.1059659582204e+01_wp, 0.1241073141809e+02_wp /
    data ((e0(i,j,2),i=1,3),j=301,310) / &
      0.9005277053115e-08_wp, 0.1280315624361e+01_wp, 0.6281591679874e+01_wp, &
      0.8995601652048e-08_wp, 0.2224439106766e+01_wp, 0.6284560021018e+01_wp, &
      0.8288040568796e-08_wp, 0.5234914433867e+01_wp, 0.1241658836951e+02_wp, &
      0.6359381347255e-08_wp, 0.4137989441490e+01_wp, 0.1596186371003e+01_wp, &
      0.8699572228626e-08_wp, 0.1758411009497e+01_wp, 0.6133512519065e+01_wp, &
      0.6456797542736e-08_wp, 0.5919285089994e+01_wp, 0.1685848245639e+02_wp, &
      0.7424573475452e-08_wp, 0.5414616938827e+01_wp, 0.4061219149443e+01_wp, &
      0.7235671196168e-08_wp, 0.1496516557134e+01_wp, 0.1610006857377e+03_wp, &
      0.8104015182733e-08_wp, 0.1919918242764e+01_wp, 0.8460828644453e+00_wp, &
      0.8098576535937e-08_wp, 0.3819615855458e+01_wp, 0.3894181736510e+01_wp /
    data ((e0(i,j,2),i=1,3),j=311,320) / &
      0.6275292346625e-08_wp, 0.6244264115141e+01_wp, 0.8531963191132e+00_wp, &
      0.6052432989112e-08_wp, 0.5037731872610e+00_wp, 0.1567108171867e+02_wp, &
      0.5705651535817e-08_wp, 0.2984557271995e+01_wp, 0.1258692712880e+02_wp, &
      0.5789650115138e-08_wp, 0.6087038140697e+01_wp, 0.1193336791622e+02_wp, &
      0.5512132153377e-08_wp, 0.5855668994076e+01_wp, 0.1232342296471e+02_wp, &
      0.7388890819102e-08_wp, 0.2443128574740e+01_wp, 0.4907302013889e+01_wp, &
      0.5467593991798e-08_wp, 0.3017561234194e+01_wp, 0.1884211409667e+02_wp, &
      0.6388519802999e-08_wp, 0.5887386712935e+01_wp, 0.5217580628120e+02_wp, &
      0.6106777149944e-08_wp, 0.3483461059895e+00_wp, 0.1422690933580e-01_wp, &
      0.7383420275489e-08_wp, 0.5417387056707e+01_wp, 0.2358125818164e+02_wp /
    data ((e0(i,j,2),i=1,3),j=321,330) / &
      0.5505208141738e-08_wp, 0.2848193644783e+01_wp, 0.1151388321134e+02_wp, &
      0.6310757462877e-08_wp, 0.2349882520828e+01_wp, 0.1041998632314e+02_wp, &
      0.6166904929691e-08_wp, 0.5728575944077e+00_wp, 0.6151533897323e+01_wp, &
      0.5263442042754e-08_wp, 0.4495796125937e+01_wp, 0.1885275071096e+02_wp, &
      0.5591828082629e-08_wp, 0.1355441967677e+01_wp, 0.4337116142245e+00_wp, &
      0.5397051680497e-08_wp, 0.1673422864307e+01_wp, 0.6286362197481e+01_wp, &
      0.5396992745159e-08_wp, 0.1833502206373e+01_wp, 0.6279789503410e+01_wp, &
      0.6572913000726e-08_wp, 0.3331122065824e+01_wp, 0.1176433076753e+02_wp, &
      0.5123421866413e-08_wp, 0.2165327142679e+01_wp, 0.1245594543367e+02_wp, &
      0.5930495725999e-08_wp, 0.2931146089284e+01_wp, 0.6414617803568e+01_wp /
    data ((e0(i,j,2),i=1,3),j=331,340) / &
      0.6431797403933e-08_wp, 0.4134407994088e+01_wp, 0.1350651127443e+00_wp, &
      0.5003182207604e-08_wp, 0.3805420303749e+01_wp, 0.1096996532989e+02_wp, &
      0.5587731032504e-08_wp, 0.1082469260599e+01_wp, 0.6062663316000e+01_wp, &
      0.5935263407816e-08_wp, 0.8384333678401e+00_wp, 0.5326786718777e+01_wp, &
      0.4756019827760e-08_wp, 0.3552588749309e+01_wp, 0.3104930017775e+01_wp, &
      0.6599951172637e-08_wp, 0.4320826409528e+01_wp, 0.4087944051283e+02_wp, &
      0.5902606868464e-08_wp, 0.4811879454445e+01_wp, 0.5849364236221e+01_wp, &
      0.5921147809031e-08_wp, 0.9942628922396e-01_wp, 0.1581959461667e+01_wp, &
      0.5505382581266e-08_wp, 0.2466557607764e+01_wp, 0.6503488384892e+01_wp, &
      0.5353771071862e-08_wp, 0.4551978748683e+01_wp, 0.1735668374386e+03_wp /
    data ((e0(i,j,2),i=1,3),j=341,350) / &
      0.5063282210946e-08_wp, 0.5710812312425e+01_wp, 0.1248988586463e+02_wp, &
      0.5926120403383e-08_wp, 0.1333998428358e+01_wp, 0.2673594526851e+02_wp, &
      0.5211016176149e-08_wp, 0.4649315360760e+01_wp, 0.2460261242967e+02_wp, &
      0.5347075084894e-08_wp, 0.5512754081205e+01_wp, 0.4171425416666e+01_wp, &
      0.4872609773574e-08_wp, 0.1308025299938e+01_wp, 0.5333900173445e+01_wp, &
      0.4727711321420e-08_wp, 0.2144908368062e+01_wp, 0.7232251527446e+01_wp, &
      0.6029426018652e-08_wp, 0.5567259412084e+01_wp, 0.3227113045244e+03_wp, &
      0.4321485284369e-08_wp, 0.5230667156451e+01_wp, 0.9388005868221e+01_wp, &
      0.4476406760553e-08_wp, 0.6134081115303e+01_wp, 0.5547199253223e+01_wp, &
      0.5835268277420e-08_wp, 0.4783808492071e+01_wp, 0.7285056171570e+02_wp /
    data ((e0(i,j,2),i=1,3),j=351,360) / &
      0.5172183602748e-08_wp, 0.5161817911099e+01_wp, 0.1884570439172e+02_wp, &
      0.5693571465184e-08_wp, 0.1381646203111e+01_wp, 0.9723862754494e+02_wp, &
      0.4060634965349e-08_wp, 0.3876705259495e+00_wp, 0.4274518229222e+01_wp, &
      0.3967398770473e-08_wp, 0.5029491776223e+01_wp, 0.3496032717521e+01_wp, &
      0.3943754005255e-08_wp, 0.1923162955490e+01_wp, 0.6244942932314e+01_wp, &
      0.4781323427824e-08_wp, 0.4633332586423e+01_wp, 0.2929661536378e+02_wp, &
      0.3871483781204e-08_wp, 0.1616650009743e+01_wp, 0.6321208768577e+01_wp, &
      0.5141741733997e-08_wp, 0.9817316704659e-01_wp, 0.1232032006293e+02_wp, &
      0.4002385978497e-08_wp, 0.3656161212139e+01_wp, 0.7018952447668e+01_wp, &
      0.4901092604097e-08_wp, 0.4404098713092e+01_wp, 0.1478866649112e+01_wp /
    data ((e0(i,j,2),i=1,3),j=361,370) / &
      0.3740932630345e-08_wp, 0.5181188732639e+00_wp, 0.6922973089781e+01_wp, &
      0.4387283718538e-08_wp, 0.3254859566869e+01_wp, 0.2331413144044e+03_wp, &
      0.5019197802033e-08_wp, 0.3086773224677e+01_wp, 0.1715706182245e+02_wp, &
      0.3834931695175e-08_wp, 0.2797882673542e+01_wp, 0.1491901785440e+02_wp, &
      0.3760413942497e-08_wp, 0.2892676280217e+01_wp, 0.1726726808967e+02_wp, &
      0.3719717204628e-08_wp, 0.5861046025739e+01_wp, 0.6297302759782e+01_wp, &
      0.4145623530149e-08_wp, 0.2168239627033e+01_wp, 0.1376059875786e+02_wp, &
      0.3932788425380e-08_wp, 0.6271811124181e+01_wp, 0.7872148766781e+01_wp, &
      0.3686377476857e-08_wp, 0.3936853151404e+01_wp, 0.6268848941110e+01_wp, &
      0.3779077950339e-08_wp, 0.1404148734043e+01_wp, 0.4157198507331e+01_wp /
    data ((e0(i,j,2),i=1,3),j=371,380) / &
      0.4091334550598e-08_wp, 0.2452436180854e+01_wp, 0.9779108567966e+01_wp, &
      0.3926694536146e-08_wp, 0.6102292739040e+01_wp, 0.1098419223922e+02_wp, &
      0.4841000253289e-08_wp, 0.6072760457276e+01_wp, 0.1252801878276e+02_wp, &
      0.4949340130240e-08_wp, 0.1154832815171e+01_wp, 0.1617106187867e+03_wp, &
      0.3761557737360e-08_wp, 0.5527545321897e+01_wp, 0.3185192151914e+01_wp, &
      0.3647396268188e-08_wp, 0.1525035688629e+01_wp, 0.6271346477544e+01_wp, &
      0.3932405074189e-08_wp, 0.5570681040569e+01_wp, 0.2139354194808e+02_wp, &
      0.3631322501141e-08_wp, 0.1981240601160e+01_wp, 0.6294805223347e+01_wp, &
      0.4130007425139e-08_wp, 0.2050060880201e+01_wp, 0.2195415756911e+02_wp, &
      0.4433905965176e-08_wp, 0.3277477970321e+01_wp, 0.7445550607224e+01_wp /
    data ((e0(i,j,2),i=1,3),j=381,390) / &
      0.3851814176947e-08_wp, 0.5210690074886e+01_wp, 0.9562891316684e+00_wp, &
      0.3485807052785e-08_wp, 0.6653274904611e+00_wp, 0.1161697602389e+02_wp, &
      0.3979772816991e-08_wp, 0.1767941436148e+01_wp, 0.2277943724828e+02_wp, &
      0.3402607460500e-08_wp, 0.3421746306465e+01_wp, 0.1087398597200e+02_wp, &
      0.4049993000926e-08_wp, 0.1127144787547e+01_wp, 0.3163918923335e+00_wp, &
      0.3420511182382e-08_wp, 0.4214794779161e+01_wp, 0.1362553364512e+02_wp, &
      0.3640772365012e-08_wp, 0.5324905497687e+01_wp, 0.1725304118033e+02_wp, &
      0.3323037987501e-08_wp, 0.6135761838271e+01_wp, 0.6279143387820e+01_wp, &
      0.4503141663637e-08_wp, 0.1802305450666e+01_wp, 0.1385561574497e+01_wp, &
      0.4314560055588e-08_wp, 0.4812299731574e+01_wp, 0.4176041334900e+01_wp /
    data ((e0(i,j,2),i=1,3),j=391,400) / &
      0.3294226949110e-08_wp, 0.3657547059723e+01_wp, 0.6287008313071e+01_wp, &
      0.3215657197281e-08_wp, 0.4866676894425e+01_wp, 0.5749861718712e+01_wp, &
      0.4129362656266e-08_wp, 0.3809342558906e+01_wp, 0.5905702259363e+01_wp, &
      0.3137762976388e-08_wp, 0.2494635174443e+01_wp, 0.2099539292909e+02_wp, &
      0.3514010952384e-08_wp, 0.2699961831678e+01_wp, 0.7335344340001e+01_wp, &
      0.3327607571530e-08_wp, 0.3318457714816e+01_wp, 0.5436992986000e+01_wp, &
      0.3541066946675e-08_wp, 0.4382703582466e+01_wp, 0.1234573916645e+02_wp, &
      0.3216179847052e-08_wp, 0.5271066317054e+01_wp, 0.3802769619140e-01_wp, &
      0.2959045059570e-08_wp, 0.5819591585302e+01_wp, 0.2670964694522e+02_wp, &
      0.3884040326665e-08_wp, 0.5980934960428e+01_wp, 0.6660449441528e+01_wp /
    data ((e0(i,j,2),i=1,3),j=401,410) / &
      0.2922027539886e-08_wp, 0.3337290282483e+01_wp, 0.1375773836557e+01_wp, &
      0.4110846382042e-08_wp, 0.5742978187327e+01_wp, 0.4480965020977e+02_wp, &
      0.2934508411032e-08_wp, 0.2278075804200e+01_wp, 0.6408777551755e+00_wp, &
      0.3966896193000e-08_wp, 0.5835747858477e+01_wp, 0.3773735910827e+00_wp, &
      0.3286695827610e-08_wp, 0.5838898193902e+01_wp, 0.3932462625300e-02_wp, &
      0.3720643094196e-08_wp, 0.1122212337858e+01_wp, 0.1646033343740e+02_wp, &
      0.3285508906174e-08_wp, 0.9182250996416e+00_wp, 0.1081813534213e+02_wp, &
      0.3753880575973e-08_wp, 0.5174761973266e+01_wp, 0.5642198095270e+01_wp, &
      0.3022129385587e-08_wp, 0.3381611020639e+01_wp, 0.2982630633589e+02_wp, &
      0.2798569205621e-08_wp, 0.3546193723922e+01_wp, 0.1937891852345e+02_wp /
    data ((e0(i,j,2),i=1,3),j=411,420) / &
      0.3397872070505e-08_wp, 0.4533203197934e+01_wp, 0.6923953605621e+01_wp, &
      0.3708099772977e-08_wp, 0.2756168198616e+01_wp, 0.3066615496545e+02_wp, &
      0.3599283541510e-08_wp, 0.1934395469918e+01_wp, 0.6147450479709e+01_wp, &
      0.3688702753059e-08_wp, 0.7149920971109e+00_wp, 0.2636725487657e+01_wp, &
      0.2681084724003e-08_wp, 0.4899819493154e+01_wp, 0.6816289982179e+01_wp, &
      0.3495993460759e-08_wp, 0.1572418915115e+01_wp, 0.6418701221183e+01_wp, &
      0.3130770324995e-08_wp, 0.8912190180489e+00_wp, 0.1235996607578e+02_wp, &
      0.2744353821941e-08_wp, 0.3800821940055e+01_wp, 0.2059724391010e+02_wp, &
      0.2842732906341e-08_wp, 0.2644717440029e+01_wp, 0.2828699048865e+02_wp, &
      0.3046882682154e-08_wp, 0.3987793020179e+01_wp, 0.6055599646783e+01_wp /
    data ((e0(i,j,2),i=1,3),j=421,430) / &
      0.2399072455143e-08_wp, 0.9908826440764e+00_wp, 0.6255674361143e+01_wp, &
      0.2384306274204e-08_wp, 0.2516149752220e+01_wp, 0.6310477339748e+01_wp, &
      0.2977324500559e-08_wp, 0.5849195642118e+01_wp, 0.1652265972112e+02_wp, &
      0.3062835258972e-08_wp, 0.1681660100162e+01_wp, 0.1172006883645e+02_wp, &
      0.3109682589231e-08_wp, 0.5804143987737e+00_wp, 0.2751146787858e+02_wp, &
      0.2903920355299e-08_wp, 0.5800768280123e+01_wp, 0.6510552054109e+01_wp, &
      0.2823221989212e-08_wp, 0.9241118370216e+00_wp, 0.5469525544182e+01_wp, &
      0.3187949696649e-08_wp, 0.3139776445735e+01_wp, 0.1693792562116e+03_wp, &
      0.2922559771655e-08_wp, 0.3549440782984e+01_wp, 0.2630839062450e+00_wp, &
      0.2436302066603e-08_wp, 0.4735540696319e+01_wp, 0.3946258593675e+00_wp /
    data ((e0(i,j,2),i=1,3),j=431,440) / &
      0.3049473043606e-08_wp, 0.4998289124561e+01_wp, 0.8390110365991e+01_wp, &
      0.2863682575784e-08_wp, 0.6709515671102e+00_wp, 0.2243449970715e+00_wp, &
      0.2641750517966e-08_wp, 0.5410978257284e+01_wp, 0.2986433403208e+02_wp, &
      0.2704093466243e-08_wp, 0.4778317207821e+01_wp, 0.6129297044991e+01_wp, &
      0.2445522177011e-08_wp, 0.6009020662222e+01_wp, 0.1171295538178e+02_wp, &
      0.2623608810230e-08_wp, 0.5010449777147e+01_wp, 0.6436854655901e+01_wp, &
      0.2079259704053e-08_wp, 0.5980943768809e+01_wp, 0.2019909489111e+02_wp, &
      0.2820225596771e-08_wp, 0.2679965110468e+01_wp, 0.5934151399930e+01_wp, &
      0.2365221950927e-08_wp, 0.1894231148810e+01_wp, 0.2470570524223e+02_wp, &
      0.2359682077149e-08_wp, 0.4220752950780e+01_wp, 0.8671969964381e+01_wp /
    data ((e0(i,j,2),i=1,3),j=441,450) / &
      0.2387577137206e-08_wp, 0.2571783940617e+01_wp, 0.7096626156709e+01_wp, &
      0.1982102089816e-08_wp, 0.5169765997119e+00_wp, 0.1727188400790e+02_wp, &
      0.2687502389925e-08_wp, 0.6239078264579e+01_wp, 0.7075506709219e+02_wp, &
      0.2207751669135e-08_wp, 0.2031184412677e+01_wp, 0.4377611041777e+01_wp, &
      0.2618370214274e-08_wp, 0.8266079985979e+00_wp, 0.6632000300961e+01_wp, &
      0.2591951887361e-08_wp, 0.8819350522008e+00_wp, 0.4873985990671e+02_wp, &
      0.2375055656248e-08_wp, 0.3520944177789e+01_wp, 0.1590676413561e+02_wp, &
      0.2472019978911e-08_wp, 0.1551431908671e+01_wp, 0.6612329252343e+00_wp, &
      0.2368157127199e-08_wp, 0.4178610147412e+01_wp, 0.3459636466239e+02_wp, &
      0.1764846605693e-08_wp, 0.1506764000157e+01_wp, 0.1980094587212e+02_wp /
    data ((e0(i,j,2),i=1,3),j=451,460) / &
      0.2291769608798e-08_wp, 0.2118250611782e+01_wp, 0.2844914056730e-01_wp, &
      0.2209997316943e-08_wp, 0.3363255261678e+01_wp, 0.2666070658668e+00_wp, &
      0.2292699097923e-08_wp, 0.4200423956460e+00_wp, 0.1484170571900e-02_wp, &
      0.1629683015329e-08_wp, 0.2331362582487e+01_wp, 0.3035599730800e+02_wp, &
      0.2206492862426e-08_wp, 0.3400274026992e+01_wp, 0.6281667977667e+01_wp, &
      0.2205746568257e-08_wp, 0.1066051230724e+00_wp, 0.6284483723224e+01_wp, &
      0.2026310767991e-08_wp, 0.2779066487979e+01_wp, 0.2449240616245e+02_wp, &
      0.1762977622163e-08_wp, 0.9951450691840e+00_wp, 0.2045286941806e+02_wp, &
      0.1368535049606e-08_wp, 0.6402447365817e+00_wp, 0.2473415438279e+02_wp, &
      0.1720598775450e-08_wp, 0.2303524214705e+00_wp, 0.1679593901136e+03_wp /
    data ((e0(i,j,2),i=1,3),j=461,470) / &
      0.1702429015449e-08_wp, 0.6164622655048e+01_wp, 0.3338575901272e+03_wp, &
      0.1414033197685e-08_wp, 0.3954561185580e+01_wp, 0.1624205518357e+03_wp, &
      0.1573768958043e-08_wp, 0.2028286308984e+01_wp, 0.3144167757552e+02_wp, &
      0.1650705184447e-08_wp, 0.2304040666128e+01_wp, 0.5267006960365e+02_wp, &
      0.1651087618855e-08_wp, 0.2538461057280e+01_wp, 0.8956999012000e+02_wp, &
      0.1616409518983e-08_wp, 0.5111054348152e+01_wp, 0.3332657872986e+02_wp, &
      0.1537175173581e-08_wp, 0.5601130666603e+01_wp, 0.3852657435933e+02_wp, &
      0.1593191980553e-08_wp, 0.2614340453411e+01_wp, 0.2282781046519e+03_wp, &
      0.1499480170643e-08_wp, 0.3624721577264e+01_wp, 0.2823723341956e+02_wp, &
      0.1493807843235e-08_wp, 0.4214569879008e+01_wp, 0.2876692439167e+02_wp /
    data ((e0(i,j,2),i=1,3),j=471,480) / &
      0.1074571199328e-08_wp, 0.1496911744704e+00_wp, 0.8397383534231e+02_wp, &
      0.1074406983417e-08_wp, 0.1187817671922e+01_wp, 0.8401985929482e+02_wp, &
      0.9757576855851e-09_wp, 0.2655703035858e+01_wp, 0.7826370942180e+02_wp, &
      0.1258432887565e-08_wp, 0.4969896184844e+01_wp, 0.3115650189215e+03_wp, &
      0.1240336343282e-08_wp, 0.5192460776926e+01_wp, 0.1784300471910e+03_wp, &
      0.9016107005164e-09_wp, 0.1960356923057e+01_wp, 0.5886454391678e+02_wp, &
      0.1135392360918e-08_wp, 0.5082427809068e+01_wp, 0.7842370451713e+02_wp, &
      0.9216046089565e-09_wp, 0.2793775037273e+01_wp, 0.1014262087719e+03_wp, &
      0.1061276615030e-08_wp, 0.3726144311409e+01_wp, 0.5660027930059e+02_wp, &
      0.1010110596263e-08_wp, 0.7404080708937e+00_wp, 0.4245678405627e+02_wp /
    data ((e0(i,j,2),i=1,3),j=481,490) / &
      0.7217424756199e-09_wp, 0.2697449980577e-01_wp, 0.2457074661053e+03_wp, &
      0.6912003846756e-09_wp, 0.4253296276335e+01_wp, 0.1679936946371e+03_wp, &
      0.6871814664847e-09_wp, 0.5148072412354e+01_wp, 0.6053048899753e+02_wp, &
      0.4887158016343e-09_wp, 0.2153581148294e+01_wp, 0.9656299901946e+02_wp, &
      0.5161802866314e-09_wp, 0.3852750634351e+01_wp, 0.2442876000072e+03_wp, &
      0.5652599559057e-09_wp, 0.1233233356270e+01_wp, 0.8365903305582e+02_wp, &
      0.4710812608586e-09_wp, 0.5610486976767e+01_wp, 0.3164282286739e+03_wp, &
      0.4909977500324e-09_wp, 0.1639629524123e+01_wp, 0.4059982187939e+03_wp, &
      0.4772641839378e-09_wp, 0.3737100368583e+01_wp, 0.1805255418145e+03_wp, &
      0.4487562567153e-09_wp, 0.1158417054478e+00_wp, 0.8433466158131e+02_wp /
    data ((e0(i,j,2),i=1,3),j=491,500) / &
      0.3943441230497e-09_wp, 0.6243502862796e+00_wp, 0.2568537517081e+03_wp, &
      0.3952236913598e-09_wp, 0.3510377382385e+01_wp, 0.2449975330562e+03_wp, &
      0.3788898363417e-09_wp, 0.5916128302299e+01_wp, 0.1568131045107e+03_wp, &
      0.3738329328831e-09_wp, 0.1042266763456e+01_wp, 0.3948519331910e+03_wp, &
      0.2451199165151e-09_wp, 0.1166788435700e+01_wp, 0.1435713242844e+03_wp, &
      0.2436734402904e-09_wp, 0.3254726114901e+01_wp, 0.2268582385539e+03_wp, &
      0.2213605274325e-09_wp, 0.1687210598530e+01_wp, 0.1658638954901e+03_wp, &
      0.1491521204829e-09_wp, 0.2657541786794e+01_wp, 0.2219950288015e+03_wp, &
      0.1474995329744e-09_wp, 0.5013089805819e+01_wp, 0.3052819430710e+03_wp, &
      0.1661939475656e-09_wp, 0.5495315428418e+01_wp, 0.2526661704812e+03_wp /
    data ((e0(i,j,2),i=1,3),j=501,ne0y) / &
      0.9015946748003e-10_wp, 0.2236989966505e+01_wp, 0.4171445043968e+03_wp /

    !  Sun-to-Earth, T^1, Y
    data ((e1(i,j,2),i=1,3),j=  1, 10) / &
      0.9304690546528e-06_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.5150715570663e-06_wp, 0.4431807116294e+01_wp, 0.1256615170089e+02_wp, &
      0.1290825411056e-07_wp, 0.4388610039678e+01_wp, 0.1884922755134e+02_wp, &
      0.4645466665386e-08_wp, 0.5827263376034e+01_wp, 0.6283075850446e+01_wp, &
      0.2079625310718e-08_wp, 0.1621698662282e+00_wp, 0.6279552690824e+01_wp, &
      0.2078189850907e-08_wp, 0.3344713435140e+01_wp, 0.6286599010068e+01_wp, &
      0.6207190138027e-09_wp, 0.5074049319576e+01_wp, 0.4705732307012e+01_wp, &
      0.5989826532569e-09_wp, 0.2231842216620e+01_wp, 0.6256777527156e+01_wp, &
      0.5961360812618e-09_wp, 0.1274975769045e+01_wp, 0.6309374173736e+01_wp, &
      0.4874165471016e-09_wp, 0.3642277426779e+01_wp, 0.7755226100720e+00_wp /
    data ((e1(i,j,2),i=1,3),j= 11, 20) / &
      0.4283834034360e-09_wp, 0.5148765510106e+01_wp, 0.1059381944224e+01_wp, &
      0.4652389287529e-09_wp, 0.4715794792175e+01_wp, 0.7860419393880e+01_wp, &
      0.3751707476401e-09_wp, 0.6617207370325e+00_wp, 0.5753384878334e+01_wp, &
      0.3559998806198e-09_wp, 0.6155548875404e+01_wp, 0.5884926831456e+01_wp, &
      0.3558447558857e-09_wp, 0.2898827297664e+01_wp, 0.6812766822558e+01_wp, &
      0.3211116927106e-09_wp, 0.3625813502509e+01_wp, 0.6681224869435e+01_wp, &
      0.2875609914672e-09_wp, 0.4345435813134e+01_wp, 0.2513230340178e+02_wp, &
      0.2843109704069e-09_wp, 0.5862263940038e+01_wp, 0.6127655567643e+01_wp, &
      0.2744676468427e-09_wp, 0.3926419475089e+01_wp, 0.6438496133249e+01_wp, &
      0.2481285237789e-09_wp, 0.1351976572828e+01_wp, 0.5486777812467e+01_wp /
    data ((e1(i,j,2),i=1,3),j= 21, 30) / &
      0.2060338481033e-09_wp, 0.2147556998591e+01_wp, 0.7079373888424e+01_wp, &
      0.2015822358331e-09_wp, 0.4408358972216e+01_wp, 0.6290189305114e+01_wp, &
      0.2001195944195e-09_wp, 0.5385829822531e+01_wp, 0.6275962395778e+01_wp, &
      0.1953667642377e-09_wp, 0.1304933746120e+01_wp, 0.5507553240374e+01_wp, &
      0.1839744078713e-09_wp, 0.6173567228835e+01_wp, 0.1179062909082e+02_wp, &
      0.1643334294845e-09_wp, 0.4635942997523e+01_wp, 0.1150676975667e+02_wp, &
      0.1768051018652e-09_wp, 0.5086283558874e+01_wp, 0.7113454667900e-02_wp, &
      0.1674874205489e-09_wp, 0.2243332137241e+01_wp, 0.7058598460518e+01_wp, &
      0.1421445397609e-09_wp, 0.6186899771515e+01_wp, 0.7962980379786e+00_wp, &
      0.1255163958267e-09_wp, 0.5730238465658e+01_wp, 0.4694002934110e+01_wp /
    data ((e1(i,j,2),i=1,3),j= 31, 40) / &
      0.1013945281961e-09_wp, 0.1726055228402e+01_wp, 0.3738761453707e+01_wp, &
      0.1047294335852e-09_wp, 0.2658801228129e+01_wp, 0.6282095334605e+01_wp, &
      0.1047103879392e-09_wp, 0.8481047835035e+00_wp, 0.6284056366286e+01_wp, &
      0.9530343962826e-10_wp, 0.3079267149859e+01_wp, 0.6069776770667e+01_wp, &
      0.9604637611690e-10_wp, 0.3258679792918e+00_wp, 0.4136910472696e+01_wp, &
      0.9153518537177e-10_wp, 0.4398599886584e+00_wp, 0.6496374930224e+01_wp, &
      0.8562458214922e-10_wp, 0.4772686794145e+01_wp, 0.1194447056968e+01_wp, &
      0.8232525360654e-10_wp, 0.5966220721679e+01_wp, 0.1589072916335e+01_wp, &
      0.6150223411438e-10_wp, 0.1780985591923e+01_wp, 0.8827390247185e+01_wp, &
      0.6272087858000e-10_wp, 0.3184305429012e+01_wp, 0.8429241228195e+01_wp /
    data ((e1(i,j,2),i=1,3),j= 41, 50) / &
      0.5540476311040e-10_wp, 0.3801260595433e+01_wp, 0.4933208510675e+01_wp, &
      0.7331901699361e-10_wp, 0.5205948591865e+01_wp, 0.4535059491685e+01_wp, &
      0.6018528702791e-10_wp, 0.4770139083623e+01_wp, 0.1255903824622e+02_wp, &
      0.5150530724804e-10_wp, 0.3574796899585e+01_wp, 0.1176985366291e+02_wp, &
      0.6471933741811e-10_wp, 0.2679787266521e+01_wp, 0.5088628793478e+01_wp, &
      0.5317460644174e-10_wp, 0.9528763345494e+00_wp, 0.3154687086868e+01_wp, &
      0.4832187748783e-10_wp, 0.5329322498232e+01_wp, 0.6040347114260e+01_wp, &
      0.4716763555110e-10_wp, 0.2395235316466e+01_wp, 0.5331357529664e+01_wp, &
      0.4871509139861e-10_wp, 0.3056663648823e+01_wp, 0.1256967486051e+02_wp, &
      0.4598417696768e-10_wp, 0.4452762609019e+01_wp, 0.6525804586632e+01_wp /
    data ((e1(i,j,2),i=1,3),j= 51, 60) / &
      0.5674189533175e-10_wp, 0.9879680872193e+00_wp, 0.5729506548653e+01_wp, &
      0.4073560328195e-10_wp, 0.5939127696986e+01_wp, 0.7632943190217e+01_wp, &
      0.5040994945359e-10_wp, 0.4549875824510e+01_wp, 0.8031092209206e+01_wp, &
      0.5078185134679e-10_wp, 0.7346659893982e+00_wp, 0.7477522907414e+01_wp, &
      0.3769343537061e-10_wp, 0.1071317188367e+01_wp, 0.7234794171227e+01_wp, &
      0.4980331365299e-10_wp, 0.2500345341784e+01_wp, 0.6836645152238e+01_wp, &
      0.3458236594757e-10_wp, 0.3825159450711e+01_wp, 0.1097707878456e+02_wp, &
      0.3578859493602e-10_wp, 0.5299664791549e+01_wp, 0.4164311961999e+01_wp, &
      0.3370504646419e-10_wp, 0.5002316301593e+01_wp, 0.1137170464392e+02_wp, &
      0.3299873338428e-10_wp, 0.2526123275282e+01_wp, 0.3930209696940e+01_wp /
    data ((e1(i,j,2),i=1,3),j= 61, 70) / &
      0.4304917318409e-10_wp, 0.3368078557132e+01_wp, 0.1592596075957e+01_wp, &
      0.3402418753455e-10_wp, 0.8385495425800e+00_wp, 0.3128388763578e+01_wp, &
      0.2778460572146e-10_wp, 0.3669905203240e+01_wp, 0.7342457794669e+01_wp, &
      0.2782710128902e-10_wp, 0.2691664812170e+00_wp, 0.1748016358760e+01_wp, &
      0.2711725179646e-10_wp, 0.4707487217718e+01_wp, 0.5296909721118e+00_wp, &
      0.2981760946340e-10_wp, 0.3190260867816e+00_wp, 0.5368044267797e+00_wp, &
      0.2811672977772e-10_wp, 0.3196532315372e+01_wp, 0.7084896783808e+01_wp, &
      0.2863454474467e-10_wp, 0.2263240324780e+00_wp, 0.5223693906222e+01_wp, &
      0.3333464634051e-10_wp, 0.3498451685065e+01_wp, 0.8018209333619e+00_wp, &
      0.3312991747609e-10_wp, 0.5839154477412e+01_wp, 0.1554202828031e+00_wp /
    data ((e1(i,j,2),i=1,3),j= 71,ne1y) / &
      0.2813255564006e-10_wp, 0.8268044346621e+00_wp, 0.5225775174439e+00_wp, &
      0.2665098083966e-10_wp, 0.3934021725360e+01_wp, 0.5216580451554e+01_wp, &
      0.2349795705216e-10_wp, 0.5197620913779e+01_wp, 0.2146165377750e+01_wp, &
      0.2330352293961e-10_wp, 0.2984999231807e+01_wp, 0.1726015463500e+02_wp, &
      0.2728001683419e-10_wp, 0.6521679638544e+00_wp, 0.8635942003952e+01_wp, &
      0.2484061007669e-10_wp, 0.3468955561097e+01_wp, 0.5230807360890e+01_wp, &
      0.2646328768427e-10_wp, 0.1013724533516e+01_wp, 0.2629832328990e-01_wp, &
      0.2518630264831e-10_wp, 0.6108081057122e+01_wp, 0.5481254917084e+01_wp, &
      0.2421901455384e-10_wp, 0.1651097776260e+01_wp, 0.1349867339771e+01_wp, &
      0.6348533267831e-11_wp, 0.3220226560321e+01_wp, 0.8433466158131e+02_wp /

    !  Sun-to-Earth, T^2, Y
    data ((e2(i,j,2),i=1,3),j=  1,ne2y) / &
      0.5063375872532e-10_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.2173815785980e-10_wp, 0.2827805833053e+01_wp, 0.1256615170089e+02_wp, &
      0.1010231999920e-10_wp, 0.4634612377133e+01_wp, 0.6283075850446e+01_wp, &
      0.9259745317636e-12_wp, 0.2620612076189e+01_wp, 0.1884922755134e+02_wp, &
      0.1022202095812e-12_wp, 0.3809562326066e+01_wp, 0.8399684731857e+02_wp /

    !  Sun-to-Earth, T^0, Z
    data ((e0(i,j,3),i=1,3),j=  1, 10) / &
      0.2796207639075e-05_wp, 0.3198701560209e+01_wp, 0.8433466158131e+02_wp, &
      0.1016042198142e-05_wp, 0.5422360395913e+01_wp, 0.5507553240374e+01_wp, &
      0.8044305033647e-06_wp, 0.3880222866652e+01_wp, 0.5223693906222e+01_wp, &
      0.4385347909274e-06_wp, 0.3704369937468e+01_wp, 0.2352866153506e+01_wp, &
      0.3186156414906e-06_wp, 0.3999639363235e+01_wp, 0.1577343543434e+01_wp, &
      0.2272412285792e-06_wp, 0.3984738315952e+01_wp, 0.1047747311755e+01_wp, &
      0.1645620103007e-06_wp, 0.3565412516841e+01_wp, 0.5856477690889e+01_wp, &
      0.1815836921166e-06_wp, 0.4984507059020e+01_wp, 0.6283075850446e+01_wp, &
      0.1447461676364e-06_wp, 0.3702753570108e+01_wp, 0.9437762937313e+01_wp, &
      0.1430760876382e-06_wp, 0.3409658712357e+01_wp, 0.1021328554739e+02_wp /
    data ((e0(i,j,3),i=1,3),j= 11, 20) / &
      0.1120445753226e-06_wp, 0.4829561570246e+01_wp, 0.1414349524433e+02_wp, &
      0.1090232840797e-06_wp, 0.2080729178066e+01_wp, 0.6812766822558e+01_wp, &
      0.9715727346551e-07_wp, 0.3476295881948e+01_wp, 0.4694002934110e+01_wp, &
      0.1036267136217e-06_wp, 0.4056639536648e+01_wp, 0.7109288135493e+02_wp, &
      0.8752665271340e-07_wp, 0.4448159519911e+01_wp, 0.5753384878334e+01_wp, &
      0.8331864956004e-07_wp, 0.4991704044208e+01_wp, 0.7084896783808e+01_wp, &
      0.6901658670245e-07_wp, 0.4325358994219e+01_wp, 0.6275962395778e+01_wp, &
      0.9144536848998e-07_wp, 0.1141826375363e+01_wp, 0.6620890113188e+01_wp, &
      0.7205085037435e-07_wp, 0.3624344170143e+01_wp, 0.5296909721118e+00_wp, &
      0.7697874654176e-07_wp, 0.5554257458998e+01_wp, 0.1676215758509e+03_wp /
    data ((e0(i,j,3),i=1,3),j= 21, 30) / &
      0.5197545738384e-07_wp, 0.6251760961735e+01_wp, 0.1807370494127e+02_wp, &
      0.5031345378608e-07_wp, 0.2497341091913e+01_wp, 0.4705732307012e+01_wp, &
      0.4527110205840e-07_wp, 0.2335079920992e+01_wp, 0.6309374173736e+01_wp, &
      0.4753355798089e-07_wp, 0.7094148987474e+00_wp, 0.5884926831456e+01_wp, &
      0.4296951977516e-07_wp, 0.1101916352091e+01_wp, 0.6681224869435e+01_wp, &
      0.3855341568387e-07_wp, 0.1825495405486e+01_wp, 0.5486777812467e+01_wp, &
      0.5253930970990e-07_wp, 0.4424740687208e+01_wp, 0.7860419393880e+01_wp, &
      0.4024630496471e-07_wp, 0.5120498157053e+01_wp, 0.1336797263425e+02_wp, &
      0.4061069791453e-07_wp, 0.6029771435451e+01_wp, 0.3930209696940e+01_wp, &
      0.3797883804205e-07_wp, 0.4435193600836e+00_wp, 0.3154687086868e+01_wp /
    data ((e0(i,j,3),i=1,3),j= 31, 40) / &
      0.2933033225587e-07_wp, 0.5124157356507e+01_wp, 0.1059381944224e+01_wp, &
      0.3503000930426e-07_wp, 0.5421830162065e+01_wp, 0.6069776770667e+01_wp, &
      0.3670096214050e-07_wp, 0.4582101667297e+01_wp, 0.1219403291462e+02_wp, &
      0.2905609437008e-07_wp, 0.1926566420072e+01_wp, 0.1097707878456e+02_wp, &
      0.2466827821713e-07_wp, 0.6090174539834e+00_wp, 0.6496374930224e+01_wp, &
      0.2691647295332e-07_wp, 0.1393432595077e+01_wp, 0.2200391463820e+02_wp, &
      0.2150554667946e-07_wp, 0.4308671715951e+01_wp, 0.5643178611111e+01_wp, &
      0.2237481922680e-07_wp, 0.8133968269414e+00_wp, 0.8635942003952e+01_wp, &
      0.1817741038157e-07_wp, 0.3755205127454e+01_wp, 0.3340612434717e+01_wp, &
      0.2227820762132e-07_wp, 0.2759558596664e+01_wp, 0.1203646072878e+02_wp /
    data ((e0(i,j,3),i=1,3),j= 41, 50) / &
      0.1944713772307e-07_wp, 0.5699645869121e+01_wp, 0.1179062909082e+02_wp, &
      0.1527340520662e-07_wp, 0.1986749091746e+01_wp, 0.3981490189893e+00_wp, &
      0.1577282574914e-07_wp, 0.3205017217983e+01_wp, 0.5088628793478e+01_wp, &
      0.1424738825424e-07_wp, 0.6256747903666e+01_wp, 0.2544314396739e+01_wp, &
      0.1616563121701e-07_wp, 0.2601671259394e+00_wp, 0.1729818233119e+02_wp, &
      0.1401210391692e-07_wp, 0.4686939173506e+01_wp, 0.7058598460518e+01_wp, &
      0.1488726974214e-07_wp, 0.2815862451372e+01_wp, 0.2593412433514e+02_wp, &
      0.1692626442388e-07_wp, 0.4956894109797e+01_wp, 0.1564752902480e+03_wp, &
      0.1123571582910e-07_wp, 0.2381192697696e+01_wp, 0.3738761453707e+01_wp, &
      0.9903308606317e-08_wp, 0.4294851657684e+01_wp, 0.9225539266174e+01_wp /
    data ((e0(i,j,3),i=1,3),j= 51, 60) / &
      0.9174533187191e-08_wp, 0.3075171510642e+01_wp, 0.4164311961999e+01_wp, &
      0.8645985631457e-08_wp, 0.5477534821633e+00_wp, 0.8429241228195e+01_wp, &
     -0.1085876492688e-07_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.9264309077815e-08_wp, 0.5968571670097e+01_wp, 0.7079373888424e+01_wp, &
      0.8243116984954e-08_wp, 0.1489098777643e+01_wp, 0.1044738781244e+02_wp, &
      0.8268102113708e-08_wp, 0.3512977691983e+01_wp, 0.1150676975667e+02_wp, &
      0.9043613988227e-08_wp, 0.1290704408221e+00_wp, 0.1101510648075e+02_wp, &
      0.7432912038789e-08_wp, 0.1991086893337e+01_wp, 0.2608790314060e+02_wp, &
      0.8586233727285e-08_wp, 0.4238357924414e+01_wp, 0.2986433403208e+02_wp, &
      0.7612230060131e-08_wp, 0.2911090150166e+01_wp, 0.4732030630302e+01_wp /
    data ((e0(i,j,3),i=1,3),j= 61, 70) / &
      0.7097787751408e-08_wp, 0.1908938392390e+01_wp, 0.8031092209206e+01_wp, &
      0.7640237040175e-08_wp, 0.6129219000168e+00_wp, 0.7962980379786e+00_wp, &
      0.7070445688081e-08_wp, 0.1380417036651e+01_wp, 0.2146165377750e+01_wp, &
      0.7690770957702e-08_wp, 0.1680504249084e+01_wp, 0.2122839202813e+02_wp, &
      0.8051292542594e-08_wp, 0.5127423484511e+01_wp, 0.2942463415728e+01_wp, &
      0.5902709104515e-08_wp, 0.2020274190917e+01_wp, 0.7755226100720e+00_wp, &
      0.5134567496462e-08_wp, 0.2606778676418e+01_wp, 0.1256615170089e+02_wp, &
      0.5525802046102e-08_wp, 0.1613011769663e+01_wp, 0.8018209333619e+00_wp, &
      0.5880724784221e-08_wp, 0.4604483417236e+01_wp, 0.4690479774488e+01_wp, &
      0.5211699081370e-08_wp, 0.5718964114193e+01_wp, 0.8827390247185e+01_wp /
    data ((e0(i,j,3),i=1,3),j= 71, 80) / &
      0.4891849573562e-08_wp, 0.3689658932196e+01_wp, 0.2132990797783e+00_wp, &
      0.5150246069997e-08_wp, 0.4099769855122e+01_wp, 0.6480980550449e+02_wp, &
      0.5102434319633e-08_wp, 0.5660834602509e+01_wp, 0.3379454372902e+02_wp, &
      0.5083405254252e-08_wp, 0.9842221218974e+00_wp, 0.4136910472696e+01_wp, &
      0.4206562585682e-08_wp, 0.1341363634163e+00_wp, 0.3128388763578e+01_wp, &
      0.4663249683579e-08_wp, 0.8130132735866e+00_wp, 0.5216580451554e+01_wp, &
      0.4099474416530e-08_wp, 0.5791497770644e+01_wp, 0.4265981595566e+00_wp, &
      0.4628251220767e-08_wp, 0.1249802769331e+01_wp, 0.1572083878776e+02_wp, &
      0.5024068728142e-08_wp, 0.4795684802743e+01_wp, 0.6290189305114e+01_wp, &
      0.5120234327758e-08_wp, 0.3810420387208e+01_wp, 0.5230807360890e+01_wp /
    data ((e0(i,j,3),i=1,3),j= 81, 90) / &
      0.5524029815280e-08_wp, 0.1029264714351e+01_wp, 0.2397622045175e+03_wp, &
      0.4757415718860e-08_wp, 0.3528044781779e+01_wp, 0.1649636139783e+02_wp, &
      0.3915786131127e-08_wp, 0.5593889282646e+01_wp, 0.1589072916335e+01_wp, &
      0.4869053149991e-08_wp, 0.3299636454433e+01_wp, 0.7632943190217e+01_wp, &
      0.3649365703729e-08_wp, 0.1286049002584e+01_wp, 0.6206810014183e+01_wp, &
      0.3992493949002e-08_wp, 0.3100307589464e+01_wp, 0.2515860172507e+02_wp, &
      0.3320247477418e-08_wp, 0.6212683940807e+01_wp, 0.1216800268190e+02_wp, &
      0.3287123739696e-08_wp, 0.4699118445928e+01_wp, 0.7234794171227e+01_wp, &
      0.3472776811103e-08_wp, 0.2630507142004e+01_wp, 0.7342457794669e+01_wp, &
      0.3423253294767e-08_wp, 0.2946432844305e+01_wp, 0.9623688285163e+01_wp /
    data ((e0(i,j,3),i=1,3),j= 91,100) / &
      0.3896173898244e-08_wp, 0.1224834179264e+01_wp, 0.6438496133249e+01_wp, &
      0.3388455337924e-08_wp, 0.1543807616351e+01_wp, 0.1494531617769e+02_wp, &
      0.3062704716523e-08_wp, 0.1191777572310e+01_wp, 0.8662240327241e+01_wp, &
      0.3270075600400e-08_wp, 0.5483498767737e+01_wp, 0.1194447056968e+01_wp, &
      0.3101209215259e-08_wp, 0.8000833804348e+00_wp, 0.3772475342596e+02_wp, &
      0.2780883347311e-08_wp, 0.4077980721888e+00_wp, 0.5863591145557e+01_wp, &
      0.2903605931824e-08_wp, 0.2617490302147e+01_wp, 0.1965104848470e+02_wp, &
      0.2682014743119e-08_wp, 0.2634703158290e+01_wp, 0.7238675589263e+01_wp, &
      0.2534360108492e-08_wp, 0.6102446114873e+01_wp, 0.6836645152238e+01_wp, &
      0.2392564882509e-08_wp, 0.3681820208691e+01_wp, 0.5849364236221e+01_wp /
    data ((e0(i,j,3),i=1,3),j=101,110) / &
      0.2656667254856e-08_wp, 0.6216045388886e+01_wp, 0.6133512519065e+01_wp, &
      0.2331242096773e-08_wp, 0.5864949777744e+01_wp, 0.4535059491685e+01_wp, &
      0.2287898363668e-08_wp, 0.4566628532802e+01_wp, 0.7477522907414e+01_wp, &
      0.2336944521306e-08_wp, 0.2442722126930e+01_wp, 0.1137170464392e+02_wp, &
      0.3156632236269e-08_wp, 0.1626628050682e+01_wp, 0.2509084901204e+03_wp, &
      0.2982612402766e-08_wp, 0.2803604512609e+01_wp, 0.1748016358760e+01_wp, &
      0.2774031674807e-08_wp, 0.4654002897158e+01_wp, 0.8223916695780e+02_wp, &
      0.2295236548638e-08_wp, 0.4326518333253e+01_wp, 0.3378142627421e+00_wp, &
      0.2190714699873e-08_wp, 0.4519614578328e+01_wp, 0.2908881142201e+02_wp, &
      0.2191495845045e-08_wp, 0.3012626912549e+01_wp, 0.1673046366289e+02_wp /
    data ((e0(i,j,3),i=1,3),j=111,120) / &
      0.2492901628386e-08_wp, 0.1290101424052e+00_wp, 0.1543797956245e+03_wp, &
      0.1993778064319e-08_wp, 0.3864046799414e+01_wp, 0.1778984560711e+02_wp, &
      0.1898146479022e-08_wp, 0.5053777235891e+01_wp, 0.2042657109477e+02_wp, &
      0.1918280127634e-08_wp, 0.2222470192548e+01_wp, 0.4165496312290e+02_wp, &
      0.1916351061607e-08_wp, 0.8719067257774e+00_wp, 0.7737595720538e+02_wp, &
      0.1834720181466e-08_wp, 0.4031491098040e+01_wp, 0.2358125818164e+02_wp, &
      0.1249201523806e-08_wp, 0.5938379466835e+01_wp, 0.3301902111895e+02_wp, &
      0.1477304050539e-08_wp, 0.6544722606797e+00_wp, 0.9548094718417e+02_wp, &
      0.1264316431249e-08_wp, 0.2059072853236e+01_wp, 0.8399684731857e+02_wp, &
      0.1203526495039e-08_wp, 0.3644813532605e+01_wp, 0.4558517281984e+02_wp /
    data ((e0(i,j,3),i=1,3),j=121,130) / &
      0.9221681059831e-09_wp, 0.3241815055602e+01_wp, 0.7805158573086e+02_wp, &
      0.7849278367646e-09_wp, 0.5043812342457e+01_wp, 0.5217580628120e+02_wp, &
      0.7983392077387e-09_wp, 0.5000024502753e+01_wp, 0.1501922143975e+03_wp, &
      0.7925395431654e-09_wp, 0.1398734871821e-01_wp, 0.9061773743175e+02_wp, &
      0.7640473285886e-09_wp, 0.5067111723130e+01_wp, 0.4951538251678e+02_wp, &
      0.5398937754482e-09_wp, 0.5597382200075e+01_wp, 0.1613385000004e+03_wp, &
      0.5626247550193e-09_wp, 0.2601338209422e+01_wp, 0.7318837597844e+02_wp, &
      0.5525197197855e-09_wp, 0.5814832109256e+01_wp, 0.1432335100216e+03_wp, &
      0.5407629837898e-09_wp, 0.3384820609076e+01_wp, 0.3230491187871e+03_wp, &
      0.3856739119801e-09_wp, 0.1072391840473e+01_wp, 0.2334791286671e+03_wp /
    data ((e0(i,j,3),i=1,3),j=131,ne0z) / &
      0.3856425239987e-09_wp, 0.2369540393327e+01_wp, 0.1739046517013e+03_wp, &
      0.4350867755983e-09_wp, 0.5255575751082e+01_wp, 0.1620484330494e+03_wp, &
      0.3844113924996e-09_wp, 0.5482356246182e+01_wp, 0.9757644180768e+02_wp, &
      0.2854869155431e-09_wp, 0.9573634763143e+00_wp, 0.1697170704744e+03_wp, &
      0.1719227671416e-09_wp, 0.1887203025202e+01_wp, 0.2265204242912e+03_wp, &
      0.1527846879755e-09_wp, 0.3982183931157e+01_wp, 0.3341954043900e+03_wp, &
      0.1128229264847e-09_wp, 0.2787457156298e+01_wp, 0.3119028331842e+03_wp /

    !  Sun-to-Earth, T^1, Z
    data ((e1(i,j,3),i=1,3),j=  1, 10) / &
      0.2278290449966e-05_wp, 0.3413716033863e+01_wp, 0.6283075850446e+01_wp, &
      0.5429458209830e-07_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.1903240492525e-07_wp, 0.3370592358297e+01_wp, 0.1256615170089e+02_wp, &
      0.2385409276743e-09_wp, 0.3327914718416e+01_wp, 0.1884922755134e+02_wp, &
      0.8676928342573e-10_wp, 0.1824006811264e+01_wp, 0.5223693906222e+01_wp, &
      0.7765442593544e-10_wp, 0.3888564279247e+01_wp, 0.5507553240374e+01_wp, &
      0.7066158332715e-10_wp, 0.5194267231944e+01_wp, 0.2352866153506e+01_wp, &
      0.7092175288657e-10_wp, 0.2333246960021e+01_wp, 0.8399684731857e+02_wp, &
      0.5357582213535e-10_wp, 0.2224031176619e+01_wp, 0.5296909721118e+00_wp, &
      0.3828035865021e-10_wp, 0.2156710933584e+01_wp, 0.6279552690824e+01_wp /
    data ((e1(i,j,3),i=1,3),j= 11,ne1z) / &
      0.3824857220427e-10_wp, 0.1529755219915e+01_wp, 0.6286599010068e+01_wp, &
      0.3286995181628e-10_wp, 0.4879512900483e+01_wp, 0.1021328554739e+02_wp /

    !  Sun-to-Earth, T^2, Z
    data ((e2(i,j,3),i=1,3),j=  1,ne2z) / &
      0.9722666114891e-10_wp, 0.5152219582658e+01_wp, 0.6283075850446e+01_wp, &
     -0.3494819171909e-11_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.6713034376076e-12_wp, 0.6440188750495e+00_wp, 0.1256615170089e+02_wp /

    !  SSB-to-Sun, T^0, X
    data ((s0(i,j,1),i=1,3),j=  1, 10) / &
      0.4956757536410e-02_wp, 0.3741073751789e+01_wp, 0.5296909721118e+00_wp, &
      0.2718490072522e-02_wp, 0.4016011511425e+01_wp, 0.2132990797783e+00_wp, &
      0.1546493974344e-02_wp, 0.2170528330642e+01_wp, 0.3813291813120e-01_wp, &
      0.8366855276341e-03_wp, 0.2339614075294e+01_wp, 0.7478166569050e-01_wp, &
      0.2936777942117e-03_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.1201317439469e-03_wp, 0.4090736353305e+01_wp, 0.1059381944224e+01_wp, &
      0.7578550887230e-04_wp, 0.3241518088140e+01_wp, 0.4265981595566e+00_wp, &
      0.1941787367773e-04_wp, 0.1012202064330e+01_wp, 0.2061856251104e+00_wp, &
      0.1889227765991e-04_wp, 0.3892520416440e+01_wp, 0.2204125344462e+00_wp, &
      0.1937896968613e-04_wp, 0.4797779441161e+01_wp, 0.1495633313810e+00_wp /
    data ((s0(i,j,1),i=1,3),j= 11, 20) / &
      0.1434506110873e-04_wp, 0.3868960697933e+01_wp, 0.5225775174439e+00_wp, &
      0.1406659911580e-04_wp, 0.4759766557397e+00_wp, 0.5368044267797e+00_wp, &
      0.1179022300202e-04_wp, 0.7774961520598e+00_wp, 0.7626583626240e-01_wp, &
      0.8085864460959e-05_wp, 0.3254654471465e+01_wp, 0.3664874755930e-01_wp, &
      0.7622752967615e-05_wp, 0.4227633103489e+01_wp, 0.3961708870310e-01_wp, &
      0.6209171139066e-05_wp, 0.2791828325711e+00_wp, 0.7329749511860e-01_wp, &
      0.4366435633970e-05_wp, 0.4440454875925e+01_wp, 0.1589072916335e+01_wp, &
      0.3792124889348e-05_wp, 0.5156393842356e+01_wp, 0.7113454667900e-02_wp, &
      0.3154548963402e-05_wp, 0.6157005730093e+01_wp, 0.4194847048887e+00_wp, &
      0.3088359882942e-05_wp, 0.2494567553163e+01_wp, 0.6398972393349e+00_wp /
    data ((s0(i,j,1),i=1,3),j= 21, 30) / &
      0.2788440902136e-05_wp, 0.4934318747989e+01_wp, 0.1102062672231e+00_wp, &
      0.3039928456376e-05_wp, 0.4895077702640e+01_wp, 0.6283075850446e+01_wp, &
      0.2272258457679e-05_wp, 0.5278394064764e+01_wp, 0.1030928125552e+00_wp, &
      0.2162007057957e-05_wp, 0.5802978019099e+01_wp, 0.3163918923335e+00_wp, &
      0.1767632855737e-05_wp, 0.3415346595193e-01_wp, 0.1021328554739e+02_wp, &
      0.1349413459362e-05_wp, 0.2001643230755e+01_wp, 0.1484170571900e-02_wp, &
      0.1170141900476e-05_wp, 0.2424750491620e+01_wp, 0.6327837846670e+00_wp, &
      0.1054355266820e-05_wp, 0.3123311487576e+01_wp, 0.4337116142245e+00_wp, &
      0.9800822461610e-06_wp, 0.3026258088130e+01_wp, 0.1052268489556e+01_wp, &
      0.1091203749931e-05_wp, 0.3157811670347e+01_wp, 0.1162474756779e+01_wp /
    data ((s0(i,j,1),i=1,3),j= 31, 40) / &
      0.6960236715913e-06_wp, 0.8219570542313e+00_wp, 0.1066495398892e+01_wp, &
      0.5689257296909e-06_wp, 0.1323052375236e+01_wp, 0.9491756770005e+00_wp, &
      0.6613172135802e-06_wp, 0.2765348881598e+00_wp, 0.8460828644453e+00_wp, &
      0.6277702517571e-06_wp, 0.5794064466382e+01_wp, 0.1480791608091e+00_wp, &
      0.6304884066699e-06_wp, 0.7323555380787e+00_wp, 0.2243449970715e+00_wp, &
      0.4897850467382e-06_wp, 0.3062464235399e+01_wp, 0.3340612434717e+01_wp, &
      0.3759148598786e-06_wp, 0.4588290469664e+01_wp, 0.3516457698740e-01_wp, &
      0.3110520548195e-06_wp, 0.1374299536572e+01_wp, 0.6373574839730e-01_wp, &
      0.3064708359780e-06_wp, 0.4222267485047e+01_wp, 0.1104591729320e-01_wp, &
      0.2856347168241e-06_wp, 0.3714202944973e+01_wp, 0.1510475019529e+00_wp /
    data ((s0(i,j,1),i=1,3),j= 41, 50) / &
      0.2840945514288e-06_wp, 0.2847972875882e+01_wp, 0.4110125927500e-01_wp, &
      0.2378951599405e-06_wp, 0.3762072563388e+01_wp, 0.2275259891141e+00_wp, &
      0.2714229481417e-06_wp, 0.1036049980031e+01_wp, 0.2535050500000e-01_wp, &
      0.2323551717307e-06_wp, 0.4682388599076e+00_wp, 0.8582758298370e-01_wp, &
      0.1881790512219e-06_wp, 0.4790565425418e+01_wp, 0.2118763888447e+01_wp, &
      0.2261353968371e-06_wp, 0.1669144912212e+01_wp, 0.7181332454670e-01_wp, &
      0.2214546389848e-06_wp, 0.3937717281614e+01_wp, 0.2968341143800e-02_wp, &
      0.2184915594933e-06_wp, 0.1129169845099e+00_wp, 0.7775000683430e-01_wp, &
      0.2000164937936e-06_wp, 0.4030009638488e+01_wp, 0.2093666171530e+00_wp, &
      0.1966105136719e-06_wp, 0.8745955786834e+00_wp, 0.2172315424036e+00_wp /
    data ((s0(i,j,1),i=1,3),j= 51, 60) / &
      0.1904742332624e-06_wp, 0.5919743598964e+01_wp, 0.2022531624851e+00_wp, &
      0.1657399705031e-06_wp, 0.2549141484884e+01_wp, 0.7358765972222e+00_wp, &
      0.1574070533987e-06_wp, 0.5277533020230e+01_wp, 0.7429900518901e+00_wp, &
      0.1832261651039e-06_wp, 0.3064688127777e+01_wp, 0.3235053470014e+00_wp, &
      0.1733615346569e-06_wp, 0.3011432799094e+01_wp, 0.1385174140878e+00_wp, &
      0.1549124014496e-06_wp, 0.4005569132359e+01_wp, 0.5154640627760e+00_wp, &
      0.1637044713838e-06_wp, 0.1831375966632e+01_wp, 0.8531963191132e+00_wp, &
      0.1123420082383e-06_wp, 0.1180270407578e+01_wp, 0.1990721704425e+00_wp, &
      0.1083754165740e-06_wp, 0.3414101320863e+00_wp, 0.5439178814476e+00_wp, &
      0.1156638012655e-06_wp, 0.6130479452594e+00_wp, 0.5257585094865e+00_wp /
    data ((s0(i,j,1),i=1,3),j= 61, 70) / &
      0.1142548785134e-06_wp, 0.3724761948846e+01_wp, 0.5336234347371e+00_wp, &
      0.7921463895965e-07_wp, 0.2435425589361e+01_wp, 0.1478866649112e+01_wp, &
      0.7428600285231e-07_wp, 0.3542144398753e+01_wp, 0.2164800718209e+00_wp, &
      0.8323211246747e-07_wp, 0.3525058072354e+01_wp, 0.1692165728891e+01_wp, &
      0.7257595116312e-07_wp, 0.1364299431982e+01_wp, 0.2101180877357e+00_wp, &
      0.7111185833236e-07_wp, 0.2460478875808e+01_wp, 0.4155522422634e+00_wp, &
      0.6868090383716e-07_wp, 0.4397327670704e+01_wp, 0.1173197218910e+00_wp, &
      0.7226419974175e-07_wp, 0.4042647308905e+01_wp, 0.1265567569334e+01_wp, &
      0.6955642383177e-07_wp, 0.2865047906085e+01_wp, 0.9562891316684e+00_wp, &
      0.7492139296331e-07_wp, 0.5014278994215e+01_wp, 0.1422690933580e-01_wp /
    data ((s0(i,j,1),i=1,3),j= 71, 80) / &
      0.6598363128857e-07_wp, 0.2376730020492e+01_wp, 0.6470106940028e+00_wp, &
      0.7381147293385e-07_wp, 0.3272990384244e+01_wp, 0.1581959461667e+01_wp, &
      0.6402909624032e-07_wp, 0.5302290955138e+01_wp, 0.9597935788730e-01_wp, &
      0.6237454263857e-07_wp, 0.5444144425332e+01_wp, 0.7084920306520e-01_wp, &
      0.5241198544016e-07_wp, 0.4215359579205e+01_wp, 0.5265099800692e+00_wp, &
      0.5144463853918e-07_wp, 0.1218916689916e+00_wp, 0.5328719641544e+00_wp, &
      0.5868164772299e-07_wp, 0.2369402002213e+01_wp, 0.7871412831580e-01_wp, &
      0.6233195669151e-07_wp, 0.1254922242403e+01_wp, 0.2608790314060e+02_wp, &
      0.6068463791422e-07_wp, 0.5679713760431e+01_wp, 0.1114304132498e+00_wp, &
      0.4359361135065e-07_wp, 0.6097219641646e+00_wp, 0.1375773836557e+01_wp /
    data ((s0(i,j,1),i=1,3),j= 81, 90) / &
      0.4686510366826e-07_wp, 0.4786231041431e+01_wp, 0.1143987543936e+00_wp, &
      0.3758977287225e-07_wp, 0.1167368068139e+01_wp, 0.1596186371003e+01_wp, &
      0.4282051974778e-07_wp, 0.1519471064319e+01_wp, 0.2770348281756e+00_wp, &
      0.5153765386113e-07_wp, 0.1860532322984e+01_wp, 0.2228608264996e+00_wp, &
      0.4575129387188e-07_wp, 0.7632857887158e+00_wp, 0.1465949902372e+00_wp, &
      0.3326844933286e-07_wp, 0.1298219485285e+01_wp, 0.5070101000000e-01_wp, &
      0.3748617450984e-07_wp, 0.1046510321062e+01_wp, 0.4903339079539e+00_wp, &
      0.2816756661499e-07_wp, 0.3434522346190e+01_wp, 0.2991266627620e+00_wp, &
      0.3412750405039e-07_wp, 0.2523766270318e+01_wp, 0.3518164938661e+00_wp, &
      0.2655796761776e-07_wp, 0.2904422260194e+01_wp, 0.6256703299991e+00_wp /
    data ((s0(i,j,1),i=1,3),j= 91,100) / &
      0.2963597929458e-07_wp, 0.5923900431149e+00_wp, 0.1099462426779e+00_wp, &
      0.2539523734781e-07_wp, 0.4851947722567e+01_wp, 0.1256615170089e+02_wp, &
      0.2283087914139e-07_wp, 0.3400498595496e+01_wp, 0.6681224869435e+01_wp, &
      0.2321309799331e-07_wp, 0.5789099148673e+01_wp, 0.3368040641550e-01_wp, &
      0.2549657649750e-07_wp, 0.3991856479792e-01_wp, 0.1169588211447e+01_wp, &
      0.2290462303977e-07_wp, 0.2788567577052e+01_wp, 0.1045155034888e+01_wp, &
      0.1945398522914e-07_wp, 0.3290896998176e+01_wp, 0.1155361302111e+01_wp, &
      0.1849171512638e-07_wp, 0.2698060129367e+01_wp, 0.4452511715700e-02_wp, &
      0.1647199834254e-07_wp, 0.3016735644085e+01_wp, 0.4408250688924e+00_wp, &
      0.1529530765273e-07_wp, 0.5573043116178e+01_wp, 0.6521991896920e-01_wp /
    data ((s0(i,j,1),i=1,3),j=101,110) / &
      0.1433199339978e-07_wp, 0.1481192356147e+01_wp, 0.9420622223326e+00_wp, &
      0.1729134193602e-07_wp, 0.1422817538933e+01_wp, 0.2108507877249e+00_wp, &
      0.1716463931346e-07_wp, 0.3469468901855e+01_wp, 0.2157473718317e+00_wp, &
      0.1391206061378e-07_wp, 0.6122436220547e+01_wp, 0.4123712502208e+00_wp, &
      0.1404746661924e-07_wp, 0.1647765641936e+01_wp, 0.4258542984690e-01_wp, &
      0.1410452399455e-07_wp, 0.5989729161964e+01_wp, 0.2258291676434e+00_wp, &
      0.1089828772168e-07_wp, 0.2833705509371e+01_wp, 0.4226656969313e+00_wp, &
      0.1047374564948e-07_wp, 0.5090690007331e+00_wp, 0.3092784376656e+00_wp, &
      0.1358279126532e-07_wp, 0.5128990262836e+01_wp, 0.7923417740620e-01_wp, &
      0.1020456476148e-07_wp, 0.9632772880808e+00_wp, 0.1456308687557e+00_wp /
    data ((s0(i,j,1),i=1,3),j=111,120) / &
      0.1033428735328e-07_wp, 0.3223779318418e+01_wp, 0.1795258541446e+01_wp, &
      0.1412435841540e-07_wp, 0.2410271572721e+01_wp, 0.1525316725248e+00_wp, &
      0.9722759371574e-08_wp, 0.2333531395690e+01_wp, 0.8434341241180e-01_wp, &
      0.9657334084704e-08_wp, 0.6199270974168e+01_wp, 0.1272681024002e+01_wp, &
      0.1083641148690e-07_wp, 0.2864222292929e+01_wp, 0.7032915397480e-01_wp, &
      0.1067318403838e-07_wp, 0.5833458866568e+00_wp, 0.2123349582968e+00_wp, &
      0.1062366201976e-07_wp, 0.4307753989494e+01_wp, 0.2142632012598e+00_wp, &
      0.1236364149266e-07_wp, 0.2873917870593e+01_wp, 0.1847279083684e+00_wp, &
      0.1092759489593e-07_wp, 0.2959887266733e+01_wp, 0.1370332435159e+00_wp, &
      0.8912069362899e-08_wp, 0.5141213702562e+01_wp, 0.2648454860559e+01_wp /
    data ((s0(i,j,1),i=1,3),j=121,130) / &
      0.9656467707970e-08_wp, 0.4532182462323e+01_wp, 0.4376440768498e+00_wp, &
      0.8098386150135e-08_wp, 0.2268906338379e+01_wp, 0.2880807454688e+00_wp, &
      0.7857714675000e-08_wp, 0.4055544260745e+01_wp, 0.2037373330570e+00_wp, &
      0.7288455940646e-08_wp, 0.5357901655142e+01_wp, 0.1129145838217e+00_wp, &
      0.9450595950552e-08_wp, 0.4264926963939e+01_wp, 0.5272426800584e+00_wp, &
      0.9381718247537e-08_wp, 0.7489366976576e-01_wp, 0.5321392641652e+00_wp, &
      0.7079052646038e-08_wp, 0.1923311052874e+01_wp, 0.6288513220417e+00_wp, &
      0.9259004415344e-08_wp, 0.2970256853438e+01_wp, 0.1606092486742e+00_wp, &
      0.8259801499742e-08_wp, 0.3327056314697e+01_wp, 0.8389694097774e+00_wp, &
      0.6476334355779e-08_wp, 0.2954925505727e+01_wp, 0.2008557621224e+01_wp /
    data ((s0(i,j,1),i=1,3),j=131,140) / &
      0.5984021492007e-08_wp, 0.9138753105829e+00_wp, 0.2042657109477e+02_wp, &
      0.5989546863181e-08_wp, 0.3244464082031e+01_wp, 0.2111650433779e+01_wp, &
      0.6233108606023e-08_wp, 0.4995232638403e+00_wp, 0.4305306221819e+00_wp, &
      0.6877299149965e-08_wp, 0.2834987233449e+01_wp, 0.9561746721300e-02_wp, &
      0.8311234227190e-08_wp, 0.2202951835758e+01_wp, 0.3801276407308e+00_wp, &
      0.6599472832414e-08_wp, 0.4478581462618e+01_wp, 0.1063314406849e+01_wp, &
      0.6160491096549e-08_wp, 0.5145858696411e+01_wp, 0.1368660381889e+01_wp, &
      0.6164772043891e-08_wp, 0.3762976697911e+00_wp, 0.4234171675140e+00_wp, &
      0.6363248684450e-08_wp, 0.3162246718685e+01_wp, 0.1253008786510e-01_wp, &
      0.6448587520999e-08_wp, 0.3442693302119e+01_wp, 0.5287268506303e+00_wp /
    data ((s0(i,j,1),i=1,3),j=141,150) / &
      0.6431662283977e-08_wp, 0.8977549136606e+00_wp, 0.5306550935933e+00_wp, &
      0.6351223158474e-08_wp, 0.4306447410369e+01_wp, 0.5217580628120e+02_wp, &
      0.5476721393451e-08_wp, 0.3888529177855e+01_wp, 0.2221856701002e+01_wp, &
      0.5341772572619e-08_wp, 0.2655560662512e+01_wp, 0.7466759693650e-01_wp, &
      0.5337055758302e-08_wp, 0.5164990735946e+01_wp, 0.7489573444450e-01_wp, &
      0.5373120816787e-08_wp, 0.6041214553456e+01_wp, 0.1274714967946e+00_wp, &
      0.5392351705426e-08_wp, 0.9177763485932e+00_wp, 0.1055449481598e+01_wp, &
      0.6688495850205e-08_wp, 0.3089608126937e+01_wp, 0.2213766559277e+00_wp, &
      0.5072003660362e-08_wp, 0.4311316541553e+01_wp, 0.2132517061319e+00_wp, &
      0.5070726650455e-08_wp, 0.5790675464444e+00_wp, 0.2133464534247e+00_wp /
    data ((s0(i,j,1),i=1,3),j=151,160) / &
      0.5658012950032e-08_wp, 0.2703945510675e+01_wp, 0.7287631425543e+00_wp, &
      0.4835509924854e-08_wp, 0.2975422976065e+01_wp, 0.7160067364790e-01_wp, &
      0.6479821978012e-08_wp, 0.1324168733114e+01_wp, 0.2209183458640e-01_wp, &
      0.6230636494980e-08_wp, 0.2860103632836e+01_wp, 0.3306188016693e+00_wp, &
      0.4649239516213e-08_wp, 0.4832259763403e+01_wp, 0.7796265773310e-01_wp, &
      0.6487325792700e-08_wp, 0.2726165825042e+01_wp, 0.3884652414254e+00_wp, &
      0.4682823682770e-08_wp, 0.6966602455408e+00_wp, 0.1073608853559e+01_wp, &
      0.5704230804976e-08_wp, 0.5669634104606e+01_wp, 0.8731175355560e-01_wp, &
      0.6125413585489e-08_wp, 0.1513386538915e+01_wp, 0.7605151500000e-01_wp, &
      0.6035825038187e-08_wp, 0.1983509168227e+01_wp, 0.9846002785331e+00_wp /
    data ((s0(i,j,1),i=1,3),j=161,170) / &
      0.4331123462303e-08_wp, 0.2782892992807e+01_wp, 0.4297791515992e+00_wp, &
      0.4681107685143e-08_wp, 0.5337232886836e+01_wp, 0.2127790306879e+00_wp, &
      0.4669105829655e-08_wp, 0.5837133792160e+01_wp, 0.2138191288687e+00_wp, &
      0.5138823602365e-08_wp, 0.3080560200507e+01_wp, 0.7233337363710e-01_wp, &
      0.4615856664534e-08_wp, 0.1661747897471e+01_wp, 0.8603097737811e+00_wp, &
      0.4496916702197e-08_wp, 0.2112508027068e+01_wp, 0.7381754420900e-01_wp, &
      0.4278479042945e-08_wp, 0.5716528462627e+01_wp, 0.7574578717200e-01_wp, &
      0.3840525503932e-08_wp, 0.6424172726492e+00_wp, 0.3407705765729e+00_wp, &
      0.4866636509685e-08_wp, 0.4919244697715e+01_wp, 0.7722995774390e-01_wp, &
      0.3526100639296e-08_wp, 0.2550821052734e+01_wp, 0.6225157782540e-01_wp /
    data ((s0(i,j,1),i=1,3),j=171,180) / &
      0.3939558488075e-08_wp, 0.3939331491710e+01_wp, 0.5268983110410e-01_wp, &
      0.4041268772576e-08_wp, 0.2275337571218e+01_wp, 0.3503323232942e+00_wp, &
      0.3948761842853e-08_wp, 0.1999324200790e+01_wp, 0.1451108196653e+00_wp, &
      0.3258394550029e-08_wp, 0.9121001378200e+00_wp, 0.5296435984654e+00_wp, &
      0.3257897048761e-08_wp, 0.3428428660869e+01_wp, 0.5297383457582e+00_wp, &
      0.3842559031298e-08_wp, 0.6132927720035e+01_wp, 0.9098186128426e+00_wp, &
      0.3109920095448e-08_wp, 0.7693650193003e+00_wp, 0.3932462625300e-02_wp, &
      0.3132237775119e-08_wp, 0.3621293854908e+01_wp, 0.2346394437820e+00_wp, &
      0.3942189421510e-08_wp, 0.4841863659733e+01_wp, 0.3180992042600e-02_wp, &
      0.3796972285340e-08_wp, 0.1814174994268e+01_wp, 0.1862120789403e+00_wp /
    data ((s0(i,j,1),i=1,3),j=181,190) / &
      0.3995640233688e-08_wp, 0.1386990406091e+01_wp, 0.4549093064213e+00_wp, &
      0.2875013727414e-08_wp, 0.9178318587177e+00_wp, 0.1905464808669e+01_wp, &
      0.3073719932844e-08_wp, 0.2688923811835e+01_wp, 0.3628624111593e+00_wp, &
      0.2731016580075e-08_wp, 0.1188259127584e+01_wp, 0.2131850110243e+00_wp, &
      0.2729549896546e-08_wp, 0.3702160634273e+01_wp, 0.2134131485323e+00_wp, &
      0.3339372892449e-08_wp, 0.7199163960331e+00_wp, 0.2007689919132e+00_wp, &
      0.2898833764204e-08_wp, 0.1916709364999e+01_wp, 0.5291709230214e+00_wp, &
      0.2894536549362e-08_wp, 0.2424043195547e+01_wp, 0.5302110212022e+00_wp, &
      0.3096872473843e-08_wp, 0.4445894977497e+01_wp, 0.2976424921901e+00_wp, &
      0.2635672326810e-08_wp, 0.3814366984117e+01_wp, 0.1485980103780e+01_wp /
    data ((s0(i,j,1),i=1,3),j=191,200) / &
      0.3649302697001e-08_wp, 0.2924200596084e+01_wp, 0.6044726378023e+00_wp, &
      0.3127954585895e-08_wp, 0.1842251648327e+01_wp, 0.1084620721060e+00_wp, &
      0.2616040173947e-08_wp, 0.4155841921984e+01_wp, 0.1258454114666e+01_wp, &
      0.2597395859860e-08_wp, 0.1158045978874e+00_wp, 0.2103781122809e+00_wp, &
      0.2593286172210e-08_wp, 0.4771850408691e+01_wp, 0.2162200472757e+00_wp, &
      0.2481823585747e-08_wp, 0.4608842558889e+00_wp, 0.1062562936266e+01_wp, &
      0.2742219550725e-08_wp, 0.1538781127028e+01_wp, 0.5651155736444e+00_wp, &
      0.3199558469610e-08_wp, 0.3226647822878e+00_wp, 0.7036329877322e+00_wp, &
      0.2666088542957e-08_wp, 0.1967991731219e+00_wp, 0.1400015846597e+00_wp, &
      0.2397067430580e-08_wp, 0.3707036669873e+01_wp, 0.2125476091956e+00_wp /
    data ((s0(i,j,1),i=1,3),j=201,210) / &
      0.2376570772738e-08_wp, 0.1182086628042e+01_wp, 0.2140505503610e+00_wp, &
      0.2547228007887e-08_wp, 0.4906256820629e+01_wp, 0.1534957940063e+00_wp, &
      0.2265575594114e-08_wp, 0.3414949866857e+01_wp, 0.2235935264888e+00_wp, &
      0.2464381430585e-08_wp, 0.4599122275378e+01_wp, 0.2091065926078e+00_wp, &
      0.2433408527044e-08_wp, 0.2830751145445e+00_wp, 0.2174915669488e+00_wp, &
      0.2443605509076e-08_wp, 0.4212046432538e+01_wp, 0.1739420156204e+00_wp, &
      0.2319779262465e-08_wp, 0.9881978408630e+00_wp, 0.7530171478090e-01_wp, &
      0.2284622835465e-08_wp, 0.5565347331588e+00_wp, 0.7426161660010e-01_wp, &
      0.2467268750783e-08_wp, 0.5655708150766e+00_wp, 0.2526561439362e+00_wp, &
      0.2808513492782e-08_wp, 0.1418405053408e+01_wp, 0.5636314030725e+00_wp /
    data ((s0(i,j,1),i=1,3),j=211,ns0x) / &
      0.2329528932532e-08_wp, 0.4069557545675e+01_wp, 0.1056200952181e+01_wp, &
      0.9698639532817e-09_wp, 0.1074134313634e+01_wp, 0.7826370942180e+02_wp /

    !  SSB-to-Sun, T^1, X
    data ((s1(i,j,1),i=1,3),j=  1, 10) / &
     -0.1296310361520e-07_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.8975769009438e-08_wp, 0.1128891609250e+01_wp, 0.4265981595566e+00_wp, &
      0.7771113441307e-08_wp, 0.2706039877077e+01_wp, 0.2061856251104e+00_wp, &
      0.7538303866642e-08_wp, 0.2191281289498e+01_wp, 0.2204125344462e+00_wp, &
      0.6061384579336e-08_wp, 0.3248167319958e+01_wp, 0.1059381944224e+01_wp, &
      0.5726994235594e-08_wp, 0.5569981398610e+01_wp, 0.5225775174439e+00_wp, &
      0.5616492836424e-08_wp, 0.5057386614909e+01_wp, 0.5368044267797e+00_wp, &
      0.1010881584769e-08_wp, 0.3473577116095e+01_wp, 0.7113454667900e-02_wp, &
      0.7259606157626e-09_wp, 0.3651858593665e+00_wp, 0.6398972393349e+00_wp, &
      0.8755095026935e-09_wp, 0.1662835408338e+01_wp, 0.4194847048887e+00_wp /
    data ((s1(i,j,1),i=1,3),j= 11, 20) / &
      0.5370491182812e-09_wp, 0.1327673878077e+01_wp, 0.4337116142245e+00_wp, &
      0.5743773887665e-09_wp, 0.4250200846687e+01_wp, 0.2132990797783e+00_wp, &
      0.4408103140300e-09_wp, 0.3598752574277e+01_wp, 0.1589072916335e+01_wp, &
      0.3101892374445e-09_wp, 0.4887822983319e+01_wp, 0.1052268489556e+01_wp, &
      0.3209453713578e-09_wp, 0.9702272295114e+00_wp, 0.5296909721118e+00_wp, &
      0.3017228286064e-09_wp, 0.5484462275949e+01_wp, 0.1066495398892e+01_wp, &
      0.3200700038601e-09_wp, 0.2846613338643e+01_wp, 0.1495633313810e+00_wp, &
      0.2137637279911e-09_wp, 0.5692163292729e+00_wp, 0.3163918923335e+00_wp, &
      0.1899686386727e-09_wp, 0.2061077157189e+01_wp, 0.2275259891141e+00_wp, &
      0.1401994545308e-09_wp, 0.4177771136967e+01_wp, 0.1102062672231e+00_wp /
    data ((s1(i,j,1),i=1,3),j= 21, 30) / &
      0.1578057810499e-09_wp, 0.5782460597335e+01_wp, 0.7626583626240e-01_wp, &
      0.1237713253351e-09_wp, 0.5705900866881e+01_wp, 0.5154640627760e+00_wp, &
      0.1313076837395e-09_wp, 0.5163438179576e+01_wp, 0.3664874755930e-01_wp, &
      0.1184963304860e-09_wp, 0.3054804427242e+01_wp, 0.6327837846670e+00_wp, &
      0.1238130878565e-09_wp, 0.2317292575962e+01_wp, 0.3961708870310e-01_wp, &
      0.1015959527736e-09_wp, 0.2194643645526e+01_wp, 0.7329749511860e-01_wp, &
      0.9017954423714e-10_wp, 0.2868603545435e+01_wp, 0.1990721704425e+00_wp, &
      0.8668024955603e-10_wp, 0.4923849675082e+01_wp, 0.5439178814476e+00_wp, &
      0.7756083930103e-10_wp, 0.3014334135200e+01_wp, 0.9491756770005e+00_wp, &
      0.7536503401741e-10_wp, 0.2704886279769e+01_wp, 0.1030928125552e+00_wp /
    data ((s1(i,j,1),i=1,3),j= 31, 40) / &
      0.5483308679332e-10_wp, 0.6010983673799e+01_wp, 0.8531963191132e+00_wp, &
      0.5184339620428e-10_wp, 0.1952704573291e+01_wp, 0.2093666171530e+00_wp, &
      0.5108658712030e-10_wp, 0.2958575786649e+01_wp, 0.2172315424036e+00_wp, &
      0.5019424524650e-10_wp, 0.1736317621318e+01_wp, 0.2164800718209e+00_wp, &
      0.4909312625978e-10_wp, 0.3167216416257e+01_wp, 0.2101180877357e+00_wp, &
      0.4456638901107e-10_wp, 0.7697579923471e+00_wp, 0.3235053470014e+00_wp, &
      0.4227030350925e-10_wp, 0.3490910137928e+01_wp, 0.6373574839730e-01_wp, &
      0.4095456040093e-10_wp, 0.5178888984491e+00_wp, 0.6470106940028e+00_wp, &
      0.4990537041422e-10_wp, 0.3323887668974e+01_wp, 0.1422690933580e-01_wp, &
      0.4321170010845e-10_wp, 0.4288484987118e+01_wp, 0.7358765972222e+00_wp /
    data ((s1(i,j,1),i=1,3),j= 41,ns1x) / &
      0.3544072091802e-10_wp, 0.6021051579251e+01_wp, 0.5265099800692e+00_wp, &
      0.3480198638687e-10_wp, 0.4600027054714e+01_wp, 0.5328719641544e+00_wp, &
      0.3440287244435e-10_wp, 0.4349525970742e+01_wp, 0.8582758298370e-01_wp, &
      0.3330628322713e-10_wp, 0.2347391505082e+01_wp, 0.1104591729320e-01_wp, &
      0.2973060707184e-10_wp, 0.4789409286400e+01_wp, 0.5257585094865e+00_wp, &
      0.2932606766089e-10_wp, 0.5831693799927e+01_wp, 0.5336234347371e+00_wp, &
      0.2876972310953e-10_wp, 0.2692638514771e+01_wp, 0.1173197218910e+00_wp, &
      0.2827488278556e-10_wp, 0.2056052487960e+01_wp, 0.2022531624851e+00_wp, &
      0.2515028239756e-10_wp, 0.7411863262449e+00_wp, 0.9597935788730e-01_wp, &
      0.2853033744415e-10_wp, 0.3948481024894e+01_wp, 0.2118763888447e+01_wp /

    !  SSB-to-Sun, T^2, X
    data ((s2(i,j,1),i=1,3),j=  1,ns2x) / &
      0.1603551636587e-11_wp, 0.4404109410481e+01_wp, 0.2061856251104e+00_wp, &
      0.1556935889384e-11_wp, 0.4818040873603e+00_wp, 0.2204125344462e+00_wp, &
      0.1182594414915e-11_wp, 0.9935762734472e+00_wp, 0.5225775174439e+00_wp, &
      0.1158794583180e-11_wp, 0.3353180966450e+01_wp, 0.5368044267797e+00_wp, &
      0.9597358943932e-12_wp, 0.5567045358298e+01_wp, 0.2132990797783e+00_wp, &
      0.6511516579605e-12_wp, 0.5630872420788e+01_wp, 0.4265981595566e+00_wp, &
      0.7419792747688e-12_wp, 0.2156188581957e+01_wp, 0.5296909721118e+00_wp, &
      0.3951972655848e-12_wp, 0.1981022541805e+01_wp, 0.1059381944224e+01_wp, &
      0.4478223877045e-12_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp /

    !  SSB-to-Sun, T^0, Y
    data ((s0(i,j,2),i=1,3),j=  1, 10) / &
      0.4955392320126e-02_wp, 0.2170467313679e+01_wp, 0.5296909721118e+00_wp, &
      0.2722325167392e-02_wp, 0.2444433682196e+01_wp, 0.2132990797783e+00_wp, &
      0.1546579925346e-02_wp, 0.5992779281546e+00_wp, 0.3813291813120e-01_wp, &
      0.8363140252966e-03_wp, 0.7687356310801e+00_wp, 0.7478166569050e-01_wp, &
      0.3385792683603e-03_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.1201192221613e-03_wp, 0.2520035601514e+01_wp, 0.1059381944224e+01_wp, &
      0.7587125720554e-04_wp, 0.1669954006449e+01_wp, 0.4265981595566e+00_wp, &
      0.1964155361250e-04_wp, 0.5707743963343e+01_wp, 0.2061856251104e+00_wp, &
      0.1891900364909e-04_wp, 0.2320960679937e+01_wp, 0.2204125344462e+00_wp, &
      0.1937373433356e-04_wp, 0.3226940689555e+01_wp, 0.1495633313810e+00_wp /
    data ((s0(i,j,2),i=1,3),j= 11, 20) / &
      0.1437139941351e-04_wp, 0.2301626908096e+01_wp, 0.5225775174439e+00_wp, &
      0.1406267683099e-04_wp, 0.5188579265542e+01_wp, 0.5368044267797e+00_wp, &
      0.1178703080346e-04_wp, 0.5489483248476e+01_wp, 0.7626583626240e-01_wp, &
      0.8079835186041e-05_wp, 0.1683751835264e+01_wp, 0.3664874755930e-01_wp, &
      0.7623253594652e-05_wp, 0.2656400462961e+01_wp, 0.3961708870310e-01_wp, &
      0.6248667483971e-05_wp, 0.4992775362055e+01_wp, 0.7329749511860e-01_wp, &
      0.4366353695038e-05_wp, 0.2869706279678e+01_wp, 0.1589072916335e+01_wp, &
      0.3829101568895e-05_wp, 0.3572131359950e+01_wp, 0.7113454667900e-02_wp, &
      0.3175733773908e-05_wp, 0.4535372530045e+01_wp, 0.4194847048887e+00_wp, &
      0.3092437902159e-05_wp, 0.9230153317909e+00_wp, 0.6398972393349e+00_wp /
    data ((s0(i,j,2),i=1,3),j= 21, 30) / &
      0.2874168812154e-05_wp, 0.3363143761101e+01_wp, 0.1102062672231e+00_wp, &
      0.3040119321826e-05_wp, 0.3324250895675e+01_wp, 0.6283075850446e+01_wp, &
      0.2699723308006e-05_wp, 0.2917882441928e+00_wp, 0.1030928125552e+00_wp, &
      0.2134832683534e-05_wp, 0.4220997202487e+01_wp, 0.3163918923335e+00_wp, &
      0.1770412139433e-05_wp, 0.4747318496462e+01_wp, 0.1021328554739e+02_wp, &
      0.1377264209373e-05_wp, 0.4305058462401e+00_wp, 0.1484170571900e-02_wp, &
      0.1127814538960e-05_wp, 0.8538177240740e+00_wp, 0.6327837846670e+00_wp, &
      0.1055608090130e-05_wp, 0.1551800742580e+01_wp, 0.4337116142245e+00_wp, &
      0.9802673861420e-06_wp, 0.1459646735377e+01_wp, 0.1052268489556e+01_wp, &
      0.1090329461951e-05_wp, 0.1587351228711e+01_wp, 0.1162474756779e+01_wp /
    data ((s0(i,j,2),i=1,3),j= 31, 40) / &
      0.6959590025090e-06_wp, 0.5534442628766e+01_wp, 0.1066495398892e+01_wp, &
      0.5664914529542e-06_wp, 0.6030673003297e+01_wp, 0.9491756770005e+00_wp, &
      0.6607787763599e-06_wp, 0.4989507233927e+01_wp, 0.8460828644453e+00_wp, &
      0.6269725742838e-06_wp, 0.4222951804572e+01_wp, 0.1480791608091e+00_wp, &
      0.6301889697863e-06_wp, 0.5444316669126e+01_wp, 0.2243449970715e+00_wp, &
      0.4891042662861e-06_wp, 0.1490552839784e+01_wp, 0.3340612434717e+01_wp, &
      0.3457083123290e-06_wp, 0.3030475486049e+01_wp, 0.3516457698740e-01_wp, &
      0.3032559967314e-06_wp, 0.2652038793632e+01_wp, 0.1104591729320e-01_wp, &
      0.2841133988903e-06_wp, 0.1276744786829e+01_wp, 0.4110125927500e-01_wp, &
      0.2855564444432e-06_wp, 0.2143368674733e+01_wp, 0.1510475019529e+00_wp /
    data ((s0(i,j,2),i=1,3),j= 41, 50) / &
      0.2765157135038e-06_wp, 0.5444186109077e+01_wp, 0.6373574839730e-01_wp, &
      0.2382312465034e-06_wp, 0.2190521137593e+01_wp, 0.2275259891141e+00_wp, &
      0.2808060365077e-06_wp, 0.5735195064841e+01_wp, 0.2535050500000e-01_wp, &
      0.2332175234405e-06_wp, 0.9481985524859e-01_wp, 0.7181332454670e-01_wp, &
      0.2322488199659e-06_wp, 0.5180499361533e+01_wp, 0.8582758298370e-01_wp, &
      0.1881850258423e-06_wp, 0.3219788273885e+01_wp, 0.2118763888447e+01_wp, &
      0.2196111392808e-06_wp, 0.2366941159761e+01_wp, 0.2968341143800e-02_wp, &
      0.2183810335519e-06_wp, 0.4825445110915e+01_wp, 0.7775000683430e-01_wp, &
      0.2002733093326e-06_wp, 0.2457148995307e+01_wp, 0.2093666171530e+00_wp, &
      0.1967111767229e-06_wp, 0.5586291545459e+01_wp, 0.2172315424036e+00_wp /
    data ((s0(i,j,2),i=1,3),j= 51, 60) / &
      0.1568473250543e-06_wp, 0.3708003123320e+01_wp, 0.7429900518901e+00_wp, &
      0.1852528314300e-06_wp, 0.4310638151560e+01_wp, 0.2022531624851e+00_wp, &
      0.1832111226447e-06_wp, 0.1494665322656e+01_wp, 0.3235053470014e+00_wp, &
      0.1746805502310e-06_wp, 0.1451378500784e+01_wp, 0.1385174140878e+00_wp, &
      0.1555730966650e-06_wp, 0.1068040418198e+01_wp, 0.7358765972222e+00_wp, &
      0.1554883462559e-06_wp, 0.2442579035461e+01_wp, 0.5154640627760e+00_wp, &
      0.1638380568746e-06_wp, 0.2597913420625e+00_wp, 0.8531963191132e+00_wp, &
      0.1159938593640e-06_wp, 0.5834512021280e+01_wp, 0.1990721704425e+00_wp, &
      0.1083427965695e-06_wp, 0.5054033177950e+01_wp, 0.5439178814476e+00_wp, &
      0.1156480369431e-06_wp, 0.5325677432457e+01_wp, 0.5257585094865e+00_wp /
    data ((s0(i,j,2),i=1,3),j= 61, 70) / &
      0.1141308860095e-06_wp, 0.2153403923857e+01_wp, 0.5336234347371e+00_wp, &
      0.7913146470946e-07_wp, 0.8642846847027e+00_wp, 0.1478866649112e+01_wp, &
      0.7439752463733e-07_wp, 0.1970628496213e+01_wp, 0.2164800718209e+00_wp, &
      0.7280277104079e-07_wp, 0.6073307250609e+01_wp, 0.2101180877357e+00_wp, &
      0.8319567719136e-07_wp, 0.1954371928334e+01_wp, 0.1692165728891e+01_wp, &
      0.7137705549290e-07_wp, 0.8904989440909e+00_wp, 0.4155522422634e+00_wp, &
      0.6900825396225e-07_wp, 0.2825717714977e+01_wp, 0.1173197218910e+00_wp, &
      0.7245757216635e-07_wp, 0.2481677513331e+01_wp, 0.1265567569334e+01_wp, &
      0.6961165696255e-07_wp, 0.1292955312978e+01_wp, 0.9562891316684e+00_wp, &
      0.7571804456890e-07_wp, 0.3427517575069e+01_wp, 0.1422690933580e-01_wp /
    data ((s0(i,j,2),i=1,3),j= 71, 80) / &
      0.6605425721904e-07_wp, 0.8052192701492e+00_wp, 0.6470106940028e+00_wp, &
      0.7375477357248e-07_wp, 0.1705076390088e+01_wp, 0.1581959461667e+01_wp, &
      0.7041664951470e-07_wp, 0.4848356967891e+00_wp, 0.9597935788730e-01_wp, &
      0.6322199535763e-07_wp, 0.3878069473909e+01_wp, 0.7084920306520e-01_wp, &
      0.5244380279191e-07_wp, 0.2645560544125e+01_wp, 0.5265099800692e+00_wp, &
      0.5143125704988e-07_wp, 0.4834486101370e+01_wp, 0.5328719641544e+00_wp, &
      0.5871866319373e-07_wp, 0.7981472548900e+00_wp, 0.7871412831580e-01_wp, &
      0.6300822573871e-07_wp, 0.5979398788281e+01_wp, 0.2608790314060e+02_wp, &
      0.6062154271548e-07_wp, 0.4108655402756e+01_wp, 0.1114304132498e+00_wp, &
      0.4361912339976e-07_wp, 0.5322624319280e+01_wp, 0.1375773836557e+01_wp /
    data ((s0(i,j,2),i=1,3),j= 81, 90) / &
      0.4417005920067e-07_wp, 0.6240817359284e+01_wp, 0.2770348281756e+00_wp, &
      0.4686806749936e-07_wp, 0.3214977301156e+01_wp, 0.1143987543936e+00_wp, &
      0.3758892132305e-07_wp, 0.5879809634765e+01_wp, 0.1596186371003e+01_wp, &
      0.5151351332319e-07_wp, 0.2893377688007e+00_wp, 0.2228608264996e+00_wp, &
      0.4554683578572e-07_wp, 0.5475427144122e+01_wp, 0.1465949902372e+00_wp, &
      0.3442381385338e-07_wp, 0.5992034796640e+01_wp, 0.5070101000000e-01_wp, &
      0.2831093954933e-07_wp, 0.5367350273914e+01_wp, 0.3092784376656e+00_wp, &
      0.3756267090084e-07_wp, 0.5758171285420e+01_wp, 0.4903339079539e+00_wp, &
      0.2816374679892e-07_wp, 0.1863718700923e+01_wp, 0.2991266627620e+00_wp, &
      0.3419307025569e-07_wp, 0.9524347534130e+00_wp, 0.3518164938661e+00_wp /
    data ((s0(i,j,2),i=1,3),j= 91,100) / &
      0.2904250494239e-07_wp, 0.5304471615602e+01_wp, 0.1099462426779e+00_wp, &
      0.2471734511206e-07_wp, 0.1297069793530e+01_wp, 0.6256703299991e+00_wp, &
      0.2539620831872e-07_wp, 0.3281126083375e+01_wp, 0.1256615170089e+02_wp, &
      0.2281017868007e-07_wp, 0.1829122133165e+01_wp, 0.6681224869435e+01_wp, &
      0.2275319473335e-07_wp, 0.5797198160181e+01_wp, 0.3932462625300e-02_wp, &
      0.2547755368442e-07_wp, 0.4752697708330e+01_wp, 0.1169588211447e+01_wp, &
      0.2285979669317e-07_wp, 0.1223205292886e+01_wp, 0.1045155034888e+01_wp, &
      0.1913386560994e-07_wp, 0.1757532993389e+01_wp, 0.1155361302111e+01_wp, &
      0.1809020525147e-07_wp, 0.4246116108791e+01_wp, 0.3368040641550e-01_wp, &
      0.1649213300201e-07_wp, 0.1445162890627e+01_wp, 0.4408250688924e+00_wp /
    data ((s0(i,j,2),i=1,3),j=101,110) / &
      0.1834972793932e-07_wp, 0.1126917567225e+01_wp, 0.4452511715700e-02_wp, &
      0.1439550648138e-07_wp, 0.6160756834764e+01_wp, 0.9420622223326e+00_wp, &
      0.1487645457041e-07_wp, 0.4358761931792e+01_wp, 0.4123712502208e+00_wp, &
      0.1731729516660e-07_wp, 0.6134456753344e+01_wp, 0.2108507877249e+00_wp, &
      0.1717747163567e-07_wp, 0.1898186084455e+01_wp, 0.2157473718317e+00_wp, &
      0.1418190430374e-07_wp, 0.4180286741266e+01_wp, 0.6521991896920e-01_wp, &
      0.1404844134873e-07_wp, 0.7654053565412e-01_wp, 0.4258542984690e-01_wp, &
      0.1409842846538e-07_wp, 0.4418612420312e+01_wp, 0.2258291676434e+00_wp, &
      0.1090948346291e-07_wp, 0.1260615686131e+01_wp, 0.4226656969313e+00_wp, &
      0.1357577323612e-07_wp, 0.3558248818690e+01_wp, 0.7923417740620e-01_wp /
    data ((s0(i,j,2),i=1,3),j=111,120) / &
      0.1018154061960e-07_wp, 0.5676087241256e+01_wp, 0.1456308687557e+00_wp, &
      0.1412073972109e-07_wp, 0.8394392632422e+00_wp, 0.1525316725248e+00_wp, &
      0.1030938326496e-07_wp, 0.1653593274064e+01_wp, 0.1795258541446e+01_wp, &
      0.1180081567104e-07_wp, 0.1285802592036e+01_wp, 0.7032915397480e-01_wp, &
      0.9708510575650e-08_wp, 0.7631889488106e+00_wp, 0.8434341241180e-01_wp, &
      0.9637689663447e-08_wp, 0.4630642649176e+01_wp, 0.1272681024002e+01_wp, &
      0.1068910429389e-07_wp, 0.5294934032165e+01_wp, 0.2123349582968e+00_wp, &
      0.1063716179336e-07_wp, 0.2736266800832e+01_wp, 0.2142632012598e+00_wp, &
      0.1234858713814e-07_wp, 0.1302891146570e+01_wp, 0.1847279083684e+00_wp, &
      0.8912631189738e-08_wp, 0.3570415993621e+01_wp, 0.2648454860559e+01_wp /
    data ((s0(i,j,2),i=1,3),j=121,130) / &
      0.1036378285534e-07_wp, 0.4236693440949e+01_wp, 0.1370332435159e+00_wp, &
      0.9667798501561e-08_wp, 0.2960768892398e+01_wp, 0.4376440768498e+00_wp, &
      0.8108314201902e-08_wp, 0.6987781646841e+00_wp, 0.2880807454688e+00_wp, &
      0.7648364324628e-08_wp, 0.2499017863863e+01_wp, 0.2037373330570e+00_wp, &
      0.7286136828406e-08_wp, 0.3787426951665e+01_wp, 0.1129145838217e+00_wp, &
      0.9448237743913e-08_wp, 0.2694354332983e+01_wp, 0.5272426800584e+00_wp, &
      0.9374276106428e-08_wp, 0.4787121277064e+01_wp, 0.5321392641652e+00_wp, &
      0.7100226287462e-08_wp, 0.3530238792101e+00_wp, 0.6288513220417e+00_wp, &
      0.9253056659571e-08_wp, 0.1399478925664e+01_wp, 0.1606092486742e+00_wp, &
      0.6636432145504e-08_wp, 0.3479575438447e+01_wp, 0.1368660381889e+01_wp /
    data ((s0(i,j,2),i=1,3),j=131,140) / &
      0.6469975312932e-08_wp, 0.1383669964800e+01_wp, 0.2008557621224e+01_wp, &
      0.7335849729765e-08_wp, 0.1243698166898e+01_wp, 0.9561746721300e-02_wp, &
      0.8743421205855e-08_wp, 0.3776164289301e+01_wp, 0.3801276407308e+00_wp, &
      0.5993635744494e-08_wp, 0.5627122113596e+01_wp, 0.2042657109477e+02_wp, &
      0.5981008479693e-08_wp, 0.1674336636752e+01_wp, 0.2111650433779e+01_wp, &
      0.6188535145838e-08_wp, 0.5214925208672e+01_wp, 0.4305306221819e+00_wp, &
      0.6596074017566e-08_wp, 0.2907653268124e+01_wp, 0.1063314406849e+01_wp, &
      0.6630815126226e-08_wp, 0.2127643669658e+01_wp, 0.8389694097774e+00_wp, &
      0.6156772830040e-08_wp, 0.5082160803295e+01_wp, 0.4234171675140e+00_wp, &
      0.6446960563014e-08_wp, 0.1872100916905e+01_wp, 0.5287268506303e+00_wp /
    data ((s0(i,j,2),i=1,3),j=141,150) / &
      0.6429324424668e-08_wp, 0.5610276103577e+01_wp, 0.5306550935933e+00_wp, &
      0.6302232396465e-08_wp, 0.1592152049607e+01_wp, 0.1253008786510e-01_wp, &
      0.6399244436159e-08_wp, 0.2746214421532e+01_wp, 0.5217580628120e+02_wp, &
      0.5474965172558e-08_wp, 0.2317666374383e+01_wp, 0.2221856701002e+01_wp, &
      0.5339293190692e-08_wp, 0.1084724961156e+01_wp, 0.7466759693650e-01_wp, &
      0.5334733683389e-08_wp, 0.3594106067745e+01_wp, 0.7489573444450e-01_wp, &
      0.5392665782110e-08_wp, 0.5630254365606e+01_wp, 0.1055449481598e+01_wp, &
      0.6682075673789e-08_wp, 0.1518480041732e+01_wp, 0.2213766559277e+00_wp, &
      0.5079130495960e-08_wp, 0.2739765115711e+01_wp, 0.2132517061319e+00_wp, &
      0.5077759793261e-08_wp, 0.5290711290094e+01_wp, 0.2133464534247e+00_wp /
    data ((s0(i,j,2),i=1,3),j=151,160) / &
      0.4832037368310e-08_wp, 0.1404473217200e+01_wp, 0.7160067364790e-01_wp, &
      0.6463279674802e-08_wp, 0.6038381695210e+01_wp, 0.2209183458640e-01_wp, &
      0.6240592771560e-08_wp, 0.1290170653666e+01_wp, 0.3306188016693e+00_wp, &
      0.4672013521493e-08_wp, 0.3261895939677e+01_wp, 0.7796265773310e-01_wp, &
      0.6500650750348e-08_wp, 0.1154522312095e+01_wp, 0.3884652414254e+00_wp, &
      0.6344161389053e-08_wp, 0.6206111545062e+01_wp, 0.7605151500000e-01_wp, &
      0.4682518370646e-08_wp, 0.5409118796685e+01_wp, 0.1073608853559e+01_wp, &
      0.5329460015591e-08_wp, 0.1202985784864e+01_wp, 0.7287631425543e+00_wp, &
      0.5701588675898e-08_wp, 0.4098715257064e+01_wp, 0.8731175355560e-01_wp, &
      0.6030690867211e-08_wp, 0.4132033218460e+00_wp, 0.9846002785331e+00_wp /
    data ((s0(i,j,2),i=1,3),j=161,170) / &
      0.4336256312655e-08_wp, 0.1211415991827e+01_wp, 0.4297791515992e+00_wp, &
      0.4688498808975e-08_wp, 0.3765479072409e+01_wp, 0.2127790306879e+00_wp, &
      0.4675578609335e-08_wp, 0.4265540037226e+01_wp, 0.2138191288687e+00_wp, &
      0.4225578112158e-08_wp, 0.5237566010676e+01_wp, 0.3407705765729e+00_wp, &
      0.5139422230028e-08_wp, 0.1507173079513e+01_wp, 0.7233337363710e-01_wp, &
      0.4619995093571e-08_wp, 0.9023957449848e-01_wp, 0.8603097737811e+00_wp, &
      0.4494776255461e-08_wp, 0.5414930552139e+00_wp, 0.7381754420900e-01_wp, &
      0.4274026276788e-08_wp, 0.4145735303659e+01_wp, 0.7574578717200e-01_wp, &
      0.5018141789353e-08_wp, 0.3344408829055e+01_wp, 0.3180992042600e-02_wp, &
      0.4866163952181e-08_wp, 0.3348534657607e+01_wp, 0.7722995774390e-01_wp /
    data ((s0(i,j,2),i=1,3),j=171,180) / &
      0.4111986020501e-08_wp, 0.4198823597220e+00_wp, 0.1451108196653e+00_wp, &
      0.3356142784950e-08_wp, 0.5609144747180e+01_wp, 0.1274714967946e+00_wp, &
      0.4070575554551e-08_wp, 0.7028411059224e+00_wp, 0.3503323232942e+00_wp, &
      0.3257451857278e-08_wp, 0.5624697983086e+01_wp, 0.5296435984654e+00_wp, &
      0.3256973703026e-08_wp, 0.1857842076707e+01_wp, 0.5297383457582e+00_wp, &
      0.3830771508640e-08_wp, 0.4562887279931e+01_wp, 0.9098186128426e+00_wp, &
      0.3725024005962e-08_wp, 0.2358058692652e+00_wp, 0.1084620721060e+00_wp, &
      0.3136763921756e-08_wp, 0.2049731526845e+01_wp, 0.2346394437820e+00_wp, &
      0.3795147256194e-08_wp, 0.2432356296933e+00_wp, 0.1862120789403e+00_wp, &
      0.2877342229911e-08_wp, 0.5631101279387e+01_wp, 0.1905464808669e+01_wp /
    data ((s0(i,j,2),i=1,3),j=181,190) / &
      0.3076931798805e-08_wp, 0.1117615737392e+01_wp, 0.3628624111593e+00_wp, &
      0.2734765945273e-08_wp, 0.5899826516955e+01_wp, 0.2131850110243e+00_wp, &
      0.2733405296885e-08_wp, 0.2130562964070e+01_wp, 0.2134131485323e+00_wp, &
      0.2898552353410e-08_wp, 0.3462387048225e+00_wp, 0.5291709230214e+00_wp, &
      0.2893736103681e-08_wp, 0.8534352781543e+00_wp, 0.5302110212022e+00_wp, &
      0.3095717734137e-08_wp, 0.2875061429041e+01_wp, 0.2976424921901e+00_wp, &
      0.2636190425832e-08_wp, 0.2242512846659e+01_wp, 0.1485980103780e+01_wp, &
      0.3645512095537e-08_wp, 0.1354016903958e+01_wp, 0.6044726378023e+00_wp, &
      0.2808173547723e-08_wp, 0.6705114365631e-01_wp, 0.6225157782540e-01_wp, &
      0.2625012866888e-08_wp, 0.4775705748482e+01_wp, 0.5268983110410e-01_wp /
    data ((s0(i,j,2),i=1,3),j=191,200) / &
      0.2572233995651e-08_wp, 0.2638924216139e+01_wp, 0.1258454114666e+01_wp, &
      0.2604238824792e-08_wp, 0.4826358927373e+01_wp, 0.2103781122809e+00_wp, &
      0.2596886385239e-08_wp, 0.3200388483118e+01_wp, 0.2162200472757e+00_wp, &
      0.3228057304264e-08_wp, 0.5384848409563e+01_wp, 0.2007689919132e+00_wp, &
      0.2481601798252e-08_wp, 0.5173373487744e+01_wp, 0.1062562936266e+01_wp, &
      0.2745977498864e-08_wp, 0.6250966149853e+01_wp, 0.5651155736444e+00_wp, &
      0.2669878833811e-08_wp, 0.4906001352499e+01_wp, 0.1400015846597e+00_wp, &
      0.3203986611711e-08_wp, 0.5034333010005e+01_wp, 0.7036329877322e+00_wp, &
      0.3354961227212e-08_wp, 0.6108262423137e+01_wp, 0.4549093064213e+00_wp, &
      0.2400407324558e-08_wp, 0.2135399294955e+01_wp, 0.2125476091956e+00_wp /
    data ((s0(i,j,2),i=1,3),j=201,210) / &
      0.2379905859802e-08_wp, 0.5893721933961e+01_wp, 0.2140505503610e+00_wp, &
      0.2550844302187e-08_wp, 0.3331940762063e+01_wp, 0.1534957940063e+00_wp, &
      0.2268824211001e-08_wp, 0.1843418461035e+01_wp, 0.2235935264888e+00_wp, &
      0.2464700891204e-08_wp, 0.3029548547230e+01_wp, 0.2091065926078e+00_wp, &
      0.2436814726024e-08_wp, 0.4994717970364e+01_wp, 0.2174915669488e+00_wp, &
      0.2443623894745e-08_wp, 0.2645102591375e+01_wp, 0.1739420156204e+00_wp, &
      0.2318701783838e-08_wp, 0.5700547397897e+01_wp, 0.7530171478090e-01_wp, &
      0.2284448700256e-08_wp, 0.5268898905872e+01_wp, 0.7426161660010e-01_wp, &
      0.2468848123510e-08_wp, 0.5276280575078e+01_wp, 0.2526561439362e+00_wp, &
      0.2814052350303e-08_wp, 0.6130168623475e+01_wp, 0.5636314030725e+00_wp /
    data ((s0(i,j,2),i=1,3),j=211,ns0y) / &
      0.2243662755220e-08_wp, 0.6631692457995e+00_wp, 0.8886590321940e-01_wp, &
      0.2330795855941e-08_wp, 0.2499435487702e+01_wp, 0.1056200952181e+01_wp, &
      0.9757679038404e-09_wp, 0.5796846023126e+01_wp, 0.7826370942180e+02_wp /

    !  SSB-to-Sun, T^1, Y
    data ((s1(i,j,2),i=1,3),j=  1, 10) / &
      0.8989047573576e-08_wp, 0.5840593672122e+01_wp, 0.4265981595566e+00_wp, &
      0.7815938401048e-08_wp, 0.1129664707133e+01_wp, 0.2061856251104e+00_wp, &
      0.7550926713280e-08_wp, 0.6196589104845e+00_wp, 0.2204125344462e+00_wp, &
      0.6056556925895e-08_wp, 0.1677494667846e+01_wp, 0.1059381944224e+01_wp, &
      0.5734142698204e-08_wp, 0.4000920852962e+01_wp, 0.5225775174439e+00_wp, &
      0.5614341822459e-08_wp, 0.3486722577328e+01_wp, 0.5368044267797e+00_wp, &
      0.1028678147656e-08_wp, 0.1877141024787e+01_wp, 0.7113454667900e-02_wp, &
      0.7270792075266e-09_wp, 0.5077167301739e+01_wp, 0.6398972393349e+00_wp, &
      0.8734141726040e-09_wp, 0.9069550282609e-01_wp, 0.4194847048887e+00_wp, &
      0.5377371402113e-09_wp, 0.6039381844671e+01_wp, 0.4337116142245e+00_wp /
    data ((s1(i,j,2),i=1,3),j= 11, 20) / &
      0.4729719431571e-09_wp, 0.2153086311760e+01_wp, 0.2132990797783e+00_wp, &
      0.4458052820973e-09_wp, 0.5059830025565e+01_wp, 0.5296909721118e+00_wp, &
      0.4406855467908e-09_wp, 0.2027971692630e+01_wp, 0.1589072916335e+01_wp, &
      0.3101659310977e-09_wp, 0.3317677981860e+01_wp, 0.1052268489556e+01_wp, &
      0.3016749232545e-09_wp, 0.3913703482532e+01_wp, 0.1066495398892e+01_wp, &
      0.3198541352656e-09_wp, 0.1275513098525e+01_wp, 0.1495633313810e+00_wp, &
      0.2142065389871e-09_wp, 0.5301351614597e+01_wp, 0.3163918923335e+00_wp, &
      0.1902615247592e-09_wp, 0.4894943352736e+00_wp, 0.2275259891141e+00_wp, &
      0.1613410990871e-09_wp, 0.2449891130437e+01_wp, 0.1102062672231e+00_wp, &
      0.1576992165097e-09_wp, 0.4211421447633e+01_wp, 0.7626583626240e-01_wp /
    data ((s1(i,j,2),i=1,3),j= 21, 30) / &
      0.1241637259894e-09_wp, 0.4140803368133e+01_wp, 0.5154640627760e+00_wp, &
      0.1313974830355e-09_wp, 0.3591920305503e+01_wp, 0.3664874755930e-01_wp, &
      0.1181697118258e-09_wp, 0.1506314382788e+01_wp, 0.6327837846670e+00_wp, &
      0.1238239742779e-09_wp, 0.7461405378404e+00_wp, 0.3961708870310e-01_wp, &
      0.1010107068241e-09_wp, 0.6271010795475e+00_wp, 0.7329749511860e-01_wp, &
      0.9226316616509e-10_wp, 0.1259158839583e+01_wp, 0.1990721704425e+00_wp, &
      0.8664946419555e-10_wp, 0.3353244696934e+01_wp, 0.5439178814476e+00_wp, &
      0.7757230468978e-10_wp, 0.1447677295196e+01_wp, 0.9491756770005e+00_wp, &
      0.7693168628139e-10_wp, 0.1120509896721e+01_wp, 0.1030928125552e+00_wp, &
      0.5487897454612e-10_wp, 0.4439380426795e+01_wp, 0.8531963191132e+00_wp /
    data ((s1(i,j,2),i=1,3),j= 31, 40) / &
      0.5196118677218e-10_wp, 0.3788856619137e+00_wp, 0.2093666171530e+00_wp, &
      0.5110853339935e-10_wp, 0.1386879372016e+01_wp, 0.2172315424036e+00_wp, &
      0.5027804534813e-10_wp, 0.1647881805466e+00_wp, 0.2164800718209e+00_wp, &
      0.4922485922674e-10_wp, 0.1594315079862e+01_wp, 0.2101180877357e+00_wp, &
      0.6155599524400e-10_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.4447147832161e-10_wp, 0.5480720918976e+01_wp, 0.3235053470014e+00_wp, &
      0.4144691276422e-10_wp, 0.1931371033660e+01_wp, 0.6373574839730e-01_wp, &
      0.4099950625452e-10_wp, 0.5229611294335e+01_wp, 0.6470106940028e+00_wp, &
      0.5060541682953e-10_wp, 0.1731112486298e+01_wp, 0.1422690933580e-01_wp, &
      0.4293615946300e-10_wp, 0.2714571038925e+01_wp, 0.7358765972222e+00_wp /
    data ((s1(i,j,2),i=1,3),j= 41,ns1y) / &
      0.3545659845763e-10_wp, 0.4451041444634e+01_wp, 0.5265099800692e+00_wp, &
      0.3479112041196e-10_wp, 0.3029385448081e+01_wp, 0.5328719641544e+00_wp, &
      0.3438516493570e-10_wp, 0.2778507143731e+01_wp, 0.8582758298370e-01_wp, &
      0.3297341285033e-10_wp, 0.7898709807584e+00_wp, 0.1104591729320e-01_wp, &
      0.2972585818015e-10_wp, 0.3218785316973e+01_wp, 0.5257585094865e+00_wp, &
      0.2931707295017e-10_wp, 0.4260731012098e+01_wp, 0.5336234347371e+00_wp, &
      0.2897198149403e-10_wp, 0.1120753978101e+01_wp, 0.1173197218910e+00_wp, &
      0.2832293240878e-10_wp, 0.4597682717827e+00_wp, 0.2022531624851e+00_wp, &
      0.2864348326612e-10_wp, 0.2169939928448e+01_wp, 0.9597935788730e-01_wp, &
      0.2852714675471e-10_wp, 0.2377659870578e+01_wp, 0.2118763888447e+01_wp /

    !  SSB-to-Sun, T^2, Y
    data ((s2(i,j,2),i=1,3),j=  1,ns2y) / &
      0.1609114495091e-11_wp, 0.2831096993481e+01_wp, 0.2061856251104e+00_wp, &
      0.1560330784946e-11_wp, 0.5193058213906e+01_wp, 0.2204125344462e+00_wp, &
      0.1183535479202e-11_wp, 0.5707003443890e+01_wp, 0.5225775174439e+00_wp, &
      0.1158183066182e-11_wp, 0.1782400404928e+01_wp, 0.5368044267797e+00_wp, &
      0.1032868027407e-11_wp, 0.4036925452011e+01_wp, 0.2132990797783e+00_wp, &
      0.6540142847741e-12_wp, 0.4058241056717e+01_wp, 0.4265981595566e+00_wp, &
      0.7305236491596e-12_wp, 0.6175401942957e+00_wp, 0.5296909721118e+00_wp, &
     -0.5580725052968e-12_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.3946122651015e-12_wp, 0.4108265279171e+00_wp, 0.1059381944224e+01_wp /

    !  SSB-to-Sun, T^0, Z
    data ((s0(i,j,3),i=1,3),j=  1, 10) / &
      0.1181255122986e-03_wp, 0.4607918989164e+00_wp, 0.2132990797783e+00_wp, &
      0.1127777651095e-03_wp, 0.4169146331296e+00_wp, 0.5296909721118e+00_wp, &
      0.4777754401806e-04_wp, 0.4582657007130e+01_wp, 0.3813291813120e-01_wp, &
      0.1129354285772e-04_wp, 0.5758735142480e+01_wp, 0.7478166569050e-01_wp, &
     -0.1149543637123e-04_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.3298730512306e-05_wp, 0.5978801994625e+01_wp, 0.4265981595566e+00_wp, &
      0.2733376706079e-05_wp, 0.7665413691040e+00_wp, 0.1059381944224e+01_wp, &
      0.9426389657270e-06_wp, 0.3710201265838e+01_wp, 0.2061856251104e+00_wp, &
      0.8187517749552e-06_wp, 0.3390675605802e+00_wp, 0.2204125344462e+00_wp, &
      0.4080447871819e-06_wp, 0.4552296640088e+00_wp, 0.5225775174439e+00_wp /
    data ((s0(i,j,3),i=1,3),j= 11, 20) / &
      0.3169973017028e-06_wp, 0.3445455899321e+01_wp, 0.5368044267797e+00_wp, &
      0.2438098615549e-06_wp, 0.5664675150648e+01_wp, 0.3664874755930e-01_wp, &
      0.2601897517235e-06_wp, 0.1931894095697e+01_wp, 0.1495633313810e+00_wp, &
      0.2314558080079e-06_wp, 0.3666319115574e+00_wp, 0.3961708870310e-01_wp, &
      0.1962549548002e-06_wp, 0.3167411699020e+01_wp, 0.7626583626240e-01_wp, &
      0.2180518287925e-06_wp, 0.1544420746580e+01_wp, 0.7113454667900e-02_wp, &
      0.1451382442868e-06_wp, 0.1583756740070e+01_wp, 0.1102062672231e+00_wp, &
      0.1358439007389e-06_wp, 0.5239941758280e+01_wp, 0.6398972393349e+00_wp, &
      0.1050585898028e-06_wp, 0.2266958352859e+01_wp, 0.3163918923335e+00_wp, &
      0.1050029870186e-06_wp, 0.2711495250354e+01_wp, 0.4194847048887e+00_wp /
    data ((s0(i,j,3),i=1,3),j= 21, 30) / &
      0.9934920679800e-07_wp, 0.1116208151396e+01_wp, 0.1589072916335e+01_wp, &
      0.1048395331560e-06_wp, 0.3408619600206e+01_wp, 0.1021328554739e+02_wp, &
      0.8370147196668e-07_wp, 0.3810459401087e+01_wp, 0.2535050500000e-01_wp, &
      0.7989856510998e-07_wp, 0.3769910473647e+01_wp, 0.7329749511860e-01_wp, &
      0.5441221655233e-07_wp, 0.2416994903374e+01_wp, 0.1030928125552e+00_wp, &
      0.4610812906784e-07_wp, 0.5858503336994e+01_wp, 0.4337116142245e+00_wp, &
      0.3923022803444e-07_wp, 0.3354170010125e+00_wp, 0.1484170571900e-02_wp, &
      0.2610725582128e-07_wp, 0.5410600646324e+01_wp, 0.6327837846670e+00_wp, &
      0.2455279767721e-07_wp, 0.6120216681403e+01_wp, 0.1162474756779e+01_wp, &
      0.2375530706525e-07_wp, 0.6055443426143e+01_wp, 0.1052268489556e+01_wp /
    data ((s0(i,j,3),i=1,3),j= 31, 40) / &
      0.1782967577553e-07_wp, 0.3146108708004e+01_wp, 0.8460828644453e+00_wp, &
      0.1581687095238e-07_wp, 0.6255496089819e+00_wp, 0.3340612434717e+01_wp, &
      0.1594657672461e-07_wp, 0.3782604300261e+01_wp, 0.1066495398892e+01_wp, &
      0.1563448615040e-07_wp, 0.1997775733196e+01_wp, 0.2022531624851e+00_wp, &
      0.1463624258525e-07_wp, 0.1736316792088e+00_wp, 0.3516457698740e-01_wp, &
      0.1331585056673e-07_wp, 0.4331941830747e+01_wp, 0.9491756770005e+00_wp, &
      0.1130634557637e-07_wp, 0.6152017751825e+01_wp, 0.2968341143800e-02_wp, &
      0.1028949607145e-07_wp, 0.2101792614637e+00_wp, 0.2275259891141e+00_wp, &
      0.1024074971618e-07_wp, 0.4071833211074e+01_wp, 0.5070101000000e-01_wp, &
      0.8826956060303e-08_wp, 0.4861633688145e+00_wp, 0.2093666171530e+00_wp /
    data ((s0(i,j,3),i=1,3),j= 41, 50) / &
      0.8572230171541e-08_wp, 0.5268190724302e+01_wp, 0.4110125927500e-01_wp, &
      0.7649332643544e-08_wp, 0.5134543417106e+01_wp, 0.2608790314060e+02_wp, &
      0.8581673291033e-08_wp, 0.2920218146681e+01_wp, 0.1480791608091e+00_wp, &
      0.8430589300938e-08_wp, 0.3604576619108e+01_wp, 0.2172315424036e+00_wp, &
      0.7776165501012e-08_wp, 0.3772942249792e+01_wp, 0.6373574839730e-01_wp, &
      0.8311070234408e-08_wp, 0.6200412329888e+01_wp, 0.3235053470014e+00_wp, &
      0.6927365212582e-08_wp, 0.4543353113437e+01_wp, 0.8531963191132e+00_wp, &
      0.6791574208598e-08_wp, 0.2882188406238e+01_wp, 0.7181332454670e-01_wp, &
      0.5593100811839e-08_wp, 0.1776646892780e+01_wp, 0.7429900518901e+00_wp, &
      0.4553381853021e-08_wp, 0.3949617611240e+01_wp, 0.7775000683430e-01_wp /
    data ((s0(i,j,3),i=1,3),j= 51, 60) / &
      0.5758000450068e-08_wp, 0.3859251775075e+01_wp, 0.1990721704425e+00_wp, &
      0.4281283457133e-08_wp, 0.1466294631206e+01_wp, 0.2118763888447e+01_wp, &
      0.4206935661097e-08_wp, 0.5421776011706e+01_wp, 0.1104591729320e-01_wp, &
      0.4213751641837e-08_wp, 0.3412048993322e+01_wp, 0.2243449970715e+00_wp, &
      0.5310506239878e-08_wp, 0.5421641370995e+00_wp, 0.5154640627760e+00_wp, &
      0.3827450341320e-08_wp, 0.8887314524995e+00_wp, 0.1510475019529e+00_wp, &
      0.4292435241187e-08_wp, 0.1405043757194e+01_wp, 0.1422690933580e-01_wp, &
      0.3189780702289e-08_wp, 0.1060049293445e+01_wp, 0.1173197218910e+00_wp, &
      0.3226611928069e-08_wp, 0.6270858897442e+01_wp, 0.2164800718209e+00_wp, &
      0.2893897608830e-08_wp, 0.5117563223301e+01_wp, 0.6470106940028e+00_wp /
    data ((s0(i,j,3),i=1,3),j= 61,ns0z) / &
      0.3239852024578e-08_wp, 0.4079092237983e+01_wp, 0.2101180877357e+00_wp, &
      0.2956892222200e-08_wp, 0.1594917021704e+01_wp, 0.3092784376656e+00_wp, &
      0.2980177912437e-08_wp, 0.5258787667564e+01_wp, 0.4155522422634e+00_wp, &
      0.3163725690776e-08_wp, 0.3854589225479e+01_wp, 0.8582758298370e-01_wp, &
      0.2662262399118e-08_wp, 0.3561326430187e+01_wp, 0.5257585094865e+00_wp, &
      0.2766689135729e-08_wp, 0.3180732086830e+00_wp, 0.1385174140878e+00_wp, &
      0.2411600278464e-08_wp, 0.3324798335058e+01_wp, 0.5439178814476e+00_wp, &
      0.2483527695131e-08_wp, 0.4169069291947e+00_wp, 0.5336234347371e+00_wp, &
      0.7788777276590e-09_wp, 0.1900569908215e+01_wp, 0.5217580628120e+02_wp /

    !  SSB-to-Sun, T^1, Z
    data ((s1(i,j,3),i=1,3),j=  1, 10) / &
      0.5444220475678e-08_wp, 0.1803825509310e+01_wp, 0.2132990797783e+00_wp, &
      0.3883412695596e-08_wp, 0.4668616389392e+01_wp, 0.5296909721118e+00_wp, &
      0.1334341434551e-08_wp, 0.0000000000000e+00_wp, 0.0000000000000e+00_wp, &
      0.3730001266883e-09_wp, 0.5401405918943e+01_wp, 0.2061856251104e+00_wp, &
      0.2894929197956e-09_wp, 0.4932415609852e+01_wp, 0.2204125344462e+00_wp, &
      0.2857950357701e-09_wp, 0.3154625362131e+01_wp, 0.7478166569050e-01_wp, &
      0.2499226432292e-09_wp, 0.3657486128988e+01_wp, 0.4265981595566e+00_wp, &
      0.1937705443593e-09_wp, 0.5740434679002e+01_wp, 0.1059381944224e+01_wp, &
      0.1374894396320e-09_wp, 0.1712857366891e+01_wp, 0.5368044267797e+00_wp, &
      0.1217248678408e-09_wp, 0.2312090870932e+01_wp, 0.5225775174439e+00_wp /
    data ((s1(i,j,3),i=1,3),j= 11,ns1z) / &
      0.7961052740870e-10_wp, 0.5283368554163e+01_wp, 0.3813291813120e-01_wp, &
      0.4979225949689e-10_wp, 0.4298290471860e+01_wp, 0.4194847048887e+00_wp, &
      0.4388552286597e-10_wp, 0.6145515047406e+01_wp, 0.7113454667900e-02_wp, &
      0.2586835212560e-10_wp, 0.3019448001809e+01_wp, 0.6398972393349e+00_wp /

    !  SSB-to-Sun, T^2, Z
    data ((s2(i,j,3),i=1,3),j=  1,ns2z) / &
      0.3749920358054e-12_wp, 0.3230285558668e+01_wp, 0.2132990797783e+00_wp, &
      0.2735037220939e-12_wp, 0.6154322683046e+01_wp, 0.5296909721118e+00_wp /

    !  Time since reference epoch, years.
    t = ( ( date1-dj00 ) + date2 ) / djy
    t2 = t*t

    !  Set status.
    if ( abs(t) <= 100.0_wp ) then
       jstat = 0
    else
       jstat = 1
    end if

    !  X then Y then Z.
    do k=1,3

       !  Initialize position and velocity component.
       xyz = 0.0_wp
       xyzd = 0.0_wp

       !  ------------------------------------------------
       !  Obtain component of Sun to Earth ecliptic vector
       !  ------------------------------------------------

       !  Sun to Earth, T^0 terms.
       do j=1,ne0(k)
          a = e0(1,j,k)
          b = e0(2,j,k)
          c = e0(3,j,k)
          p = b + c*t
          xyz  = xyz  + a*cos(p)
          xyzd = xyzd - a*c*sin(p)
       end do

       !  Sun to Earth, T^1 terms.
       do j=1,ne1(k)
          a = e1(1,j,k)
          b = e1(2,j,k)
          c = e1(3,j,k)
          ct = c*t
          p = b + ct
          cp = cos(p)
          xyz  = xyz  + a*t*cp
          xyzd = xyzd + a*(cp-ct*sin(p))
       end do

       !  Sun to Earth, T^2 terms.
       do j=1,ne2(k)
          a = e2(1,j,k)
          b = e2(2,j,k)
          c = e2(3,j,k)
          ct = c*t
          p = b + ct
          cp = cos(p)
          xyz  = xyz  + a*t2*cp
          xyzd = xyzd + a*t*(2.0_wp*cp-ct*sin(p))
       end do

       !  Heliocentric Earth position and velocity component.
       ph(k) = xyz
       vh(k) = xyzd / djy

       !  ------------------------------------------------
       !  Obtain component of SSB to Earth ecliptic vector
       !  ------------------------------------------------

       !  SSB to Sun, T^0 terms.
       do j=1,ns0(k)
          a = s0(1,j,k)
          b = s0(2,j,k)
          c = s0(3,j,k)
          p = b + c*t
          xyz  = xyz  + a*cos(p)
          xyzd = xyzd - a*c*sin(p)
       end do

       !  SSB to Sun, T^1 terms.
       do j=1,ns1(k)
          a = s1(1,j,k)
          b = s1(2,j,k)
          c = s1(3,j,k)
          ct = c*t
          p = b + ct
          cp = cos(p)
          xyz  = xyz  + a*t*cp
          xyzd = xyzd + a*(cp-ct*sin(p))
       end do

       !  SSB to Sun, T^2 terms.
       do j=1,ns2(k)
          a = s2(1,j,k)
          b = s2(2,j,k)
          c = s2(3,j,k)
          ct = c*t
          p = b + ct
          cp = cos(p)
          xyz  = xyz  + a*t2*cp
          xyzd = xyzd + a*t*(2.0_wp*cp-ct*sin(p))
       end do

       !  Barycentric Earth position and velocity component.
       pb(k) = xyz
       vb(k) = xyzd / djy

       !  Next Cartesian component.
    end do

    !  Rotate from ecliptic to ICRF coordinates and return the results.
    x = ph(1)
    y = ph(2)
    z = ph(3)
    pvh(1,1) =      x + am12*y + am13*z
    pvh(2,1) = am21*x + am22*y + am23*z
    pvh(3,1) =          am32*y + am33*z
    x = vh(1)
    y = vh(2)
    z = vh(3)
    pvh(1,2) =      x + am12*y + am13*z
    pvh(2,2) = am21*x + am22*y + am23*z
    pvh(3,2) =          am32*y + am33*z
    x = pb(1)
    y = pb(2)
    z = pb(3)
    pvb(1,1) =      x + am12*y + am13*z
    pvb(2,1) = am21*x + am22*y + am23*z
    pvb(3,1) =          am32*y + am33*z
    x = vb(1)
    y = vb(2)
    z = vb(3)
    pvb(1,2) =      x + am12*y + am13*z
    pvb(2,2) = am21*x + am22*y + am23*z
    pvb(3,2) =          am32*y + am33*z

    end subroutine EPV00
!***********************************************************************

!***********************************************************************
!>
!  Transformation from ICRS equatorial coordinates to ecliptic
!  coordinates (mean equinox and ecliptic of date) using IAU 2006
!  precession model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. No assumptions are made about whether the coordinates represent
!     starlight and embody astrometric effects such as parallax or
!     aberration.
!
!  3. The transformation is approximately that from mean J2000.0 right
!     ascension and declination to ecliptic longitude and latitude (mean
!     equinox and ecliptic of date), with only frame bias (always less
!     than 25 mas) to disturb this classical picture.
!
!### History
!  * IAU SOFA revision: 2016 February 9

    subroutine EQEC06 ( date1, date2, dr, dd, dl, db )

    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) :: dr !! ICRS right ascension (radians)
    real(wp),intent(in) :: dd !! ICRS declination (radians)
    real(wp),intent(out) :: dl !! ecliptic longitude (radians)
    real(wp),intent(out) :: db !! ecliptic latitude (radians)

    real(wp) :: rm(3,3), v1(3), v2(3), a, b

    !  Spherical to Cartesian.
    call S2C ( dr, dd, v1 )

    !  Rotation matrix, ICRS equatorial to ecliptic.
    call ECM06 ( date1, date2, rm )

    !  The transformation from ICRS to ecliptic.
    call RXP ( rm, v1, v2 )

    !  Cartesian to spherical.
    call C2S ( v2, a, b )

    !  Express in conventional ranges.
    dl = ANP ( a )
    db = ANPM ( b )

    end subroutine EQEC06
!***********************************************************************

!***********************************************************************
!>
!  Equation of the equinoxes, IAU 1994 model.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  2. The result, which is in radians, operates in the following sense:
!
!        Greenwich apparent ST = GMST + equation of the equinoxes
!
!### References
!
!  * IAU Resolution C7, Recommendation 3 (1994)
!
!  * Capitaine, N. & Gontier, A.-M., Astron.Astrophys., 275,
!    645-650 (1993)
!
!### History
!  * IAU SOFA revision: 2017 October 12

    function EQEQ94 ( date1, date2 ) result(eqe)

    implicit none

    real(wp),intent(in) :: date1 !! TDB date (Note 1)
    real(wp),intent(in) :: date2 !! TDB date (Note 1)
    real(wp) :: eqe !! equation of the equinoxes (Note 2)

    real(wp) :: t, om, dpsi, deps, eps0

    !  Interval between fundamental epoch J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Longitude of the mean ascending node of the lunar orbit on the
    !  ecliptic, measured from the mean equinox of date.
    om = ANPM( ( 450160.280_wp + ( -482890.539_wp + &
               ( 7.455_wp + 0.008_wp * t ) * t ) * t ) * das2r &
                 + mod(-5.0_wp*t,1.0_wp) * d2pi )

    !  Nutation components and mean obliquity.
    call NUT80 ( date1, date2, dpsi, deps )
    eps0 = OBL80 ( date1, date2 )

    !  Equation of the equinoxes.
    eqe = dpsi * cos(eps0) + das2r * ( 0.00264_wp * sin(om) + &
                                       0.000063_wp * sin(om+om))

    end function EQEQ94
!***********************************************************************

!***********************************************************************
!>
!  Earth rotation angle (IAU 2000 model).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The UT1 date DJ1+DJ2 is a Julian Date, apportioned in any
!     convenient way between the arguments DJ1 and DJ2.  For example,
!     JD(UT1)=2450123.7 could be expressed in any of these ways,
!     among others:
!
!             DJ1            DJ2
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  The date & time method is
!     best matched to the algorithm used:  maximum accuracy (or, at
!     least, minimum noise) is delivered when the DJ1 argument is for
!     0hrs UT1 on the day in question and the DJ2 argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. The algorithm is adapted from Expression 22 of Capitaine et al.
!     2000.  The time argument has been expressed in days directly,
!     and, to retain precision, integer contributions have been
!     eliminated.  The same formulation is given in IERS Conventions
!     (2003), Chap. 5, Eq. 14.
!
!### References
!
!  * Capitaine N., Guinot B. and McCarthy D.D, 2000, Astron.
!    Astrophys., 355, 398-405.
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function ERA00 ( dj1, dj2 ) result(era)

    implicit none

    real(wp),intent(in) :: dj1 !! UT1 as a 2-part Julian Date (see note)
    real(wp),intent(in) :: dj2 !! UT1 as a 2-part Julian Date (see note)
    real(wp) :: era !! the Earth rotation angle (radians), in the range 0 to 2pi.

    real(wp) :: d1, d2, t, f

    !  Days since fundamental epoch.
    if ( dj1 < dj2 ) then
       d1 = dj1
       d2 = dj2
    else
       d1 = dj2
       d2 = dj1
    end if
    t = d1 + ( d2-dj00 )

    !  Fractional part of T (days).
    f = mod ( d1, 1.0_wp ) + mod ( d2, 1.0_wp )

    !  Earth rotation angle at this UT1.
    era = ANP ( d2pi * ( f + 0.7790572732640_wp &
                           + 0.00273781191135448_wp * t ) )

    end function ERA00
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean elongation of the Moon from the Sun.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAD03 ( t ) result(fa)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: fa !! D, radians (Note 2)

    !  Arcseconds in a full circle.
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Mean elongation of the Moon from the Sun (IERS Conventions 2003).
    fa = mod (  1072260.703692_wp + &
                t*( 1602961601.2090_wp + &
                t*(        - 6.3706_wp + &
                t*(          0.006593_wp + &
                t*(        - 0.00003169_wp )))), turnas ) * das2r

    end function FAD03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Earth.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     comes from Souchay et al. (1999) after Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAE03 ( t ) result(fae)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: fae !! mean longitude of Earth, radians (Note 2)

    !  Mean longitude of Earth (IERS Conventions 2003).
    fae = mod ( 1.753470314_wp + 628.3075849991_wp * t, d2pi )

    end function FAE03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of the Moon minus mean longitude of the ascending
!  node.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAF03 ( t ) result(f)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: f !! F, radians (Note 2)

    !  Arcseconds in a full circle.
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Mean longitude of the Moon minus that of the ascending node
    !  (IERS Conventions 2003).
    f = mod ( 335779.526232_wp + &
               t*( 1739527262.8478_wp + &
               t*(       - 12.7512_wp + &
               t*(       -  0.001037_wp + &
               t*(          0.00000417_wp )))), turnas ) * das2r

    end function FAF03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Jupiter.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     comes from Souchay et al. (1999) after Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAJU03 ( t ) result(fa)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: fa !! mean longitude of Jupiter, radians (Note 2)

    !  Mean longitude of Jupiter (IERS Conventions 2003).
    fa = mod ( 0.599546497_wp + 52.9690962641_wp * t, d2pi )

    end function FAJU03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean anomaly of the Moon.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAL03 ( t ) result(l)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: l !! l, radians (Note 2)

    !  Arcseconds in a full circle.
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Mean anomaly of the Moon (IERS Conventions 2003).
    l = mod ( 485868.249036_wp + &
              t*( 1717915923.2178_wp + &
              t*(         31.8792_wp + &
              t*(          0.051635_wp + &
              t*(        - 0.00024470_wp )))), turnas ) * das2r

    end function FAL03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean anomaly of the Sun.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FALP03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! l', radians (Note 2)

    !  Arcseconds in a full circle.
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Mean anomaly of the Sun (IERS Conventions 2003).
    res = mod ( 1287104.793048_wp + &
                t*( 129596581.0481_wp + &
                t*(       - 0.5532_wp + &
                t*(         0.000136_wp + &
                t*(       - 0.00001149_wp )))), turnas ) * das2r

    end function FALP03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Mars.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     comes from Souchay et al. (1999) after Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAMA03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! mean longitude of Mars, radians (Note 2)

    !  Mean longitude of Mars (IERS Conventions 2003).
    res = mod ( 6.203480913_wp + 334.0612426700_wp * t, d2pi )

    end function FAMA03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Mercury.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     comes from Souchay et al. (1999) after Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAME03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! mean longitude of Mercury, radians (Note 2)

    !  Mean longitude of Mercury (IERS Conventions 2003).
    res = mod ( 4.402608842_wp + 2608.7903141574_wp * t, d2pi )

    end function FAME03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Neptune.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is adapted from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FANE03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! mean longitude of Neptune, radians (Note 2)

    !  Mean longitude of Neptune (IERS Conventions 2003).
    res = mod ( 5.311886287_wp + 3.8133035638_wp * t, d2pi )

    end function FANE03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of the Moon's ascending node.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAOM03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! Omega, radians (Note 2)

    !  Arcseconds in a full circle.
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Mean longitude of the Moon's ascending node (IERS Conventions 2003).
    res  = mod ( 450160.398036_wp + &
                 t*( - 6962890.5431_wp + &
                 t*(         7.4722_wp + &
                 t*(         0.007702_wp + &
                 t*(       - 0.00005939_wp )))), turnas ) * das2r

    end function FAOM03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  general accumulated precession in longitude.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003).  It
!     is taken from Kinoshita & Souchay (1990) and comes originally from
!     Lieske et al. (1977).
!
!### References
!
!  * Kinoshita, H. and Souchay J. 1990, Celest.Mech. and Dyn.Astron.
!    48, 187
!
!  * Lieske, J.H., Lederle, T., Fricke, W. & Morando, B. 1977,
!    Astron.Astrophys. 58, 1-16
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAPA03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! general precession in longitude, radians (Note 2)

    !  General accumulated precession in longitude.
    res = ( 0.024381750_wp + 0.00000538691_wp * t ) * t

    end function FAPA03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Saturn.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     comes from Souchay et al. (1999) after Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FASA03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! mean longitude of Saturn, radians (Note 2)

    !  Mean longitude of Saturn (IERS Conventions 2003).
    res = mod ( 0.874016757_wp + 21.3299104960_wp * t, d2pi )

    end function FASA03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Uranus.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     is adapted from Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAUR03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! mean longitude of Uranus, radians (Note 2)

    !  Mean longitude of Uranus (IERS Conventions 2003).
    res = mod ( 5.481293872_wp + 7.4781598567_wp * t, d2pi )

    end function FAUR03
!***********************************************************************

!***********************************************************************
!>
!  Fundamental argument, IERS Conventions (2003):
!  mean longitude of Venus.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. Though T is strictly TDB, it is usually more convenient to use TT,
!     which makes no significant difference.
!
!  2. The expression used is as adopted in IERS Conventions (2003) and
!     comes from Souchay et al. (1999) after Simon et al. (1994).
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function FAVE03 ( t ) result(res)

    implicit none

    real(wp),intent(in) :: t !! TDB, Julian centuries since J2000.0 (Note 1)
    real(wp) :: res !! mean longitude of Venus, radians (Note 2)

    !  Mean longitude of Venus (IERS Conventions 2003).
    res = mod ( 3.176146697_wp + 1021.3285546211_wp * t, d2pi )

    end function FAVE03
!***********************************************************************

!***********************************************************************
!>
!  Convert B1950.0 FK4 star catalog data to J2000.0 FK5.
!
!  Status:  support routine.
!
!  This routine converts a star's catalog data from the old FK4
!  (Bessel-Newcomb) system to the later IAU 1976 FK5 (Fricke) system.
!
!### Notes
!
!  1. The proper motions in RA are dRA/dt rather than cos(Dec)*dRA/dt,
!     and are per year rather than per century.
!
!  2. The conversion is somewhat complicated, for several reasons:
!
!     * Change of standard epoch from B1950.0 to J2000.0.
!
!     * An intermediate transition date of 1984 January 1.0 TT.
!
!     * A change of precession model.
!
!     * Change of time unit for proper motion (tropical to Julian).
!
!     * FK4 positions include the E-terms of aberration, to simplify the
!       hand computation of annual aberration.  FK5 positions assume a
!       rigorous aberration computation based on the Earth's barycentric
!       velocity.
!
!     * The E-terms also affect proper motions, and in particular cause
!       objects at large distances to exhibit fictitious proper motions.
!
!     The algorithm is based on Smith et al. (1989) and Yallop et al.
!     (1989), which presented a matrix method due to Standish (1982) as
!     developed by Aoki et al. (1983), using Kinoshita's development of
!     Andoyer's post-Newcomb precession.  The numerical constants from
!     Seidelmann (1992) are used canonically.
!
!  3. Conversion from B1950.0 FK4 to J2000.0 FK5 only is provided for.
!     Conversions for different epochs and equinoxes would require
!     additional treatment for precession, proper motion and E-terms.
!
!  4. In the FK4 catalog the proper motions of stars within 10 degrees
!     of the poles do not embody differential E-terms effects and
!     should, strictly speaking, be handled in a different manner from
!     stars outside these regions.  However, given the general lack of
!     homogeneity of the star data available for routine astrometry, the
!     difficulties of handling positions that may have been determined
!     from astrometric fields spanning the polar and non-polar regions,
!     the likelihood that the differential E-terms effect was not taken
!     into account when allowing for proper motion in past astrometry,
!     and the undesirability of a discontinuity in the algorithm, the
!     decision has been made in this SOFA algorithm to include the
!     effects of differential E-terms on the proper motions for all
!     stars, whether polar or not.  At epoch J2000.0, and measuring "on
!     the sky" rather than in terms of RA change, the errors resulting
!     from this simplification are less than 1 milliarcsecond in
!     position and 1 milliarcsecond per century in proper motion.
!
!### References
!
!  * Aoki, S. et al., 1983, "Conversion matrix of epoch B1950.0
!    FK4-based positions of stars to epoch J2000.0 positions in
!    accordance with the new IAU resolutions".  Astron.Astrophys.
!    128, 263-267.
!
!  * Seidelmann, P.K. (ed), 1992, "Explanatory Supplement to the
!    Astronomical Almanac", ISBN 0-935702-68-7.
!
!  * Smith, C.A. et al., 1989, "The transformation of astrometric
!    catalog systems to the equinox J2000.0".  Astron.J. 97, 265.
!
!  * Standish, E.M., 1982, "Conversion of positions and proper motions
!    from B1950.0 to the IAU system at J2000.0".  Astron.Astrophys.,
!    115, 1, 20-22.
!
!  * Yallop, B.D. et al., 1989, "Transformation of mean star places
!    from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space".
!    Astron.J. 97, 274.
!
!### History
!  * IAU SOFA revision:  2018 January 11

    subroutine FK425 ( r1950, d1950, &
                       dr1950, dd1950, p1950, v1950, &
                       r2000, d2000, &
                       dr2000, dd2000, p2000, v2000 )

    implicit none

    real(wp),intent(in) :: r1950 !! B1950.0 RA (rad)
    real(wp),intent(in) :: d1950 !! B1950.0 Dec (rad)
    real(wp),intent(in) :: dr1950 !! B1950.0 proper motions (rad/trop.yr)
    real(wp),intent(in) :: dd1950 !! B1950.0 proper motions (rad/trop.yr)
    real(wp),intent(in) :: p1950 !! parallax (arcsec)
    real(wp),intent(in) :: v1950 !! radial velocity (km/s, +ve = moving away)
    real(wp),intent(out) :: r2000 !! J2000.0 RA (rad)
    real(wp),intent(out) :: d2000 !! J2000.0 Dec (rad)
    real(wp),intent(out) :: dr2000 !! J2000.0 proper motions (rad/Jul.yr)
    real(wp),intent(out) :: dd2000 !! J2000.0 proper motions (rad/Jul.yr)
    real(wp),intent(out) :: p2000 !! parallax (arcsec)
    real(wp),intent(out) :: v2000 !! radial velocity (km/s, +ve = moving away)

    !  Radians per year to arcsec per century
    real(wp),parameter :: pmf = 100.0_wp*60.0_wp*60.0_wp*360.0_wp/d2pi

    !  Small number to avoid arithmetic problems
    real(wp),parameter :: tiny = 1e-30_wp

    !  Miscellaneous
    real(wp) :: r, d, ur, ud, px, rv, pxvf, w, rd
    integer :: l, k, j, i

    !  Pv-vectors
    real(wp) :: r0(3,2), pv1(3,2), pv2(3,2), pv3(3,2)

    !  Functions
    !
    !  CANONICAL CONSTANTS  (Seidelmann 1992)
    !

    !  Km per sec to AU per tropical century
    !  = 86400 * 36524.2198782 / 149597870.7
    real(wp),parameter :: vf = 21.095_wp

    !  Constant pv-vector (cf. Seidelmann 3.591-2, vectors A and Adot)
    real(wp),dimension(3,2),parameter :: a = reshape([&
        -1.62557e-6_wp, -0.31919e-6_wp, -0.13843e-6_wp, &
        +1.245e-3_wp,   -1.580e-3_wp,   -0.659e-3_wp ], [3,2])

    !  3x2 matrix of pv-vectors (cf. Seidelmann 3.591-4, matrix M)
    real(wp),dimension(3,2,3,2),parameter :: em = reshape([&
       +0.9999256782_wp,     -0.0111820611_wp,     -0.0048579477_wp, &
       +0.00000242395018_wp, -0.00000002710663_wp, -0.00000001177656_wp, &
       +0.0111820610_wp,     +0.9999374784_wp,     -0.0000271765_wp, &
       +0.00000002710663_wp, +0.00000242397878_wp, -0.00000000006587_wp, &
       +0.0048579479_wp,     -0.0000271474_wp,     +0.9999881997_wp, &
       +0.00000001177656_wp, -0.00000000006582_wp, +0.00000242410173_wp, &
       -0.000551_wp,         -0.238565_wp,         +0.435739_wp, &
       +0.99994704_wp,       -0.01118251_wp,       -0.00485767_wp, &
       +0.238514_wp,         -0.002667_wp,         -0.008541_wp, &
       +0.01118251_wp,       +0.99995883_wp,       -0.00002718_wp, &
       -0.435623_wp,         +0.012254_wp,         +0.002117_wp, &
       +0.00485767_wp,       -0.00002714_wp,       +1.00000956_wp ], [3,2,3,2])

    !  The FK4 data (units radians and arcsec per tropical century).
    r = r1950
    d = d1950
    ur = dr1950*pmf
    ud = dd1950*pmf
    px = p1950
    rv = v1950

    !  Express as a pv-vector.
    pxvf = px*vf
    w = rv*pxvf
    call S2PV ( r, d, 1.0_wp, ur, ud, w, r0 )

    !  Allow for E-terms (cf. Seidelmann 3.591-2).
    call PVMPV ( r0, a, pv1 )
    call PDP ( r0, a, w )
    call SXP ( w, r0, pv2 )
    call PDP ( r0, a(1:3,2), w )
    call SXP ( w, r0, pv2(1,2) )
    call PVPPV ( pv1, pv2, pv3 )

    !  Convert pv-vector to Fricke system (cf. Seidelmann 3.591-3).
    do l = 1,2
       do k=1,3
          w = 0.0_wp
          do j=1,2
             do i=1,3
                w = w + em(i,j,k,l)*pv3(i,j)
             end do
          end do
          pv1(k,l) = w
       end do
    end do

    !  Revert to catalog form.
    call PV2S ( pv1, r, d, w, ur, ud, rd )
    if ( px>tiny ) then
       rv = rd/pxvf
       px = px/w
    end if

    !  Return the results.
    r2000 = ANP(r)
    d2000 = d
    dr2000 = ur/pmf
    dd2000 = ud/pmf
    v2000 = rv
    p2000 = px

    end subroutine FK425
!***********************************************************************

!***********************************************************************
!>
!  Convert a B1950.0 FK4 star position to J2000.0 FK5, assuming zero
!  proper motion in the FK5 system.
!
!  Status:  support routine.
!
!  This routine converts a star's catalog data from the old FK4
!  (Bessel-Newcomb) system to the later IAU 1976 FK5 (Fricke) system,
!  in such a way that the FK5 proper motion is zero.  Because such a
!  star has, in general, a non-zero proper motion in the FK4 system,
!  the routine requires the epoch at which the position in the FK4
!  system was determined.
!
!### Notes
!
!  1. The epoch BEPOCH is strictly speaking Besselian, but if a Julian
!     epoch is supplied the result will be affected only to a negligible
!     extent.
!
!  2. The method is from Appendix 2 of Aoki et al. (1983), but using the
!     constants of Seidelmann (1992).  See the routine FK425 for a
!     general introduction to the FK4 to FK5 conversion.
!
!  3. Conversion from equinox B1950.0 FK4 to equinox J2000.0 FK5 only is
!     provided for.  Conversions for different starting and/or ending
!     epochs would require additional treatment for precession, proper
!     motion and E-terms.
!
!  4. In the FK4 catalog the proper motions of stars within 10 degrees
!     of the poles do not embody differential E-terms effects and
!     should, strictly speaking, be handled in a different manner from
!     stars outside these regions.  However, given the general lack of
!     homogeneity of the star data available for routine astrometry, the
!     difficulties of handling positions that may have been determined
!     from astrometric fields spanning the polar and non-polar regions,
!     the likelihood that the differential E-terms effect was not taken
!     into account when allowing for proper motion in past astrometry,
!     and the undesirability of a discontinuity in the algorithm, the
!     decision has been made in this SOFA algorithm to include the
!     effects of differential E-terms on the proper motions for all
!     stars, whether polar or not.  At epoch 2000.0, and measuring "on
!     the sky" rather than in terms of RA change, the errors resulting
!     from this simplification are less than 1 milliarcsecond in
!     position and 1 milliarcsecond per century in proper motion.
!
!### References
!
!  * Aoki, S. et al., 1983, "Conversion matrix of epoch B1950.0
!    FK4-based positions of stars to epoch J2000.0 positions in
!    accordance with the new IAU resolutions".  Astron.Astrophys.
!    128, 263-267.
!
!  * Seidelmann, P.K. (ed), 1992, "Explanatory Supplement to the
!    Astronomical Almanac", ISBN 0-935702-68-7.
!
!### History
!  * IAU SOFA revision:  2018 January 11

    subroutine FK45Z ( r1950, d1950, bepoch, r2000, d2000 )

    implicit none

    real(wp),intent(in) :: r1950 !! B1950.0 FK4 RA at epoch (rad)
    real(wp),intent(in) :: d1950 !! B1950.0 FK4 Dec at epoch (rad)
    real(wp),intent(in) :: bepoch !! Besselian epoch (e.g. 1979.3D0)
    real(wp),intent(out) :: r2000 !! J2000.0 FK5 RA (rad)
    real(wp),intent(out) :: d2000 !! J2000.0 FK5 Dec (rad)

    !  Radians per year to arcsec per century
    real(wp),parameter :: pmf = 100.0_wp*60.0_wp*60.0_wp*360.0_wp/d2pi

    !  Position and position+velocity vectors
    real(wp) :: r0(3), a1(3), p1(3), p2(3), pv1(3,2), pv2(3,2)

    !  Miscellaneous
    real(wp) :: w, djm0, djm
    integer :: k, j, i

    !  Functions
    !
    !  CANONICAL CONSTANTS
    !

    !  Vectors A and Adot (Seidelmann 3.591-2)
    real(wp),dimension(3),parameter :: a  = [-1.62557e-6_wp,  -0.31919e-6_wp, -0.13843e-6_wp]
    real(wp),dimension(3),parameter :: ad = [+1.245e-3_wp,    -1.580e-3_wp,   -0.659e-3_wp]

    !  3x2 matrix of p-vectors (cf. Seidelmann 3.591-4, matrix M)
    real(wp),dimension(3,3,2),parameter :: em = reshape([&
       +0.9999256782_wp,     -0.0111820611_wp,     -0.0048579477_wp, &
       +0.0111820610_wp,     +0.9999374784_wp,     -0.0000271765_wp, &
       +0.0048579479_wp,     -0.0000271474_wp,     +0.9999881997_wp, &
       -0.000551_wp,         -0.238565_wp,         +0.435739_wp, &
       +0.238514_wp,         -0.002667_wp,         -0.008541_wp, &
       -0.435623_wp,         +0.012254_wp,         +0.002117_wp ], [3,3,2])

    !  Spherical coordinates to p-vector.
    call S2C ( r1950, d1950, r0 )

    !  Adjust p-vector A to give zero proper motion in FK5.
    w = ( bepoch - 1950.0_wp ) / pmf
    call PPSP ( a, w, ad, a1 )

    !  Remove E-terms.
    call PDP ( r0, a1, w )
    call PPSP ( a1, -w, r0, p1 )
    call PMP ( r0, p1, p2 )

    !  Convert to Fricke system pv-vector (cf. Seidelmann 3.591-3).
    do k = 1,2
       do j=1,3
          w = 0.0_wp
          do i=1,3
             w = w + em(i,j,k)*p2(i)
          end do
          pv1(j,k) = w
       end do
    end do

    !  Allow for fictitious proper motion.
    call EPB2JD ( bepoch, djm0, djm )
    w = ( EPJ(djm0,djm) - 2000.0_wp ) / pmf
    call PVU ( w, pv1, pv2 )

    !  Revert to spherical coordinates.
    call C2S ( pv2, w, d2000 )
    r2000 = ANP ( w )

    end subroutine FK45Z
!***********************************************************************

!***********************************************************************
!>
!  Convert J2000.0 FK5 star catalog data to B1950.0 FK4.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The proper motions in RA are dRA/dt rather than cos(Dec)*dRA/dt,
!     and are per year rather than per century.
!
!  2. The conversion is somewhat complicated, for several reasons:
!
!     * Change of standard epoch from J2000.0 to B1950.0.
!
!     * An intermediate transition date of 1984 January 1.0 TT.
!
!     * A change of precession model.
!
!     * Change of time unit for proper motion (Julian to tropical).
!
!     * FK4 positions include the E-terms of aberration, to simplify the
!       hand computation of annual aberration.  FK5 positions assume a
!       rigorous aberration computation based on the Earth's barycentric
!       velocity.
!
!     * The E-terms also affect proper motions, and in particular cause
!       objects at large distances to exhibit fictitious proper motions.
!
!     The algorithm is based on Smith et al. (1989) and Yallop et al.
!     (1989), which presented a matrix method due to Standish (1982) as
!     developed by Aoki et al. (1983), using Kinoshita's development of
!     Andoyer's post-Newcomb precession.  The numerical constants from
!     Seidelmann (1992) are used canonically.
!
!  4. In the FK4 catalog the proper motions of stars within 10 degrees
!     of the poles do not embody differential E-terms effects and
!     should, strictly speaking, be handled in a different manner from
!     stars outside these regions.  However, given the general lack of
!     homogeneity of the star data available for routine astrometry, the
!     difficulties of handling positions that may have been determined
!     from astrometric fields spanning the polar and non-polar regions,
!     the likelihood that the differential E-terms effect was not taken
!     into account when allowing for proper motion in past astrometry,
!     and the undesirability of a discontinuity in the algorithm, the
!     decision has been made in this SOFA algorithm to include the
!     effects of differential E-terms on the proper motions for all
!     stars, whether polar or not.  At epoch J2000.0, and measuring "on
!     the sky" rather than in terms of RA change, the errors resulting
!     from this simplification are less than 1 milliarcsecond in
!     position and 1 milliarcsecond per century in proper motion.
!
!### References
!
!  * Aoki, S. et al., 1983, "Conversion matrix of epoch B1950.0
!    FK4-based positions of stars to epoch J2000.0 positions in
!    accordance with the new IAU resolutions".  Astron.Astrophys.
!    128, 263-267.
!
!  * Seidelmann, P.K. (ed), 1992, "Explanatory Supplement to the
!    Astronomical Almanac", ISBN 0-935702-68-7.
!
!  * Smith, C.A. et al., 1989, "The transformation of astrometric
!    catalog systems to the equinox J2000.0".  Astron.J. 97, 265.
!
!  * Standish, E.M., 1982, "Conversion of positions and proper motions
!    from B1950.0 to the IAU system at J2000.0".  Astron.Astrophys.,
!    115, 1, 20-22.
!
!  * Yallop, B.D. et al., 1989, "Transformation of mean star places
!    from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space".
!    Astron.J. 97, 274.
!
!### History
!  * IAU SOFA revision:  2018 January 11

    subroutine FK524 ( r2000, d2000, &
                       dr2000, dd2000, p2000, v2000, &
                       r1950, d1950, &
                       dr1950, dd1950, p1950, v1950 )

    implicit none

    real(wp),intent(in) :: r2000 !! J2000.0 RA (rad)
    real(wp),intent(in) :: d2000 !! J2000.0 Dec (rad)
    real(wp),intent(in) :: dr2000 !! J2000.0 proper motions (rad/Jul.yr)
    real(wp),intent(in) :: dd2000 !! J2000.0 proper motions (rad/Jul.yr)
    real(wp),intent(in) :: p2000 !! parallax (arcsec)
    real(wp),intent(in) :: v2000 !! radial velocity (km/s, +ve = moving away)
    real(wp),intent(out) :: r1950 !! B1950.0 RA (rad)
    real(wp),intent(out) :: d1950 !! B1950.0 Dec (rad)
    real(wp),intent(out) :: dr1950 !! B1950.0 proper motions (rad/trop.yr)
    real(wp),intent(out) :: dd1950 !! B1950.0 proper motions (rad/trop.yr)
    real(wp),intent(out) :: p1950 !! parallax (arcsec)
    real(wp),intent(out) :: v1950 !! radial velocity (km/s, +ve = moving away)

    !  Radians per year to arcsec per century
    real(wp),parameter :: pmf = 100.0_wp*60.0_wp*60.0_wp*360.0_wp/d2pi

    !  Small number to avoid arithmetic problems
    real(wp),parameter :: tiny = 1.0e-30_wp

    !  Miscellaneous
    real(wp) :: r, d, ur, ud, px, rv, pxvf, w, wr, rd
    integer :: l, k, j, i

    !  Vectors, p and pv
    real(wp) :: r0(3,2), r1(3,2), p1(3), p2(3), p3(3), pv(3,2)

    !  Functions
    !
    !  CANONICAL CONSTANTS  (Seidelmann 1992)
    !

    !  Km per sec to AU per tropical century
    !  = 86400 * 36524.2198782 / 149597870
    real(wp),parameter :: vf = 21.095_wp

    !  Constant pv-vector (cf. Seidelmann 3.591-2, vectors A and Adot)
    real(wp),dimension(3,2),parameter :: a = reshape([ -1.62557e-6_wp, &
                                                       -0.31919e-6_wp, &
                                                       -0.13843e-6_wp, &    ! WARNING: there is some gfortran compiler bug here
                                                        1.245e-3_wp,   &
                                                       -1.580e-3_wp,   &
                                                       -0.659e-3_wp    ], [3,2])

    !  3x2 matrix of pv-vectors (cf. Seidelmann 3.592-1, matrix M^-1)
    real(wp),dimension(3,2,3,2),parameter :: emi = reshape([&
       +0.9999256795_wp,     +0.0111814828_wp,     +0.0048590039_wp, &
       -0.00000242389840_wp, -0.00000002710544_wp, -0.00000001177742_wp, &
       -0.0111814828_wp,     +0.9999374849_wp,     -0.0000271771_wp, &
       +0.00000002710544_wp, -0.00000242392702_wp, +0.00000000006585_wp, &
       -0.0048590040_wp,     -0.0000271557_wp,     +0.9999881946_wp, &
       +0.00000001177742_wp, +0.00000000006585_wp, -0.00000242404995_wp, &
       -0.000551_wp,         +0.238509_wp,         -0.435614_wp, &
       +0.99990432_wp,       +0.01118145_wp,       +0.00485852_wp, &
       -0.238560_wp,         -0.002667_wp,         +0.012254_wp, &
       -0.01118145_wp,       +0.99991613_wp,       -0.00002717_wp, &
       +0.435730_wp,         -0.008541_wp,         +0.002117_wp, &
       -0.00485852_wp,       -0.00002716_wp,       +0.99996684_wp ], [3,2,3,2])

    !  The FK5 data (units radians and arcsec per Julian century).
    r = r2000
    d = d2000
    ur = dr2000*pmf
    ud = dd2000*pmf
    px = p2000
    rv = v2000

    !  Express as a pv-vector.
    pxvf = px*vf
    w = rv*pxvf
    call S2PV ( r, d, 1.0_wp, ur, ud, w, r0 )

    !  Convert pv-vector to Bessel-Newcomb system (cf. Seidelmann 3.592-1).
    do l = 1,2
       do k=1,3
          w = 0.0_wp
          do j=1,2
             do i=1,3
                w = w + emi(i,j,k,l)*r0(i,j)
             end do
          end do
          r1(k,l) = w
       end do
    end do

    !  Apply E-terms (equivalent to Seidelmann 3.592-3, two iterations).

    !  Direction.
    call PM ( r1, wr )
    call PDP ( r1, a, w )
    call SXP ( w, r1, p1 )
    call SXP ( wr, a, p2 )
    call PMP ( p2, p1, p3 )
    call PPP ( r1, p3, p1 )

    !  Recompute length.
    call PM ( p1, wr )

    !  Direction.
    call PDP ( r1, a, w )
    call SXP ( w, r1, p1 )
    call SXP ( wr, a, p2 )
    call PMP ( p2, p1, p3 )
    call PPP ( r1, p3, pv )

    !  Derivative.
    call PDP ( r1, a(1:3,2), w )
    call SXP ( w, pv, p1 )
    call SXP ( wr, a(1:3,2), p2 )
    call PMP ( p2, p1, p3 )
    call PPP ( r1(1,2), p3, pv(1,2) )

    !  Revert to catalog form.
    call PV2S ( pv, r, d, w, ur, ud, rd )
    if ( px>tiny ) then
       rv = rd/pxvf
       px = px/w
    end if

    !  Return the results.
    r1950 = ANP(r)
    d1950 = d
    dr1950 = ur/pmf
    dd1950 = ud/pmf
    p1950 = px
    v1950 = rv

    end subroutine FK524
!***********************************************************************

!***********************************************************************
!>
!  Transform FK5 (J2000.0) star data into the Hipparcos system.
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine transforms FK5 star positions and proper motions into
!     the system of the Hipparcos catalog.
!
!  2. The proper motions in RA are dRA/dt rather than cos(Dec)*dRA/dt,
!     and are per year rather than per century.
!
!  3. The FK5 to Hipparcos transformation is modeled as a pure rotation
!     and spin;  zonal errors in the FK5 catalog are not taken into
!     account.
!
!  4. See also H2FK5, FK5HZ, HFK5Z.
!
!### Reference
!
!  * F. Mignard & M. Froeschle, Astron.Astrophys., 354, 732-739 (2000).
!
!### History
!  * IAU SOFA revision: 2017 October 12

    subroutine FK52H ( r5, d5, dr5, dd5, px5, rv5, &
                       rh, dh, drh, ddh, pxh, rvh )

    implicit none

    real(wp),intent(in) :: r5 !! RA (radians)
    real(wp),intent(in) :: d5 !! Dec (radians)
    real(wp),intent(in) :: dr5 !! proper motion in RA (dRA/dt, rad/Jyear)
    real(wp),intent(in) :: dd5 !! proper motion in Dec (dDec/dt, rad/Jyear)
    real(wp),intent(in) :: px5 !! parallax (arcsec)
    real(wp),intent(in) :: rv5 !! radial velocity (km/s, positive = receding)
    real(wp),intent(out) :: rh !! RA (radians)
    real(wp),intent(out) :: dh !! Dec (radians)
    real(wp),intent(out) :: drh !! proper motion in RA (dRA/dt, rad/Jyear)
    real(wp),intent(out) :: ddh !! proper motion in Dec (dDec/dt, rad/Jyear)
    real(wp),intent(out) :: pxh !! parallax (arcsec)
    real(wp),intent(out) :: rvh !! radial velocity (km/s, positive = receding)

    real(wp) :: pv5(3,2), r5h(3,3), s5h(3), wxp(3), vv(3), &
                pvh(3,2)
    integer :: j, i

    !  FK5 barycentric position/velocity pv-vector (normalized).
    call STARPV ( r5, d5, dr5, dd5, px5, rv5, pv5, j )

    !  FK5 to Hipparcos orientation matrix and spin vector.
    call FK5HIP ( r5h, s5h )

    !  Make spin units per day instead of per year.
    do i=1,3
       s5h(i) = s5h(i) / 365.25_wp
    end do

    !  Orient the FK5 position into the Hipparcos system.
    call RXP ( r5h, pv5(1,1), pvh(1,1) )

    !  Apply spin to the position giving an extra space motion component.
    call PXP ( pv5(1,1), s5h, wxp )

    !  Add this component to the FK5 space motion.
    call PPP ( wxp, pv5(1,2), vv )

    !  Orient the FK5 space motion into the Hipparcos system.
    call RXP ( r5h, vv, pvh(1,2) )

    !  Hipparcos pv-vector to spherical.
    call PVSTAR ( pvh, rh, dh, drh, ddh, pxh, rvh, j )

    end subroutine FK52H
!***********************************************************************

!***********************************************************************
!>
!  Convert a J2000.0 FK5 star position to B1950.0 FK4, assuming zero
!  proper motion in FK5 and parallax.
!
!  Status:  support routine.
!
!### Notes
!
!  1. In contrast to the FK524 routine, here the FK5 proper motions,
!     the parallax and the radial velocity are presumed zero.
!
!  2. This routine converts a star position from the IAU 1976 FK5
!     (Fricke) system to the former FK4 (Bessel-Newcomb) system, for
!     cases such as distant radio sources where it is presumed there is
!     zero parallax and no proper motion.  Because of the E-terms of
!     aberration, such objects have (in general) non-zero proper motion
!     in FK4, and the present routine returns those fictitious proper
!     motions.
!
!  3. Conversion from B1950.0 FK4 to J2000.0 FK5 only is provided for.
!     Conversions involving other equinoxes would require additional
!     treatment for precession.
!
!  4. The position returned by this routine is in the B1950.0 FK4
!     reference system but at Besselian epoch BEPOCH.  For comparison
!     with catalogs the BEPOCH argument will frequently be 1950D0.  (In
!     this context the distinction between Besselian and Julian epoch is
!     insignificant.)
!
!  5. The RA component of the returned (fictitious) proper motion is
!     dRA/dt rather than cos(Dec)*dRA/dt.
!
!### History
!  * IAU SOFA revision:  2018 January 11

    subroutine FK54Z ( r2000, d2000, bepoch, &
                       r1950, d1950, dr1950, dd1950 )

    implicit none

    real(wp),intent(in) :: r2000 !! J2000.0 FK5 RA (rad)
    real(wp),intent(in) :: d2000 !! J2000.0 FK5 Dec (rad)
    real(wp),intent(in) :: bepoch !! Besselian epoch (e.g. 1950D0)
    real(wp),intent(out) :: r1950 !! B1950.0 FK4 RA (rad) at epoch BEPOCH
    real(wp),intent(out) :: d1950 !! B1950.0 FK4 Dec (rad) at epoch BEPOCH
    real(wp),intent(out) :: dr1950 !! B1950.0 FK4 proper motions (rad/trop.yr)
    real(wp),intent(out) :: dd1950 !! B1950.0 FK4 proper motions (rad/trop.yr)

    real(wp) :: r, d, pr, pd, px, rv, p(3), w, v(3)
    integer :: i

    !  FK5 equinox J2000.0 to FK4 equinox B1950.0.
    call FK524 ( r2000, d2000, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
                 r, d, pr, pd, px, rv )

    !  Spherical to Cartesian.
    call S2C ( r, d, p )

    !  Fictitious proper motion (radians per year).
    v(1) = - pr*p(2) - pd*cos(r)*sin(d)
    v(2) =   pr*p(1) - pd*sin(r)*sin(d)
    v(3) =             pd*cos(d)

    !  Apply the motion.
    w = bepoch - 1950.0_wp
    do i=1,3
       p(i) = p(i) + w*v(i)
    end do

    !  Cartesian to spherical.
    call C2S ( p, w, d1950 )
    r1950 = ANP ( w )

    !  Fictitious proper motion.
    dr1950 = pr
    dd1950 = pd

    end subroutine FK54Z
!***********************************************************************

!***********************************************************************
!>
!  FK5 to Hipparcos rotation and spin.
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine models the FK5 to Hipparcos transformation as a
!     pure rotation and spin;  zonal errors in the FK5 catalogue are
!     not taken into account.
!
!  2. The r-matrix R5H operates in the sense:
!
!           P_Hipparcos = R5H x P_FK5
!
!     where P_FK5 is a p-vector in the FK5 frame, and P_Hipparcos is
!     the equivalent Hipparcos p-vector.
!
!  3. The r-vector S5H represents the time derivative of the FK5 to
!     Hipparcos rotation.  The units are radians per year (Julian,
!     TDB).
!
!### Reference
!
!  * F. Mignard & M. Froeschle, Astron.Astrophys., 354, 732-739 (2000).
!
!### History
!  * IAU SOFA revision: 2017 October 12

    subroutine FK5HIP ( r5h, s5h )

    implicit none

    real(wp),dimension(3,3),intent(out) :: r5h !! r-matrix: FK5 rotation wrt Hipparcos (Note 2)
    real(wp),dimension(3),intent(out) :: s5h !! r-vector: FK5 spin wrt Hipparcos (Note 3)

    !  FK5 to Hipparcos orientation and spin (radians, radians/year)
    real(wp),parameter :: epx = -19.9e-3_wp * das2r
    real(wp),parameter :: epy =  -9.1e-3_wp * das2r
    real(wp),parameter :: epz = +22.9e-3_wp * das2r
    real(wp),parameter :: omx = -0.30e-3_wp * das2r
    real(wp),parameter :: omy = +0.60e-3_wp * das2r
    real(wp),parameter :: omz = +0.70e-3_wp * das2r

    real(wp) :: v(3)

    !  FK5 to Hipparcos orientation expressed as an r-vector.
    v(1) = epx
    v(2) = epy
    v(3) = epz

    !  Re-express as an r-matrix.
    call RV2M ( v, r5h )

    !  Hipparcos wrt FK5 spin expressed as an r-vector.
    s5h(1) = omx
    s5h(2) = omy
    s5h(3) = omz

    end subroutine FK5HIP
!***********************************************************************

!***********************************************************************
!>
!  Transform an FK5 (J2000.0) star position into the system of the
!  Hipparcos catalogue, assuming zero Hipparcos proper motion.
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine converts a star position from the FK5 system to
!     the Hipparcos system, in such a way that the Hipparcos proper
!     motion is zero.  Because such a star has, in general, a non-zero
!     proper motion in the FK5 system, the routine requires the date
!     at which the position in the FK5 system was determined.
!
!  2. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  3. The FK5 to Hipparcos transformation is modeled as a pure
!     rotation and spin;  zonal errors in the FK5 catalogue are
!     not taken into account.
!
!  4. The position returned by this routine is in the Hipparcos
!     reference system but at date DATE1+DATE2.
!
!  5. See also FK52H, H2FK5, HFK5Z.
!
!### Reference
!
!  * F. Mignard & M. Froeschle, Astron. Astrophys. 354, 732-739 (2000).
!
!### History
!  * IAU SOFA revision: 2012 September 5

    subroutine FK5HZ ( r5, d5, date1, date2, rh, dh )

    implicit none

    real(wp),intent(in) :: r5 !! FK5 RA (radians), equinox J2000.0, at date
    real(wp),intent(in) :: d5 !! FK5 Dec (radians), equinox J2000.0, at date
    real(wp),intent(in) :: date1 !! TDB date (Notes 1,2)
    real(wp),intent(in) :: date2 !! TDB date (Notes 1,2)
    real(wp),intent(out) :: rh !! Hipparcos RA (radians)
    real(wp),intent(out) :: dh !! Hipparcos Dec (radians)

    real(wp) :: t, p5e(3), r5h(3,3), s5h(3), vst(3), rst(3,3), &
                p5(3), ph(3), w

    !  Interval from given date to fundamental epoch J2000.0 (JY).
    t = - ( ( date1-dj00 ) + date2 ) / djy

    !  FK5 barycentric position vector.
    call S2C ( r5, d5, p5e )

    !  FK5 to Hipparcos orientation matrix and spin vector.
    call FK5HIP ( r5h, s5h )

    !  Accumulated Hipparcos wrt FK5 spin over that interval.
    call SXP ( t, s5h, vst )

    !  Express the accumulated spin as a rotation matrix.
    call RV2M ( vst, rst )

    !  Derotate the vector's FK5 axes back to date.
    call TRXP ( rst, p5e, p5 )

    !  Rotate the vector into the Hipparcos system.
    call RXP ( r5h, p5, ph )

    !  Hipparcos vector to spherical.
    call C2S ( ph, w, dh )
    rh = ANP ( w )

    end subroutine FK5HZ
!***********************************************************************

!***********************************************************************
!>
!  Form rotation matrix given the Fukushima-Williams angles.
!
!  Status:  support routine.
!
!### Notes
!
!  1. Naming the following points:
!
!           e = J2000.0 ecliptic pole,
!           p = GCRS pole,
!           E = ecliptic pole of date,
!     and   P = CIP,
!
!     the four Fukushima-Williams angles are as follows:
!
!        GAMB = gamma = epE
!        PHIB = phi = pE
!        PSI = psi = pEP
!        EPS = epsilon = EP
!
!  2. The matrix representing the combined effects of frame bias,
!     precession and nutation is:
!
!        NxPxB = R_1(-EPS).R_3(-PSI).R_1(PHIB).R_3(GAMB)
!
!  3. Three different matrices can be constructed, depending on the
!     supplied angles:
!
!     *  To obtain the nutation x precession x frame bias matrix,
!        generate the four precession angles, generate the nutation
!        components and add them to the psi_bar and epsilon_A angles,
!        and call the present routine.
!
!     *  To obtain the precession x frame bias matrix, generate the
!        four precession angles and call the present routine.
!
!     *  To obtain the frame bias matrix, generate the four precession
!        angles for date J2000.0 and call the present routine.
!
!     The nutation-only and precession-only matrices can if necessary
!     be obtained by combining these three appropriately.
!
!### Reference
!
!  * Hilton, J. et al., 2006, Celest.Mech.Dyn.Astron. 94, 351
!
!### History
!  * IAU SOFA revision:  2009 December 15

    subroutine FW2M ( gamb, phib, psi, eps, r )

    implicit none

    real(wp),intent(in) :: gamb !! F-W angle gamma_bar (radians)
    real(wp),intent(in) :: phib !! F-W angle phi_bar (radians)
    real(wp),intent(in) :: psi !! F-W angle psi (radians)
    real(wp),intent(in) :: eps !! F-W angle epsilon (radians)
    real(wp),dimension(3,3),intent(out) :: r !! rotation matrix

    !  Construct the matrix.
    call IR ( r )
    call RZ ( gamb, r )
    call RX ( phib, r )
    call RZ ( -psi, r )
    call RX ( -eps, r )

    end subroutine FW2M
!***********************************************************************

!***********************************************************************
!>
!  CIP X,Y given Fukushima-Williams bias-precession-nutation angles.
!
!  Status:  support routine.
!
!### Notes
!
!  1. Naming the following points:
!
!           e = J2000.0 ecliptic pole,
!           p = GCRS pole
!           E = ecliptic pole of date,
!     and   P = CIP,
!
!     the four Fukushima-Williams angles are as follows:
!
!        GAMB = gamma = epE
!        PHIB = phi = pE
!        PSI = psi = pEP
!        EPS = epsilon = EP
!
!  2. The matrix representing the combined effects of frame bias,
!     precession and nutation is:
!
!        NxPxB = R_1(-EPSA).R_3(-PSI).R_1(PHIB).R_3(GAMB)
!
!     The returned values x,y are elements (3,1) and (3,2) of the
!     matrix.  Near J2000.0, they are essentially angles in radians.
!
!### Reference
!
!  * Hilton, J. et al., 2006, Celest.Mech.Dyn.Astron. 94, 351
!
!### History
!  * IAU SOFA revision:  2013 September 2

    subroutine FW2XY ( gamb, phib, psi, eps, x, y )

    implicit none

    real(wp),intent(in) :: gamb !! F-W angle gamma_bar (radians)
    real(wp),intent(in) :: phib !! F-W angle phi_bar (radians)
    real(wp),intent(in) :: psi !! F-W angle psi (radians)
    real(wp),intent(in) :: eps !! F-W angle epsilon (radians)
    real(wp),intent(out) :: x !! CIP unit vector X,Y
    real(wp),intent(out) :: y !! CIP unit vector X,Y

    real(wp) :: r(3,3)

    !  Form NxPxB matrix.
    call FW2M ( gamb, phib, psi, eps, r )

    !  Extract CIP X,Y.
    call BPN2XY ( r, x, y )

    end subroutine FW2XY
!***********************************************************************

!***********************************************************************
!>
!  Transformation from Galactic Coordinates to ICRS.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The IAU 1958 system of Galactic coordinates was defined with
!     respect to the now obsolete reference system FK4 B1950.0.  When
!     interpreting the system in a modern context, several factors have
!     to be taken into account:
!
!     * The inclusion in FK4 positions of the E-terms of aberration.
!
!     * The distortion of the FK4 proper motion system by differential
!       Galactic rotation.
!
!     * The use of the B1950.0 equinox rather than the now-standard
!       J2000.0.
!
!     * The frame bias between ICRS and the J2000.0 mean place system.
!
!     The Hipparcos Catalogue (Perryman & ESA 1997) provides a rotation
!     matrix that transforms directly between ICRS and Galactic
!     coordinates with the above factors taken into account.  The
!     matrix is derived from three angles, namely the ICRS coordinates
!     of the Galactic pole and the longitude of the ascending node of
!     the galactic equator on the ICRS equator.  They are given in
!     degrees to five decimal places and for canonical purposes are
!     regarded as exact.  In the Hipparcos Catalogue the matrix elements
!     are given to 10 decimal places (about 20 microarcsec).  In the
!     present SOFA routine the matrix elements have been recomputed from
!     the canonical three angles and are given to 30 decimal places.
!
!  2. The inverse transformation is performed by the routine ICRS2G.
!
!### Reference
!  * Perryman M.A.C. & ESA, 1997, ESA SP-1200, The Hipparcos and Tycho
!    catalogues.  Astrometric and photometric star catalogues
!    derived from the ESA Hipparcos Space Astrometry Mission.  ESA
!    Publications Division, Noordwijk, Netherlands.
!
!### History
!  * IAU SOFA revision:  2015 January 9

    subroutine G2ICRS ( dl, db, dr, dd )

    implicit none

    real(wp),intent(in) :: dl !! galactic longitude (radians)
    real(wp),intent(in) :: db !! galactic latitude (radians)
    real(wp),intent(out) :: dr !! ICRS right ascension (radians)
    real(wp),intent(out) :: dd !! ICRS declination (radians)

    real(wp) v1(3), v2(3)

    !
    !  L2,B2 system of galactic coordinates in the form presented in the
    !  Hipparcos Catalogue.  In degrees:
    !
    !  P = 192.85948    right ascension of the Galactic north pole in ICRS
    !  Q =  27.12825    declination of the Galactic north pole in ICRS
    !  R =  32.93192    longitude of the ascending node of the Galactic
    !                   plane on the ICRS equator
    !
    !  ICRS to galactic rotation matrix, obtained by computing
    !  R_3(-R) R_1(pi/2-Q) R_3(pi/2+P) to the full precision shown:
    !
    real(wp),dimension(3,3),parameter :: r = transpose(reshape([&
        -0.054875560416215368492398900454_wp, &
        -0.873437090234885048760383168409_wp, &
        -0.483835015548713226831774175116_wp, &
        +0.494109427875583673525222371358_wp, &
        -0.444829629960011178146614061616_wp, &
        +0.746982244497218890527388004556_wp, &
        -0.867666149019004701181616534570_wp, &
        -0.198076373431201528180486091412_wp, &
        +0.455983776175066922272100478348_wp ], [3,3]))

    !  Spherical to Cartesian.
    call S2C ( dl, db, v1 )

    !  Galactic to ICRS.
    call TRXP ( r, v1, v2 )

    !  Cartesian to spherical.
    call C2S ( v2, dr, dd )

    !  Express in conventional ranges.
    dr = ANP ( dr )
    dd = ANPM ( dd )

    end subroutine G2ICRS
!***********************************************************************

!***********************************************************************
!>
!  Transform geocentric coordinates to geodetic using the specified
!  reference ellipsoid.
!
!  Status:  canonical transformation.
!
!### Notes
!
!  1. The identifier N is a number that specifies the choice of
!     reference ellipsoid.  The following are supported:
!
!        N   ellipsoid
!
!        1    WGS84
!        2    GRS80
!        3    WGS72
!
!     The number N has no significance outside the SOFA software.
!
!  2. The geocentric vector (XYZ, given) and height (HEIGHT, returned)
!     are in meters.
!
!  3. An error status J=-1 means that the identifier N is illegal.  An
!     error status J=-2 is theoretically impossible.  In all error
!     cases, all three results are set to -1D9.
!
!  4. The inverse transformation is performed in the routine GD2GC.
!
!### History
!  * IAU SOFA revision: 2013 September 1

    subroutine GC2GD ( n, xyz, elong, phi, height, j )

    implicit none

    integer,intent(in) :: n !! ellipsoid identifier (Note 1)
    real(wp),dimension(3),intent(in) :: xyz !! geocentric vector (Note 2)
    real(wp),intent(out) :: elong !! longitude (radians, east +ve, Note 3)
    real(wp),intent(out) :: phi !! latitude (geodetic, radians, Note 3)
    real(wp),intent(out) :: height !! height above ellipsoid (geodetic, Notes 2,3)
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * -1 = illegal identifier (Note 3)
                             !! * -2 = internal error (Note 3)

    real(wp) :: a, f

    !  Obtain reference ellipsoid parameters.
    call EFORM ( n, a, f, j )

    !  If OK, transform x,y,z to longitude, geodetic latitude, height.
    if ( j==0 ) then
       call GC2GDE ( a, f, xyz, elong, phi, height, j )
       if ( j<0 ) j=-2
    end if

    !  Deal with any errors.
    if ( j<0 ) then
       elong = -1.0e9_wp
       phi = -1.0e9_wp
       height = -1.0e9_wp
    end if

    end subroutine GC2GD
!***********************************************************************

!***********************************************************************
!>
!  Transform geocentric coordinates to geodetic for a reference
!  ellipsoid of specified form.
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine is closely based on the GCONV2H subroutine by
!     Toshio Fukushima (see reference).
!
!  2. The equatorial radius, A, can be in any units, but meters is
!     the conventional choice.
!
!  3. The flattening, F, is (for the Earth) a value around 0.00335,
!     i.e. around 1/298.
!
!  4. The equatorial radius, A, and the geocentric vector, XYZ,
!     must be given in the same units, and determine the units of
!     the returned height, HEIGHT.
!
!  5. If an error occurs (J<0), ELONG, PHI and HEIGHT are unchanged.
!
!  6. The inverse transformation is performed in the routine GD2GCE.
!
!  7. The transformation for a standard ellipsoid (such as WGS84) can
!     more conveniently be performed by calling GC2GD, which uses a
!     numerical code (1 for WGS84) to identify the required A and F
!     values.
!
!### Reference
!
!  * Fukushima, T., "Transformation from Cartesian to geodetic
!    coordinates accelerated by Halley's method", J.Geodesy (2006)
!    79: 689-693
!
!### History
!  * IAU SOFA revision: 2014 November 7

    subroutine GC2GDE ( a, f, xyz, elong, phi, height, j )

    implicit none

    real(wp),intent(in) :: a !! equatorial radius (Notes 2,4)
    real(wp),intent(in) :: f !! flattening (Note 3)
    real(wp),dimension(3),intent(in) :: xyz !! geocentric vector (Note 4)
    real(wp),intent(out) :: elong !! longitude (radians, east +ve)
    real(wp),intent(out) :: phi !! latitude (geodetic, radians)
    real(wp),intent(out) :: height !! height above ellipsoid (geodetic, Note 4)
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * -1 = illegal F
                             !! * -2 = illegal A

    real(wp) :: aeps2, e2, e4t, ec2, ec, b, x, y, z, p2, absz, p, &
                s0, pn, zc, c0, c02, c03, s02, s03, a02, a0, a03, &
                d0, f0, b0, s1, cc, s12, cc2

    !  -------------
    !  Preliminaries
    !  -------------

    !  Validate ellipsoid parameters.
    if ( f<0.0_wp .or. f>=1.0_wp ) then
       j = -1
       return
    else if ( a <= 0.0_wp ) then
       j = -2
       return
    end if

    !  Functions of ellipsoid parameters (with further validation of F).
    aeps2 = a*a*1.0e-32_wp
    e2 = (2.0_wp-f)*f
    e4t = e2*e2*1.5_wp
    ec2 = 1.0_wp-e2
    if ( ec2 <= 0.0_wp ) then
       j = -1
       return
    end if
    ec = sqrt(ec2)
    b = a*ec

    !  Cartesian components.
    x = xyz(1)
    y = xyz(2)
    z = xyz(3)

    !  Distance from polar axis squared.
    p2 = x*x + y*y

    !  Longitude.
    if ( p2>0.0_wp ) then
       elong = atan2(y,x)
    else
       elong = 0.0_wp
    end if

    !  Unsigned z-coordinate.
    absz = abs(z)

    !  Proceed unless polar case.
    if ( p2>aeps2 ) then

       !  Distance from polar axis.
       p = sqrt(p2)

       !  Normalization.
       s0 = absz/a
       pn = p/a
       zc = ec*s0

       !  Prepare Newton correction factors.
       c0 = ec*pn
       c02 = c0*c0
       c03 = c02*c0
       s02 = s0*s0
       s03 = s02*s0
       a02 = c02+s02
       a0 = sqrt(a02)
       a03 = a02*a0
       d0 = zc*a03 + e2*s03
       f0 = pn*a03 - e2*c03

       !  Prepare Halley correction factor.
       b0 = e4t*s02*c02*pn*(a0-ec)
       s1 = d0*f0 - b0*s0
       cc = ec*(f0*f0-b0*c0)

       !  Evaluate latitude and height.
       phi = atan(s1/cc)
       s12 = s1*s1
       cc2 = cc*cc
       height = (p*cc+absz*s1-a*sqrt(ec2*s12+cc2))/sqrt(s12+cc2)
    else

       !  Exception: pole.
       phi = dpi/2.0_wp
       height = absz-b
    end if

    !  Restore sign of latitude.
    if ( z<0.0_wp ) phi = -phi

    !  OK status.
    j = 0

    end subroutine GC2GDE
!***********************************************************************

!***********************************************************************
!>
!  Transform geodetic coordinates to geocentric using the specified
!  reference ellipsoid.
!
!  Status:  canonical transformation.
!
!### Notes
!
!  1. The identifier N is a number that specifies the choice of
!     reference ellipsoid.  The following are supported:
!
!        N   ellipsoid
!
!        1    WGS84
!        2    GRS80
!        3    WGS72
!
!     The number N has no significance outside the SOFA software.
!
!  2. The height (HEIGHT, given) and the geocentric vector (XYZ,
!     returned) are in meters.
!
!  3. No validation is performed on the arguments ELONG, PHI and HEIGHT.
!     An error status J=-1 means that the identifier N is illegal.  An
!     error status J=-2 protects against cases that would lead to
!     arithmetic exceptions.  In all error cases, XYZ is set to zeros.
!
!  4. The inverse transformation is performed in the routine GC2GD.
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine GD2GC ( n, elong, phi, height, xyz, j )

    implicit none

    integer,intent(in) :: n !! ellipsoid identifier (Note 1)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve)
    real(wp),intent(in) :: phi !! latitude (geodetic, radians, Note 3)
    real(wp),intent(in) :: height !! height above ellipsoid (geodetic, Notes 2,3)
    real(wp),dimension(3),intent(out) :: xyz !! geocentric vector (Note 2)
    integer,intent(out) :: j !! status:
                             !! *  0 = OK
                             !! * -1 = illegal identifier (Note 3)
                             !! * -2 = illegal case (Note 3)

    real(wp) :: a, f

    !  Obtain reference ellipsoid parameters.
    call EFORM ( n, a, f, j )

    !  If OK, transform longitude, geodetic latitude, height to x,y,z.
    if ( j==0 ) then
       call GD2GCE ( a, f, elong, phi, height, xyz, j )
       if ( j/=0 ) j=-2
    end if

    !  Deal with any errors.
    if ( j/=0 ) call ZP ( xyz )

    end subroutine GD2GC
!***********************************************************************

!***********************************************************************
!>
!  Transform geodetic coordinates to geocentric for a reference
!  ellipsoid of specified form.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The equatorial radius, A, can be in any units, but meters is
!     the conventional choice.
!
!  2. The flattening, F, is (for the Earth) a value around 0.00335,
!     i.e. around 1/298.
!
!  3. The equatorial radius, A, and the height, HEIGHT, must be
!     given in the same units, and determine the units of the
!     returned geocentric vector, XYZ.
!
!  4. No validation is performed on individual arguments.  The error
!     status J=-1 protects against (unrealistic) cases that would lead
!     to arithmetic exceptions.  If an error occurs, XYZ is unchanged.
!
!  5. The inverse transformation is performed in the routine GC2GDE.
!
!  6. The transformation for a standard ellipsoid (such as WGS84) can
!     more conveniently be performed by calling GD2GC, which uses a
!     numerical code (1 for WGS84) to identify the required A and F
!     values.
!
!### References
!
!  * Green, R.M., Spherical Astronomy, Cambridge University Press,
!    (1985) Section 4.5, p96.
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 4.22, p202.
!
!### History
!  * IAU SOFA revision: 2009 November 2

    subroutine GD2GCE ( a, f, elong, phi, height, xyz, j )

    implicit none

    real(wp),intent(in) :: a !! equatorial radius (Notes 1,4)
    real(wp),intent(in) :: f !! flattening (Notes 2,4)
    real(wp),intent(in) :: elong !! longitude (radians, east +ve)
    real(wp),intent(in) :: phi !! latitude (geodetic, radians, Note 4)
    real(wp),intent(in) :: height !! height above ellipsoid (geodetic, Notes 3,4)
    real(wp),dimension(3),intent(out) :: xyz !! geocentric vector (Note 3)
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * -1 = illegal case (Note 4)

    real(wp) :: sp, cp, w, d, ac, as, r

    !  Functions of geodetic latitude.
    sp = sin(phi)
    cp = cos(phi)
    w = 1.0_wp-f
    w = w*w
    d = cp*cp + w*sp*sp
    if ( d > 0.0_wp ) then
       ac = a / sqrt(d)
       as = w * ac

       !  Geocentric vector.
       r = ( ac + height ) * cp
       xyz(1) = r * cos(elong)
       xyz(2) = r * sin(elong)
       xyz(3) = ( as + height ) * sp

       !  Success.
       j = 0
    else

       !  Fail.
       j = -1
    end if

    end subroutine GD2GCE
!***********************************************************************

!***********************************************************************
!>
!  Greenwich Mean Sidereal Time (model consistent with IAU 2000
!  resolutions).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The UT1 and TT dates UTA+UTB and TTA+TTB respectively, are both
!     Julian Dates, apportioned in any convenient way between the
!     argument pairs.  For example, JD=2450123.7 could be expressed in
!     any of these ways, among others:
!
!            Part A         Part B
!
!         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 (in the case of UT;  the TT is not at all critical
!     in this respect).  The J2000 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     Rotation Angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. Both UT1 and TT are required, UT1 to predict the Earth rotation
!     and TT to predict the effects of precession.  If UT1 is used for
!     both purposes, errors of order 100 microarcseconds result.
!
!  3. This GMST is compatible with the IAU 2000 resolutions and must be
!     used only in conjunction with other IAU 2000 compatible components
!     such as precession-nutation and equation of the equinoxes.
!
!  4. The result is returned in the range 0 to 2pi.
!
!  5. The algorithm is from Capitaine et al. (2003) and IERS Conventions
!     2003.
!
!### References
!
!  * Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to
!    implement the IAU 2000 definition of UT1", Astronomy &
!    Astrophysics, 406, 1135-1149 (2003)
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function GMST00 ( uta, utb, tta, ttb ) result(gmst)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp) :: gmst !! Greenwich mean sidereal time (radians)

    real(wp) :: t

    !  TT Julian centuries since J2000.0.
    t = ( ( tta-dj00 ) + ttb ) / djc

    !  Greenwich Mean Sidereal Time, IAU 2000.
    gmst = ANP ( ERA00 ( uta, utb ) + &
                       (    0.014506_wp   + &
                       ( 4612.15739966_wp + &
                       (  + 1.39667721_wp + &
                       (  - 0.00009344_wp + &
                       (  + 0.00001882_wp ) &
                           * t ) * t ) * t ) * t ) * das2r )

    end function GMST00
!***********************************************************************

!***********************************************************************
!>
!  Greenwich mean sidereal time (consistent with IAU 2006 precession).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The UT1 and TT dates UTA+UTB and TTA+TTB respectively, are both
!     Julian Dates, apportioned in any convenient way between the
!     argument pairs.  For example, JD=2450123.7 could be expressed in
!     any of these ways, among others:
!
!            Part A         Part B
!
!         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 (in the case of UT;  the TT is not at all critical
!     in this respect).  The J2000 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     rotation angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. Both UT1 and TT are required, UT1 to predict the Earth rotation
!     and TT to predict the effects of precession.  If UT1 is used for
!     both purposes, errors of order 100 microarcseconds result.
!
!  3. This GMST is compatible with the IAU 2006 precession and must not
!     be used with other precession models.
!
!  4. The result is returned in the range 0 to 2pi.
!
!### Reference
!
!  * Capitaine, N., Wallace, P.T. & Chapront, J., 2005,
!    Astron.Astrophys. 432, 355
!
!### History
!  * IAU SOFA revision: 2010 March 9

    function GMST06 ( uta, utb, tta, ttb ) result(gmst)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp) :: gmst !! Greenwich mean sidereal time (radians)

    real(wp) :: t

    !  TT Julian centuries since J2000.0.
    t = ( ( tta-dj00 ) + ttb ) / djc

    !  Greenwich mean sidereal time, IAU 2006.
    gmst = ANP ( ERA00 ( uta, utb ) + &
                       (    0.014506_wp    + &
                       ( 4612.156534_wp    + &
                       (    1.3915817_wp   + &
                       (  - 0.00000044_wp  + &
                       (  - 0.000029956_wp + &
                       (  - 0.0000000368_wp ) &
                           * t ) * t ) * t ) * t ) * t ) * das2r )

    end function GMST06
!***********************************************************************

!***********************************************************************
!>
!  Universal Time to Greenwich Mean Sidereal Time (IAU 1982 model).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The UT1 epoch DJ1+DJ2 is a Julian Date, apportioned in any
!     convenient way between the arguments DJ1 and DJ2.  For example,
!     JD(UT1)=2450123.7 could be expressed in any of these ways,
!     among others:
!
!             DJ1            DJ2
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  The date & time method is
!     best matched to the algorithm used:  maximum accuracy (or, at
!     least, minimum noise) is delivered when the DJ1 argument is for
!     0hrs UT1 on the day in question and the DJ2 argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. The algorithm is based on the IAU 1982 expression.  This is always
!     described as giving the GMST at 0 hours UT1.  In fact, it gives the
!     difference between the GMST and the UT, the steady 4-minutes-per-day
!     drawing-ahead of ST with respect to UT.  When whole days are ignored,
!     the expression happens to equal the GMST at 0 hours UT1 each day.
!
!  3. In this routine, the entire UT1 (the sum of the two arguments DJ1
!     and DJ2) is used directly as the argument for the standard formula,
!     the constant term of which is adjusted by 12 hours to take account
!     of the noon phasing of Julian Date.  The UT1 is then added, but
!     omitting whole days to conserve accuracy.
!
!  4. The result is returned in the range 0 to 2pi.
!
!### References
!
!  * Transactions of the International Astronomical Union,
!    XVIII B, 67 (1983).
!
!  * Aoki et al., Astron.Astrophys., 105, 359-361 (1982).
!
!### History
!  * IAU SOFA revision: 2017 October 12

    function GMST82 ( dj1, dj2 ) result(gmst)

    implicit none

    real(wp),intent(in) :: dj1 !! UT1 Julian Date (see note)
    real(wp),intent(in) :: dj2 !! UT1 Julian Date (see note)
    real(wp) :: gmst !! Greenwich mean sidereal time (radians)

    !  Coefficients of IAU 1982 GMST-UT1 model
    real(wp),parameter :: a = 24110.54841_wp - d2s/2.0_wp
    real(wp),parameter :: b = 8640184.812866_wp
    real(wp),parameter :: c = 0.093104_wp
    real(wp),parameter :: d = -6.2e-6_wp

    !  Note: the first constant, A, has to be adjusted by 12 hours because
    !  the UT1 is supplied as a Julian date, which begins at noon.

    real(wp) :: d1, d2, t, f

    !  Julian centuries since fundamental epoch.
    if ( dj1 < dj2 ) then
       d1 = dj1
       d2 = dj2
    else
       d1 = dj2
       d2 = dj1
    end if
    t = ( d1 + ( d2-dj00 ) ) / djc

    !  Fractional part of JD(UT1), in seconds.
    f = d2s * ( mod(d1,1.0_wp) + mod(d2,1.0_wp) )

    !  GMST at this UT1.
    gmst = ANP ( ds2r * ( (a+(b+(c+d*t)*t)*t) + f ) )

    end function GMST82
!***********************************************************************

!***********************************************************************
!>
!  Greenwich Apparent Sidereal Time (consistent with IAU 2000
!  resolutions).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The UT1 and TT dates UTA+UTB and TTA+TTB respectively, are both
!     Julian Dates, apportioned in any convenient way between the
!     argument pairs.  For example, JD=2450123.7 could be expressed in
!     any of these ways, among others:
!
!            Part A         Part B
!
!         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 (in the case of UT;  the TT is not at all critical
!     in this respect).  The J2000 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     Rotation Angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. Both UT1 and TT are required, UT1 to predict the Earth rotation
!     and TT to predict the effects of precession-nutation.  If UT1 is
!     used for both purposes, errors of order 100 microarcseconds
!     result.
!
!  3. This GAST is compatible with the IAU 2000 resolutions and must be
!     used only in conjunction with other IAU 2000 compatible components
!     such as precession-nutation.
!
!  4. The result is returned in the range 0 to 2pi.
!
!  5. The algorithm is from Capitaine et al. (2003) and IERS Conventions
!     2003.
!
!### References
!
!  * Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to
!    implement the IAU 2000 definition of UT1", Astronomy &
!    Astrophysics, 406, 1135-1149 (2003)
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2007 December 8

    function GST00A ( uta, utb, tta, ttb ) result(gast)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp) :: gast !! Greenwich apparent sidereal time (radians)

    gast = ANP ( GMST00 ( uta,utb, tta,ttb ) + EE00A ( tta,ttb ) )

    end function GST00A
!***********************************************************************

!***********************************************************************
!>
!  Greenwich Apparent Sidereal Time (consistent with IAU 2000
!  resolutions but using the truncated nutation model IAU 2000B).
!
!  Status:  support routine.
!
!### Notes
!
!  1. The UT1 date UTA+UTB is a Julian Date, apportioned in any
!     convenient way between the argument pair.  For example,
!     JD=2450123.7 could be expressed in any of these ways, among
!     others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     Rotation Angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. The result is compatible with the IAU 2000 resolutions, except
!     that accuracy has been compromised for the sake of speed and
!     convenience in two respects:
!
!     * UT is used instead of TDB (or TT) to compute the precession
!       component of GMST and the equation of the equinoxes.  This
!       results in errors of order 0.1 mas at present.
!
!     * The IAU 2000B abridged nutation model (McCarthy & Luzum, 2001)
!       is used, introducing errors of up to 1 mas.
!
!  3. This GAST is compatible with the IAU 2000 resolutions and must be
!     used only in conjunction with other IAU 2000 compatible components
!     such as precession-nutation.
!
!  4. The result is returned in the range 0 to 2pi.
!
!  5. The algorithm is from Capitaine et al. (2003) and IERS Conventions
!     2003.
!
!### References
!
!  * Capitaine, N., Wallace, P.T. and McCarthy, D.D., "Expressions to
!    implement the IAU 2000 definition of UT1", Astronomy &
!    Astrophysics, 406, 1135-1149 (2003)
!
!  * McCarthy, D.D. & Luzum, B.J., "An abridged model of the
!    precession-nutation of the celestial pole", Celestial Mechanics &
!    Dynamical Astronomy, 85, 37-49 (2003)
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2007 December 8

    function GST00B ( uta, utb ) result(gast)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp) :: gast !! Greenwich apparent sidereal time (radians)

    gast = ANP ( GMST00 ( uta,utb, uta,utb ) + EE00B ( uta,utb ) )

    end function GST00B
!***********************************************************************

!***********************************************************************
!>
!  Greenwich apparent sidereal time, IAU 2006, given the NPB matrix.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The UT1 and TT dates UTA+UTB and TTA+TTB respectively, are both
!     Julian Dates, apportioned in any convenient way between the
!     argument pairs.  For example, JD=2450123.7 could be expressed in
!     any of these ways, among others:
!
!            Part A         Part B
!
!         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 (in the case of UT;  the TT is not at all critical
!     in this respect).  The J2000 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     rotation angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. Both UT1 and TT are required, UT1 to predict the Earth rotation
!     and TT to predict the effects of precession-nutation.  If UT1 is
!     used for both purposes, errors of order 100 microarcseconds
!     result.
!
!  3. Although the routine uses the IAU 2006 series for s+XY/2, it is
!     otherwise independent of the precession-nutation model and can in
!     practice be used with any equinox-based NPB matrix.
!
!  4. The result is returned in the range 0 to 2pi.
!
!### Reference
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2008 January 2

    function GST06 ( uta, utb, tta, ttb, rnpb ) result(gast)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp),dimension(3,3),intent(in) :: rnpb !! nutation x precession x bias matrix
    real(wp) :: gast !! Greenwich apparent sidereal time (radians)

    real(wp) :: x, y, s

    !  Extract CIP coordinates.
    call BPN2XY ( rnpb, x, y )

    !  The CIO locator, s.
    s = S06 ( tta, ttb, x, y )

    !  Greenwich apparent sidereal time.
    gast = ANP ( ERA00 ( uta, utb ) - EORS ( rnpb, s ) )

    end function GST06
!***********************************************************************

!***********************************************************************
!>
!  Greenwich apparent sidereal time (consistent with IAU 2000 and 2006
!  resolutions).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The UT1 and TT dates UTA+UTB and TTA+TTB respectively, are both
!     Julian Dates, apportioned in any convenient way between the
!     argument pairs.  For example, JD=2450123.7 could be expressed in
!     any of these ways, among others:
!
!            Part A         Part B
!
!         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 (in the case of UT;  the TT is not at all critical
!     in this respect).  The J2000 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     rotation angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. Both UT1 and TT are required, UT1 to predict the Earth rotation
!     and TT to predict the effects of precession-nutation.  If UT1 is
!     used for both purposes, errors of order 100 microarcseconds
!     result.
!
!  3. This GAST is compatible with the IAU 2000/2006 resolutions and
!     must be used only in conjunction with IAU 2006 precession and
!     IAU 2000A nutation.
!
!  4. The result is returned in the range 0 to 2pi.
!
!### Reference
!
!     Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2010 March 5

    function GST06A ( uta, utb, tta, ttb ) result(gast)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: tta !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: ttb !! TT as a 2-part Julian Date (Notes 1,2)
    real(wp) :: gast !! Greenwich apparent sidereal time (radians)

    real(wp) :: rnpb(3,3)

    !  Classical nutation x precession x bias matrix, IAU 2000A/2006.
    call PNM06A ( tta, ttb, rnpb )

    !  Greenwich apparent sidereal time.
    gast = GST06 ( uta, utb, tta, ttb, rnpb )

    end function GST06A
!***********************************************************************

!***********************************************************************
!>
!  Greenwich Apparent Sidereal Time (consistent with IAU 1982/94
!  resolutions).
!
!  Status:  support routine.
!
!### Notes
!
!  1. The UT1 date UTA+UTB is a Julian Date, apportioned in any
!     convenient way between the argument pair.  For example,
!     JD=2450123.7 could be expressed in any of these ways, among
!     others:
!
!             UTA            UTB
!
!         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 and MJD methods are good compromises
!     between resolution and convenience.  For UT, the date & time
!     method is best matched to the algorithm that is used by the Earth
!     Rotation Angle routine, called internally:  maximum accuracy (or,
!     at least, minimum noise) is delivered when the UTA argument is for
!     0hrs UT1 on the day in question and the UTB argument lies in the
!     range 0 to 1, or vice versa.
!
!  2. The result is compatible with the IAU 1982 and 1994 resolutions,
!     except that accuracy has been compromised for the sake of
!     convenience in that UT is used instead of TDB (or TT) to compute
!     the equation of the equinoxes.
!
!  3. This GAST must be used only in conjunction with contemporaneous
!     IAU standards such as 1976 precession, 1980 obliquity and 1982
!     nutation.  It is not compatible with the IAU 2000 resolutions.
!
!  4. The result is returned in the range 0 to 2pi.
!
!### References
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!  * IAU Resolution C7, Recommendation 3 (1994)
!
!### History
!  * IAU SOFA revision: 2007 December 8

    function GST94 ( uta, utb ) result(gast)

    implicit none

    real(wp),intent(in) :: uta !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp),intent(in) :: utb !! UT1 as a 2-part Julian Date (Notes 1,2)
    real(wp) :: gast !! Greenwich apparent sidereal time (radians)

    gast = ANP ( GMST82 ( uta, utb ) + EQEQ94 ( uta, utb ) )

    end function GST94
!***********************************************************************

!***********************************************************************
!>
!  Transform Hipparcos star data into the FK5 (J2000.0) system.
!
!  Status:  support routine.
!
!### Notes
!
!  1. This routine transforms Hipparcos star positions and proper
!     motions into FK5 J2000.0.
!
!  2. The proper motions in RA are dRA/dt rather than cos(Dec)*dRA/dt,
!     and are per year rather than per century.
!
!  3. The FK5 to Hipparcos transformation is modeled as a pure rotation
!     and spin;  zonal errors in the FK5 catalog are not taken into
!     account.
!
!  4. See also FK52H, FK5HZ, HFK5Z.
!
!### Reference
!
!  * F. Mignard & M. Froeschle, Astron.Astrophys., 354, 732-739 (2000).
!
!### History
!  * IAU SOFA revision: 2017 October 12

    subroutine H2FK5 ( rh, dh, drh, ddh, pxh, rvh, &
                       r5, d5, dr5, dd5, px5, rv5 )

    implicit none

    real(wp),intent(in) :: rh !! RA (radians) [Hipparcos, epoch J2000.0]
    real(wp),intent(in) :: dh !! Dec (radians) [Hipparcos, epoch J2000.0]
    real(wp),intent(in) :: drh !! proper motion in RA (dRA/dt, rad/Jyear) [Hipparcos, epoch J2000.0]
    real(wp),intent(in) :: ddh !! proper motion in Dec (dDec/dt, rad/Jyear) [Hipparcos, epoch J2000.0]
    real(wp),intent(in) :: pxh !! parallax (arcsec) [Hipparcos, epoch J2000.0]
    real(wp),intent(in) :: rvh !! radial velocity (km/s, positive = receding) [Hipparcos, epoch J2000.0]
    real(wp),intent(out) :: r5 !! RA (radians) [FK5, equinox J2000.0, epoch J2000.0]
    real(wp),intent(out) :: d5 !! Dec (radians) [FK5, equinox J2000.0, epoch J2000.0]
    real(wp),intent(out) :: dr5 !! proper motion in RA (dRA/dt, rad/Jyear) [FK5, equinox J2000.0, epoch J2000.0]
    real(wp),intent(out) :: dd5 !! proper motion in Dec (dDec/dt, rad/Jyear) [FK5, equinox J2000.0, epoch J2000.0]
    real(wp),intent(out) :: px5 !! parallax (arcsec) [FK5, equinox J2000.0, epoch J2000.0]
    real(wp),intent(out) :: rv5 !! radial velocity (km/s, positive = receding) [FK5, equinox J2000.0, epoch J2000.0]

    real(wp) :: pvh(3,2), r5h(3,3), s5h(3), sh(3), wxp(3), &
                vv(3), pv5(3,2)
    integer :: j, i

    !  Hipparcos barycentric position/velocity pv-vector (normalized).
    call STARPV ( rh, dh, drh, ddh, pxh, rvh, pvh, j )

    !  FK5 to Hipparcos orientation matrix and spin vector.
    call FK5HIP ( r5h, s5h )

    !  Make spin units per day instead of per year.
    do i=1,3
       s5h(i) = s5h(i) / 365.25_wp
    end do

    !  Orient the spin into the Hipparcos system.
    call RXP ( r5h, s5h, sh )

    !  De-orient the Hipparcos position into the FK5 system.
    call TRXP ( r5h, pvh(1,1), pv5(1,1) )

    !  Apply spin to the position giving an extra space motion component.
    call PXP ( pvh(1,1), sh, wxp )

    !  Subtract this component from the Hipparcos space motion.
    call PMP ( pvh(1,2), wxp, vv )

    !  De-orient the Hipparcos space motion into the FK5 system.
    call TRXP ( r5h, vv, pv5(1,2) )

    !  FK5 pv-vector to spherical.
    call PVSTAR ( pv5, r5, d5, dr5, dd5, px5, rv5, j )

    end subroutine H2FK5
!***********************************************************************

!***********************************************************************
!>
!  Equatorial to horizon coordinates:  transform hour angle and
!  declination to azimuth and altitude.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  All the arguments are angles in radians.
!
!  2.  Azimuth is returned in the range 0-2pi;  north is zero, and east
!      is +pi/2.  Altitude is returned in the range +/- pi/2.
!
!  3.  The latitude PHI is pi/2 minus the angle between the Earth's
!      rotation axis and the adopted zenith.  In many applications it
!      will be sufficient to use the published geodetic latitude of the
!      site.  In very precise (sub-arcsecond) applications, PHI can be
!      corrected for polar motion.
!
!  4.  The returned azimuth AZ is with respect to the rotational north
!      pole, as opposed to the ITRS pole, and for sub-arcsecond accuracy
!      will need to be adjusted for polar motion if it is to be with
!      respect to north on a map of the Earth's surface.
!
!  5.  Should the user wish to work with respect to the astronomical
!      zenith rather than the geodetic zenith, PHI will need to be
!      adjusted for deflection of the vertical (often tens of
!      arcseconds), and the zero point of HA will also be affected.
!
!  6.  The transformation is the same as Vh = Rz(pi)*Ry(pi/2-phi)*Ve,
!      where Vh and Ve are lefthanded unit vectors in the (az,el) and
!      (ha,dec) systems respectively and Ry and Rz are rotations about
!      first the y-axis and then the z-axis.  (n.b. Rz(pi) simply
!      reverses the signs of the x and y components.)  For efficiency,
!      the algorithm is written out rather than calling other utility
!      functions.  For applications that require even greater
!      efficiency, additional savings are possible if constant terms
!      such as functions of latitude are computed once and for all.
!
!  7.  Again for efficiency, no range checking of arguments is carried
!      out.
!
!  Last revision:   2018 January 2

    subroutine HD2AE ( ha, dec, phi, az, el )

    implicit none

    real(wp),intent(in) :: ha !! hour angle (local)
    real(wp),intent(in) :: dec !! declination
    real(wp),intent(in) :: phi !! site latitude
    real(wp),intent(out) :: az !! azimuth
    real(wp),intent(out) :: el !! altitude (informally, elevation)

    real(wp) :: sh, ch, sd, cd, sp, cp, x, y, z, r, a

    !  Useful trig functions.
    sh = sin(ha)
    ch = cos(ha)
    sd = sin(dec)
    cd = cos(dec)
    sp = sin(phi)
    cp = cos(phi)

    !  Az,Alt unit vector.
    x = - ch*cd*sp + sd*cp
    y = - sh*cd
    z = ch*cd*cp + sd*sp

    !  To spherical.
    r = sqrt(x*x + y*y)
    if ( r==0.0_wp ) then
       a = 0.0_wp
    else
       a = atan2(y,x)
    end if
    if ( a<0.0_wp ) a = a+d2pi
    az = a
    el = atan2(z,r)

    end subroutine HD2AE
!***********************************************************************

!***********************************************************************
!>
!  Parallactic angle for a given hour angle and declination.
!
!### Notes
!
!  1.  All the arguments are angles in radians.
!
!  2.  The parallactic angle at a point in the sky is the position angle
!      of the vertical, i.e. the angle between the directions to the
!      north celestial pole and to the zenith respectively.
!
!  3.  The result is returned in the range -pi to +pi.
!
!  4.  At the pole itself a zero result is returned.
!
!  5.  The latitude PHI is pi/2 minus the angle between the Earth's
!      rotation axis and the adopted zenith.  In many applications it
!      will be sufficient to use the published geodetic latitude of the
!      site.  In very precise (sub-arcsecond) applications, PHI can be
!      corrected for polar motion.
!
!  6.  Should the user wish to work with respect to the astronomical
!      zenith rather than the geodetic zenith, PHI will need to be
!      adjusted for deflection of the vertical (often tens of
!      arcseconds), and the zero point of HA will also be affected.
!
!### Reference
!  * Smart, W.M., "Spherical Astronomy", Cambridge University Press,
!    6th edition (Green, 1977), p49.
!
!### History
!  * IAU SOFA revision:  2017 September 12

    function HD2PA ( ha, dec, phi ) result(res)

    implicit none

    real(wp),intent(in) :: ha !! hour angle
    real(wp),intent(in) :: dec !! declination
    real(wp),intent(in) :: phi !! site latitude
    real(wp) :: res !! parallactic angle

    real(wp) :: cp, sqsz, cqsz

    cp = cos(phi)
    sqsz = cp*sin(ha)
    cqsz = sin(phi)*cos(dec) - cp*sin(dec)*cos(ha)
    if ( sqsz==0.0_wp .and. cqsz==0.0_wp ) cqsz = 1.0_wp
    res = atan2(sqsz,cqsz)

    end function HD2PA
!***********************************************************************

!***********************************************************************
!>
!  Transform a Hipparcos star position into FK5 J2000.0, assuming
!  zero Hipparcos proper motion.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  2. The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.
!
!  3. The FK5 to Hipparcos transformation is modeled as a pure
!     rotation and spin;  zonal errors in the FK5 catalogue are
!     not taken into account.
!
!  4. It was the intention that Hipparcos should be a close
!     approximation to an inertial frame, so that distant objects
!     have zero proper motion;  such objects have (in general)
!     non-zero proper motion in FK5, and this routine returns those
!     fictitious proper motions.
!
!  5. The position returned by this routine is in the FK5 J2000.0
!     reference system but at date DATE1+DATE2.
!
!  6. See also FK52H, H2FK5, FK5ZHZ.
!
!### Reference
!
!  * F. Mignard & M. Froeschle, Astron. Astrophys. 354, 732-739 (2000).
!
!### History
!  * IAU SOFA revision: 2012 September 5

    subroutine HFK5Z ( rh, dh, date1, date2, r5, d5, dr5, dd5 )

    implicit none

    real(wp),intent(in) :: rh !! Hipparcos RA (radians)
    real(wp),intent(in) :: dh !! Hipparcos Dec (radians)
    real(wp),intent(in) :: date1 !! TDB date (Note 1)
    real(wp),intent(in) :: date2 !! TDB date (Note 1)
    real(wp),intent(out) :: r5 !! RA (radians) [FK5, equinox J2000.0, date DATE1+DATE2]
    real(wp),intent(out) :: d5 !! Dec (radians) [FK5, equinox J2000.0, date DATE1+DATE2]
    real(wp),intent(out) :: dr5 !! FK5 RA proper motion (rad/year, Note 4) [FK5, equinox J2000.0, date DATE1+DATE2]
    real(wp),intent(out) :: dd5 !! Dec proper motion (rad/year, Note 4) [FK5, equinox J2000.0, date DATE1+DATE2]

    real(wp) :: t, ph(3), r5h(3,3), s5h(3), sh(3), vst(3), &
                rst(3,3), r5ht(3,3), pv5e(3,2), vv(3), &
                w, r, v

    !  Time interval from fundamental epoch J2000.0 to given date (JY).
    t = ( ( date1-dj00 ) + date2 ) / djy

    !  Hipparcos barycentric position vector (normalized).
    call S2C ( rh, dh, ph )

    !  FK5 to Hipparcos orientation matrix and spin vector.
    call FK5HIP ( r5h, s5h )

    !  Rotate the spin into the Hipparcos system.
    call RXP ( r5h, s5h, sh )

    !  Accumulated Hipparcos wrt FK5 spin over that interval.
    call SXP ( t, s5h, vst )

    !  Express the accumulated spin as a rotation matrix.
    call RV2M ( vst, rst )

    !  Rotation matrix:  accumulated spin, then FK5 to Hipparcos.
    call RXR ( r5h, rst, r5ht )

    !  De-orient & de-spin the Hipparcos position into FK5 J2000.0.
    call TRXP ( r5ht, ph, pv5e )

    !  Apply spin to the position giving a space motion.
    call PXP ( sh, ph, vv )

    !  De-orient & de-spin the Hipparcos space motion into FK5 J2000.0.
    call TRXP ( r5ht, vv, pv5e(1,2) )

    !  FK5 position/velocity pv-vector to spherical.
    call PV2S ( pv5e, w, d5, r, dr5, dd5, v )
    r5 = ANP ( w )

    end subroutine HFK5Z
!***********************************************************************

!***********************************************************************
!>
!  Transformation from ICRS to Galactic Coordinates.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The IAU 1958 system of Galactic coordinates was defined with
!     respect to the now obsolete reference system FK4 B1950.0.  When
!     interpreting the system in a modern context, several factors have
!     to be taken into account:
!
!     * The inclusion in FK4 positions of the E-terms of aberration.
!
!     * The distortion of the FK4 proper motion system by differential
!       Galactic rotation.
!
!     * The use of the B1950.0 equinox rather than the now-standard
!       J2000.0.
!
!     * The frame bias between ICRS and the J2000.0 mean place system.
!
!     The Hipparcos Catalogue (Perryman & ESA 1997) provides a rotation
!     matrix that transforms directly between ICRS and Galactic
!     coordinates with the above factors taken into account.  The
!     matrix is derived from three angles, namely the ICRS coordinates
!     of the Galactic pole and the longitude of the ascending node of
!     the galactic equator on the ICRS equator.  They are given in
!     degrees to five decimal places and for canonical purposes are
!     regarded as exact.  In the Hipparcos Catalogue the matrix elements
!     are given to 10 decimal places (about 20 microarcsec).  In the
!     present SOFA routine the matrix elements have been recomputed from
!     the canonical three angles and are given to 30 decimal places.
!
!  2. The inverse transformation is performed by the routine G2ICRS.
!
!### Reference
!  * Perryman M.A.C. & ESA, 1997, ESA SP-1200, The Hipparcos and Tycho
!    catalogues.  Astrometric and photometric star catalogues
!    derived from the ESA Hipparcos Space Astrometry Mission.  ESA
!    Publications Division, Noordwijk, Netherlands.
!
!### History
!  * IAU SOFA revision:  2015 January 9

    subroutine ICRS2G ( dr, dd, dl, db )

    implicit none

    real(wp),intent(in) :: dr !! ICRS right ascension (radians)
    real(wp),intent(in) :: dd !! ICRS declination (radians)
    real(wp),intent(out) :: dl !! galactic longitude (radians)
    real(wp),intent(out) :: db !! galactic latitude (radians)

    real(wp) v1(3), v2(3)

    !
    !  L2,B2 system of galactic coordinates in the form presented in the
    !  Hipparcos Catalogue.  In degrees:
    !
    !  P = 192.85948    right ascension of the Galactic north pole in ICRS
    !  Q =  27.12825    declination of the Galactic north pole in ICRS
    !  R =  32.93192    longitude of the ascending node of the Galactic
    !                   plane on the ICRS equator
    !
    !  ICRS to galactic rotation matrix, obtained by computing
    !  R_3(-R) R_1(pi/2-Q) R_3(pi/2+P) to the full precision shown:
    !
    real(wp),dimension(3,3),parameter :: r = transpose(reshape([&
        -0.054875560416215368492398900454_wp, &
        -0.873437090234885048760383168409_wp, &
        -0.483835015548713226831774175116_wp, &
        +0.494109427875583673525222371358_wp, &
        -0.444829629960011178146614061616_wp, &
        +0.746982244497218890527388004556_wp, &
        -0.867666149019004701181616534570_wp, &
        -0.198076373431201528180486091412_wp, &
        +0.455983776175066922272100478348_wp ], [3,3]))

    !  Spherical to Cartesian.
    call S2C ( dr, dd, v1 )

    !  ICRS to Galactic.
    call RXP ( r, v1, v2 )

    !  Cartesian to spherical.
    call C2S ( v2, dl, db )

    !  Express in conventional ranges.
    dl = ANP ( dl )
    db = ANPM ( db )

    end subroutine ICRS2G
!***********************************************************************

!***********************************************************************
!>
!  Initialize an r-matrix to the identity matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2012 April 3

    subroutine IR ( r )

    implicit none

    real(wp),dimension(3,3),intent(out) :: r !! r-matrix

    r(1,1) = 1.0_wp
    r(1,2) = 0.0_wp
    r(1,3) = 0.0_wp
    r(2,1) = 0.0_wp
    r(2,2) = 1.0_wp
    r(2,3) = 0.0_wp
    r(3,1) = 0.0_wp
    r(3,2) = 0.0_wp
    r(3,3) = 1.0_wp

    end subroutine IR
!***********************************************************************

!***********************************************************************
!>
!  Julian Date to Gregorian year, month, day, and fraction of a day.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The earliest valid date is -68569.5 (-4900 March 1).  The
!     largest value accepted is 10^9.
!
!  2. The Julian Date is apportioned in any convenient way between
!     the arguments DJ1 and DJ2.  For example, JD=2450123.7 could
!     be expressed in any of these ways, among others:
!
!             DJ1            DJ2
!
!         2450123.7D0        0D0        (JD method)
!          2451545D0      -1421.3D0     (J2000 method)
!         2400000.5D0     50123.2D0     (MJD method)
!         2450123.5D0       0.2D0       (date & time method)
!
!  3. In early eras the conversion is from the "Proleptic Gregorian
!     Calendar";  no account is taken of the date(s) of adoption of
!     the Gregorian Calendar, nor is the AD/BC numbering convention
!     observed.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 12.92 (p604).
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine JD2CAL ( dj1, dj2, iy, im, id, fd, j )

    implicit none

    real(wp),intent(in) :: dj1 !! Julian Date (Notes 1, 2)
    real(wp),intent(in) :: dj2 !! Julian Date (Notes 1, 2)
    integer,intent(out) :: iy !! year
    integer,intent(out) :: im !! month
    integer,intent(out) :: id !! day
    real(wp),intent(out) :: fd !! fraction of day
    integer,intent(out) :: j !! status:
                             !! *  0 = OK
                             !! * -1 = unacceptable date (Note 1)

    !  Minimum and maximum allowed JD
    real(wp),parameter :: djmin = -68569.5_wp
    real(wp),parameter :: djmax = 1.0e9_wp

    integer :: jd, l, n, i, k
    real(wp) :: dj, d1, d2, f1, f2, f, d

    !  Check if date is acceptable.
    dj = dj1 + dj2
    if ( dj<djmin .or. dj>djmax ) then
       j = -1
    else
       j = 0

       !  Copy the date, big then small, and re-align to midnight.
       if ( abs(dj1) >= abs(dj2) ) then
          d1 = dj1
          d2 = dj2
       else
          d1 = dj2
          d2 = dj1
       end if
       d2 = d2 - 0.5_wp

       !  Separate day and fraction.
       f1 = mod(d1,1.0_wp)
       f2 = mod(d2,1.0_wp)
       f = mod(f1+f2,1.0_wp)
       if ( f < 0.0_wp ) f = f+1.0_wp
       d = anint(d1-f1) + anint(d2-f2) + anint(f1+f2-f)
       jd = nint(d) + 1

       !  Express day in Gregorian calendar.
       l = jd + 68569
       n = ( 4*l ) / 146097
       l = l - ( 146097*n + 3 ) / 4
       i = ( 4000 * (l+1) ) / 1461001
       l = l - ( 1461*i ) / 4 + 31
       k = ( 80*l ) / 2447
       id = l - ( 2447*k ) / 80
       l = k / 11
       im = k + 2 - 12*l
       iy = 100 * ( n-49 ) + i + l

       fd = f
    end if

    end subroutine JD2CAL
!***********************************************************************

!***********************************************************************
!>
!  Julian Date to Gregorian Calendar, expressed in a form convenient
!  for formatting messages:  rounded to a specified precision, and with
!  the fields stored in a single array.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The Julian Date is apportioned in any convenient way between
!     the arguments DJ1 and DJ2.  For example, JD=2450123.7 could
!     be expressed in any of these ways, among others:
!
!             DJ1            DJ2
!
!         2450123.7D0        0D0        (JD method)
!          2451545D0      -1421.3D0     (J2000 method)
!         2400000.5D0     50123.2D0     (MJD method)
!         2450123.5D0       0.2D0       (date & time method)
!
!  2. In early eras the conversion is from the "Proleptic Gregorian
!     Calendar";  no account is taken of the date(s) of adoption of
!     the Gregorian Calendar, nor is the AD/BC numbering convention
!     observed.
!
!  3. Refer to the routine JD2CAL.
!
!  4. NDP should be 4 or less if internal overflows are to be
!     avoided on machines which use 16-bit integers.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 12.92 (p604).
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine JDCALF ( ndp, dj1, dj2, iymdf, j )

    implicit none

    integer,intent(in) :: ndp !! number of decimal places of days in fraction
    real(wp),intent(in) :: dj1 !! DJ1+DJ2 = Julian Date (Note 1)
    real(wp),intent(in) :: dj2 !! DJ1+DJ2 = Julian Date (Note 1)
    integer,dimension(4),intent(out) :: iymdf !! year, month, day, fraction in Gregorian calendar
    integer,intent(out) :: j !! status:
                             !! * -1 = date out of range
                             !! *  0 = OK
                             !! * +1 = NDP not 0-9 (interpreted as 0)

    integer :: js
    real(wp) :: denom, d1, d2, f1, f2, f

    !  Denominator of fraction (e.g. 100 for 2 decimal places).
    if ( ndp>=0 .and. ndp<=9 ) then
       j = 0
       denom = real(10**ndp,wp)
    else
       j = 1
       denom = 1.0_wp
    end if

    !  Copy the date, big then small, and realign to midnight.
    if ( abs(dj1) >= abs(dj2) ) then
       d1 = dj1
       d2 = dj2
    else
       d1 = dj2
       d2 = dj1
    end if
    d2 = d2 - 0.5_wp

    !  Separate days and fractions.
    f1 = mod(d1,1.0_wp)
    f2 = mod(d2,1.0_wp)
    d1 = anint(d1-f1)
    d2 = anint(d2-f2)

    !  Round the total fraction to the specified number of places.
    f = anint(( f1+f2 ) * denom) / denom

    !  Re-assemble the rounded date and re-align to noon.
    d2 = d2 + f + 0.5_wp

    !  Convert to Gregorian calendar.
    call JD2CAL ( d1, d2, iymdf(1), iymdf(2), iymdf(3), f, js )
    if ( js == 0 ) then
       iymdf(4) = nint(f*denom)
    else
       j = js
    end if

    end subroutine JDCALF
!***********************************************************************

!***********************************************************************
!>
!  Apply light deflection by a solar-system body, as part of
!  transforming coordinate direction into natural direction.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The algorithm is based on Expr. (70) in Klioner (2003) and
!     Expr. (7.63) in the Explanatory Supplement (Urban & Seidelmann
!     2013), with some rearrangement to minimize the effects of machine
!     precision.
!
!  2. The mass parameter BM can, as required, be adjusted in order to
!     allow for such effects as quadrupole field.
!
!  3. The barycentric position of the deflecting body should ideally
!     correspond to the time of closest approach of the light ray to
!     the body.
!
!  4. The deflection limiter parameter DLIM is phi^2/2, where phi is the
!     angular separation (in radians) between source and body at which
!     limiting is applied.  As phi shrinks below the chosen threshold,
!     the deflection is artificially reduced, reaching zero for phi = 0.
!
!  5. The returned vector P1 is not normalized, but the consequential
!     departure from unit magnitude is always negligible.
!
!  6. To accumulate total light deflection taking into account the
!     contributions from several bodies, call the present routine for
!     each body in succession, in decreasing order of distance from the
!     observer.
!
!  7. For efficiency, validation is omitted.  The supplied vectors must
!     be of unit magnitude, and the deflection limiter non-zero and
!     positive.
!
!### References
!
!  * Urban, S. & Seidelmann, P. K. (eds), Explanatory Supplement to
!    the Astronomical Almanac, 3rd ed., University Science Books
!    (2013).
!
!  * Klioner, Sergei A., "A practical relativistic model for micro-
!    arcsecond astrometry in space", Astr. J. 125, 1580-1597 (2003).
!
!### History
!  * IAU SOFA revision:  2013 September 3

    subroutine LD ( bm, p, q, e, em, dlim, p1 )

    implicit none

    real(wp),intent(in) :: bm !! mass of the gravitating body (solar masses)
    real(wp),dimension(3),intent(in) :: p !! direction from observer to source (unit vector)
    real(wp),dimension(3),intent(in) :: q !! direction from body to source (unit vector)
    real(wp),dimension(3),intent(in) :: e !! direction from body to observer (unit vector)
    real(wp),intent(in) :: em !! distance from body to observer (au)
    real(wp),intent(in) :: dlim !! deflection limiter (Note 4)
    real(wp),dimension(3),intent(out) :: p1 !! observer to deflected source (unit vector)

    !  Schwarzschild radius of the Sun (au)
    !  = 2 * 1.32712440041 D20 / (2.99792458 D8)^2 / 1.49597870700 D11
    real(wp),parameter :: srs = 1.97412574336e-08_wp

    integer :: i
    real(wp) :: qpe(3), qdqpe, w, eq(3), peq(3)

    !  Q . (Q + E).
    do i=1,3
       qpe(i) = q(i) + e(i)
    end do
    call PDP ( q, qpe, qdqpe )

    !  2 x G x BM / ( EM x c^2 x ( Q . (Q + E) ) ).
    w = bm * srs / em / max ( qdqpe, dlim )

    !  P x (E x Q).
    call PXP ( e, q, eq )
    call PXP ( p, eq, peq )

    !  Apply the deflection.
    do i = 1,3
       p1(i) = p(i) + w*peq(i)
    end do

    end subroutine LD
!***********************************************************************

!***********************************************************************
!>
!  For a star, apply light deflection by multiple solar-system bodies,
!  as part of transforming coordinate direction into natural direction.
!
!  Status:  support routine.
!
!  1. The array B contains N entries, one for each body to be
!     considered.  If N = 0, no gravitational light deflection will be
!     applied, not even for the Sun.
!
!  2. The array B should include an entry for the Sun as well as for any
!     planet or other body to be taken into account.  The entries should
!     be in the order in which the light passes the body.
!
!  3. In the entry in the B array for body I, the mass parameter B(1,I)
!     can, as required, be adjusted in order to allow for such effects
!     as quadrupole field.
!
!  4. The deflection limiter parameter B(2,I) is phi^2/2, where phi is
!     the angular separation (in radians) between star and body at which
!     limiting is applied.  As phi shrinks below the chosen threshold,
!     the deflection is artificially reduced, reaching zero for phi = 0.
!     Example values suitable for a terrestrial observer, together with
!     masses, are as follows:
!
!        body I     B(1,I)         B(2,I)
!
!        Sun        1D0            6D-6
!        Jupiter    0.00095435D0   3D-9
!        Saturn     0.00028574D0   3D-10
!
!  5. For cases where the starlight passes the body before reaching the
!     observer, the body is placed back along its barycentric track by
!     the light time from that point to the observer.  For cases where
!     the body is "behind" the observer no such shift is applied.  If
!     a different treatment is preferred, the user has the option of
!     instead using the LD routine.  Similarly, LD can be used
!     for cases where the source is nearby, not a star.
!
!  6. The returned vector SN is not normalized, but the consequential
!     departure from unit magnitude is always negligible.
!
!  7. For efficiency, validation is omitted.  The supplied masses must
!     be greater than zero, the position and velocity vectors must be
!     right, and the deflection limiter greater than zero.
!
!### Reference
!
!  * Urban, S. & Seidelmann, P. K. (eds), Explanatory Supplement to
!    the Astronomical Almanac, 3rd ed., University Science Books
!    (2013), Section 7.2.4.
!
!### History
!  * IAU SOFA revision:  2017 March 16

    subroutine LDN ( n, b, ob, sc, sn )

    implicit none

    integer,intent(in) :: n !! number of bodies (Note 1)
    real(wp),dimension(8,n),intent(in) :: b !! data for each of the N bodies (Notes 1,2):
                                            !! (1,I)     mass of the body (solar masses, Note 3)
                                            !! (2,I)     deflection limiter (Note 4)
                                            !! (3-5,I)   barycentric position of the body (au)
                                            !! (6-8,I)   barycentric velocity of the body (au/day)
    real(wp),dimension(3),intent(in) :: ob !! barycentric position of the observer (au)
    real(wp),dimension(3),intent(in) :: sc !! observer to star coordinate direction (unit vector)
    real(wp),dimension(3),intent(out) :: sn !! observer to deflected star (unit vector)

    !  Astronomical unit (m, IAU 2012)
    real(wp),parameter :: aum = 149597870.7d3

    !  Light time for 1 au (day)
    real(wp),parameter :: cr = aum/cmps/d2s

    integer :: i
    real(wp) :: s(3), v(3), d , dt, ev(3), em, e(3)

    !  Star direction prior to deflection.
    call CP ( sc, s )

    !  Body by body.
    do i=1,n

       !  Body to observer vector at epoch of observation (au).
       call PMP ( ob, b(3,i), v )

       !  Minus the time since the light passed the body (days).
       call PDP ( s, v, d )
       dt = d * cr

       !  Neutralize if the star is "behind" the observer.
       dt = min ( dt, 0.0_wp )

       !  Backtrack the body to the time the light was passing the body.
       call PPSP ( v, -dt, b(6,i), ev )

       !  Separate the body to observer vector into magnitude and direction.
       call PN ( ev, em, e )

       !  Apply light deflection for this body.
       call LD ( b(1,i), s, s, e, em, b(2,i), v )

       !  Update the star direction.
       call CP ( v, s )

       !  Next body.
    end do

    !  Return the deflected star direction.
    call CP ( s, sn )

    end subroutine LDN
!***********************************************************************

!***********************************************************************
!>
!  Deflection of starlight by the Sun.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The source is presumed to be sufficiently distant that its
!     directions seen from the Sun and the observer are essentially
!     the same.
!
!  2. The deflection is restrained when the angle between the star and
!     the center of the Sun is less than a threshold value, falling to
!     zero deflection for zero separation.  The chosen threshold value
!     is within the solar limb for all solar-system applications, and
!     is about 5 arcminutes for the case of a terrestrial observer.
!
!### History
!  * IAU SOFA revision:  2016 June 16

    subroutine LDSUN ( p, e, em, p1 )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! direction from observer to star (unit vector)
    real(wp),dimension(3),intent(in) :: e !! direction from Sun to observer (unit vector)
    real(wp),intent(in) :: em !! distance from Sun to observer (au)
    real(wp),dimension(3),intent(out) :: p1 !! observer to deflected star (unit vector)

    real(wp) :: dlim

    !  Deflection limiter (smaller for distant observers).
    dlim = 1.0e-6_wp / max(em*em,1.0_wp)

    !  Apply the deflection.
    call LD ( 1.0_wp, p, p, e, em, dlim, p1 )

    end subroutine LDSUN
!***********************************************************************

!***********************************************************************
!>
!  Transformation from ecliptic coordinates (mean equinox and ecliptic
!  of date) to ICRS RA,Dec, using a long-term precession model.
!
!  Status:  support routine.
!
!  1. No assumptions are made about whether the coordinates represent
!     starlight and embody astrometric effects such as parallax or
!     aberration.
!
!  2. The transformation is approximately that from ecliptic longitude
!     and latitude (mean equinox and ecliptic of date) to mean J2000.0
!     right ascension and declination, with only frame bias (always less
!     than 25 mas) to disturb this classical picture.
!
!  3. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2016 February 9

    subroutine LTECEQ ( epj, dl, db, dr, dd )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),intent(in) :: dl !! ecliptic longitude (radians)
    real(wp),intent(in) :: db !! ecliptic latitude (radians)
    real(wp),intent(out) :: dr !! ICRS right ascension (radians)
    real(wp),intent(out) :: dd !! ICRS declination (radians)

    real(wp) :: rm(3,3), v1(3), v2(3), a, b

    !  Spherical to Cartesian.
    call S2C ( dl, db, v1 )

    !  Rotation matrix, ICRS equatorial to ecliptic.
    call LTECM ( epj, rm )

    !  The transformation from ecliptic to ICRS.
    call TRXP ( rm, v1, v2 )

    !  Cartesian to spherical.
    call C2S ( v2, a, b )

    !  Express in conventional ranges.
    dr = ANP ( a )
    dd = ANPM ( b )

    end subroutine LTECEQ
!***********************************************************************

!***********************************************************************
!>
!  ICRS equatorial to ecliptic rotation matrix, long-term.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The matrix is in the sense
!
!        E_ep = RM x P_ICRS,
!
!     where P_ICRS is a vector with respect to ICRS right ascension
!     and declination axes and E_ep is the same vector with respect to
!     the (inertial) ecliptic and equinox of epoch EPJ.
!
!  2. P_ICRS is a free vector, merely a direction, typically of unit
!     magnitude, and not bound to any particular spatial origin, such as
!     the Earth, Sun or SSB.  No assumptions are made about whether it
!     represents starlight and embodies astrometric effects such as
!     parallax or aberration.  The transformation is approximately that
!     between mean J2000.0 right ascension and declination and ecliptic
!     longitude and latitude, with only frame bias (always less than
!     25 mas) to disturb this classical picture.
!
!  3. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2015 December 6

    subroutine LTECM ( epj, rm )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),dimension(3,3),intent(out) :: rm !! ICRS to ecliptic rotation matrix

    !  Frame bias (IERS Conventions 2010, Eqs. 5.21 and 5.33)
    real(wp),parameter :: dx = -0.016617_wp * das2r
    real(wp),parameter :: de = -0.0068192_wp * das2r
    real(wp),parameter :: dr = -0.0146_wp * das2r

    real(wp) :: p(3), z(3), w(3), s, x(3), y(3)

    !  Equator pole.
    call LTPEQU ( epj, p )

    !  Ecliptic pole (bottom row of equatorial to ecliptic matrix).
    call LTPECL ( epj, z )

    !  Equinox (top row of matrix).
    call PXP ( p, z, w )
    call PN ( w, s, x )

    !  Middle row of matrix.
    call PXP ( z, x, y )

    !  Combine with frame bias.
    rm(1,1) =   x(1)    - x(2)*dr + x(3)*dx
    rm(1,2) =   x(1)*dr + x(2)    + x(3)*de
    rm(1,3) = - x(1)*dx - x(2)*de + x(3)
    rm(2,1) =   y(1)    - y(2)*dr + y(3)*dx
    rm(2,2) =   y(1)*dr + y(2)    + y(3)*de
    rm(2,3) = - y(1)*dx - y(2)*de + y(3)
    rm(3,1) =   z(1)    - z(2)*dr + z(3)*dx
    rm(3,2) =   z(1)*dr + z(2)    + z(3)*de
    rm(3,3) = - z(1)*dx - z(2)*de + z(3)

    end subroutine LTECM
!***********************************************************************

!***********************************************************************
!>
!  Transformation from ICRS equatorial coordinates to ecliptic
!  coordinates (mean equinox and ecliptic of date), using a long-term
!  precession model.
!
!  Status:  support routine.
!
!  1. No assumptions are made about whether the coordinates represent
!     starlight and embody astrometric effects such as parallax or
!     aberration.
!
!  2. The transformation is approximately that from mean J2000.0 right
!     ascension and declination to ecliptic longitude and latitude
!     (mean equinox and ecliptic of date), with only frame bias (always
!     less than 25 mas) to disturb this classical picture.
!
!  3. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2016 February 9

    subroutine LTEQEC ( epj, dr, dd, dl, db )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),intent(in) :: dr !! ICRS right ascension (radians)
    real(wp),intent(in) :: dd !! ICRS right declination (radians)
    real(wp),intent(out) :: dl !! ecliptic longitude (radians)
    real(wp),intent(out) :: db !! ecliptic latitude (radians)

    real(wp) :: rm(3,3), v1(3), v2(3), a, b

    !  Spherical to Cartesian.
    call S2C ( dr, dd, v1 )

    !  Rotation matrix, ICRS equatorial to ecliptic.
    call LTECM ( epj, rm )

    !  The transformation from ICRS to ecliptic.
    call RXP ( rm, v1, v2 )

    !  Cartesian to spherical.
    call C2S ( v2, a, b )

    !  Express in conventional ranges.
    dl = ANP ( a )
    db = ANPM ( b )

    end subroutine LTEQEC
!***********************************************************************

!***********************************************************************
!>
!  Long-term precession matrix.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The matrix is in the sense
!
!        P_date = RP x P_J2000,
!
!     where P_J2000 is a vector with respect to the J2000.0 mean equator
!     and equinox and P_date is the same vector with respect to the
!     equator and equinox of epoch EPJ.
!
!  2. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2015 December 6

    subroutine LTP ( epj, rp )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix, J2000.0 to date

    integer :: i
    real(wp) :: peqr(3), pecl(3), v(3), w, eqx(3)

    !  Equator pole (bottom row of matrix).
    call LTPEQU ( epj, peqr )

    !  Ecliptic pole.
    call LTPECL ( epj, pecl )

    !  Equinox (top row of matrix).
    call PXP ( peqr, pecl, v )
    call PN ( v, w, eqx )

    !  Middle row of matrix.
    call PXP ( peqr, eqx, v )

    !  Assemble the matrix.
    do i=1,3
       rp(1,i) = eqx(i)
       rp(2,i) = v(i)
       rp(3,i) = peqr(i)
    end do

    end subroutine LTP
!***********************************************************************

!***********************************************************************
!>
!  Long-term precession matrix, including ICRS frame bias.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The matrix is in the sense
!
!        P_date = RPB x P_ICRS,
!
!     where P_J2000 is a vector in the International Celestial Reference
!     System, and P_date is the vector with respect to the Celestial
!     Intermediate Reference System at that date but with nutation
!     neglected.
!
!  2. A first order frame bias formulation is used, of sub-
!     microarcsecond accuracy compared with a full 3D rotation.
!
!  3. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2015 December 6

    subroutine LTPB ( epj, rpb )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),dimension(3,3),intent(out) :: rpb !! precession-bias matrix, J2000.0 to date

    !  Frame bias (IERS Conventions 2010, Eqs. 5.21 and 5.33)
    real(wp),parameter :: dx = -0.016617_wp * das2r
    real(wp),parameter :: de = -0.0068192_wp * das2r
    real(wp),parameter :: dr = -0.0146_wp * das2r

    integer :: i
    real(wp) :: rp(3,3)

    !  Precession matrix.
    call LTP  ( epj, rp )

    !  Apply the bias.
    do i=1,3
       rpb(i,1) =   rp(i,1)    - rp(i,2)*dr + rp(i,3)*dx
       rpb(i,2) =   rp(i,1)*dr + rp(i,2)    + rp(i,3)*de
       rpb(i,3) = - rp(i,1)*dx - rp(i,2)*de + rp(i,3)
    end do

    end subroutine LTPB
!***********************************************************************

!***********************************************************************
!>
!  Long-term precession of the ecliptic.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The returned vector is with respect to the J2000.0 mean equator
!     and equinox.
!
!  2. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2016 February 9

    subroutine LTPECL ( epj, vec )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),dimension(3),intent(out) :: vec !! ecliptic pole unit vector

    !  Obliquity at J2000.0 (radians).
    real(wp),parameter :: eps0 = 84381.406_wp * das2r

    !  Number of polynomial terms
    integer,parameter :: npol = 4

    !  Number of periodic terms
    integer,parameter :: nper = 8

    !  Miscellaneous
    integer :: i, j
    real(wp) :: t, p, q, w, a, s, c

    !  Polynomial and periodic coefficients

    !  Polynomials
    real(wp),dimension(npol,2),parameter :: pqpol = reshape([&
           +5851.607687_wp, &
              -0.1189000_wp, &
              -0.00028913_wp, &
              +0.000000101_wp, &
           -1600.886300_wp, &
              +1.1689818_wp, &
              -0.00000020_wp, &
              -0.000000437_wp ], [npol,2])

    !  Periodics
    real(wp),dimension(5,nper),parameter :: pqper = reshape([&
       708.15_wp,  -5486.751211_wp,   -684.661560_wp, &
                     667.666730_wp,  -5523.863691_wp, &
      2309.00_wp,    -17.127623_wp,   2446.283880_wp, &
                   -2354.886252_wp,   -549.747450_wp, &
      1620.00_wp,   -617.517403_wp,    399.671049_wp, &
                    -428.152441_wp,   -310.998056_wp, &
       492.20_wp,    413.442940_wp,   -356.652376_wp, &
                     376.202861_wp,    421.535876_wp, &
      1183.00_wp,     78.614193_wp,   -186.387003_wp, &
                     184.778874_wp,    -36.776172_wp, &
       622.00_wp,   -180.732815_wp,   -316.800070_wp, &
                     335.321713_wp,   -145.278396_wp, &
       882.00_wp,    -87.676083_wp,    198.296701_wp, &
                    -185.138669_wp,    -34.744450_wp, &
       547.00_wp,     46.140315_wp,    101.135679_wp, &
                    -120.972830_wp,     22.885731_wp ], [5,nper])

    !  Centuries since J2000.
    t = (epj-2000.0_wp)/100.0_wp

    !  Initialize P_A and Q_A accumulators.
    p = 0.0_wp
    q = 0.0_wp

    !  Periodic terms.
    w = d2pi*t
    do i=1,nper
       a = w/pqper(1,i)
       s = sin(a)
       c = cos(a)
       p = p + c*pqper(2,i) + s*pqper(4,i)
       q = q + c*pqper(3,i) + s*pqper(5,i)
    end do

    !  Polynomial terms.
    w = 1.0_wp
    do i=1,npol
       p = p + pqpol(i,1)*w
       q = q + pqpol(i,2)*w
       w = w*t
    end do

    !  P_A and Q_A (radians).
    p = p*das2r
    q = q*das2r

    !  Form the ecliptic pole vector.
    w = sqrt(max(1.0_wp-p*p-q*q,0.0_wp))
    s = sin(eps0)
    c = cos(eps0)
    vec(1) = p
    vec(2) = - q*c - w*s
    vec(3) = - q*s + w*c

    end subroutine LTPECL
!***********************************************************************

!***********************************************************************
!>
!  Long-term precession of the equator.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The returned vector is with respect to the J2000.0 mean equator
!     and equinox.
!
!  2. The Vondrak et al. (2011, 2012) 400 millennia precession model
!     agrees with the IAU 2006 precession at J2000.0 and stays within
!     100 microarcseconds during the 20th and 21st centuries.  It is
!     accurate to a few arcseconds throughout the historical period,
!     worsening to a few tenths of a degree at the end of the
!     +/- 200,000 year time span.
!
!### References
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2011, New precession
!    expressions, valid for long time intervals, Astron.Astrophys. 534,
!    A22
!
!  * Vondrak, J., Capitaine, N. and Wallace, P., 2012, New precession
!    expressions, valid for long time intervals (Corrigendum),
!    Astron.Astrophys. 541, C1
!
!### History
!  * IAU SOFA revision: 2016 February 9

    subroutine LTPEQU ( epj, veq )

    implicit none

    real(wp),intent(in) :: epj !! Julian epoch (TT)
    real(wp),dimension(3),intent(out) :: veq !! equator pole unit vector

    !  Number of polynomial terms
    integer,parameter :: npol = 4

    !  Number of periodic terms
    integer,parameter :: nper = 14

    !  Miscellaneous
    integer :: i, j
    real(wp) :: t, x, y, w, a, s, c

    !  Polynomial and periodic coefficients

    !  Polynomials
    real(wp),dimension(npol,2),parameter :: xypol = reshape([&
           +5453.282155_wp, &
              +0.4252841_wp, &
              -0.00037173_wp, &
              -0.000000152_wp, &
          -73750.930350_wp, &
              -0.7675452_wp, &
              -0.00018725_wp, &
              +0.000000231_wp ], [npol,2])

    !  Periodics
    real(wp),dimension(5,nper),parameter :: xyper = reshape([&
       256.75_wp,   -819.940624_wp,  75004.344875_wp, &
                   81491.287984_wp,   1558.515853_wp, &
       708.15_wp,  -8444.676815_wp,    624.033993_wp, &
                     787.163481_wp,   7774.939698_wp, &
       274.20_wp,   2600.009459_wp,   1251.136893_wp, &
                    1251.296102_wp,  -2219.534038_wp, &
       241.45_wp,   2755.175630_wp,  -1102.212834_wp, &
                   -1257.950837_wp,  -2523.969396_wp, &
      2309.00_wp,   -167.659835_wp,  -2660.664980_wp, &
                   -2966.799730_wp,    247.850422_wp, &
       492.20_wp,    871.855056_wp,    699.291817_wp, &
                     639.744522_wp,   -846.485643_wp, &
       396.10_wp,     44.769698_wp,    153.167220_wp, &
                     131.600209_wp,  -1393.124055_wp, &
       288.90_wp,   -512.313065_wp,   -950.865637_wp, &
                    -445.040117_wp,    368.526116_wp, &
       231.10_wp,   -819.415595_wp,    499.754645_wp, &
                     584.522874_wp,    749.045012_wp, &
      1610.00_wp,   -538.071099_wp,   -145.188210_wp, &
                     -89.756563_wp,    444.704518_wp, &
       620.00_wp,   -189.793622_wp,    558.116553_wp, &
                     524.429630_wp,    235.934465_wp, &
       157.87_wp,   -402.922932_wp,    -23.923029_wp, &
                     -13.549067_wp,    374.049623_wp, &
       220.30_wp,    179.516345_wp,   -165.405086_wp, &
                    -210.157124_wp,   -171.330180_wp, &
      1200.00_wp,     -9.814756_wp,      9.344131_wp, &
                     -44.919798_wp,    -22.899655_wp ], [5,nper])

    !  Centuries since J2000.
    t = (epj-2000.0_wp)/100.0_wp

    !  Initialize X and Y accumulators.
    x = 0.0_wp
    y = 0.0_wp

    !  Periodic terms.
    w = d2pi*t
    do i=1,nper
       a = w/xyper(1,i)
       s = sin(a)
       c = cos(a)
       x = x + c*xyper(2,i) + s*xyper(4,i)
       y = y + c*xyper(3,i) + s*xyper(5,i)
    end do

    !  Polynomial terms.
    w = 1.0_wp
    do i=1,npol
       x = x + xypol(i,1)*w
       y = y + xypol(i,2)*w
       w = w*t
    end do

    !  X and Y (direction cosines).
    x = x*das2r
    y = y*das2r

    !  Form the equator pole vector.
    veq(1) = x
    veq(2) = y
    veq(3) = sqrt(max(1.0_wp-x*x-y*y,0.0_wp))

    end subroutine LTPEQU
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of nutation for a given date, IAU 2000A model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix operates in the sense V(true) = RMATN * V(mean),
!     where the p-vector V(true) is with respect to the true
!     equatorial triad of date and the p-vector V(mean) is with
!     respect to the mean equatorial triad of date.
!
!  3. A faster, but slightly less accurate result (about 1 mas), can be
!     obtained by using instead the NUM00B routine.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 3.222-3 (p114).
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine NUM00A ( date1, date2, rmatn )

    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),dimension(3,3),intent(out) :: rmatn !! nutation matrix

    real(wp) :: dpsi, deps, epsa, &
                rb(3,3), rp(3,3), rbp(3,3), rbpn(3,3)

    !  Obtain the required matrix (discarding other results).
    call PN00A ( date1, date2, &
                 dpsi, deps, epsa, rb, rp, rbp, rmatn, rbpn )

    end subroutine NUM00A
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of nutation for a given date, IAU 2000B model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix operates in the sense V(true) = RMATN * V(mean),
!     where the p-vector V(true) is with respect to the true
!     equatorial triad of date and the p-vector V(mean) is with
!     respect to the mean equatorial triad of date.
!
!  3. The present routine is faster, but slightly less accurate (about
!     1 mas), than the NUM00A routine.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 3.222-3 (p114).
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine NUM00B ( date1, date2, rmatn )

    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),dimension(3,3),intent(out) :: rmatn !! nutation matrix

    real(wp) :: dpsi, deps, epsa, &
                rb(3,3), rp(3,3), rbp(3,3), rbpn(3,3)

    !  Obtain the required matrix (discarding other results).
    call PN00B ( date1, date2, &
                 dpsi, deps, epsa, rb, rp, rbp, rmatn, rbpn )

    end subroutine NUM00B
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of nutation for a given date, IAU 2006/2000A model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix operates in the sense V(true) = RMATN * V(mean),
!     where the p-vector V(true) is with respect to the true
!     equatorial triad of date and the p-vector V(mean) is with
!     respect to the mean equatorial triad of date.
!
!### References
!
!  * Capitaine, N., Wallace, P.T. & Chapront, J., 2005, Astron.
!    Astrophys. 432, 355
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2007 May 11

    subroutine NUM06A ( date1, date2, rmatn )

    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),dimension(3,3),intent(out) :: rmatn !! nutation matrix

    real(wp) :: eps, dp, de

    !  Mean obliquity.
    eps = OBL06 ( date1, date2 )

    !  Nutation components.
    call NUT06A ( date1, date2, dp, de )

    !  Nutation matrix.
    call NUMAT ( eps, dp, de, rmatn )

    end subroutine NUM06A
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of nutation.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The supplied mean obliquity EPSA, must be consistent with the
!     precession-nutation models from which DPSI and DEPS were obtained.
!
!  2. The caller is responsible for providing the nutation components;
!     they are in longitude and obliquity, in radians and are with
!     respect to the equinox and ecliptic of date.
!
!  3. The matrix operates in the sense V(true) = RMATN * V(mean),
!     where the p-vector V(true) is with respect to the true
!     equatorial triad of date and the p-vector V(mean) is with
!     respect to the mean equatorial triad of date.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 3.222-3 (p114).
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine NUMAT ( epsa, dpsi, deps, rmatn )

    implicit none

    real(wp),intent(in) :: epsa !! mean obliquity of date (Note 1)
    real(wp),intent(in) :: dpsi !! nutation (Note 2)
    real(wp),intent(in) :: deps !! nutation (Note 2)
    real(wp),dimension(3,3),intent(out) :: rmatn !! nutation matrix (Note 3)

    !  Build the rotation matrix.
    call IR ( rmatn )
    call RX ( epsa, rmatn )
    call RZ ( -dpsi, rmatn )
    call RX ( -(epsa+deps), rmatn )

    end subroutine NUMAT
!***********************************************************************

!***********************************************************************
!>
!  Nutation, IAU 2000A model (MHB2000 luni-solar and planetary nutation
!  with free core nutation omitted).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The nutation components in longitude and obliquity are in radians
!     and with respect to the equinox and ecliptic of date.  The
!     obliquity at J2000.0 is assumed to be the Lieske et al. (1977)
!     value of 84381.448 arcsec.
!
!     Both the luni-solar and planetary nutations are included.  The
!     latter are due to direct planetary nutations and the perturbations
!     of the lunar and terrestrial orbits.
!
!  3. The routine computes the MHB2000 nutation series with the
!     associated corrections for planetary nutations.  It is an
!     implementation of the nutation part of the IAU 2000A precession-
!     nutation model, formally adopted by the IAU General Assembly in
!     2000, namely MHB2000 (Mathews et al. 2002), but with the free core
!     nutation (FCN - see Note 4) omitted.
!
!  4. The full MHB2000 model also contains contributions to the
!     nutations in longitude and obliquity due to the free-excitation of
!     the free-core-nutation during the period 1979-2000.  These FCN
!     terms, which are time-dependent and unpredictable, are NOT
!     included in the present routine and, if required, must be
!     independently computed.  With the FCN corrections included, the
!     present routine delivers a pole which is at current epochs
!     accurate to a few hundred microarcseconds.  The omission of FCN
!     introduces further errors of about that size.
!
!  5. The present routine provides classical nutation.  The MHB2000
!     algorithm, from which it is adapted, deals also with (i) the
!     offsets between the GCRS and mean poles and (ii) the adjustments
!     in longitude and obliquity due to the changed precession rates.
!     These additional functions, namely frame bias and precession
!     adjustments, are supported by the SOFA routines BI00 and
!     PR00.
!
!  6. The MHB2000 algorithm also provides "total" nutations, comprising
!     the arithmetic sum of the frame bias, precession adjustments,
!     luni-solar nutation and planetary nutation.  These total nutations
!     can be used in combination with an existing IAU 1976 precession
!     implementation, such as PMAT76, to deliver GCRS-to-true
!     predictions of sub-mas accuracy at current epochs.  However, there
!     are three shortcomings in the MHB2000 model that must be taken
!     into account if more accurate or definitive results are required
!     (see Wallace 2002):
!
!       (i) The MHB2000 total nutations are simply arithmetic sums,
!           yet in reality the various components are successive Euler
!           rotations.  This slight lack of rigor leads to cross terms
!           that exceed 1 mas after a century.  The rigorous procedure
!           is to form the GCRS-to-true rotation matrix by applying the
!           bias, precession and nutation in that order.
!
!      (ii) Although the precession adjustments are stated to be with
!           respect to Lieske et al. (1977), the MHB2000 model does
!           not specify which set of Euler angles are to be used and
!           how the adjustments are to be applied.  The most literal and
!           straightforward procedure is to adopt the 4-rotation
!           epsilon_0, psi_A, omega_A, xi_A option, and to add DPSIPR to
!           psi_A and DEPSPR to both omega_A and eps_A.
!
!     (iii) The MHB2000 model predates the determination by Chapront
!           et al. (2002) of a 14.6 mas displacement between the J2000.0
!           mean equinox and the origin of the ICRS frame.  It should,
!           however, be noted that neglecting this displacement when
!           calculating star coordinates does not lead to a 14.6 mas
!           change in right ascension, only a small second-order
!           distortion in the pattern of the precession-nutation effect.
!
!     For these reasons, the SOFA routines do not generate the "total
!     nutations" directly, though they can of course easily be generated
!     by calling BI00, PR00 and the present routine and adding
!     the results.
!
!  7. The MHB2000 model contains 41 instances where the same frequency
!     appears multiple times, of which 38 are duplicates and three are
!     triplicates.  To keep the present code close to the original MHB
!     algorithm, this small inefficiency has not been corrected.
!
!### References
!
!  * Chapront, J., Chapront-Touze, M. & Francou, G. 2002,
!    Astron.Astrophys. 387, 700
!
!  * Lieske, J.H., Lederle, T., Fricke, W. & Morando, B. 1977,
!    Astron.Astrophys. 58, 1-16
!
!  * Mathews, P.M., Herring, T.A., Buffet, B.A. 2002, J.Geophys.Res.
!    107, B4.  The MHB_2000 code itself was obtained on 9th September
!    2002 from ftp//maia.usno.navy.mil/conv2000/chapter5/IAU2000A.
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J. 1994, Astron.Astrophys. 282, 663-683
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M. 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!  * Wallace, P.T., "Software for Implementing the IAU 2000
!    Resolutions", in IERS Workshop 5.1 (2002)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine NUT00A ( date1, date2, dpsi, deps )

    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(out) :: dpsi !! nutation, luni-solar + planetary (Note 2)
    real(wp),intent(out) :: deps !! nutation, luni-solar + planetary (Note 2)

    !  Arcseconds in a full circle
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Units of 0.1 microarcsecond to radians
    real(wp),parameter :: u2r = das2r/1.0e7_wp

    !  Miscellaneous
    integer :: i, j
    real(wp) :: t, el, elp, f, d, om, arg, dp, de, sarg, carg, &
                al, alsu, af, ad, aom, alme, alve, alea, alma, &
                alju, alsa, alur, alne, apa, dpsils, depsls, &
                dpsipl, depspl

    !  -------------------------
    !  Luni-Solar nutation model
    !  -------------------------

    !  Number of terms in the luni-solar nutation model
    integer,parameter :: nls = 678

    !  ---------------
    !  Planetary terms
    !  ---------------

    !  Number of terms in the planetary nutation model
    integer,parameter :: npl = 687

    !  ----------------------------------------
    !  Tables of argument and term coefficients
    !  ----------------------------------------

    !
    !  Luni-Solar argument multipliers
    !               L     L'    F     D     Om

    !  Coefficients for fundamental arguments
    integer,dimension(5,nls),parameter :: nals = reshape([&
              0,    0,    0,    0,    1, &
              0,    0,    2,   -2,    2, &
              0,    0,    2,    0,    2, &
              0,    0,    0,    0,    2, &
              0,    1,    0,    0,    0, &
              0,    1,    2,   -2,    2, &
              1,    0,    0,    0,    0, &
              0,    0,    2,    0,    1, &
              1,    0,    2,    0,    2, &
              0,   -1,    2,   -2,    2, &
              0,    0,    2,   -2,    1, &
             -1,    0,    2,    0,    2, &
             -1,    0,    0,    2,    0, &
              1,    0,    0,    0,    1, &
             -1,    0,    0,    0,    1, &
             -1,    0,    2,    2,    2, &
              1,    0,    2,    0,    1, &
             -2,    0,    2,    0,    1, &
              0,    0,    0,    2,    0, &
              0,    0,    2,    2,    2, &
              0,   -2,    2,   -2,    2, &
             -2,    0,    0,    2,    0, &
              2,    0,    2,    0,    2, &
              1,    0,    2,   -2,    2, &
             -1,    0,    2,    0,    1, &
              2,    0,    0,    0,    0, &
              0,    0,    2,    0,    0, &
              0,    1,    0,    0,    1, &
             -1,    0,    0,    2,    1, &
              0,    2,    2,   -2,    2, &
              0,    0,   -2,    2,    0, &
              1,    0,    0,   -2,    1, &
              0,   -1,    0,    0,    1, &
             -1,    0,    2,    2,    1, &
              0,    2,    0,    0,    0, &
              1,    0,    2,    2,    2, &
             -2,    0,    2,    0,    0, &
              0,    1,    2,    0,    2, &
              0,    0,    2,    2,    1, &
              0,   -1,    2,    0,    2, &
              0,    0,    0,    2,    1, &
              1,    0,    2,   -2,    1, &
              2,    0,    2,   -2,    2, &
             -2,    0,    0,    2,    1, &
              2,    0,    2,    0,    1, &
              0,   -1,    2,   -2,    1, &
              0,    0,    0,   -2,    1, &
             -1,   -1,    0,    2,    0, &
              2,    0,    0,   -2,    1, &
              1,    0,    0,    2,    0, &
              0,    1,    2,   -2,    1, &
              1,   -1,    0,    0,    0, &
             -2,    0,    2,    0,    2, &
              3,    0,    2,    0,    2, &
              0,   -1,    0,    2,    0, &
              1,   -1,    2,    0,    2, &
              0,    0,    0,    1,    0, &
             -1,   -1,    2,    2,    2, &
             -1,    0,    2,    0,    0, &
              0,   -1,    2,    2,    2, &
             -2,    0,    0,    0,    1, &
              1,    1,    2,    0,    2, &
              2,    0,    0,    0,    1, &
             -1,    1,    0,    1,    0, &
              1,    1,    0,    0,    0, &
              1,    0,    2,    0,    0, &
             -1,    0,    2,   -2,    1, &
              1,    0,    0,    0,    2, &
             -1,    0,    0,    1,    0, &
              0,    0,    2,    1,    2, &
             -1,    0,    2,    4,    2, &
             -1,    1,    0,    1,    1, &
              0,   -2,    2,   -2,    1, &
              1,    0,    2,    2,    1, &
             -2,    0,    2,    2,    2, &
             -1,    0,    0,    0,    2, &
              1,    1,    2,   -2,    2, &
             -2,    0,    2,    4,    2, &
             -1,    0,    4,    0,    2, &
              2,    0,    2,   -2,    1, &
              2,    0,    2,    2,    2, &
              1,    0,    0,    2,    1, &
              3,    0,    0,    0,    0, &
              3,    0,    2,   -2,    2, &
              0,    0,    4,   -2,    2, &
              0,    1,    2,    0,    1, &
              0,    0,   -2,    2,    1, &
              0,    0,    2,   -2,    3, &
             -1,    0,    0,    4,    0, &
              2,    0,   -2,    0,    1, &
             -2,    0,    0,    4,    0, &
             -1,   -1,    0,    2,    1, &
             -1,    0,    0,    1,    1, &
              0,    1,    0,    0,    2, &
              0,    0,   -2,    0,    1, &
              0,   -1,    2,    0,    1, &
              0,    0,    2,   -1,    2, &
              0,    0,    2,    4,    2, &
             -2,   -1,    0,    2,    0, &
              1,    1,    0,   -2,    1, &
             -1,    1,    0,    2,    0, &
             -1,    1,    0,    1,    2, &
              1,   -1,    0,    0,    1, &
              1,   -1,    2,    2,    2, &
             -1,    1,    2,    2,    2, &
              3,    0,    2,    0,    1, &
              0,    1,   -2,    2,    0, &
             -1,    0,    0,   -2,    1, &
              0,    1,    2,    2,    2, &
             -1,   -1,    2,    2,    1, &
              0,   -1,    0,    0,    2, &
              1,    0,    2,   -4,    1, &
             -1,    0,   -2,    2,    0, &
              0,   -1,    2,    2,    1, &
              2,   -1,    2,    0,    2, &
              0,    0,    0,    2,    2, &
              1,   -1,    2,    0,    1, &
             -1,    1,    2,    0,    2, &
              0,    1,    0,    2,    0, &
              0,   -1,   -2,    2,    0, &
              0,    3,    2,   -2,    2, &
              0,    0,    0,    1,    1, &
             -1,    0,    2,    2,    0, &
              2,    1,    2,    0,    2, &
              1,    1,    0,    0,    1, &
              1,    1,    2,    0,    1, &
              2,    0,    0,    2,    0, &
              1,    0,   -2,    2,    0, &
             -1,    0,    0,    2,    2, &
              0,    1,    0,    1,    0, &
              0,    1,    0,   -2,    1, &
             -1,    0,    2,   -2,    2, &
              0,    0,    0,   -1,    1, &
             -1,    1,    0,    0,    1, &
              1,    0,    2,   -1,    2, &
              1,   -1,    0,    2,    0, &
              0,    0,    0,    4,    0, &
              1,    0,    2,    1,    2, &
              0,    0,    2,    1,    1, &
              1,    0,    0,   -2,    2, &
             -1,    0,    2,    4,    1, &
              1,    0,   -2,    0,    1, &
              1,    1,    2,   -2,    1, &
              0,    0,    2,    2,    0, &
             -1,    0,    2,   -1,    1, &
             -2,    0,    2,    2,    1, &
              4,    0,    2,    0,    2, &
              2,   -1,    0,    0,    0, &
              2,    1,    2,   -2,    2, &
              0,    1,    2,    1,    2, &
              1,    0,    4,   -2,    2, &
             -1,   -1,    0,    0,    1, &
              0,    1,    0,    2,    1, &
             -2,    0,    2,    4,    1, &
              2,    0,    2,    0,    0, &
              1,    0,    0,    1,    0, &
             -1,    0,    0,    4,    1, &
             -1,    0,    4,    0,    1, &
              2,    0,    2,    2,    1, &
              0,    0,    2,   -3,    2, &
             -1,   -2,    0,    2,    0, &
              2,    1,    0,    0,    0, &
              0,    0,    4,    0,    2, &
              0,    0,    0,    0,    3, &
              0,    3,    0,    0,    0, &
              0,    0,    2,   -4,    1, &
              0,   -1,    0,    2,    1, &
              0,    0,    0,    4,    1, &
             -1,   -1,    2,    4,    2, &
              1,    0,    2,    4,    2, &
             -2,    2,    0,    2,    0, &
             -2,   -1,    2,    0,    1, &
             -2,    0,    0,    2,    2, &
             -1,   -1,    2,    0,    2, &
              0,    0,    4,   -2,    1, &
              3,    0,    2,   -2,    1, &
             -2,   -1,    0,    2,    1, &
              1,    0,    0,   -1,    1, &
              0,   -2,    0,    2,    0, &
             -2,    0,    0,    4,    1, &
             -3,    0,    0,    0,    1, &
              1,    1,    2,    2,    2, &
              0,    0,    2,    4,    1, &
              3,    0,    2,    2,    2, &
             -1,    1,    2,   -2,    1, &
              2,    0,    0,   -4,    1, &
              0,    0,    0,   -2,    2, &
              2,    0,    2,   -4,    1, &
             -1,    1,    0,    2,    1, &
              0,    0,    2,   -1,    1, &
              0,   -2,    2,    2,    2, &
              2,    0,    0,    2,    1, &
              4,    0,    2,   -2,    2, &
              2,    0,    0,   -2,    2, &
              0,    2,    0,    0,    1, &
              1,    0,    0,   -4,    1, &
              0,    2,    2,   -2,    1, &
             -3,    0,    0,    4,    0, &
             -1,    1,    2,    0,    1, &
             -1,   -1,    0,    4,    0, &
             -1,   -2,    2,    2,    2, &
             -2,   -1,    2,    4,    2, &
              1,   -1,    2,    2,    1, &
             -2,    1,    0,    2,    0, &
             -2,    1,    2,    0,    1, &
              2,    1,    0,   -2,    1, &
             -3,    0,    2,    0,    1, &
             -2,    0,    2,   -2,    1, &
             -1,    1,    0,    2,    2, &
              0,   -1,    2,   -1,    2, &
             -1,    0,    4,   -2,    2, &
              0,   -2,    2,    0,    2, &
             -1,    0,    2,    1,    2, &
              2,    0,    0,    0,    2, &
              0,    0,    2,    0,    3, &
             -2,    0,    4,    0,    2, &
             -1,    0,   -2,    0,    1, &
             -1,    1,    2,    2,    1, &
              3,    0,    0,    0,    1, &
             -1,    0,    2,    3,    2, &
              2,   -1,    2,    0,    1, &
              0,    1,    2,    2,    1, &
              0,   -1,    2,    4,    2, &
              2,   -1,    2,    2,    2, &
              0,    2,   -2,    2,    0, &
             -1,   -1,    2,   -1,    1, &
              0,   -2,    0,    0,    1, &
              1,    0,    2,   -4,    2, &
              1,   -1,    0,   -2,    1, &
             -1,   -1,    2,    0,    1, &
              1,   -1,    2,   -2,    2, &
             -2,   -1,    0,    4,    0, &
             -1,    0,    0,    3,    0, &
             -2,   -1,    2,    2,    2, &
              0,    2,    2,    0,    2, &
              1,    1,    0,    2,    0, &
              2,    0,    2,   -1,    2, &
              1,    0,    2,    1,    1, &
              4,    0,    0,    0,    0, &
              2,    1,    2,    0,    1, &
              3,   -1,    2,    0,    2, &
             -2,    2,    0,    2,    1, &
              1,    0,    2,   -3,    1, &
              1,    1,    2,   -4,    1, &
             -1,   -1,    2,   -2,    1, &
              0,   -1,    0,   -1,    1, &
              0,   -1,    0,   -2,    1, &
             -2,    0,    0,    0,    2, &
             -2,    0,   -2,    2,    0, &
             -1,    0,   -2,    4,    0, &
              1,   -2,    0,    0,    0, &
              0,    1,    0,    1,    1, &
             -1,    2,    0,    2,    0, &
              1,   -1,    2,   -2,    1, &
              1,    2,    2,   -2,    2, &
              2,   -1,    2,   -2,    2, &
              1,    0,    2,   -1,    1, &
              2,    1,    2,   -2,    1, &
             -2,    0,    0,   -2,    1, &
              1,   -2,    2,    0,    2, &
              0,    1,    2,    1,    1, &
              1,    0,    4,   -2,    1, &
             -2,    0,    4,    2,    2, &
              1,    1,    2,    1,    2, &
              1,    0,    0,    4,    0, &
              1,    0,    2,    2,    0, &
              2,    0,    2,    1,    2, &
              3,    1,    2,    0,    2, &
              4,    0,    2,    0,    1, &
             -2,   -1,    2,    0,    0, &
              0,    1,   -2,    2,    1, &
              1,    0,   -2,    1,    0, &
              0,   -1,   -2,    2,    1, &
              2,   -1,    0,   -2,    1, &
             -1,    0,    2,   -1,    2, &
              1,    0,    2,   -3,    2, &
              0,    1,    2,   -2,    3, &
              0,    0,    2,   -3,    1, &
             -1,    0,   -2,    2,    1, &
              0,    0,    2,   -4,    2, &
             -2,    1,    0,    0,    1, &
             -1,    0,    0,   -1,    1, &
              2,    0,    2,   -4,    2, &
              0,    0,    4,   -4,    4, &
              0,    0,    4,   -4,    2, &
             -1,   -2,    0,    2,    1, &
             -2,    0,    0,    3,    0, &
              1,    0,   -2,    2,    1, &
             -3,    0,    2,    2,    2, &
             -3,    0,    2,    2,    1, &
             -2,    0,    2,    2,    0, &
              2,   -1,    0,    0,    1, &
             -2,    1,    2,    2,    2, &
              1,    1,    0,    1,    0, &
              0,    1,    4,   -2,    2, &
             -1,    1,    0,   -2,    1, &
              0,    0,    0,   -4,    1, &
              1,   -1,    0,    2,    1, &
              1,    1,    0,    2,    1, &
             -1,    2,    2,    2,    2, &
              3,    1,    2,   -2,    2, &
              0,   -1,    0,    4,    0, &
              2,   -1,    0,    2,    0, &
              0,    0,    4,    0,    1, &
              2,    0,    4,   -2,    2, &
             -1,   -1,    2,    4,    1, &
              1,    0,    0,    4,    1, &
              1,   -2,    2,    2,    2, &
              0,    0,    2,    3,    2, &
             -1,    1,    2,    4,    2, &
              3,    0,    0,    2,    0, &
             -1,    0,    4,    2,    2, &
              1,    1,    2,    2,    1, &
             -2,    0,    2,    6,    2, &
              2,    1,    2,    2,    2, &
             -1,    0,    2,    6,    2, &
              1,    0,    2,    4,    1, &
              2,    0,    2,    4,    2, &
              1,    1,   -2,    1,    0, &
             -3,    1,    2,    1,    2, &
              2,    0,   -2,    0,    2, &
             -1,    0,    0,    1,    2, &
             -4,    0,    2,    2,    1, &
             -1,   -1,    0,    1,    0, &
              0,    0,   -2,    2,    2, &
              1,    0,    0,   -1,    2, &
              0,   -1,    2,   -2,    3, &
             -2,    1,    2,    0,    0, &
              0,    0,    2,   -2,    4, &
             -2,   -2,    0,    2,    0, &
             -2,    0,   -2,    4,    0, &
              0,   -2,   -2,    2,    0, &
              1,    2,    0,   -2,    1, &
              3,    0,    0,   -4,    1, &
             -1,    1,    2,   -2,    2, &
              1,   -1,    2,   -4,    1, &
              1,    1,    0,   -2,    2, &
             -3,    0,    2,    0,    0, &
             -3,    0,    2,    0,    2, &
             -2,    0,    0,    1,    0, &
              0,    0,   -2,    1,    0, &
             -3,    0,    0,    2,    1, &
             -1,   -1,   -2,    2,    0, &
              0,    1,    2,   -4,    1, &
              2,    1,    0,   -4,    1, &
              0,    2,    0,   -2,    1, &
              1,    0,    0,   -3,    1, &
             -2,    0,    2,   -2,    2, &
             -2,   -1,    0,    0,    1, &
             -4,    0,    0,    2,    0, &
              1,    1,    0,   -4,    1, &
             -1,    0,    2,   -4,    1, &
              0,    0,    4,   -4,    1, &
              0,    3,    2,   -2,    2, &
             -3,   -1,    0,    4,    0, &
             -3,    0,    0,    4,    1, &
              1,   -1,   -2,    2,    0, &
             -1,   -1,    0,    2,    2, &
              1,   -2,    0,    0,    1, &
              1,   -1,    0,    0,    2, &
              0,    0,    0,    1,    2, &
             -1,   -1,    2,    0,    0, &
              1,   -2,    2,   -2,    2, &
              0,   -1,    2,   -1,    1, &
             -1,    0,    2,    0,    3, &
              1,    1,    0,    0,    2, &
             -1,    1,    2,    0,    0, &
              1,    2,    0,    0,    0, &
             -1,    2,    2,    0,    2, &
             -1,    0,    4,   -2,    1, &
              3,    0,    2,   -4,    2, &
              1,    2,    2,   -2,    1, &
              1,    0,    4,   -4,    2, &
             -2,   -1,    0,    4,    1, &
              0,   -1,    0,    2,    2, &
             -2,    1,    0,    4,    0, &
             -2,   -1,    2,    2,    1, &
              2,    0,   -2,    2,    0, &
              1,    0,    0,    1,    1, &
              0,    1,    0,    2,    2, &
              1,   -1,    2,   -1,    2, &
             -2,    0,    4,    0,    1, &
              2,    1,    0,    0,    1, &
              0,    1,    2,    0,    0, &
              0,   -1,    4,   -2,    2, &
              0,    0,    4,   -2,    4, &
              0,    2,    2,    0,    1, &
             -3,    0,    0,    6,    0, &
             -1,   -1,    0,    4,    1, &
              1,   -2,    0,    2,    0, &
             -1,    0,    0,    4,    2, &
             -1,   -2,    2,    2,    1, &
             -1,    0,    0,   -2,    2, &
              1,    0,   -2,   -2,    1, &
              0,    0,   -2,   -2,    1, &
             -2,    0,   -2,    0,    1, &
              0,    0,    0,    3,    1, &
              0,    0,    0,    3,    0, &
             -1,    1,    0,    4,    0, &
             -1,   -1,    2,    2,    0, &
             -2,    0,    2,    3,    2, &
              1,    0,    0,    2,    2, &
              0,   -1,    2,    1,    2, &
              3,   -1,    0,    0,    0, &
              2,    0,    0,    1,    0, &
              1,   -1,    2,    0,    0, &
              0,    0,    2,    1,    0, &
              1,    0,    2,    0,    3, &
              3,    1,    0,    0,    0, &
              3,   -1,    2,   -2,    2, &
              2,    0,    2,   -1,    1, &
              1,    1,    2,    0,    0, &
              0,    0,    4,   -1,    2, &
              1,    2,    2,    0,    2, &
             -2,    0,    0,    6,    0, &
              0,   -1,    0,    4,    1, &
             -2,   -1,    2,    4,    1, &
              0,   -2,    2,    2,    1, &
              0,   -1,    2,    2,    0, &
             -1,    0,    2,    3,    1, &
             -2,    1,    2,    4,    2, &
              2,    0,    0,    2,    2, &
              2,   -2,    2,    0,    2, &
             -1,    1,    2,    3,    2, &
              3,    0,    2,   -1,    2, &
              4,    0,    2,   -2,    1, &
             -1,    0,    0,    6,    0, &
             -1,   -2,    2,    4,    2, &
             -3,    0,    2,    6,    2, &
             -1,    0,    2,    4,    0, &
              3,    0,    0,    2,    1, &
              3,   -1,    2,    0,    1, &
              3,    0,    2,    0,    0, &
              1,    0,    4,    0,    2, &
              5,    0,    2,   -2,    2, &
              0,   -1,    2,    4,    1, &
              2,   -1,    2,    2,    1, &
              0,    1,    2,    4,    2, &
              1,   -1,    2,    4,    2, &
              3,   -1,    2,    2,    2, &
              3,    0,    2,    2,    1, &
              5,    0,    2,    0,    2, &
              0,    0,    2,    6,    2, &
              4,    0,    2,    2,    2, &
              0,   -1,    1,   -1,    1, &
             -1,    0,    1,    0,    3, &
              0,   -2,    2,   -2,    3, &
              1,    0,   -1,    0,    1, &
              2,   -2,    0,   -2,    1, &
             -1,    0,    1,    0,    2, &
             -1,    0,    1,    0,    1, &
             -1,   -1,    2,   -1,    2, &
             -2,    2,    0,    2,    2, &
             -1,    0,    1,    0,    0, &
             -4,    1,    2,    2,    2, &
             -3,    0,    2,    1,    1, &
             -2,   -1,    2,    0,    2, &
              1,    0,   -2,    1,    1, &
              2,   -1,   -2,    0,    1, &
             -4,    0,    2,    2,    0, &
             -3,    1,    0,    3,    0, &
             -1,    0,   -1,    2,    0, &
              0,   -2,    0,    0,    2, &
              0,   -2,    0,    0,    2, &
             -3,    0,    0,    3,    0, &
             -2,   -1,    0,    2,    2, &
             -1,    0,   -2,    3,    0, &
             -4,    0,    0,    4,    0, &
              2,    1,   -2,    0,    1, &
              2,   -1,    0,   -2,    2, &
              0,    0,    1,   -1,    0, &
             -1,    2,    0,    1,    0, &
             -2,    1,    2,    0,    2, &
              1,    1,    0,   -1,    1, &
              1,    0,    1,   -2,    1, &
              0,    2,    0,    0,    2, &
              1,   -1,    2,   -3,    1, &
             -1,    1,    2,   -1,    1, &
             -2,    0,    4,   -2,    2, &
             -2,    0,    4,   -2,    1, &
             -2,   -2,    0,    2,    1, &
             -2,    0,   -2,    4,    0, &
              1,    2,    2,   -4,    1, &
              1,    1,    2,   -4,    2, &
             -1,    2,    2,   -2,    1, &
              2,    0,    0,   -3,    1, &
             -1,    2,    0,    0,    1, &
              0,    0,    0,   -2,    0, &
             -1,   -1,    2,   -2,    2, &
             -1,    1,    0,    0,    2, &
              0,    0,    0,   -1,    2, &
             -2,    1,    0,    1,    0, &
              1,   -2,    0,   -2,    1, &
              1,    0,   -2,    0,    2, &
             -3,    1,    0,    2,    0, &
             -1,    1,   -2,    2,    0, &
             -1,   -1,    0,    0,    2, &
             -3,    0,    0,    2,    0, &
             -3,   -1,    0,    2,    0, &
              2,    0,    2,   -6,    1, &
              0,    1,    2,   -4,    2, &
              2,    0,    0,   -4,    2, &
             -2,    1,    2,   -2,    1, &
              0,   -1,    2,   -4,    1, &
              0,    1,    0,   -2,    2, &
             -1,    0,    0,   -2,    0, &
              2,    0,   -2,   -2,    1, &
             -4,    0,    2,    0,    1, &
             -1,   -1,    0,   -1,    1, &
              0,    0,   -2,    0,    2, &
             -3,    0,    0,    1,    0, &
             -1,    0,   -2,    1,    0, &
             -2,    0,   -2,    2,    1, &
              0,    0,   -4,    2,    0, &
             -2,   -1,   -2,    2,    0, &
              1,    0,    2,   -6,    1, &
             -1,    0,    2,   -4,    2, &
              1,    0,    0,   -4,    2, &
              2,    1,    2,   -4,    2, &
              2,    1,    2,   -4,    1, &
              0,    1,    4,   -4,    4, &
              0,    1,    4,   -4,    2, &
             -1,   -1,   -2,    4,    0, &
             -1,   -3,    0,    2,    0, &
             -1,    0,   -2,    4,    1, &
             -2,   -1,    0,    3,    0, &
              0,    0,   -2,    3,    0, &
             -2,    0,    0,    3,    1, &
              0,   -1,    0,    1,    0, &
             -3,    0,    2,    2,    0, &
              1,    1,   -2,    2,    0, &
             -1,    1,    0,    2,    2, &
              1,   -2,    2,   -2,    1, &
              0,    0,    1,    0,    2, &
              0,    0,    1,    0,    1, &
              0,    0,    1,    0,    0, &
             -1,    2,    0,    2,    1, &
              0,    0,    2,    0,    2, &
             -2,    0,    2,    0,    2, &
              2,    0,    0,   -1,    1, &
              3,    0,    0,   -2,    1, &
              1,    0,    2,   -2,    3, &
              1,    2,    0,    0,    1, &
              2,    0,    2,   -3,    2, &
             -1,    1,    4,   -2,    2, &
             -2,   -2,    0,    4,    0, &
              0,   -3,    0,    2,    0, &
              0,    0,   -2,    4,    0, &
             -1,   -1,    0,    3,    0, &
             -2,    0,    0,    4,    2, &
             -1,    0,    0,    3,    1, &
              2,   -2,    0,    0,    0, &
              1,   -1,    0,    1,    0, &
             -1,    0,    0,    2,    0, &
              0,   -2,    2,    0,    1, &
             -1,    0,    1,    2,    1, &
             -1,    1,    0,    3,    0, &
             -1,   -1,    2,    1,    2, &
              0,   -1,    2,    0,    0, &
             -2,    1,    2,    2,    1, &
              2,   -2,    2,   -2,    2, &
              1,    1,    0,    1,    1, &
              1,    0,    1,    0,    1, &
              1,    0,    1,    0,    0, &
              0,    2,    0,    2,    0, &
              2,   -1,    2,   -2,    1, &
              0,   -1,    4,   -2,    1, &
              0,    0,    4,   -2,    3, &
              0,    1,    4,   -2,    1, &
              4,    0,    2,   -4,    2, &
              2,    2,    2,   -2,    2, &
              2,    0,    4,   -4,    2, &
             -1,   -2,    0,    4,    0, &
             -1,   -3,    2,    2,    2, &
             -3,    0,    2,    4,    2, &
             -3,    0,    2,   -2,    1, &
             -1,   -1,    0,   -2,    1, &
             -3,    0,    0,    0,    2, &
             -3,    0,   -2,    2,    0, &
              0,    1,    0,   -4,    1, &
             -2,    1,    0,   -2,    1, &
             -4,    0,    0,    0,    1, &
             -1,    0,    0,   -4,    1, &
             -3,    0,    0,   -2,    1, &
              0,    0,    0,    3,    2, &
             -1,    1,    0,    4,    1, &
              1,   -2,    2,    0,    1, &
              0,    1,    0,    3,    0, &
             -1,    0,    2,    2,    3, &
              0,    0,    2,    2,    2, &
             -2,    0,    2,    2,    2, &
             -1,    1,    2,    2,    0, &
              3,    0,    0,    0,    2, &
              2,    1,    0,    1,    0, &
              2,   -1,    2,   -1,    2, &
              0,    0,    2,    0,    1, &
              0,    0,    3,    0,    3, &
              0,    0,    3,    0,    2, &
             -1,    2,    2,    2,    1, &
             -1,    0,    4,    0,    0, &
              1,    2,    2,    0,    1, &
              3,    1,    2,   -2,    1, &
              1,    1,    4,   -2,    2, &
             -2,   -1,    0,    6,    0, &
              0,   -2,    0,    4,    0, &
             -2,    0,    0,    6,    1, &
             -2,   -2,    2,    4,    2, &
              0,   -3,    2,    2,    2, &
              0,    0,    0,    4,    2, &
             -1,   -1,    2,    3,    2, &
             -2,    0,    2,    4,    0, &
              2,   -1,    0,    2,    1, &
              1,    0,    0,    3,    0, &
              0,    1,    0,    4,    1, &
              0,    1,    0,    4,    0, &
              1,   -1,    2,    1,    2, &
              0,    0,    2,    2,    3, &
              1,    0,    2,    2,    2, &
             -1,    0,    2,    2,    2, &
             -2,    0,    4,    2,    1, &
              2,    1,    0,    2,    1, &
              2,    1,    0,    2,    0, &
              2,   -1,    2,    0,    0, &
              1,    0,    2,    1,    0, &
              0,    1,    2,    2,    0, &
              2,    0,    2,    0,    3, &
              3,    0,    2,    0,    2, &
              1,    0,    2,    0,    2, &
              1,    0,    3,    0,    3, &
              1,    1,    2,    1,    1, &
              0,    2,    2,    2,    2, &
              2,    1,    2,    0,    0, &
              2,    0,    4,   -2,    1, &
              4,    1,    2,   -2,    2, &
             -1,   -1,    0,    6,    0, &
             -3,   -1,    2,    6,    2, &
             -1,    0,    0,    6,    1, &
             -3,    0,    2,    6,    1, &
              1,   -1,    0,    4,    1, &
              1,   -1,    0,    4,    0, &
             -2,    0,    2,    5,    2, &
              1,   -2,    2,    2,    1, &
              3,   -1,    0,    2,    0, &
              1,   -1,    2,    2,    0, &
              0,    0,    2,    3,    1, &
             -1,    1,    2,    4,    1, &
              0,    1,    2,    3,    2, &
             -1,    0,    4,    2,    1, &
              2,    0,    2,    1,    1, &
              5,    0,    0,    0,    0, &
              2,    1,    2,    1,    2, &
              1,    0,    4,    0,    1, &
              3,    1,    2,    0,    1, &
              3,    0,    4,   -2,    2, &
             -2,   -1,    2,    6,    2, &
              0,    0,    0,    6,    0, &
              0,   -2,    2,    4,    2, &
             -2,    0,    2,    6,    1, &
              2,    0,    0,    4,    1, &
              2,    0,    0,    4,    0, &
              2,   -2,    2,    2,    2, &
              0,    0,    2,    4,    0, &
              1,    0,    2,    3,    2, &
              4,    0,    0,    2,    0, &
              2,    0,    2,    2,    0, &
              0,    0,    4,    2,    2, &
              4,   -1,    2,    0,    2, &
              3,    0,    2,    1,    2, &
              2,    1,    2,    2,    1, &
              4,    1,    2,    0,    2, &
             -1,   -1,    2,    6,    2, &
             -1,    0,    2,    6,    1, &
              1,   -1,    2,    4,    1, &
              1,    1,    2,    4,    2, &
              3,    1,    2,    2,    2, &
              5,    0,    2,    0,    1, &
              2,   -1,    2,    4,    2, &
              2,    0,    2,    4,    1 ], [5,nls])

    !
    !  Luni-Solar nutation coefficients, unit 1e-7 arcsec
    !  longitude (sin, t*sin, cos), obliquity (cos, t*cos, sin)
    !
    real(wp),dimension(6,nls),parameter :: cls = reshape([&
     -172064161.0_wp, -174666.0_wp,  33386.0_wp, 92052331.0_wp,  9086.0_wp, 15377.0_wp, &
      -13170906.0_wp,   -1675.0_wp, -13696.0_wp,  5730336.0_wp, -3015.0_wp, -4587.0_wp, &
       -2276413.0_wp,    -234.0_wp,   2796.0_wp,   978459.0_wp,  -485.0_wp,  1374.0_wp, &
        2074554.0_wp,     207.0_wp,   -698.0_wp,  -897492.0_wp,   470.0_wp,  -291.0_wp, &
        1475877.0_wp,   -3633.0_wp,  11817.0_wp,    73871.0_wp,  -184.0_wp, -1924.0_wp, &
        -516821.0_wp,    1226.0_wp,   -524.0_wp,   224386.0_wp,  -677.0_wp,  -174.0_wp, &
         711159.0_wp,      73.0_wp,   -872.0_wp,    -6750.0_wp,     0.0_wp,   358.0_wp, &
        -387298.0_wp,    -367.0_wp,    380.0_wp,   200728.0_wp,    18.0_wp,   318.0_wp, &
        -301461.0_wp,     -36.0_wp,    816.0_wp,   129025.0_wp,   -63.0_wp,   367.0_wp, &
         215829.0_wp,    -494.0_wp,    111.0_wp,   -95929.0_wp,   299.0_wp,   132.0_wp, &
         128227.0_wp,     137.0_wp,    181.0_wp,   -68982.0_wp,    -9.0_wp,    39.0_wp, &
         123457.0_wp,      11.0_wp,     19.0_wp,   -53311.0_wp,    32.0_wp,    -4.0_wp, &
         156994.0_wp,      10.0_wp,   -168.0_wp,    -1235.0_wp,     0.0_wp,    82.0_wp, &
          63110.0_wp,      63.0_wp,     27.0_wp,   -33228.0_wp,     0.0_wp,    -9.0_wp, &
         -57976.0_wp,     -63.0_wp,   -189.0_wp,    31429.0_wp,     0.0_wp,   -75.0_wp, &
         -59641.0_wp,     -11.0_wp,    149.0_wp,    25543.0_wp,   -11.0_wp,    66.0_wp, &
         -51613.0_wp,     -42.0_wp,    129.0_wp,    26366.0_wp,     0.0_wp,    78.0_wp, &
          45893.0_wp,      50.0_wp,     31.0_wp,   -24236.0_wp,   -10.0_wp,    20.0_wp, &
          63384.0_wp,      11.0_wp,   -150.0_wp,    -1220.0_wp,     0.0_wp,    29.0_wp, &
         -38571.0_wp,      -1.0_wp,    158.0_wp,    16452.0_wp,   -11.0_wp,    68.0_wp, &
          32481.0_wp,       0.0_wp,      0.0_wp,   -13870.0_wp,     0.0_wp,     0.0_wp, &
         -47722.0_wp,       0.0_wp,    -18.0_wp,      477.0_wp,     0.0_wp,   -25.0_wp, &
         -31046.0_wp,      -1.0_wp,    131.0_wp,    13238.0_wp,   -11.0_wp,    59.0_wp, &
          28593.0_wp,       0.0_wp,     -1.0_wp,   -12338.0_wp,    10.0_wp,    -3.0_wp, &
          20441.0_wp,      21.0_wp,     10.0_wp,   -10758.0_wp,     0.0_wp,    -3.0_wp, &
          29243.0_wp,       0.0_wp,    -74.0_wp,     -609.0_wp,     0.0_wp,    13.0_wp, &
          25887.0_wp,       0.0_wp,    -66.0_wp,     -550.0_wp,     0.0_wp,    11.0_wp, &
         -14053.0_wp,     -25.0_wp,     79.0_wp,     8551.0_wp,    -2.0_wp,   -45.0_wp, &
          15164.0_wp,      10.0_wp,     11.0_wp,    -8001.0_wp,     0.0_wp,    -1.0_wp, &
         -15794.0_wp,      72.0_wp,    -16.0_wp,     6850.0_wp,   -42.0_wp,    -5.0_wp, &
          21783.0_wp,       0.0_wp,     13.0_wp,     -167.0_wp,     0.0_wp,    13.0_wp, &
         -12873.0_wp,     -10.0_wp,    -37.0_wp,     6953.0_wp,     0.0_wp,   -14.0_wp, &
         -12654.0_wp,      11.0_wp,     63.0_wp,     6415.0_wp,     0.0_wp,    26.0_wp, &
         -10204.0_wp,       0.0_wp,     25.0_wp,     5222.0_wp,     0.0_wp,    15.0_wp, &
          16707.0_wp,     -85.0_wp,    -10.0_wp,      168.0_wp,    -1.0_wp,    10.0_wp, &
          -7691.0_wp,       0.0_wp,     44.0_wp,     3268.0_wp,     0.0_wp,    19.0_wp, &
         -11024.0_wp,       0.0_wp,    -14.0_wp,      104.0_wp,     0.0_wp,     2.0_wp, &
           7566.0_wp,     -21.0_wp,    -11.0_wp,    -3250.0_wp,     0.0_wp,    -5.0_wp, &
          -6637.0_wp,     -11.0_wp,     25.0_wp,     3353.0_wp,     0.0_wp,    14.0_wp, &
          -7141.0_wp,      21.0_wp,      8.0_wp,     3070.0_wp,     0.0_wp,     4.0_wp, &
          -6302.0_wp,     -11.0_wp,      2.0_wp,     3272.0_wp,     0.0_wp,     4.0_wp, &
           5800.0_wp,      10.0_wp,      2.0_wp,    -3045.0_wp,     0.0_wp,    -1.0_wp, &
           6443.0_wp,       0.0_wp,     -7.0_wp,    -2768.0_wp,     0.0_wp,    -4.0_wp, &
          -5774.0_wp,     -11.0_wp,    -15.0_wp,     3041.0_wp,     0.0_wp,    -5.0_wp, &
          -5350.0_wp,       0.0_wp,     21.0_wp,     2695.0_wp,     0.0_wp,    12.0_wp, &
          -4752.0_wp,     -11.0_wp,     -3.0_wp,     2719.0_wp,     0.0_wp,    -3.0_wp, &
          -4940.0_wp,     -11.0_wp,    -21.0_wp,     2720.0_wp,     0.0_wp,    -9.0_wp, &
           7350.0_wp,       0.0_wp,     -8.0_wp,      -51.0_wp,     0.0_wp,     4.0_wp, &
           4065.0_wp,       0.0_wp,      6.0_wp,    -2206.0_wp,     0.0_wp,     1.0_wp, &
           6579.0_wp,       0.0_wp,    -24.0_wp,     -199.0_wp,     0.0_wp,     2.0_wp, &
           3579.0_wp,       0.0_wp,      5.0_wp,    -1900.0_wp,     0.0_wp,     1.0_wp, &
           4725.0_wp,       0.0_wp,     -6.0_wp,      -41.0_wp,     0.0_wp,     3.0_wp, &
          -3075.0_wp,       0.0_wp,     -2.0_wp,     1313.0_wp,     0.0_wp,    -1.0_wp, &
          -2904.0_wp,       0.0_wp,     15.0_wp,     1233.0_wp,     0.0_wp,     7.0_wp, &
           4348.0_wp,       0.0_wp,    -10.0_wp,      -81.0_wp,     0.0_wp,     2.0_wp, &
          -2878.0_wp,       0.0_wp,      8.0_wp,     1232.0_wp,     0.0_wp,     4.0_wp, &
          -4230.0_wp,       0.0_wp,      5.0_wp,      -20.0_wp,     0.0_wp,    -2.0_wp, &
          -2819.0_wp,       0.0_wp,      7.0_wp,     1207.0_wp,     0.0_wp,     3.0_wp, &
          -4056.0_wp,       0.0_wp,      5.0_wp,       40.0_wp,     0.0_wp,    -2.0_wp, &
          -2647.0_wp,       0.0_wp,     11.0_wp,     1129.0_wp,     0.0_wp,     5.0_wp, &
          -2294.0_wp,       0.0_wp,    -10.0_wp,     1266.0_wp,     0.0_wp,    -4.0_wp, &
           2481.0_wp,       0.0_wp,     -7.0_wp,    -1062.0_wp,     0.0_wp,    -3.0_wp, &
           2179.0_wp,       0.0_wp,     -2.0_wp,    -1129.0_wp,     0.0_wp,    -2.0_wp, &
           3276.0_wp,       0.0_wp,      1.0_wp,       -9.0_wp,     0.0_wp,     0.0_wp, &
          -3389.0_wp,       0.0_wp,      5.0_wp,       35.0_wp,     0.0_wp,    -2.0_wp, &
           3339.0_wp,       0.0_wp,    -13.0_wp,     -107.0_wp,     0.0_wp,     1.0_wp, &
          -1987.0_wp,       0.0_wp,     -6.0_wp,     1073.0_wp,     0.0_wp,    -2.0_wp, &
          -1981.0_wp,       0.0_wp,      0.0_wp,      854.0_wp,     0.0_wp,     0.0_wp, &
           4026.0_wp,       0.0_wp,   -353.0_wp,     -553.0_wp,     0.0_wp,  -139.0_wp, &
           1660.0_wp,       0.0_wp,     -5.0_wp,     -710.0_wp,     0.0_wp,    -2.0_wp, &
          -1521.0_wp,       0.0_wp,      9.0_wp,      647.0_wp,     0.0_wp,     4.0_wp, &
           1314.0_wp,       0.0_wp,      0.0_wp,     -700.0_wp,     0.0_wp,     0.0_wp, &
          -1283.0_wp,       0.0_wp,      0.0_wp,      672.0_wp,     0.0_wp,     0.0_wp, &
          -1331.0_wp,       0.0_wp,      8.0_wp,      663.0_wp,     0.0_wp,     4.0_wp, &
           1383.0_wp,       0.0_wp,     -2.0_wp,     -594.0_wp,     0.0_wp,    -2.0_wp, &
           1405.0_wp,       0.0_wp,      4.0_wp,     -610.0_wp,     0.0_wp,     2.0_wp, &
           1290.0_wp,       0.0_wp,      0.0_wp,     -556.0_wp,     0.0_wp,     0.0_wp, &
          -1214.0_wp,       0.0_wp,      5.0_wp,      518.0_wp,     0.0_wp,     2.0_wp, &
           1146.0_wp,       0.0_wp,     -3.0_wp,     -490.0_wp,     0.0_wp,    -1.0_wp, &
           1019.0_wp,       0.0_wp,     -1.0_wp,     -527.0_wp,     0.0_wp,    -1.0_wp, &
          -1100.0_wp,       0.0_wp,      9.0_wp,      465.0_wp,     0.0_wp,     4.0_wp, &
           -970.0_wp,       0.0_wp,      2.0_wp,      496.0_wp,     0.0_wp,     1.0_wp, &
           1575.0_wp,       0.0_wp,     -6.0_wp,      -50.0_wp,     0.0_wp,     0.0_wp, &
            934.0_wp,       0.0_wp,     -3.0_wp,     -399.0_wp,     0.0_wp,    -1.0_wp, &
            922.0_wp,       0.0_wp,     -1.0_wp,     -395.0_wp,     0.0_wp,    -1.0_wp, &
            815.0_wp,       0.0_wp,     -1.0_wp,     -422.0_wp,     0.0_wp,    -1.0_wp, &
            834.0_wp,       0.0_wp,      2.0_wp,     -440.0_wp,     0.0_wp,     1.0_wp, &
           1248.0_wp,       0.0_wp,      0.0_wp,     -170.0_wp,     0.0_wp,     1.0_wp, &
           1338.0_wp,       0.0_wp,     -5.0_wp,      -39.0_wp,     0.0_wp,     0.0_wp, &
            716.0_wp,       0.0_wp,     -2.0_wp,     -389.0_wp,     0.0_wp,    -1.0_wp, &
           1282.0_wp,       0.0_wp,     -3.0_wp,      -23.0_wp,     0.0_wp,     1.0_wp, &
            742.0_wp,       0.0_wp,      1.0_wp,     -391.0_wp,     0.0_wp,     0.0_wp, &
           1020.0_wp,       0.0_wp,    -25.0_wp,     -495.0_wp,     0.0_wp,   -10.0_wp, &
            715.0_wp,       0.0_wp,     -4.0_wp,     -326.0_wp,     0.0_wp,     2.0_wp, &
           -666.0_wp,       0.0_wp,     -3.0_wp,      369.0_wp,     0.0_wp,    -1.0_wp, &
           -667.0_wp,       0.0_wp,      1.0_wp,      346.0_wp,     0.0_wp,     1.0_wp, &
           -704.0_wp,       0.0_wp,      0.0_wp,      304.0_wp,     0.0_wp,     0.0_wp, &
           -694.0_wp,       0.0_wp,      5.0_wp,      294.0_wp,     0.0_wp,     2.0_wp, &
          -1014.0_wp,       0.0_wp,     -1.0_wp,        4.0_wp,     0.0_wp,    -1.0_wp, &
           -585.0_wp,       0.0_wp,     -2.0_wp,      316.0_wp,     0.0_wp,    -1.0_wp, &
           -949.0_wp,       0.0_wp,      1.0_wp,        8.0_wp,     0.0_wp,    -1.0_wp, &
           -595.0_wp,       0.0_wp,      0.0_wp,      258.0_wp,     0.0_wp,     0.0_wp, &
            528.0_wp,       0.0_wp,      0.0_wp,     -279.0_wp,     0.0_wp,     0.0_wp, &
           -590.0_wp,       0.0_wp,      4.0_wp,      252.0_wp,     0.0_wp,     2.0_wp, &
            570.0_wp,       0.0_wp,     -2.0_wp,     -244.0_wp,     0.0_wp,    -1.0_wp, &
           -502.0_wp,       0.0_wp,      3.0_wp,      250.0_wp,     0.0_wp,     2.0_wp, &
           -875.0_wp,       0.0_wp,      1.0_wp,       29.0_wp,     0.0_wp,     0.0_wp, &
           -492.0_wp,       0.0_wp,     -3.0_wp,      275.0_wp,     0.0_wp,    -1.0_wp, &
            535.0_wp,       0.0_wp,     -2.0_wp,     -228.0_wp,     0.0_wp,    -1.0_wp, &
           -467.0_wp,       0.0_wp,      1.0_wp,      240.0_wp,     0.0_wp,     1.0_wp, &
            591.0_wp,       0.0_wp,      0.0_wp,     -253.0_wp,     0.0_wp,     0.0_wp, &
           -453.0_wp,       0.0_wp,     -1.0_wp,      244.0_wp,     0.0_wp,    -1.0_wp, &
            766.0_wp,       0.0_wp,      1.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
           -446.0_wp,       0.0_wp,      2.0_wp,      225.0_wp,     0.0_wp,     1.0_wp, &
           -488.0_wp,       0.0_wp,      2.0_wp,      207.0_wp,     0.0_wp,     1.0_wp, &
           -468.0_wp,       0.0_wp,      0.0_wp,      201.0_wp,     0.0_wp,     0.0_wp, &
           -421.0_wp,       0.0_wp,      1.0_wp,      216.0_wp,     0.0_wp,     1.0_wp, &
            463.0_wp,       0.0_wp,      0.0_wp,     -200.0_wp,     0.0_wp,     0.0_wp, &
           -673.0_wp,       0.0_wp,      2.0_wp,       14.0_wp,     0.0_wp,     0.0_wp, &
            658.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
           -438.0_wp,       0.0_wp,      0.0_wp,      188.0_wp,     0.0_wp,     0.0_wp, &
           -390.0_wp,       0.0_wp,      0.0_wp,      205.0_wp,     0.0_wp,     0.0_wp, &
            639.0_wp,     -11.0_wp,     -2.0_wp,      -19.0_wp,     0.0_wp,     0.0_wp, &
            412.0_wp,       0.0_wp,     -2.0_wp,     -176.0_wp,     0.0_wp,    -1.0_wp, &
           -361.0_wp,       0.0_wp,      0.0_wp,      189.0_wp,     0.0_wp,     0.0_wp, &
            360.0_wp,       0.0_wp,     -1.0_wp,     -185.0_wp,     0.0_wp,    -1.0_wp, &
            588.0_wp,       0.0_wp,     -3.0_wp,      -24.0_wp,     0.0_wp,     0.0_wp, &
           -578.0_wp,       0.0_wp,      1.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
           -396.0_wp,       0.0_wp,      0.0_wp,      171.0_wp,     0.0_wp,     0.0_wp, &
            565.0_wp,       0.0_wp,     -1.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
           -335.0_wp,       0.0_wp,     -1.0_wp,      184.0_wp,     0.0_wp,    -1.0_wp, &
            357.0_wp,       0.0_wp,      1.0_wp,     -154.0_wp,     0.0_wp,     0.0_wp, &
            321.0_wp,       0.0_wp,      1.0_wp,     -174.0_wp,     0.0_wp,     0.0_wp, &
           -301.0_wp,       0.0_wp,     -1.0_wp,      162.0_wp,     0.0_wp,     0.0_wp, &
           -334.0_wp,       0.0_wp,      0.0_wp,      144.0_wp,     0.0_wp,     0.0_wp, &
            493.0_wp,       0.0_wp,     -2.0_wp,      -15.0_wp,     0.0_wp,     0.0_wp, &
            494.0_wp,       0.0_wp,     -2.0_wp,      -19.0_wp,     0.0_wp,     0.0_wp, &
            337.0_wp,       0.0_wp,     -1.0_wp,     -143.0_wp,     0.0_wp,    -1.0_wp, &
            280.0_wp,       0.0_wp,     -1.0_wp,     -144.0_wp,     0.0_wp,     0.0_wp, &
            309.0_wp,       0.0_wp,      1.0_wp,     -134.0_wp,     0.0_wp,     0.0_wp, &
           -263.0_wp,       0.0_wp,      2.0_wp,      131.0_wp,     0.0_wp,     1.0_wp, &
            253.0_wp,       0.0_wp,      1.0_wp,     -138.0_wp,     0.0_wp,     0.0_wp, &
            245.0_wp,       0.0_wp,      0.0_wp,     -128.0_wp,     0.0_wp,     0.0_wp, &
            416.0_wp,       0.0_wp,     -2.0_wp,      -17.0_wp,     0.0_wp,     0.0_wp, &
           -229.0_wp,       0.0_wp,      0.0_wp,      128.0_wp,     0.0_wp,     0.0_wp, &
            231.0_wp,       0.0_wp,      0.0_wp,     -120.0_wp,     0.0_wp,     0.0_wp, &
           -259.0_wp,       0.0_wp,      2.0_wp,      109.0_wp,     0.0_wp,     1.0_wp, &
            375.0_wp,       0.0_wp,     -1.0_wp,       -8.0_wp,     0.0_wp,     0.0_wp, &
            252.0_wp,       0.0_wp,      0.0_wp,     -108.0_wp,     0.0_wp,     0.0_wp, &
           -245.0_wp,       0.0_wp,      1.0_wp,      104.0_wp,     0.0_wp,     0.0_wp, &
            243.0_wp,       0.0_wp,     -1.0_wp,     -104.0_wp,     0.0_wp,     0.0_wp, &
            208.0_wp,       0.0_wp,      1.0_wp,     -112.0_wp,     0.0_wp,     0.0_wp, &
            199.0_wp,       0.0_wp,      0.0_wp,     -102.0_wp,     0.0_wp,     0.0_wp, &
           -208.0_wp,       0.0_wp,      1.0_wp,      105.0_wp,     0.0_wp,     0.0_wp, &
            335.0_wp,       0.0_wp,     -2.0_wp,      -14.0_wp,     0.0_wp,     0.0_wp, &
           -325.0_wp,       0.0_wp,      1.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
           -187.0_wp,       0.0_wp,      0.0_wp,       96.0_wp,     0.0_wp,     0.0_wp, &
            197.0_wp,       0.0_wp,     -1.0_wp,     -100.0_wp,     0.0_wp,     0.0_wp, &
           -192.0_wp,       0.0_wp,      2.0_wp,       94.0_wp,     0.0_wp,     1.0_wp, &
           -188.0_wp,       0.0_wp,      0.0_wp,       83.0_wp,     0.0_wp,     0.0_wp, &
            276.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
           -286.0_wp,       0.0_wp,      1.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
            186.0_wp,       0.0_wp,     -1.0_wp,      -79.0_wp,     0.0_wp,     0.0_wp, &
           -219.0_wp,       0.0_wp,      0.0_wp,       43.0_wp,     0.0_wp,     0.0_wp, &
            276.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
           -153.0_wp,       0.0_wp,     -1.0_wp,       84.0_wp,     0.0_wp,     0.0_wp, &
           -156.0_wp,       0.0_wp,      0.0_wp,       81.0_wp,     0.0_wp,     0.0_wp, &
           -154.0_wp,       0.0_wp,      1.0_wp,       78.0_wp,     0.0_wp,     0.0_wp, &
           -174.0_wp,       0.0_wp,      1.0_wp,       75.0_wp,     0.0_wp,     0.0_wp, &
           -163.0_wp,       0.0_wp,      2.0_wp,       69.0_wp,     0.0_wp,     1.0_wp, &
           -228.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             91.0_wp,       0.0_wp,     -4.0_wp,      -54.0_wp,     0.0_wp,    -2.0_wp, &
            175.0_wp,       0.0_wp,      0.0_wp,      -75.0_wp,     0.0_wp,     0.0_wp, &
           -159.0_wp,       0.0_wp,      0.0_wp,       69.0_wp,     0.0_wp,     0.0_wp, &
            141.0_wp,       0.0_wp,      0.0_wp,      -72.0_wp,     0.0_wp,     0.0_wp, &
            147.0_wp,       0.0_wp,      0.0_wp,      -75.0_wp,     0.0_wp,     0.0_wp, &
           -132.0_wp,       0.0_wp,      0.0_wp,       69.0_wp,     0.0_wp,     0.0_wp, &
            159.0_wp,       0.0_wp,    -28.0_wp,      -54.0_wp,     0.0_wp,    11.0_wp, &
            213.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
            123.0_wp,       0.0_wp,      0.0_wp,      -64.0_wp,     0.0_wp,     0.0_wp, &
           -118.0_wp,       0.0_wp,     -1.0_wp,       66.0_wp,     0.0_wp,     0.0_wp, &
            144.0_wp,       0.0_wp,     -1.0_wp,      -61.0_wp,     0.0_wp,     0.0_wp, &
           -121.0_wp,       0.0_wp,      1.0_wp,       60.0_wp,     0.0_wp,     0.0_wp, &
           -134.0_wp,       0.0_wp,      1.0_wp,       56.0_wp,     0.0_wp,     1.0_wp, &
           -105.0_wp,       0.0_wp,      0.0_wp,       57.0_wp,     0.0_wp,     0.0_wp, &
           -102.0_wp,       0.0_wp,      0.0_wp,       56.0_wp,     0.0_wp,     0.0_wp, &
            120.0_wp,       0.0_wp,      0.0_wp,      -52.0_wp,     0.0_wp,     0.0_wp, &
            101.0_wp,       0.0_wp,      0.0_wp,      -54.0_wp,     0.0_wp,     0.0_wp, &
           -113.0_wp,       0.0_wp,      0.0_wp,       59.0_wp,     0.0_wp,     0.0_wp, &
           -106.0_wp,       0.0_wp,      0.0_wp,       61.0_wp,     0.0_wp,     0.0_wp, &
           -129.0_wp,       0.0_wp,      1.0_wp,       55.0_wp,     0.0_wp,     0.0_wp, &
           -114.0_wp,       0.0_wp,      0.0_wp,       57.0_wp,     0.0_wp,     0.0_wp, &
            113.0_wp,       0.0_wp,     -1.0_wp,      -49.0_wp,     0.0_wp,     0.0_wp, &
           -102.0_wp,       0.0_wp,      0.0_wp,       44.0_wp,     0.0_wp,     0.0_wp, &
            -94.0_wp,       0.0_wp,      0.0_wp,       51.0_wp,     0.0_wp,     0.0_wp, &
           -100.0_wp,       0.0_wp,     -1.0_wp,       56.0_wp,     0.0_wp,     0.0_wp, &
             87.0_wp,       0.0_wp,      0.0_wp,      -47.0_wp,     0.0_wp,     0.0_wp, &
            161.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             96.0_wp,       0.0_wp,      0.0_wp,      -50.0_wp,     0.0_wp,     0.0_wp, &
            151.0_wp,       0.0_wp,     -1.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
           -104.0_wp,       0.0_wp,      0.0_wp,       44.0_wp,     0.0_wp,     0.0_wp, &
           -110.0_wp,       0.0_wp,      0.0_wp,       48.0_wp,     0.0_wp,     0.0_wp, &
           -100.0_wp,       0.0_wp,      1.0_wp,       50.0_wp,     0.0_wp,     0.0_wp, &
             92.0_wp,       0.0_wp,     -5.0_wp,       12.0_wp,     0.0_wp,    -2.0_wp, &
             82.0_wp,       0.0_wp,      0.0_wp,      -45.0_wp,     0.0_wp,     0.0_wp, &
             82.0_wp,       0.0_wp,      0.0_wp,      -45.0_wp,     0.0_wp,     0.0_wp, &
            -78.0_wp,       0.0_wp,      0.0_wp,       41.0_wp,     0.0_wp,     0.0_wp, &
            -77.0_wp,       0.0_wp,      0.0_wp,       43.0_wp,     0.0_wp,     0.0_wp, &
              2.0_wp,       0.0_wp,      0.0_wp,       54.0_wp,     0.0_wp,     0.0_wp, &
             94.0_wp,       0.0_wp,      0.0_wp,      -40.0_wp,     0.0_wp,     0.0_wp, &
            -93.0_wp,       0.0_wp,      0.0_wp,       40.0_wp,     0.0_wp,     0.0_wp, &
            -83.0_wp,       0.0_wp,     10.0_wp,       40.0_wp,     0.0_wp,    -2.0_wp, &
             83.0_wp,       0.0_wp,      0.0_wp,      -36.0_wp,     0.0_wp,     0.0_wp, &
            -91.0_wp,       0.0_wp,      0.0_wp,       39.0_wp,     0.0_wp,     0.0_wp, &
            128.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
            -79.0_wp,       0.0_wp,      0.0_wp,       34.0_wp,     0.0_wp,     0.0_wp, &
            -83.0_wp,       0.0_wp,      0.0_wp,       47.0_wp,     0.0_wp,     0.0_wp, &
             84.0_wp,       0.0_wp,      0.0_wp,      -44.0_wp,     0.0_wp,     0.0_wp, &
             83.0_wp,       0.0_wp,      0.0_wp,      -43.0_wp,     0.0_wp,     0.0_wp, &
             91.0_wp,       0.0_wp,      0.0_wp,      -39.0_wp,     0.0_wp,     0.0_wp, &
            -77.0_wp,       0.0_wp,      0.0_wp,       39.0_wp,     0.0_wp,     0.0_wp, &
             84.0_wp,       0.0_wp,      0.0_wp,      -43.0_wp,     0.0_wp,     0.0_wp, &
            -92.0_wp,       0.0_wp,      1.0_wp,       39.0_wp,     0.0_wp,     0.0_wp, &
            -92.0_wp,       0.0_wp,      1.0_wp,       39.0_wp,     0.0_wp,     0.0_wp, &
            -94.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             68.0_wp,       0.0_wp,      0.0_wp,      -36.0_wp,     0.0_wp,     0.0_wp, &
            -61.0_wp,       0.0_wp,      0.0_wp,       32.0_wp,     0.0_wp,     0.0_wp, &
             71.0_wp,       0.0_wp,      0.0_wp,      -31.0_wp,     0.0_wp,     0.0_wp, &
             62.0_wp,       0.0_wp,      0.0_wp,      -34.0_wp,     0.0_wp,     0.0_wp, &
            -63.0_wp,       0.0_wp,      0.0_wp,       33.0_wp,     0.0_wp,     0.0_wp, &
            -73.0_wp,       0.0_wp,      0.0_wp,       32.0_wp,     0.0_wp,     0.0_wp, &
            115.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
           -103.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             63.0_wp,       0.0_wp,      0.0_wp,      -28.0_wp,     0.0_wp,     0.0_wp, &
             74.0_wp,       0.0_wp,      0.0_wp,      -32.0_wp,     0.0_wp,     0.0_wp, &
           -103.0_wp,       0.0_wp,     -3.0_wp,        3.0_wp,     0.0_wp,    -1.0_wp, &
            -69.0_wp,       0.0_wp,      0.0_wp,       30.0_wp,     0.0_wp,     0.0_wp, &
             57.0_wp,       0.0_wp,      0.0_wp,      -29.0_wp,     0.0_wp,     0.0_wp, &
             94.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
             64.0_wp,       0.0_wp,      0.0_wp,      -33.0_wp,     0.0_wp,     0.0_wp, &
            -63.0_wp,       0.0_wp,      0.0_wp,       26.0_wp,     0.0_wp,     0.0_wp, &
            -38.0_wp,       0.0_wp,      0.0_wp,       20.0_wp,     0.0_wp,     0.0_wp, &
            -43.0_wp,       0.0_wp,      0.0_wp,       24.0_wp,     0.0_wp,     0.0_wp, &
            -45.0_wp,       0.0_wp,      0.0_wp,       23.0_wp,     0.0_wp,     0.0_wp, &
             47.0_wp,       0.0_wp,      0.0_wp,      -24.0_wp,     0.0_wp,     0.0_wp, &
            -48.0_wp,       0.0_wp,      0.0_wp,       25.0_wp,     0.0_wp,     0.0_wp, &
             45.0_wp,       0.0_wp,      0.0_wp,      -26.0_wp,     0.0_wp,     0.0_wp, &
             56.0_wp,       0.0_wp,      0.0_wp,      -25.0_wp,     0.0_wp,     0.0_wp, &
             88.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
            -75.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             85.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             49.0_wp,       0.0_wp,      0.0_wp,      -26.0_wp,     0.0_wp,     0.0_wp, &
            -74.0_wp,       0.0_wp,     -3.0_wp,       -1.0_wp,     0.0_wp,    -1.0_wp, &
            -39.0_wp,       0.0_wp,      0.0_wp,       21.0_wp,     0.0_wp,     0.0_wp, &
             45.0_wp,       0.0_wp,      0.0_wp,      -20.0_wp,     0.0_wp,     0.0_wp, &
             51.0_wp,       0.0_wp,      0.0_wp,      -22.0_wp,     0.0_wp,     0.0_wp, &
            -40.0_wp,       0.0_wp,      0.0_wp,       21.0_wp,     0.0_wp,     0.0_wp, &
             41.0_wp,       0.0_wp,      0.0_wp,      -21.0_wp,     0.0_wp,     0.0_wp, &
            -42.0_wp,       0.0_wp,      0.0_wp,       24.0_wp,     0.0_wp,     0.0_wp, &
            -51.0_wp,       0.0_wp,      0.0_wp,       22.0_wp,     0.0_wp,     0.0_wp, &
            -42.0_wp,       0.0_wp,      0.0_wp,       22.0_wp,     0.0_wp,     0.0_wp, &
             39.0_wp,       0.0_wp,      0.0_wp,      -21.0_wp,     0.0_wp,     0.0_wp, &
             46.0_wp,       0.0_wp,      0.0_wp,      -18.0_wp,     0.0_wp,     0.0_wp, &
            -53.0_wp,       0.0_wp,      0.0_wp,       22.0_wp,     0.0_wp,     0.0_wp, &
             82.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
             81.0_wp,       0.0_wp,     -1.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
             47.0_wp,       0.0_wp,      0.0_wp,      -19.0_wp,     0.0_wp,     0.0_wp, &
             53.0_wp,       0.0_wp,      0.0_wp,      -23.0_wp,     0.0_wp,     0.0_wp, &
            -45.0_wp,       0.0_wp,      0.0_wp,       22.0_wp,     0.0_wp,     0.0_wp, &
            -44.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
            -33.0_wp,       0.0_wp,      0.0_wp,       16.0_wp,     0.0_wp,     0.0_wp, &
            -61.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             28.0_wp,       0.0_wp,      0.0_wp,      -15.0_wp,     0.0_wp,     0.0_wp, &
            -38.0_wp,       0.0_wp,      0.0_wp,       19.0_wp,     0.0_wp,     0.0_wp, &
            -33.0_wp,       0.0_wp,      0.0_wp,       21.0_wp,     0.0_wp,     0.0_wp, &
            -60.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             48.0_wp,       0.0_wp,      0.0_wp,      -10.0_wp,     0.0_wp,     0.0_wp, &
             27.0_wp,       0.0_wp,      0.0_wp,      -14.0_wp,     0.0_wp,     0.0_wp, &
             38.0_wp,       0.0_wp,      0.0_wp,      -20.0_wp,     0.0_wp,     0.0_wp, &
             31.0_wp,       0.0_wp,      0.0_wp,      -13.0_wp,     0.0_wp,     0.0_wp, &
            -29.0_wp,       0.0_wp,      0.0_wp,       15.0_wp,     0.0_wp,     0.0_wp, &
             28.0_wp,       0.0_wp,      0.0_wp,      -15.0_wp,     0.0_wp,     0.0_wp, &
            -32.0_wp,       0.0_wp,      0.0_wp,       15.0_wp,     0.0_wp,     0.0_wp, &
             45.0_wp,       0.0_wp,      0.0_wp,       -8.0_wp,     0.0_wp,     0.0_wp, &
            -44.0_wp,       0.0_wp,      0.0_wp,       19.0_wp,     0.0_wp,     0.0_wp, &
             28.0_wp,       0.0_wp,      0.0_wp,      -15.0_wp,     0.0_wp,     0.0_wp, &
            -51.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -36.0_wp,       0.0_wp,      0.0_wp,       20.0_wp,     0.0_wp,     0.0_wp, &
             44.0_wp,       0.0_wp,      0.0_wp,      -19.0_wp,     0.0_wp,     0.0_wp, &
             26.0_wp,       0.0_wp,      0.0_wp,      -14.0_wp,     0.0_wp,     0.0_wp, &
            -60.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             35.0_wp,       0.0_wp,      0.0_wp,      -18.0_wp,     0.0_wp,     0.0_wp, &
            -27.0_wp,       0.0_wp,      0.0_wp,       11.0_wp,     0.0_wp,     0.0_wp, &
             47.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             36.0_wp,       0.0_wp,      0.0_wp,      -15.0_wp,     0.0_wp,     0.0_wp, &
            -36.0_wp,       0.0_wp,      0.0_wp,       20.0_wp,     0.0_wp,     0.0_wp, &
            -35.0_wp,       0.0_wp,      0.0_wp,       19.0_wp,     0.0_wp,     0.0_wp, &
            -37.0_wp,       0.0_wp,      0.0_wp,       19.0_wp,     0.0_wp,     0.0_wp, &
             32.0_wp,       0.0_wp,      0.0_wp,      -16.0_wp,     0.0_wp,     0.0_wp, &
             35.0_wp,       0.0_wp,      0.0_wp,      -14.0_wp,     0.0_wp,     0.0_wp, &
             32.0_wp,       0.0_wp,      0.0_wp,      -13.0_wp,     0.0_wp,     0.0_wp, &
             65.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             47.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             32.0_wp,       0.0_wp,      0.0_wp,      -16.0_wp,     0.0_wp,     0.0_wp, &
             37.0_wp,       0.0_wp,      0.0_wp,      -16.0_wp,     0.0_wp,     0.0_wp, &
            -30.0_wp,       0.0_wp,      0.0_wp,       15.0_wp,     0.0_wp,     0.0_wp, &
            -32.0_wp,       0.0_wp,      0.0_wp,       16.0_wp,     0.0_wp,     0.0_wp, &
            -31.0_wp,       0.0_wp,      0.0_wp,       13.0_wp,     0.0_wp,     0.0_wp, &
             37.0_wp,       0.0_wp,      0.0_wp,      -16.0_wp,     0.0_wp,     0.0_wp, &
             31.0_wp,       0.0_wp,      0.0_wp,      -13.0_wp,     0.0_wp,     0.0_wp, &
             49.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             32.0_wp,       0.0_wp,      0.0_wp,      -13.0_wp,     0.0_wp,     0.0_wp, &
             23.0_wp,       0.0_wp,      0.0_wp,      -12.0_wp,     0.0_wp,     0.0_wp, &
            -43.0_wp,       0.0_wp,      0.0_wp,       18.0_wp,     0.0_wp,     0.0_wp, &
             26.0_wp,       0.0_wp,      0.0_wp,      -11.0_wp,     0.0_wp,     0.0_wp, &
            -32.0_wp,       0.0_wp,      0.0_wp,       14.0_wp,     0.0_wp,     0.0_wp, &
            -29.0_wp,       0.0_wp,      0.0_wp,       14.0_wp,     0.0_wp,     0.0_wp, &
            -27.0_wp,       0.0_wp,      0.0_wp,       12.0_wp,     0.0_wp,     0.0_wp, &
             30.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -11.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -21.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
            -34.0_wp,       0.0_wp,      0.0_wp,       15.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
            -36.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -9.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -21.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -29.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
            -15.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
            -20.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             28.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,    -2.0_wp, &
             17.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -22.0_wp,       0.0_wp,      0.0_wp,       12.0_wp,     0.0_wp,     0.0_wp, &
            -14.0_wp,       0.0_wp,      0.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
             24.0_wp,       0.0_wp,      0.0_wp,      -11.0_wp,     0.0_wp,     0.0_wp, &
             11.0_wp,       0.0_wp,      0.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
             14.0_wp,       0.0_wp,      0.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
             24.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             18.0_wp,       0.0_wp,      0.0_wp,       -8.0_wp,     0.0_wp,     0.0_wp, &
            -38.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -31.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -16.0_wp,       0.0_wp,      0.0_wp,        8.0_wp,     0.0_wp,     0.0_wp, &
             29.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -18.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -17.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
             16.0_wp,       0.0_wp,      0.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
             22.0_wp,       0.0_wp,      0.0_wp,      -12.0_wp,     0.0_wp,     0.0_wp, &
             20.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -13.0_wp,       0.0_wp,      0.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
            -17.0_wp,       0.0_wp,      0.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
            -14.0_wp,       0.0_wp,      0.0_wp,        8.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,      0.0_wp,       -7.0_wp,     0.0_wp,     0.0_wp, &
             14.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             19.0_wp,       0.0_wp,      0.0_wp,      -10.0_wp,     0.0_wp,     0.0_wp, &
            -34.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -20.0_wp,       0.0_wp,      0.0_wp,        8.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
            -18.0_wp,       0.0_wp,      0.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
             13.0_wp,       0.0_wp,      0.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
             17.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
             15.0_wp,       0.0_wp,      0.0_wp,       -8.0_wp,     0.0_wp,     0.0_wp, &
            -11.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             13.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
            -18.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -35.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
            -19.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
            -26.0_wp,       0.0_wp,      0.0_wp,       11.0_wp,     0.0_wp,     0.0_wp, &
              8.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             10.0_wp,       0.0_wp,      0.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
            -21.0_wp,       0.0_wp,      0.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
            -15.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
            -29.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -19.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
             12.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
             22.0_wp,       0.0_wp,      0.0_wp,       -9.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -20.0_wp,       0.0_wp,      0.0_wp,       11.0_wp,     0.0_wp,     0.0_wp, &
            -20.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -17.0_wp,       0.0_wp,      0.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
             15.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              8.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
             14.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
             25.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -13.0_wp,       0.0_wp,      0.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
            -14.0_wp,       0.0_wp,      0.0_wp,        8.0_wp,     0.0_wp,     0.0_wp, &
             13.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
            -17.0_wp,       0.0_wp,      0.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
             10.0_wp,       0.0_wp,      0.0_wp,       -6.0_wp,     0.0_wp,     0.0_wp, &
            -15.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -22.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             28.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             15.0_wp,       0.0_wp,      0.0_wp,       -7.0_wp,     0.0_wp,     0.0_wp, &
             23.0_wp,       0.0_wp,      0.0_wp,      -10.0_wp,     0.0_wp,     0.0_wp, &
             12.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
             29.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
            -25.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             22.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -18.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             15.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
            -23.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             12.0_wp,       0.0_wp,      0.0_wp,       -5.0_wp,     0.0_wp,     0.0_wp, &
             -8.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
            -19.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             21.0_wp,       0.0_wp,      0.0_wp,       -9.0_wp,     0.0_wp,     0.0_wp, &
             23.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
            -16.0_wp,       0.0_wp,      0.0_wp,        8.0_wp,     0.0_wp,     0.0_wp, &
            -19.0_wp,       0.0_wp,      0.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
            -22.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
             27.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             16.0_wp,       0.0_wp,      0.0_wp,       -8.0_wp,     0.0_wp,     0.0_wp, &
             19.0_wp,       0.0_wp,      0.0_wp,       -8.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
             -9.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             -9.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             -8.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             18.0_wp,       0.0_wp,      0.0_wp,       -9.0_wp,     0.0_wp,     0.0_wp, &
             16.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
            -10.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
            -23.0_wp,       0.0_wp,      0.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
             16.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        6.0_wp,     0.0_wp,     0.0_wp, &
             -8.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             30.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             24.0_wp,       0.0_wp,      0.0_wp,      -10.0_wp,     0.0_wp,     0.0_wp, &
             10.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
            -16.0_wp,       0.0_wp,      0.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
            -16.0_wp,       0.0_wp,      0.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
             17.0_wp,       0.0_wp,      0.0_wp,       -7.0_wp,     0.0_wp,     0.0_wp, &
            -24.0_wp,       0.0_wp,      0.0_wp,       10.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -24.0_wp,       0.0_wp,      0.0_wp,       11.0_wp,     0.0_wp,     0.0_wp, &
            -23.0_wp,       0.0_wp,      0.0_wp,        9.0_wp,     0.0_wp,     0.0_wp, &
            -13.0_wp,       0.0_wp,      0.0_wp,        5.0_wp,     0.0_wp,     0.0_wp, &
            -15.0_wp,       0.0_wp,      0.0_wp,        7.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,  -1988.0_wp,        0.0_wp,     0.0_wp, -1679.0_wp, &
              0.0_wp,       0.0_wp,    -63.0_wp,        0.0_wp,     0.0_wp,   -27.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,      5.0_wp,        0.0_wp,     0.0_wp,     4.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,    364.0_wp,        0.0_wp,     0.0_wp,   176.0_wp, &
              0.0_wp,       0.0_wp,  -1044.0_wp,        0.0_wp,     0.0_wp,  -891.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,    330.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,      5.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,    -12.0_wp,        0.0_wp,     0.0_wp,   -10.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -8.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              8.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
            -13.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             10.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             10.0_wp,       0.0_wp,     13.0_wp,        6.0_wp,     0.0_wp,    -5.0_wp, &
              0.0_wp,       0.0_wp,     30.0_wp,        0.0_wp,     0.0_wp,    14.0_wp, &
              0.0_wp,       0.0_wp,   -162.0_wp,        0.0_wp,     0.0_wp,  -138.0_wp, &
              0.0_wp,       0.0_wp,     75.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              9.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,     -3.0_wp,        3.0_wp,     0.0_wp,     1.0_wp, &
              0.0_wp,       0.0_wp,     -3.0_wp,        0.0_wp,     0.0_wp,    -2.0_wp, &
             11.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             11.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -1.0_wp,       0.0_wp,      3.0_wp,        3.0_wp,     0.0_wp,    -1.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,    -13.0_wp,        0.0_wp,     0.0_wp,   -11.0_wp, &
              3.0_wp,       0.0_wp,      6.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              8.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             11.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              8.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             11.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -8.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,    -26.0_wp,        0.0_wp,     0.0_wp,   -11.0_wp, &
              0.0_wp,       0.0_wp,    -10.0_wp,        0.0_wp,     0.0_wp,    -5.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
            -13.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             13.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
            -11.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
            -12.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
              0.0_wp,       0.0_wp,     -5.0_wp,        0.0_wp,     0.0_wp,    -2.0_wp, &
             -7.0_wp,       0.0_wp,      0.0_wp,        4.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             12.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              6.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,       -4.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -5.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        3.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             10.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              7.0_wp,       0.0_wp,      0.0_wp,       -3.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
             11.0_wp,       0.0_wp,      0.0_wp,        0.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -6.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              5.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -4.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp, &
              4.0_wp,       0.0_wp,      0.0_wp,       -2.0_wp,     0.0_wp,     0.0_wp, &
              3.0_wp,       0.0_wp,      0.0_wp,       -1.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        1.0_wp,     0.0_wp,     0.0_wp, &
             -3.0_wp,       0.0_wp,      0.0_wp,        2.0_wp,     0.0_wp,     0.0_wp], [6,nls])

    !
    !  Planetary argument multipliers
    !    :         L   L'  F   D   Om  Me  Ve  E  Ma  Ju  Sa  Ur  Ne  pre

    !  Coefficients for fundamental arguments

    integer,dimension(14,npl),parameter :: napl = reshape( [ &
             0,  0,  0,  0,  0,  0,  0,  8,-16,  4,  5,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -8, 16, -4, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  8,-16,  4,  5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, -1,  2,  2, &
             0,  0,  0,  0,  0,  0,  0, -4,  8, -1, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0,  3, -8,  3,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0, 10, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0, -2,  6, -3,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -5,  8, -3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -4,  8, -3,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  4, -8,  1,  5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  6,  4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  2, -5,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0, -2,  5,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0, -2,  5,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0, -2,  5,  0,  0,  2, &
             2,  0, -1, -1,  0,  0,  0,  3, -7,  0,  0,  0,  0,  0, &
             1,  0,  0, -2,  0,  0, 19,-21,  3,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  2, -4,  0, -3,  0,  0,  0,  0, &
             1,  0,  0, -1,  1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0, -4, 10,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  0,  2,  0,  0, -5,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -7,  4,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  1, -1,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0, 18,-16,  0,  0,  0,  0,  0,  0, &
            -2,  0,  1,  1,  2,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
            -1,  0,  1, -1,  1,  0, 18,-17,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  1,  1,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -8, 13,  0,  0,  0,  0,  0,  2, &
             0,  0,  2, -2,  2,  0, -8, 11,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -8, 13,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -8, 12,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  8,-13,  0,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  8,-14,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  8,-13,  0,  0,  0,  0,  0,  1, &
            -2,  0,  0,  2,  1,  0,  0,  2,  0, -4,  5,  0,  0,  0, &
            -2,  0,  0,  2,  2,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -3,  1,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  3, -5,  0,  2,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -4,  3,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -1,  2,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
            -1,  0,  1,  0,  1,  0,  3, -5,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  1,  0,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -2, -2,  0,  0,  0, &
            -2,  0,  2,  0,  2,  0,  0, -5,  9,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0, -1,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  0,  2,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  2, &
            -1,  0,  0,  1,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  0,  2,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -1,  0,  0,  2,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -9, 17,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  2,  0, -3,  5,  0,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0, -1,  2,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0, &
             1,  0,  0, -2,  0,  0, 17,-16,  0, -2,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  1, -3,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  0,  5, -6,  0,  0,  0,  0,  0, &
             0,  0, -2,  2,  0,  0,  0,  9,-13,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -1,  0,  0,  1,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  1,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  0,  1,  0,  0,  0, &
             0,  0, -2,  2,  0,  0,  5, -6,  0,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  1,  0,  5, -7,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  6, -8,  0,  0,  0,  0,  0,  0, &
             2,  0,  1, -3,  1,  0, -6,  7,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  2,  0,  0,  0,  0,  1,  0,  0,  0,  0, &
             0,  0, -1,  1,  1,  0,  0,  1,  0,  1,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  2,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -8, 15,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -8, 15,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -9, 15,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  8,-15,  0,  0,  0,  0,  0, &
             1,  0, -1, -1,  0,  0,  0,  8,-15,  0,  0,  0,  0,  0, &
             2,  0,  0, -2,  0,  0,  2, -5,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -5,  5,  0,  0,  0, &
             2,  0,  0, -2,  1,  0,  0, -6,  8,  0,  0,  0,  0,  0, &
             2,  0,  0, -2,  1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
            -2,  0,  1,  1,  0,  0,  0,  1,  0, -3,  0,  0,  0,  0, &
            -2,  0,  1,  1,  1,  0,  0,  1,  0, -3,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  6, -8,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -1, -5,  0,  0,  0, &
            -1,  0,  0,  1,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
            -1,  0,  1,  1,  1,  0,-20, 20,  0,  0,  0,  0,  0,  0, &
             1,  0,  0, -2,  0,  0, 20,-21,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  8,-15,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0,-10, 15,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  0,  0,  1,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0, -2,  4,  0,  0,  0, &
             2,  0,  0, -2,  1,  0, -6,  8,  0,  0,  0,  0,  0,  0, &
             0,  0, -2,  2,  1,  0,  5, -6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0, -1,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0, -1,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  1,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  2, &
             0,  0,  2, -2,  1,  0,  0, -9, 13,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  7,-13,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  9,-17,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -9, 17,  0,  0,  0,  0,  2, &
             1,  0,  0, -1,  1,  0,  0, -3,  4,  0,  0,  0,  0,  0, &
             1,  0,  0, -1,  1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  2,  0,  0, -1,  2,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  1,  0,  0,  0,  2,  0,  0,  0,  0,  0, &
             0,  0, -2,  2,  0,  1,  0, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -5,  0,  2,  0,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  0,  2,  0, -3,  1,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  8,-13,  0,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  8,-12,  0,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0, -8, 11,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  1,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
            -1,  0,  0,  0,  1,  0, 18,-16,  0,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0, -1,  1,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  3, -7,  4,  0,  0,  0,  0,  0, &
            -2,  0,  1,  1,  1,  0,  0, -3,  7,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -1,  0, -2,  5,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  0,  0, -2,  5,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
             1,  0,  0,  0,  1,  0,-10,  3,  0,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -2,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  0,  1,  0, 10, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  0,  0,  2, -5,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  2, -5,  0,  0,  0, &
             2,  0, -1, -1,  1,  0,  0,  3, -7,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0,  0, -5,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -3,  7, -4,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             1,  0,  0,  0,  1,  0,-18, 16,  0,  0,  0,  0,  0,  0, &
            -2,  0,  1,  1,  1,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0, -8, 12,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -8, 13,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0,  0, -2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  2,  0,  0,  0,  0,  1, &
            -1,  0,  0,  1,  1,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  1,  1,  0,  0,  3, -4,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0, -2,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  2,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  2, &
             0,  0,  1, -1,  0,  0,  3, -6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -3,  5,  0,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -2,  4,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  5, -7,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  5, -8,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  6, -8,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -8, 15,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
            -2,  0,  0,  2,  1,  0,  0,  6, -8,  0,  0,  0,  0,  0, &
             1,  0,  0, -1,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0, -1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0, -1,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  2, &
             0,  0,  1, -1,  2,  0,  0, -1,  0,  0, -1,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  0,  0,  0, -1,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  0, -1,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -7, 13,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  7,-13,  0,  0,  0,  0,  0, &
             2,  0,  0, -2,  1,  0,  0, -5,  6,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -8, 11,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1, -1,  0,  2,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  3,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  2, &
            -2,  0,  0,  2,  0,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
             0,  0,  0,  0,  2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             2,  0,  0, -2,  1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0,  0, -2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  1, -2,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0,  0, -2,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -2,  0,  0,  2,  0,  0,  0, &
             0,  0,  1, -1,  1,  0,  3, -6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -3,  5,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -3,  5,  0,  0,  0,  0,  0,  2, &
             0,  0,  2, -2,  2,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -3,  5,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0,  1, -4,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -2,  4,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -3,  4,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -2,  4,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0, -2,  4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  8,  0,  0,  0,  0,  0,  2, &
             0,  0,  2, -2,  2,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -5,  8,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  8,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -5,  7,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -5,  8,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0,  0, -1,  0, -1,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  0,  0, -1,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -2,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -6, 11,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6,-11,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0, -1,  0,  4,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  1,  0, -4,  0,  0,  0,  0,  0,  0, &
             2,  0,  0, -2,  1,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  2,  0,  0, -2,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -7,  9,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  2, &
             0,  0,  2, -2,  2,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  5,  0,  0,  2, &
             0,  0,  0,  0,  1,  0,  3, -5,  0,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  2, -4,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -4,  4,  0,  0,  0,  0,  0, &
             0,  0,  1, -1,  2,  0, -5,  7,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -3,  6,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -4,  6,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -3,  6,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0, -3,  6,  0,  0,  0,  0,  2, &
             0,  0, -1,  1,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  2, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -5,  9,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -5,  9,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  5, -9,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
            -2,  0,  1,  1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             0,  0, -2,  2,  0,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -6, 10,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -6, 10,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -2,  3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -2,  3,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0, -1,  0,  3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4, -8,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -4,  8,  0,  0,  0,  0,  2, &
             0,  0, -2,  2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -4,  7,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -4,  7,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  4, -7,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -2,  3,  0,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -5, 10,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  1,  0, -1,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  4,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -3,  5,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -3,  5,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  1, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -1,  2,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -1,  2,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -7, 11,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -7, 11,  0,  0,  0,  0,  0,  1, &
             0,  0, -2,  2,  0,  0,  4, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0, -4,  4,  0,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  4, -5,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -4,  7,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -4,  6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -4,  7,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -4,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -4,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -4,  5,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -4,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0, &
             0,  0, -1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  5,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  3,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -7, 12,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -1,  1,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -1,  1,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -1,  0,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  1, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -2,  5,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  4,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -4,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -6, 10,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -6, 10,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -3,  0,  3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -3,  7,  0,  0,  0,  0,  2, &
            -2,  0,  0,  2,  0,  0,  4, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -5,  8,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  3,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -2,  4,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -2,  3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -2,  4,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -6,  9,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -6,  9,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -4,  6,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -5,  9,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -3,  4,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -3,  4,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  1,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -3,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  1, -5,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  1,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -3,  5,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -2,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -1,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -8, 14,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  2, -5,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  5, -8,  3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  5, -8,  3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  3, -8,  3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -3,  8, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1,  0, -2,  5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 12,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 12,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  1, -2,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  1,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  2,  0,  0,  2, &
             0,  0,  2, -2,  1,  0, -5,  5,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -3,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -3,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  7,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  7,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0, -1,  0,  3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -2,  6,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  1,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -6,  9,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -2,  2,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -2,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  1,  0,  3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -5,  7,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -1,  3,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0, -1,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -1,  3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -7, 10,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -7, 10,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -4,  8,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -4,  5,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -4,  5,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -2,  0,  5,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -9, 13,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  5,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -2,  0,  4,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -4,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -2,  7,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -2,  5,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -2,  5,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -6,  8,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -6,  8,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  6, -8,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  1,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -3,  9,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5, 10,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -3,  3,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -3,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0, -5, 13,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -2,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -2,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -1,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -6, 15,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 15,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -3,  9, -4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  2, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -2,  8, -1, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6, -8,  3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  1, &
             0,  0,  1, -1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -6, 16, -4, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -2,  8, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -2,  8, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6, -8,  1,  5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  3, -5,  4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 11,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 11,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -8, 11,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, 11,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  1,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  3, -3,  0,  2,  0,  0,  0,  2, &
             0,  0,  2, -2,  1,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             0,  0,  1, -1,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  1,  2,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -3,  7,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  0,  2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  6,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  7, -9,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  2, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2, -1,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6, -7,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -1,  4,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -1,  4,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -7,  9,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -7,  9,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  4, -3,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -4,  4,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -3,  0,  5,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -9, 12,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -4,  0,  0,  0,  0, &
             0,  0,  2, -2,  1,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  7, -8,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -3,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -2,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -6,  7,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  6, -7,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5, -4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0, -1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0,  0, -2,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0,  0, -1,  0,  0,  2, &
             0,  0,  2, -2,  1,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0, -8, 16,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0,  2, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  7, -8,  3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -5, 16, -4, -5,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0, -1,  8, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 10,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8, 10,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -8, 10,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  2,  2,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  3,  0,  1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -3,  8,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -5,  5,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  7, -7,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  7, -7,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6, -5,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  7, -8,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  5, -3,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  4, -3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  1,  2,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -9, 11,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -9, 11,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  4,  0, -4,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4,  0, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -6,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  4,  0, -2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6, -4,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4,  0, -1,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4,  0,  0, -2,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5, -2,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  4,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  8, -9,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  5, -4,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -7,  7,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  7, -7,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  5,  0, -4,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5,  0, -3,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  5,  0, -2,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -8,  8,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  8, -8,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  5, -3,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  5, -3,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0, -9,  9,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -9,  9,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0, -9,  9,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  9, -9,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  6, -4,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  1, &
             0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  2, &
             0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2, &
             1,  0,  0, -2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             1,  0,  0, -2,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             1,  0,  0, -2,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             1,  0,  0, -2,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
            -1,  0,  0,  2,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             1,  0,  0, -2,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
            -2,  0,  0,  2,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  2,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             1,  0, -1,  1,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  2,  0,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
            -2,  0,  0,  0,  0,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
             1,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
            -1,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  0,  0,  0, &
             1,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
            -1,  0,  0,  2,  1,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
            -1,  0,  0,  2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
            -1,  0,  0,  2,  0,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
             1,  0,  0, -2,  1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
             1,  0,  2, -2,  2,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
             1,  0,  2, -2,  2,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
             1,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
             1,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  0, -2,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
             0,  0,  0, -2,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0, -2,  3,  0,  0,  0,  0,  0,  0, &
             0,  0,  0,  2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             0,  0,  1,  1,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             1,  0,  2,  0,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  2,  0,  2,  0, 10, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  1,  1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             1,  0,  2,  0,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
            -1,  0,  2,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
             2,  0,  2, -2,  2,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
             1,  0,  2,  0,  1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
             0,  0,  1,  1,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  2,  0,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
            -2,  0,  2,  2,  2,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  2, -3,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
            -1,  0,  2,  2,  2,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
             1,  0,  2,  0,  2,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  2,  2,  2,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
             2,  0,  2,  0,  2,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
             1,  0,  2,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
             1,  0,  2,  0,  2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
             1,  0,  1,  1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  0,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
             2,  0,  2,  0,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
            -1,  0,  2,  2,  2,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
            -1,  0,  2,  2,  2,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
             1,  0,  2,  0,  2,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
             0,  0,  2,  2,  2,  0,  0,  2,  0, -2,  0,  0,  0,  0 ] , [14,npl])

    !
    !  Planetary nutation coefficients, unit 1e-7 arcsec
    !  longitude (sin, cos), obliquity (sin, cos)
    !

    !  Longitude and obliquity coefficients
    integer,dimension(4,npl),parameter :: icpl = reshape([ &
           1440,          0,          0,          0, &
             56,       -117,        -42,        -40, &
            125,        -43,          0,        -54, &
              0,          5,          0,          0, &
              3,         -7,         -3,          0, &
              3,          0,          0,         -2, &
           -114,          0,          0,         61, &
           -219,         89,          0,          0, &
             -3,          0,          0,          0, &
           -462,       1604,          0,          0, &
             99,          0,          0,        -53, &
             -3,          0,          0,          2, &
              0,          6,          2,          0, &
              3,          0,          0,          0, &
            -12,          0,          0,          0, &
             14,       -218,        117,          8, &
             31,       -481,       -257,        -17, &
           -491,        128,          0,          0, &
          -3084,       5123,       2735,       1647, &
          -1444,       2409,      -1286,       -771, &
             11,        -24,        -11,         -9, &
             26,         -9,          0,          0, &
            103,        -60,          0,          0, &
              0,        -13,         -7,          0, &
            -26,        -29,        -16,         14, &
              9,        -27,        -14,         -5, &
             12,          0,          0,         -6, &
             -7,          0,          0,          0, &
              0,         24,          0,          0, &
            284,          0,          0,       -151, &
            226,        101,          0,          0, &
              0,         -8,         -2,          0, &
              0,         -6,         -3,          0, &
              5,          0,          0,         -3, &
            -41,        175,         76,         17, &
              0,         15,          6,          0, &
            425,        212,       -133,        269, &
           1200,        598,        319,       -641, &
            235,        334,          0,          0, &
             11,        -12,         -7,         -6, &
              5,         -6,          3,          3, &
             -5,          0,          0,          3, &
              6,          0,          0,         -3, &
             15,          0,          0,          0, &
             13,          0,          0,         -7, &
             -6,         -9,          0,          0, &
            266,        -78,          0,          0, &
           -460,       -435,       -232,        246, &
              0,         15,          7,          0, &
             -3,          0,          0,          2, &
              0,        131,          0,          0, &
              4,          0,          0,          0, &
              0,          3,          0,          0, &
              0,          4,          2,          0, &
              0,          3,          0,          0, &
            -17,        -19,        -10,          9, &
             -9,        -11,          6,         -5, &
             -6,          0,          0,          3, &
            -16,          8,          0,          0, &
              0,          3,          0,          0, &
             11,         24,         11,         -5, &
             -3,         -4,         -2,          1, &
              3,          0,          0,         -1, &
              0,         -8,         -4,          0, &
              0,          3,          0,          0, &
              0,          5,          0,          0, &
              0,          3,          2,          0, &
             -6,          4,          2,          3, &
             -3,         -5,          0,          0, &
             -5,          0,          0,          2, &
              4,         24,         13,         -2, &
            -42,         20,          0,          0, &
            -10,        233,          0,          0, &
             -3,          0,          0,          1, &
             78,        -18,          0,          0, &
              0,          3,          1,          0, &
              0,         -3,         -1,          0, &
              0,         -4,         -2,          1, &
              0,         -8,         -4,         -1, &
              0,         -5,          3,          0, &
             -7,          0,          0,          3, &
            -14,          8,          3,          6, &
              0,          8,         -4,          0, &
              0,         19,         10,          0, &
             45,        -22,          0,          0, &
             -3,          0,          0,          0, &
              0,         -3,          0,          0, &
              0,          3,          0,          0, &
              3,          5,          3,         -2, &
             89,        -16,         -9,        -48, &
              0,          3,          0,          0, &
             -3,          7,          4,          2, &
           -349,        -62,          0,          0, &
            -15,         22,          0,          0, &
             -3,          0,          0,          0, &
            -53,          0,          0,          0, &
              5,          0,          0,         -3, &
              0,         -8,          0,          0, &
             15,         -7,         -4,         -8, &
             -3,          0,          0,          1, &
            -21,        -78,          0,          0, &
             20,        -70,        -37,        -11, &
              0,          6,          3,          0, &
              5,          3,          2,         -2, &
            -17,         -4,         -2,          9, &
              0,          6,          3,          0, &
             32,         15,         -8,         17, &
            174,         84,         45,        -93, &
             11,         56,          0,          0, &
            -66,        -12,         -6,         35, &
             47,          8,          4,        -25, &
              0,          8,          4,          0, &
             10,        -22,        -12,         -5, &
             -3,          0,          0,          2, &
            -24,         12,          0,          0, &
              5,         -6,          0,          0, &
              3,          0,          0,         -2, &
              4,          3,          1,         -2, &
              0,         29,         15,          0, &
             -5,         -4,         -2,          2, &
              8,         -3,         -1,         -5, &
              0,         -3,          0,          0, &
             10,          0,          0,          0, &
              3,          0,          0,         -2, &
             -5,          0,          0,          3, &
             46,         66,         35,        -25, &
            -14,          7,          0,          0, &
              0,          3,          2,          0, &
             -5,          0,          0,          0, &
            -68,        -34,        -18,         36, &
              0,         14,          7,          0, &
             10,         -6,         -3,         -5, &
             -5,         -4,         -2,          3, &
             -3,          5,          2,          1, &
             76,         17,          9,        -41, &
             84,        298,        159,        -45, &
              3,          0,          0,         -1, &
             -3,          0,          0,          2, &
             -3,          0,          0,          1, &
            -82,        292,        156,         44, &
            -73,         17,          9,         39, &
             -9,        -16,          0,          0, &
              3,          0,         -1,         -2, &
             -3,          0,          0,          0, &
             -9,         -5,         -3,          5, &
           -439,          0,          0,          0, &
             57,        -28,        -15,        -30, &
              0,         -6,         -3,          0, &
             -4,          0,          0,          2, &
            -40,         57,         30,         21, &
             23,          7,          3,        -13, &
            273,         80,         43,       -146, &
           -449,        430,          0,          0, &
             -8,        -47,        -25,          4, &
              6,         47,         25,         -3, &
              0,         23,         13,          0, &
             -3,          0,          0,          2, &
              3,         -4,         -2,         -2, &
            -48,       -110,        -59,         26, &
             51,        114,         61,        -27, &
           -133,          0,          0,         57, &
              0,          4,          0,          0, &
            -21,         -6,         -3,         11, &
              0,         -3,         -1,          0, &
            -11,        -21,        -11,          6, &
            -18,       -436,       -233,          9, &
             35,         -7,          0,          0, &
              0,          5,          3,          0, &
             11,         -3,         -1,         -6, &
             -5,         -3,         -1,          3, &
            -53,         -9,         -5,         28, &
              0,          3,          2,          1, &
              4,          0,          0,         -2, &
              0,         -4,          0,          0, &
            -50,        194,        103,         27, &
            -13,         52,         28,          7, &
            -91,        248,          0,          0, &
              6,         49,         26,         -3, &
             -6,        -47,        -25,          3, &
              0,          5,          3,          0, &
             52,         23,         10,        -23, &
             -3,          0,          0,          1, &
              0,          5,          3,          0, &
             -4,          0,          0,          0, &
             -4,          8,          3,          2, &
             10,          0,          0,          0, &
              3,          0,          0,         -2, &
              0,          8,          4,          0, &
              0,          8,          4,          1, &
             -4,          0,          0,          0, &
             -4,          0,          0,          0, &
             -8,          4,          2,          4, &
              8,         -4,         -2,         -4, &
              0,         15,          7,          0, &
           -138,          0,          0,          0, &
              0,         -7,         -3,          0, &
              0,         -7,         -3,          0, &
             54,          0,          0,        -29, &
              0,         10,          4,          0, &
             -7,          0,          0,          3, &
            -37,         35,         19,         20, &
              0,          4,          0,          0, &
             -4,          9,          0,          0, &
              8,          0,          0,         -4, &
             -9,        -14,         -8,          5, &
             -3,         -9,         -5,          3, &
           -145,         47,          0,          0, &
            -10,         40,         21,          5, &
             11,        -49,        -26,         -7, &
          -2150,          0,          0,        932, &
            -12,          0,          0,          5, &
             85,          0,          0,        -37, &
              4,          0,          0,         -2, &
              3,          0,          0,         -2, &
            -86,        153,          0,          0, &
             -6,          9,          5,          3, &
              9,        -13,         -7,         -5, &
             -8,         12,          6,          4, &
            -51,          0,          0,         22, &
            -11,       -268,       -116,          5, &
              0,         12,          5,          0, &
              0,          7,          3,          0, &
             31,          6,          3,        -17, &
            140,         27,         14,        -75, &
             57,         11,          6,        -30, &
            -14,        -39,          0,          0, &
              0,         -6,         -2,          0, &
              4,         15,          8,         -2, &
              0,          4,          0,          0, &
             -3,          0,          0,          1, &
              0,         11,          5,          0, &
              9,          6,          0,          0, &
             -4,         10,          4,          2, &
              5,          3,          0,          0, &
             16,          0,          0,         -9, &
             -3,          0,          0,          0, &
              0,          3,          2,         -1, &
              7,          0,          0,         -3, &
            -25,         22,          0,          0, &
             42,        223,        119,        -22, &
            -27,       -143,        -77,         14, &
              9,         49,         26,         -5, &
          -1166,          0,          0,        505, &
             -5,          0,          0,          2, &
             -6,          0,          0,          3, &
             -8,          0,          1,          4, &
              0,         -4,          0,          0, &
            117,          0,          0,        -63, &
             -4,          8,          4,          2, &
              3,          0,          0,         -2, &
             -5,          0,          0,          2, &
              0,         31,          0,          0, &
             -5,          0,          1,          3, &
              4,          0,          0,         -2, &
             -4,          0,          0,          2, &
            -24,        -13,         -6,         10, &
              3,          0,          0,          0, &
              0,        -32,        -17,          0, &
              8,         12,          5,         -3, &
              3,          0,          0,         -1, &
              7,         13,          0,          0, &
             -3,         16,          0,          0, &
             50,          0,          0,        -27, &
              0,         -5,         -3,          0, &
             13,          0,          0,          0, &
              0,          5,          3,          1, &
             24,          5,          2,        -11, &
              5,        -11,         -5,         -2, &
             30,         -3,         -2,        -16, &
             18,          0,          0,         -9, &
              8,        614,          0,          0, &
              3,         -3,         -1,         -2, &
              6,         17,          9,         -3, &
             -3,         -9,         -5,          2, &
              0,          6,          3,         -1, &
           -127,         21,          9,         55, &
              3,          5,          0,          0, &
             -6,        -10,         -4,          3, &
              5,          0,          0,          0, &
             16,          9,          4,         -7, &
              3,          0,          0,         -2, &
              0,         22,          0,          0, &
              0,         19,         10,          0, &
              7,          0,          0,         -4, &
              0,         -5,         -2,          0, &
              0,          3,          1,          0, &
             -9,          3,          1,          4, &
             17,          0,          0,         -7, &
              0,         -3,         -2,         -1, &
            -20,         34,          0,          0, &
            -10,          0,          1,          5, &
             -4,          0,          0,          2, &
             22,        -87,          0,          0, &
             -4,          0,          0,          2, &
             -3,         -6,         -2,          1, &
            -16,         -3,         -1,          7, &
              0,         -3,         -2,          0, &
              4,          0,          0,          0, &
            -68,         39,          0,          0, &
             27,          0,          0,        -14, &
              0,         -4,          0,          0, &
            -25,          0,          0,          0, &
            -12,         -3,         -2,          6, &
              3,          0,          0,         -1, &
              3,         66,         29,         -1, &
            490,          0,          0,       -213, &
            -22,         93,         49,         12, &
             -7,         28,         15,          4, &
             -3,         13,          7,          2, &
            -46,         14,          0,          0, &
             -5,          0,          0,          0, &
              2,          1,          0,          0, &
              0,         -3,          0,          0, &
            -28,          0,          0,         15, &
              5,          0,          0,         -2, &
              0,          3,          0,          0, &
            -11,          0,          0,          5, &
              0,          3,          1,          0, &
             -3,          0,          0,          1, &
             25,        106,         57,        -13, &
              5,         21,         11,         -3, &
           1485,          0,          0,          0, &
             -7,        -32,        -17,          4, &
              0,          5,          3,          0, &
             -6,         -3,         -2,          3, &
             30,         -6,         -2,        -13, &
             -4,          4,          0,          0, &
            -19,          0,          0,         10, &
              0,          4,          2,         -1, &
              0,          3,          0,          0, &
              4,          0,          0,         -2, &
              0,         -3,         -1,          0, &
             -3,          0,          0,          0, &
              5,          3,          1,         -2, &
              0,         11,          0,          0, &
            118,          0,          0,        -52, &
              0,         -5,         -3,          0, &
            -28,         36,          0,          0, &
              5,         -5,          0,          0, &
             14,        -59,        -31,         -8, &
              0,          9,          5,          1, &
           -458,          0,          0,        198, &
              0,        -45,        -20,          0, &
              9,          0,          0,         -5, &
              0,         -3,          0,          0, &
              0,         -4,         -2,         -1, &
             11,          0,          0,         -6, &
              6,          0,          0,         -2, &
            -16,         23,          0,          0, &
              0,         -4,         -2,          0, &
             -5,          0,          0,          2, &
           -166,        269,          0,          0, &
             15,          0,          0,         -8, &
             10,          0,          0,         -4, &
            -78,         45,          0,          0, &
              0,         -5,         -2,          0, &
              7,          0,          0,         -4, &
             -5,        328,          0,          0, &
              3,          0,          0,         -2, &
              5,          0,          0,         -2, &
              0,          3,          1,          0, &
             -3,          0,          0,          0, &
             -3,          0,          0,          0, &
              0,         -4,         -2,          0, &
          -1223,        -26,          0,          0, &
              0,          7,          3,          0, &
              3,          0,          0,          0, &
              0,          3,          2,          0, &
             -6,         20,          0,          0, &
           -368,          0,          0,          0, &
            -75,          0,          0,          0, &
             11,          0,          0,         -6, &
              3,          0,          0,         -2, &
             -3,          0,          0,          1, &
            -13,        -30,          0,          0, &
             21,          3,          0,          0, &
             -3,          0,          0,          1, &
             -4,          0,          0,          2, &
              8,        -27,          0,          0, &
            -19,        -11,          0,          0, &
             -4,          0,          0,          2, &
              0,          5,          2,          0, &
             -6,          0,          0,          2, &
             -8,          0,          0,          0, &
             -1,          0,          0,          0, &
            -14,          0,          0,          6, &
              6,          0,          0,          0, &
            -74,          0,          0,         32, &
              0,         -3,         -1,          0, &
              4,          0,          0,         -2, &
              8,         11,          0,          0, &
              0,          3,          2,          0, &
           -262,          0,          0,        114, &
              0,         -4,          0,          0, &
             -7,          0,          0,          4, &
              0,        -27,        -12,          0, &
            -19,         -8,         -4,          8, &
            202,          0,          0,        -87, &
             -8,         35,         19,          5, &
              0,          4,          2,          0, &
             16,         -5,          0,          0, &
              5,          0,          0,         -3, &
              0,         -3,          0,          0, &
              1,          0,          0,          0, &
            -35,        -48,        -21,         15, &
             -3,         -5,         -2,          1, &
              6,          0,          0,         -3, &
              3,          0,          0,         -1, &
              0,         -5,          0,          0, &
             12,         55,         29,         -6, &
              0,          5,          3,          0, &
           -598,          0,          0,          0, &
             -3,        -13,         -7,          1, &
             -5,         -7,         -3,          2, &
              3,          0,          0,         -1, &
              5,         -7,          0,          0, &
              4,          0,          0,         -2, &
             16,         -6,          0,          0, &
              8,         -3,          0,          0, &
              8,        -31,        -16,         -4, &
              0,          3,          1,          0, &
            113,          0,          0,        -49, &
              0,        -24,        -10,          0, &
              4,          0,          0,         -2, &
             27,          0,          0,          0, &
             -3,          0,          0,          1, &
              0,         -4,         -2,          0, &
              5,          0,          0,         -2, &
              0,         -3,          0,          0, &
            -13,          0,          0,          6, &
              5,          0,          0,         -2, &
            -18,        -10,         -4,          8, &
             -4,        -28,          0,          0, &
             -5,          6,          3,          2, &
             -3,          0,          0,          1, &
             -5,         -9,         -4,          2, &
             17,          0,          0,         -7, &
             11,          4,          0,          0, &
              0,         -6,         -2,          0, &
             83,         15,          0,          0, &
             -4,          0,          0,          2, &
              0,       -114,        -49,          0, &
            117,          0,          0,        -51, &
             -5,         19,         10,          2, &
             -3,          0,          0,          0, &
             -3,          0,          0,          2, &
              0,         -3,         -1,          0, &
              3,          0,          0,          0, &
              0,         -6,         -2,          0, &
            393,          3,          0,          0, &
             -4,         21,         11,          2, &
             -6,          0,         -1,          3, &
             -3,          8,          4,          1, &
              8,          0,          0,          0, &
             18,        -29,        -13,         -8, &
              8,         34,         18,         -4, &
             89,          0,          0,          0, &
              3,         12,          6,         -1, &
             54,        -15,         -7,        -24, &
              0,          3,          0,          0, &
              3,          0,          0,         -1, &
              0,         35,          0,          0, &
           -154,        -30,        -13,         67, &
             15,          0,          0,          0, &
              0,          4,          2,          0, &
              0,          9,          0,          0, &
             80,        -71,        -31,        -35, &
              0,        -20,         -9,          0, &
             11,          5,          2,         -5, &
             61,        -96,        -42,        -27, &
             14,          9,          4,         -6, &
            -11,         -6,         -3,          5, &
              0,         -3,         -1,          0, &
            123,       -415,       -180,        -53, &
              0,          0,          0,        -35, &
             -5,          0,          0,          0, &
              7,        -32,        -17,         -4, &
              0,         -9,         -5,          0, &
              0,         -4,          2,          0, &
            -89,          0,          0,         38, &
              0,        -86,        -19,         -6, &
              0,          0,        -19,          6, &
           -123,       -416,       -180,         53, &
              0,         -3,         -1,          0, &
             12,         -6,         -3,         -5, &
            -13,          9,          4,          6, &
              0,        -15,         -7,          0, &
              3,          0,          0,         -1, &
            -62,        -97,        -42,         27, &
            -11,          5,          2,          5, &
              0,        -19,         -8,          0, &
             -3,          0,          0,          1, &
              0,          4,          2,          0, &
              0,          3,          0,          0, &
              0,          4,          2,          0, &
            -85,        -70,        -31,         37, &
            163,        -12,         -5,        -72, &
            -63,        -16,         -7,         28, &
            -21,        -32,        -14,          9, &
              0,         -3,         -1,          0, &
              3,          0,          0,         -2, &
              0,          8,          0,          0, &
              3,         10,          4,         -1, &
              3,          0,          0,         -1, &
              0,         -7,         -3,          0, &
              0,         -4,         -2,          0, &
              6,         19,          0,          0, &
              5,       -173,        -75,         -2, &
              0,         -7,         -3,          0, &
              7,        -12,         -5,         -3, &
             -3,          0,          0,          2, &
              3,         -4,         -2,         -1, &
             74,          0,          0,        -32, &
             -3,         12,          6,          2, &
             26,        -14,         -6,        -11, &
             19,          0,          0,         -8, &
              6,         24,         13,         -3, &
             83,          0,          0,          0, &
              0,        -10,         -5,          0, &
             11,         -3,         -1,         -5, &
              3,          0,          1,         -1, &
              3,          0,          0,         -1, &
             -4,          0,          0,          0, &
              5,        -23,        -12,         -3, &
           -339,          0,          0,        147, &
              0,        -10,         -5,          0, &
              5,          0,          0,          0, &
              3,          0,          0,         -1, &
              0,         -4,         -2,          0, &
             18,         -3,          0,          0, &
              9,        -11,         -5,         -4, &
             -8,          0,          0,          4, &
              3,          0,          0,         -1, &
              0,          9,          0,          0, &
              6,         -9,         -4,         -2, &
             -4,        -12,          0,          0, &
             67,        -91,        -39,        -29, &
             30,        -18,         -8,        -13, &
              0,          0,          0,          0, &
              0,       -114,        -50,          0, &
              0,          0,          0,         23, &
            517,         16,          7,       -224, &
              0,         -7,         -3,          0, &
            143,         -3,         -1,        -62, &
             29,          0,          0,        -13, &
             -4,          0,          0,          2, &
             -6,          0,          0,          3, &
              5,         12,          5,         -2, &
            -25,          0,          0,         11, &
             -3,          0,          0,          1, &
              0,          4,          2,          0, &
            -22,         12,          5,         10, &
             50,          0,          0,        -22, &
              0,          7,          4,          0, &
              0,          3,          1,          0, &
             -4,          4,          2,          2, &
             -5,        -11,         -5,          2, &
              0,          4,          2,          0, &
              4,         17,          9,         -2, &
             59,          0,          0,          0, &
              0,         -4,         -2,          0, &
             -8,          0,          0,          4, &
             -3,          0,          0,          0, &
              4,        -15,         -8,         -2, &
            370,         -8,          0,       -160, &
              0,          0,         -3,          0, &
              0,          3,          1,          0, &
             -6,          3,          1,          3, &
              0,          6,          0,          0, &
            -10,          0,          0,          4, &
              0,          9,          4,          0, &
              4,         17,          7,         -2, &
             34,          0,          0,        -15, &
              0,          5,          3,          0, &
             -5,          0,          0,          2, &
            -37,         -7,         -3,         16, &
              3,         13,          7,         -2, &
             40,          0,          0,          0, &
              0,         -3,         -2,          0, &
           -184,         -3,         -1,         80, &
             -3,          0,          0,          1, &
             -3,          0,          0,          0, &
              0,        -10,         -6,         -1, &
             31,         -6,          0,        -13, &
             -3,        -32,        -14,          1, &
             -7,          0,          0,          3, &
              0,         -8,         -4,          0, &
              3,         -4,          0,          0, &
              0,          4,          0,          0, &
              0,          3,          1,          0, &
             19,        -23,        -10,          2, &
              0,          0,          0,        -10, &
              0,          3,          2,          0, &
              0,          9,          5,         -1, &
             28,          0,          0,          0, &
              0,         -7,         -4,          0, &
              8,         -4,          0,         -4, &
              0,          0,         -2,          0, &
              0,          3,          0,          0, &
             -3,          0,          0,          1, &
             -9,          0,          1,          4, &
              3,         12,          5,         -1, &
             17,         -3,         -1,          0, &
              0,          7,          4,          0, &
             19,          0,          0,          0, &
              0,         -5,         -3,          0, &
             14,         -3,          0,         -1, &
              0,          0,         -1,          0, &
              0,          0,          0,         -5, &
              0,          5,          3,          0, &
             13,          0,          0,          0, &
              0,         -3,         -2,          0, &
              2,          9,          4,          3, &
              0,          0,          0,         -4, &
              8,          0,          0,          0, &
              0,          4,          2,          0, &
              6,          0,          0,         -3, &
              6,          0,          0,          0, &
              0,          3,          1,          0, &
              5,          0,          0,         -2, &
              3,          0,          0,         -1, &
             -3,          0,          0,          0, &
              6,          0,          0,          0, &
              7,          0,          0,          0, &
             -4,          0,          0,          0, &
              4,          0,          0,          0, &
              6,          0,          0,          0, &
              0,         -4,          0,          0, &
              0,         -4,          0,          0, &
              5,          0,          0,          0, &
             -3,          0,          0,          0, &
              4,          0,          0,          0, &
             -5,          0,          0,          0, &
              4,          0,          0,          0, &
              0,          3,          0,          0, &
             13,          0,          0,          0, &
             21,         11,          0,          0, &
              0,         -5,          0,          0, &
              0,         -5,         -2,          0, &
              0,          5,          3,          0, &
              0,         -5,          0,          0, &
             -3,          0,          0,          2, &
             20,         10,          0,          0, &
            -34,          0,          0,          0, &
            -19,          0,          0,          0, &
              3,          0,          0,         -2, &
             -3,          0,          0,          1, &
             -6,          0,          0,          3, &
             -4,          0,          0,          0, &
              3,          0,          0,          0, &
              3,          0,          0,          0, &
              4,          0,          0,          0, &
              3,          0,          0,         -1, &
              6,          0,          0,         -3, &
             -8,          0,          0,          3, &
              0,          3,          1,          0, &
             -3,          0,          0,          0, &
              0,         -3,         -2,          0, &
            126,        -63,        -27,        -55, &
             -5,          0,          1,          2, &
             -3,         28,         15,          2, &
              5,          0,          1,         -2, &
              0,          9,          4,          1, &
              0,          9,          4,         -1, &
           -126,        -63,        -27,         55, &
              3,          0,          0,         -1, &
             21,        -11,         -6,        -11, &
              0,         -4,          0,          0, &
            -21,        -11,         -6,         11, &
             -3,          0,          0,          1, &
              0,          3,          1,          0, &
              8,          0,          0,         -4, &
             -6,          0,          0,          3, &
             -3,          0,          0,          1, &
              3,          0,          0,         -1, &
             -3,          0,          0,          1, &
             -5,          0,          0,          2, &
             24,        -12,         -5,        -11, &
              0,          3,          1,          0, &
              0,          3,          1,          0, &
              0,          3,          2,          0, &
            -24,        -12,         -5,         10, &
              4,          0,         -1,         -2, &
             13,          0,          0,         -6, &
              7,          0,          0,         -3, &
              3,          0,          0,         -1, &
              3,          0,          0,         -1 ], [4,npl])

    !  Interval between fundamental date J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  -------------------
    !  LUNI-SOLAR NUTATION
    !  -------------------

    !
    !  Fundamental (Delaunay) arguments
    !

    !  Mean anomaly of the Moon (IERS 2003).
    el = FAL03 ( t )

    !  Mean anomaly of the Sun (MHB2000).
    elp = mod (       1287104.79305_wp + &
                t*( 129596581.0481_wp + &
                t*(       - 0.5532_wp + &
                t*(         0.000136_wp + &
                t*(       - 0.00001149_wp )))), turnas ) * das2r

    !  Mean longitude of the Moon minus that of the ascending node
    !  (IERS 2003.
    f = FAF03 ( t )

    !  Mean elongation of the Moon from the Sun (MHB2000).
    d = mod (        1072260.70369_wp + &
              t*( 1602961601.2090_wp + &
              t*(        - 6.3706_wp + &
              t*(          0.006593_wp + &
              t*(        - 0.00003169_wp )))), turnas ) * das2r

    !  Mean longitude of the ascending node of the Moon (IERS 2003).
    om = FAOM03 ( t )

    !  Initialize the nutation values.
    dp = 0.0_wp
    de = 0.0_wp

    !  Summation of luni-solar nutation series (in reverse order).
    do i = nls, 1, -1

       !  Argument and functions.
       arg = mod ( real ( nals(1,i), wp ) * el  + &
                   real ( nals(2,i), wp ) * elp + &
                   real ( nals(3,i), wp ) * f   + &
                   real ( nals(4,i), wp ) * d   + &
                   real ( nals(5,i), wp ) * om, d2pi )
       sarg = sin(arg)
       carg = cos(arg)

       !  Term.
       dp = dp + ( cls(1,i) + cls(2,i) * t ) * sarg &
               +   cls(3,i)                  * carg
       de = de + ( cls(4,i) + cls(5,i) * t ) * carg &
               +   cls(6,i)                  * sarg

    end do

    !  Convert from 0.1 microarcsec units to radians.
    dpsils = dp * u2r
    depsls = de * u2r

    !  ------------------
    !  PLANETARY NUTATION
    !  ------------------

    !  n.b.  The MHB2000 code computes the luni-solar and planetary nutation
    !        in different routines, using slightly different Delaunay
    !        arguments in the two cases.  This behaviour is faithfully
    !        reproduced here.  Use of the IERS 2003 expressions for both
    !        cases leads to negligible changes, well below
    !        0.1 microarcsecond.

    !  Mean anomaly of the Moon (MHB2000).
    al = mod ( 2.35555598_wp + 8328.6914269554_wp * t, d2pi )

    !  Mean anomaly of the Sun (MHB2000).
    alsu = mod ( 6.24006013_wp + 628.301955_wp * t, d2pi )

    !  Mean longitude of the Moon minus that of the ascending node
    ! (MHB2000).
    af = mod ( 1.627905234_wp + 8433.466158131_wp * t, d2pi )

    !  Mean elongation of the Moon from the Sun (MHB2000).
    ad = mod ( 5.198466741_wp + 7771.3771468121_wp * t, d2pi )

    !  Mean longitude of the ascending node of the Moon (MHB2000).
    aom = mod ( 2.18243920_wp - 33.757045_wp * t, d2pi )

    !  General accumulated precession in longitude (IERS 2003).
    apa = FAPA03 ( t )

    !  Planetary longitudes, Mercury through Uranus (IERS 2003).
    alme = FAME03 ( t )
    alve = FAVE03 ( t )
    alea = FAE03 ( t )
    alma = FAMA03 ( t )
    alju = FAJU03 ( t )
    alsa = FASA03 ( t )
    alur = FAUR03 ( t )

    !  Neptune longitude (MHB2000).
    alne = mod ( 5.321159000_wp + 3.8127774000_wp * t, d2pi )

    !  Initialize the nutation values.
    dp = 0.0_wp
    de = 0.0_wp

    !  Summation of planetary nutation series (in reverse order).
    do i = npl, 1, -1

       !  Argument and functions.
       arg = mod ( real ( napl( 1,i), wp ) * al   + &
                   real ( napl( 2,i), wp ) * alsu + &
                   real ( napl( 3,i), wp ) * af   + &
                   real ( napl( 4,i), wp ) * ad   + &
                   real ( napl( 5,i), wp ) * aom  + &
                   real ( napl( 6,i), wp ) * alme + &
                   real ( napl( 7,i), wp ) * alve + &
                   real ( napl( 8,i), wp ) * alea + &
                   real ( napl( 9,i), wp ) * alma + &
                   real ( napl(10,i), wp ) * alju + &
                   real ( napl(11,i), wp ) * alsa + &
                   real ( napl(12,i), wp ) * alur + &
                   real ( napl(13,i), wp ) * alne + &
                   real ( napl(14,i), wp ) * apa, d2pi )
       sarg = sin(arg)
       carg = cos(arg)

       !  Term.
       dp = dp + real(icpl(1,i), wp) * sarg + real(icpl(2,i), wp) * carg
       de = de + real(icpl(3,i), wp) * sarg + real(icpl(4,i), wp) * carg

    end do

    !  Convert from 0.1 microarcsec units to radians.
    dpsipl = dp * u2r
    depspl = de * u2r

    !  -------
    !  RESULTS
    !  -------

    !  Add luni-solar and planetary components.
    dpsi = dpsils + dpsipl
    deps = depsls + depspl

    end subroutine NUT00A
!***********************************************************************

!***********************************************************************
!>
!  Nutation, IAU 2000B model.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The nutation components in longitude and obliquity are in radians
!     and with respect to the equinox and ecliptic of date.  The
!     obliquity at J2000.0 is assumed to be the Lieske et al. (1977)
!     value of 84381.448 arcsec.  (The errors that result from using
!     this routine with the IAU 2006 value of 84381.406 arcsec can be
!     neglected.)
!
!     The nutation model consists only of luni-solar terms, but includes
!     also a fixed offset which compensates for certain long-period
!     planetary terms (Note 7).
!
!  3. This routine is an implementation of the IAU 2000B abridged
!     nutation model formally adopted by the IAU General Assembly in
!     2000.  The routine computes the MHB_2000_SHORT luni-solar nutation
!     series (Luzum 2001), but without the associated corrections for
!     the precession rate adjustments and the offset between the GCRS
!     and J2000.0 mean poles.
!
!  4. The full IAU 2000A (MHB2000) nutation model contains nearly 1400
!     terms.  The IAU 2000B model (McCarthy & Luzum 2003) contains only
!     77 terms, plus additional simplifications, yet still delivers
!     results of 1 mas accuracy at present epochs.  This combination of
!     accuracy and size makes the IAU 2000B abridged nutation model
!     suitable for most practical applications.
!
!     The routine delivers a pole accurate to 1 mas from 1900 to 2100
!     (usually better than 1 mas, very occasionally just outside 1 mas).
!     The full IAU 2000A model, which is implemented in the routine
!     NUT00A (q.v.), delivers considerably greater accuracy at
!     current epochs;  however, to realize this improved accuracy,
!     corrections for the essentially unpredictable free-core-nutation
!     (FCN) must also be included.
!
!  5. The present routine provides classical nutation.  The
!     MHB_2000_SHORT algorithm, from which it is adapted, deals also
!     with (i) the offsets between the GCRS and mean poles and (ii) the
!     adjustments in longitude and obliquity due to the changed
!     precession rates.  These additional functions, namely frame bias
!     and precession adjustments, are supported by the SOFA routines
!     BI00 and PR00.
!
!  6. The MHB_2000_SHORT algorithm also provides "total" nutations,
!     comprising the arithmetic sum of the frame bias, precession
!     adjustments, and nutation (luni-solar + planetary).  These total
!     nutations can be used in combination with an existing IAU 1976
!     precession implementation, such as PMAT76, to deliver GCRS-to-
!     true predictions of mas accuracy at current epochs.  However, for
!     symmetry with the NUT00A routine (q.v. for the reasons), the
!     SOFA routines do not generate the "total nutations" directly.
!     Should they be required, they could of course easily be generated
!     by calling BI00, PR00 and the present routine and adding
!     the results.
!
!  7. The IAU 2000B model includes "planetary bias" terms that are fixed
!     in size but compensate for long-period nutations.  The amplitudes
!     quoted in McCarthy & Luzum (2003), namely Dpsi = -1.5835 mas and
!     Depsilon = +1.6339 mas, are optimized for the "total nutations"
!     method described in Note 6.  The Luzum (2001) values used in this
!     SOFA implementation, namely -0.135 mas and +0.388 mas, are
!     optimized for the "rigorous" method, where frame bias, precession
!     and nutation are applied separately and in that order.  During the
!     interval 1995-2050, the SOFA implementation delivers a maximum
!     error of 1.001 mas (not including FCN).
!
!### References
!
!  * Lieske, J.H., Lederle, T., Fricke, W., Morando, B., "Expressions
!    for the precession quantities based upon the IAU /1976/ system of
!    astronomical constants", Astron.Astrophys. 58, 1-2, 1-16. (1977)
!
!  * Luzum, B., private communication, 2001 (Fortran code
!    MHB_2000_SHORT)
!
!  * McCarthy, D.D. & Luzum, B.J., "An abridged model of the
!    precession-nutation of the celestial pole", Cel.Mech.Dyn.Astron.
!    85, 37-49 (2003)
!
!  * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G., Laskar, J., Astron.Astrophys. 282, 663-683 (1994)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine NUT00B ( date1, date2, dpsi, deps )

    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(out) :: dpsi !! nutation, luni-solar + planetary (Note 2)
    real(wp),intent(out) :: deps !! nutation, luni-solar + planetary (Note 2)

    !  Milliarcseconds to radians
    real(wp),parameter :: dmas2r = das2r / 1.0e3_wp

    !  Arcseconds in a full circle
    real(wp),parameter :: turnas = 1296000.0_wp

    !  Units of 0.1 microarcsecond to radians
    real(wp),parameter :: u2r = das2r/1.0e7_wp

    !  Miscellaneous
    real(wp) :: t, el, elp, f, d, om, arg, dp, de, sarg, carg, &
                     dpsils, depsls, dpsipl, depspl
    integer :: i, j

    !  -------------------------
    !  Luni-Solar nutation model
    !  -------------------------

    !  Number of terms in the luni-solar nutation model
    integer,parameter :: nls = 77

    !  ---------------------------------------
    !  Fixed offset in lieu of planetary terms (radians)
    !  ---------------------------------------

    real(wp),parameter :: dpplan = - 0.135_wp * dmas2r
    real(wp),parameter :: deplan = + 0.388_wp * dmas2r

    !  ----------------------------------------
    !  Tables of argument and term coefficients
    !  ----------------------------------------

    !
    !  Luni-Solar argument multipliers:
    !
    !               L     L'    F     D     Om

    !  Coefficients for fundamental arguments
    integer,dimension(5,nls),parameter :: nals = reshape([ &
              0,    0,    0,    0,    1, &
              0,    0,    2,   -2,    2, &
              0,    0,    2,    0,    2, &
              0,    0,    0,    0,    2, &
              0,    1,    0,    0,    0, &
              0,    1,    2,   -2,    2, &
              1,    0,    0,    0,    0, &
              0,    0,    2,    0,    1, &
              1,    0,    2,    0,    2, &
              0,   -1,    2,   -2,    2, &
              0,    0,    2,   -2,    1, &
             -1,    0,    2,    0,    2, &
             -1,    0,    0,    2,    0, &
              1,    0,    0,    0,    1, &
             -1,    0,    0,    0,    1, &
             -1,    0,    2,    2,    2, &
              1,    0,    2,    0,    1, &
             -2,    0,    2,    0,    1, &
              0,    0,    0,    2,    0, &
              0,    0,    2,    2,    2, &
              0,   -2,    2,   -2,    2, &
             -2,    0,    0,    2,    0, &
              2,    0,    2,    0,    2, &
              1,    0,    2,   -2,    2, &
             -1,    0,    2,    0,    1, &
              2,    0,    0,    0,    0, &
              0,    0,    2,    0,    0, &
              0,    1,    0,    0,    1, &
             -1,    0,    0,    2,    1, &
              0,    2,    2,   -2,    2, &
              0,    0,   -2,    2,    0, &
              1,    0,    0,   -2,    1, &
              0,   -1,    0,    0,    1, &
             -1,    0,    2,    2,    1, &
              0,    2,    0,    0,    0, &
              1,    0,    2,    2,    2, &
             -2,    0,    2,    0,    0, &
              0,    1,    2,    0,    2, &
              0,    0,    2,    2,    1, &
              0,   -1,    2,    0,    2, &
              0,    0,    0,    2,    1, &
              1,    0,    2,   -2,    1, &
              2,    0,    2,   -2,    2, &
             -2,    0,    0,    2,    1, &
              2,    0,    2,    0,    1, &
              0,   -1,    2,   -2,    1, &
              0,    0,    0,   -2,    1, &
             -1,   -1,    0,    2,    0, &
              2,    0,    0,   -2,    1, &
              1,    0,    0,    2,    0, &
              0,    1,    2,   -2,    1, &
              1,   -1,    0,    0,    0, &
             -2,    0,    2,    0,    2, &
              3,    0,    2,    0,    2, &
              0,   -1,    0,    2,    0, &
              1,   -1,    2,    0,    2, &
              0,    0,    0,    1,    0, &
             -1,   -1,    2,    2,    2, &
             -1,    0,    2,    0,    0, &
              0,   -1,    2,    2,    2, &
             -2,    0,    0,    0,    1, &
              1,    1,    2,    0,    2, &
              2,    0,    0,    0,    1, &
             -1,    1,    0,    1,    0, &
              1,    1,    0,    0,    0, &
              1,    0,    2,    0,    0, &
             -1,    0,    2,   -2,    1, &
              1,    0,    0,    0,    2, &
             -1,    0,    0,    1,    0, &
              0,    0,    2,    1,    2, &
             -1,    0,    2,    4,    2, &
             -1,    1,    0,    1,    1, &
              0,   -2,    2,   -2,    1, &
              1,    0,    2,    2,    1, &
             -2,    0,    2,    2,    2, &
             -1,    0,    0,    0,    2, &
              1,    1,    2,   -2,    2 ], [5,nls])

    !
    !  Luni-Solar nutation coefficients, unit 1e-7 arcsec:
    !  longitude (sin, t*sin, cos), obliquity (cos, t*cos, sin)
    !

    !  Longitude and obliquity coefficients
    real(wp),dimension(6,nls),parameter :: cls = reshape([ &
     -172064161.0_wp, -174666.0_wp,  33386.0_wp, 92052331.0_wp,  9086.0_wp, 15377.0_wp, &
      -13170906.0_wp,   -1675.0_wp, -13696.0_wp,  5730336.0_wp, -3015.0_wp, -4587.0_wp, &
       -2276413.0_wp,    -234.0_wp,   2796.0_wp,   978459.0_wp,  -485.0_wp,  1374.0_wp, &
        2074554.0_wp,     207.0_wp,   -698.0_wp,  -897492.0_wp,   470.0_wp,  -291.0_wp, &
        1475877.0_wp,   -3633.0_wp,  11817.0_wp,    73871.0_wp,  -184.0_wp, -1924.0_wp, &
        -516821.0_wp,    1226.0_wp,   -524.0_wp,   224386.0_wp,  -677.0_wp,  -174.0_wp, &
         711159.0_wp,      73.0_wp,   -872.0_wp,    -6750.0_wp,     0.0_wp,   358.0_wp, &
        -387298.0_wp,    -367.0_wp,    380.0_wp,   200728.0_wp,    18.0_wp,   318.0_wp, &
        -301461.0_wp,     -36.0_wp,    816.0_wp,   129025.0_wp,   -63.0_wp,   367.0_wp, &
         215829.0_wp,    -494.0_wp,    111.0_wp,   -95929.0_wp,   299.0_wp,   132.0_wp, &
         128227.0_wp,     137.0_wp,    181.0_wp,   -68982.0_wp,    -9.0_wp,    39.0_wp, &
         123457.0_wp,      11.0_wp,     19.0_wp,   -53311.0_wp,    32.0_wp,    -4.0_wp, &
         156994.0_wp,      10.0_wp,   -168.0_wp,    -1235.0_wp,     0.0_wp,    82.0_wp, &
          63110.0_wp,      63.0_wp,     27.0_wp,   -33228.0_wp,     0.0_wp,    -9.0_wp, &
         -57976.0_wp,     -63.0_wp,   -189.0_wp,    31429.0_wp,     0.0_wp,   -75.0_wp, &
         -59641.0_wp,     -11.0_wp,    149.0_wp,    25543.0_wp,   -11.0_wp,    66.0_wp, &
         -51613.0_wp,     -42.0_wp,    129.0_wp,    26366.0_wp,     0.0_wp,    78.0_wp, &
          45893.0_wp,      50.0_wp,     31.0_wp,   -24236.0_wp,   -10.0_wp,    20.0_wp, &
          63384.0_wp,      11.0_wp,   -150.0_wp,    -1220.0_wp,     0.0_wp,    29.0_wp, &
         -38571.0_wp,      -1.0_wp,    158.0_wp,    16452.0_wp,   -11.0_wp,    68.0_wp, &
          32481.0_wp,       0.0_wp,      0.0_wp,   -13870.0_wp,     0.0_wp,     0.0_wp, &
         -47722.0_wp,       0.0_wp,    -18.0_wp,      477.0_wp,     0.0_wp,   -25.0_wp, &
         -31046.0_wp,      -1.0_wp,    131.0_wp,    13238.0_wp,   -11.0_wp,    59.0_wp, &
          28593.0_wp,       0.0_wp,     -1.0_wp,   -12338.0_wp,    10.0_wp,    -3.0_wp, &
          20441.0_wp,      21.0_wp,     10.0_wp,   -10758.0_wp,     0.0_wp,    -3.0_wp, &
          29243.0_wp,       0.0_wp,    -74.0_wp,     -609.0_wp,     0.0_wp,    13.0_wp, &
          25887.0_wp,       0.0_wp,    -66.0_wp,     -550.0_wp,     0.0_wp,    11.0_wp, &
         -14053.0_wp,     -25.0_wp,     79.0_wp,     8551.0_wp,    -2.0_wp,   -45.0_wp, &
          15164.0_wp,      10.0_wp,     11.0_wp,    -8001.0_wp,     0.0_wp,    -1.0_wp, &
         -15794.0_wp,      72.0_wp,    -16.0_wp,     6850.0_wp,   -42.0_wp,    -5.0_wp, &
          21783.0_wp,       0.0_wp,     13.0_wp,     -167.0_wp,     0.0_wp,    13.0_wp, &
         -12873.0_wp,     -10.0_wp,    -37.0_wp,     6953.0_wp,     0.0_wp,   -14.0_wp, &
         -12654.0_wp,      11.0_wp,     63.0_wp,     6415.0_wp,     0.0_wp,    26.0_wp, &
         -10204.0_wp,       0.0_wp,     25.0_wp,     5222.0_wp,     0.0_wp,    15.0_wp, &
          16707.0_wp,     -85.0_wp,    -10.0_wp,      168.0_wp,    -1.0_wp,    10.0_wp, &
          -7691.0_wp,       0.0_wp,     44.0_wp,     3268.0_wp,     0.0_wp,    19.0_wp, &
         -11024.0_wp,       0.0_wp,    -14.0_wp,      104.0_wp,     0.0_wp,     2.0_wp, &
           7566.0_wp,     -21.0_wp,    -11.0_wp,    -3250.0_wp,     0.0_wp,    -5.0_wp, &
          -6637.0_wp,     -11.0_wp,     25.0_wp,     3353.0_wp,     0.0_wp,    14.0_wp, &
          -7141.0_wp,      21.0_wp,      8.0_wp,     3070.0_wp,     0.0_wp,     4.0_wp, &
          -6302.0_wp,     -11.0_wp,      2.0_wp,     3272.0_wp,     0.0_wp,     4.0_wp, &
           5800.0_wp,      10.0_wp,      2.0_wp,    -3045.0_wp,     0.0_wp,    -1.0_wp, &
           6443.0_wp,       0.0_wp,     -7.0_wp,    -2768.0_wp,     0.0_wp,    -4.0_wp, &
          -5774.0_wp,     -11.0_wp,    -15.0_wp,     3041.0_wp,     0.0_wp,    -5.0_wp, &
          -5350.0_wp,       0.0_wp,     21.0_wp,     2695.0_wp,     0.0_wp,    12.0_wp, &
          -4752.0_wp,     -11.0_wp,     -3.0_wp,     2719.0_wp,     0.0_wp,    -3.0_wp, &
          -4940.0_wp,     -11.0_wp,    -21.0_wp,     2720.0_wp,     0.0_wp,    -9.0_wp, &
           7350.0_wp,       0.0_wp,     -8.0_wp,      -51.0_wp,     0.0_wp,     4.0_wp, &
           4065.0_wp,       0.0_wp,      6.0_wp,    -2206.0_wp,     0.0_wp,     1.0_wp, &
           6579.0_wp,       0.0_wp,    -24.0_wp,     -199.0_wp,     0.0_wp,     2.0_wp, &
           3579.0_wp,       0.0_wp,      5.0_wp,    -1900.0_wp,     0.0_wp,     1.0_wp, &
           4725.0_wp,       0.0_wp,     -6.0_wp,      -41.0_wp,     0.0_wp,     3.0_wp, &
          -3075.0_wp,       0.0_wp,     -2.0_wp,     1313.0_wp,     0.0_wp,    -1.0_wp, &
          -2904.0_wp,       0.0_wp,     15.0_wp,     1233.0_wp,     0.0_wp,     7.0_wp, &
           4348.0_wp,       0.0_wp,    -10.0_wp,      -81.0_wp,     0.0_wp,     2.0_wp, &
          -2878.0_wp,       0.0_wp,      8.0_wp,     1232.0_wp,     0.0_wp,     4.0_wp, &
          -4230.0_wp,       0.0_wp,      5.0_wp,      -20.0_wp,     0.0_wp,    -2.0_wp, &
          -2819.0_wp,       0.0_wp,      7.0_wp,     1207.0_wp,     0.0_wp,     3.0_wp, &
          -4056.0_wp,       0.0_wp,      5.0_wp,       40.0_wp,     0.0_wp,    -2.0_wp, &
          -2647.0_wp,       0.0_wp,     11.0_wp,     1129.0_wp,     0.0_wp,     5.0_wp, &
          -2294.0_wp,       0.0_wp,    -10.0_wp,     1266.0_wp,     0.0_wp,    -4.0_wp, &
           2481.0_wp,       0.0_wp,     -7.0_wp,    -1062.0_wp,     0.0_wp,    -3.0_wp, &
           2179.0_wp,       0.0_wp,     -2.0_wp,    -1129.0_wp,     0.0_wp,    -2.0_wp, &
           3276.0_wp,       0.0_wp,      1.0_wp,       -9.0_wp,     0.0_wp,     0.0_wp, &
          -3389.0_wp,       0.0_wp,      5.0_wp,       35.0_wp,     0.0_wp,    -2.0_wp, &
           3339.0_wp,       0.0_wp,    -13.0_wp,     -107.0_wp,     0.0_wp,     1.0_wp, &
          -1987.0_wp,       0.0_wp,     -6.0_wp,     1073.0_wp,     0.0_wp,    -2.0_wp, &
          -1981.0_wp,       0.0_wp,      0.0_wp,      854.0_wp,     0.0_wp,     0.0_wp, &
           4026.0_wp,       0.0_wp,   -353.0_wp,     -553.0_wp,     0.0_wp,  -139.0_wp, &
           1660.0_wp,       0.0_wp,     -5.0_wp,     -710.0_wp,     0.0_wp,    -2.0_wp, &
          -1521.0_wp,       0.0_wp,      9.0_wp,      647.0_wp,     0.0_wp,     4.0_wp, &
           1314.0_wp,       0.0_wp,      0.0_wp,     -700.0_wp,     0.0_wp,     0.0_wp, &
          -1283.0_wp,       0.0_wp,      0.0_wp,      672.0_wp,     0.0_wp,     0.0_wp, &
          -1331.0_wp,       0.0_wp,      8.0_wp,      663.0_wp,     0.0_wp,     4.0_wp, &
           1383.0_wp,       0.0_wp,     -2.0_wp,     -594.0_wp,     0.0_wp,    -2.0_wp, &
           1405.0_wp,       0.0_wp,      4.0_wp,     -610.0_wp,     0.0_wp,     2.0_wp, &
           1290.0_wp,       0.0_wp,      0.0_wp,     -556.0_wp,     0.0_wp,     0.0_wp ], [6,nls])

    !  Interval between fundamental epoch J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  -------------------
    !  LUNI-SOLAR NUTATION
    !  -------------------

    !
    !  Fundamental (Delaunay) arguments from Simon et al. (1994)
    !

    !  Mean anomaly of the Moon.
    el  = mod (         485868.249036_wp + &
                ( + 1717915923.2178_wp ) * t, turnas ) * das2r

    !  Mean anomaly of the Sun.
    elp = mod (        1287104.79305_wp + &
                (  + 129596581.0481_wp ) * t, turnas ) * das2r

    !  Mean argument of the latitude of the Moon.
    f   = mod (         335779.526232_wp + &
                ( + 1739527262.8478_wp ) * t, turnas ) * das2r

    !  Mean elongation of the Moon from the Sun.
    d   = mod (        1072260.70369_wp + &
                ( + 1602961601.2090_wp ) * t, turnas ) * das2r

    !  Mean longitude of the ascending node of the Moon.
    om  = mod (         450160.398036_wp + &
                (    - 6962890.5431_wp ) * t, turnas ) * das2r

    !  Initialize the nutation values.
    dp = 0.0_wp
    de = 0.0_wp

    !  Summation of luni-solar nutation series (in reverse order).
    do i = nls, 1, -1

    !     Argument and functions.
       arg = mod ( real ( nals(1,i), wp ) * el  + &
                   real ( nals(2,i), wp ) * elp + &
                   real ( nals(3,i), wp ) * f   + &
                   real ( nals(4,i), wp ) * d   + &
                   real ( nals(5,i), wp ) * om, d2pi )
       sarg = sin(arg)
       carg = cos(arg)

    !     Term.
       dp = dp + ( cls(1,i) + cls(2,i) * t ) * sarg &
               +   cls(3,i)                  * carg
       de = de + ( cls(4,i) + cls(5,i) * t ) * carg &
               +   cls(6,i)                  * sarg

    end do

    !  Convert from 0.1 microarcsec units to radians.
    dpsils = dp * u2r
    depsls = de * u2r

    !  -----------------------------
    !  IN LIEU OF PLANETARY NUTATION
    !  -----------------------------

    !  Fixed offset to correct for missing terms in truncated series.
    dpsipl = dpplan
    depspl = deplan

    !  -------
    !  RESULTS
    !  -------

    !  Add luni-solar and planetary components.
    dpsi = dpsils + dpsipl
    deps = depsls + depspl

    end subroutine NUT00B
!***********************************************************************

!***********************************************************************
!>
!  IAU 2000A nutation with adjustments to match the IAU 2006 precession.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The nutation components in longitude and obliquity are in radians
!     and with respect to the mean equinox and ecliptic of date,
!     IAU 2006 precession model (Hilton et al. 2006, Capitaine et al.
!     2005).
!
!  3. The routine first computes the IAU 2000A nutation, then applies
!     adjustments for (i) the consequences of the change in obliquity
!     from the IAU 1980 ecliptic to the IAU 2006 ecliptic and (ii) the
!     secular variation in the Earth's dynamical form factor J2.
!
!  4. The present routine provides classical nutation, complementing
!     the IAU 2000 frame bias and IAU 2006 precession.  It delivers a
!     pole which is at current epochs accurate to a few tens of
!     microarcseconds, apart from the free core nutation.
!
!### Reference
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2011 April 3

    subroutine NUT06A ( date1, date2, dpsi, deps )

    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(out) :: dpsi !! nutation, luni-solar + planetary (Note 2)
    real(wp),intent(out) :: deps !! nutation, luni-solar + planetary (Note 2)

    !  Miscellaneous
    real(wp) :: t, fj2, dp, de

    !  Interval between fundamental date J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Factor correcting for secular variation of J2.
    fj2 = -2.7774e-6_wp * t

    !  Obtain IAU 2000A nutation.
    call NUT00A ( date1, date2, dp, de )

    !  Apply P03 adjustments (Wallace & Capitaine, 2006, Eqs.5).
    dpsi = dp + dp * ( 0.4697e-6_wp + fj2 )
    deps = de + de * fj2

    end subroutine NUT06A
!***********************************************************************

!***********************************************************************
!>
!  Nutation, IAU 1980 model.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The DATE DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  2. The nutation components are with respect to the ecliptic of
!     date.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 3.222 (p111).
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine NUT80 ( date1, date2, dpsi, deps )

    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(out) :: dpsi !! nutation in longitude (radians)
    real(wp),intent(out) :: deps !! nutation in obliquity (radians)

    !  Units of 0.1 milliarcsecond to radians
    real(wp),parameter :: u2r = das2r/1.0e4_wp

    real(wp) :: t, el, elp, f, d, om, dp, de, arg, s, c
    integer :: i, j

    !  ------------------------------------------------
    !  Table of multiples of arguments and coefficients
    !  ------------------------------------------------
    !
    !  The coefficient values are in 0.1 mas units and the rates of change
    !  are in mas per Julian millennium.

    !                Multiple of            Longitude        Obliquity
    !           L    L'   F    D  Omega   coeff. of sin    coeff. of cos
    !                                         1       t        1     t

    real(wp),dimension(9,106),parameter :: x = reshape([ &
          0.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  1.0_wp, -171996.0_wp, -1742.0_wp,  92025.0_wp,  89.0_wp, &
          0.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,    2062.0_wp,     2.0_wp,   -895.0_wp,   5.0_wp, &
         -2.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,      46.0_wp,     0.0_wp,    -24.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,  0.0_wp,      11.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
         -2.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,      -3.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          1.0_wp, -1.0_wp,  0.0_wp, -1.0_wp,  0.0_wp,      -3.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp, -2.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,      -2.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,  1.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,  -13187.0_wp,   -16.0_wp,   5736.0_wp, -31.0_wp, &
          0.0_wp,  1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,    1426.0_wp,   -34.0_wp,     54.0_wp,  -1.0_wp, &
          0.0_wp,  1.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,    -517.0_wp,    12.0_wp,    224.0_wp,  -6.0_wp, &
          0.0_wp, -1.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,     217.0_wp,    -5.0_wp,    -95.0_wp,   3.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,     129.0_wp,     1.0_wp,    -70.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,      48.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  0.0_wp,     -22.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  2.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,      17.0_wp,    -1.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,     -15.0_wp,     0.0_wp,      9.0_wp,   0.0_wp, &
          0.0_wp,  2.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,     -16.0_wp,     1.0_wp,      7.0_wp,   0.0_wp, &
          0.0_wp, -1.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,     -12.0_wp,     0.0_wp,      6.0_wp,   0.0_wp, &
         -2.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  1.0_wp,      -6.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          0.0_wp, -1.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,      -5.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  0.0_wp, -2.0_wp,  1.0_wp,       4.0_wp,     0.0_wp,     -2.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,       4.0_wp,     0.0_wp,     -2.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp, -1.0_wp,  0.0_wp,      -4.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          2.0_wp,  1.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp, -2.0_wp,  2.0_wp,  1.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp, -2.0_wp,  2.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,  1.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  2.0_wp, -2.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,   -2274.0_wp,    -2.0_wp,    977.0_wp,  -5.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,     712.0_wp,     1.0_wp,     -7.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,    -386.0_wp,    -4.0_wp,    200.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,    -301.0_wp,     0.0_wp,    129.0_wp,  -1.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,    -158.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,     123.0_wp,     0.0_wp,    -53.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,      63.0_wp,     0.0_wp,     -2.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,      63.0_wp,     1.0_wp,    -33.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,     -58.0_wp,    -1.0_wp,     32.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,     -59.0_wp,     0.0_wp,     26.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,     -51.0_wp,     0.0_wp,     27.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,     -38.0_wp,     0.0_wp,     16.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,      29.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,      29.0_wp,     0.0_wp,    -12.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,     -31.0_wp,     0.0_wp,     13.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  0.0_wp,      26.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,      21.0_wp,     0.0_wp,    -10.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  1.0_wp,      16.0_wp,     0.0_wp,     -8.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp, -2.0_wp,  1.0_wp,     -13.0_wp,     0.0_wp,      7.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  1.0_wp,     -10.0_wp,     0.0_wp,      5.0_wp,   0.0_wp, &
          1.0_wp,  1.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,      -7.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,       7.0_wp,     0.0_wp,     -3.0_wp,   0.0_wp, &
          0.0_wp, -1.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,      -7.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,      -8.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,       6.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,       6.0_wp,     0.0_wp,     -3.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  1.0_wp,      -6.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  1.0_wp,      -7.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,       6.0_wp,     0.0_wp,     -3.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  0.0_wp, -2.0_wp,  1.0_wp,      -5.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          1.0_wp, -1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,       5.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,      -5.0_wp,     0.0_wp,      3.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,      -4.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,  0.0_wp,       4.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,  0.0_wp,      -4.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,      -3.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  0.0_wp,       3.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp, -1.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,      -3.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
         -1.0_wp, -1.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,      -3.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
         -2.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,      -2.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          3.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,      -3.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          0.0_wp, -1.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,      -3.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          1.0_wp,  1.0_wp,  2.0_wp,  0.0_wp,  2.0_wp,       2.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,      -2.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  1.0_wp,       2.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,      -2.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          3.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,       2.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  1.0_wp,  2.0_wp,       2.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp, -4.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
         -2.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  2.0_wp,  4.0_wp,  2.0_wp,      -2.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  0.0_wp, -4.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  1.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  1.0_wp,      -1.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
         -2.0_wp,  0.0_wp,  2.0_wp,  4.0_wp,  2.0_wp,      -1.0_wp,     0.0_wp,      1.0_wp,   0.0_wp, &
         -1.0_wp,  0.0_wp,  4.0_wp,  0.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp, -1.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  1.0_wp,       1.0_wp,     0.0_wp,     -1.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  2.0_wp,  2.0_wp,  2.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  1.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  4.0_wp, -2.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          3.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  2.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp,  2.0_wp, -2.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
         -1.0_wp, -1.0_wp,  0.0_wp,  2.0_wp,  1.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp, -2.0_wp,  0.0_wp,  1.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp, -1.0_wp,  2.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp, -2.0_wp, -2.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp, -1.0_wp,  2.0_wp,  0.0_wp,  1.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  1.0_wp,  0.0_wp, -2.0_wp,  1.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          1.0_wp,  0.0_wp, -2.0_wp,  2.0_wp,  0.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          2.0_wp,  0.0_wp,  0.0_wp,  2.0_wp,  0.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  0.0_wp,  2.0_wp,  4.0_wp,  2.0_wp,      -1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp, &
          0.0_wp,  1.0_wp,  0.0_wp,  1.0_wp,  0.0_wp,       1.0_wp,     0.0_wp,      0.0_wp,   0.0_wp ], [9,106])

    !  Interval between fundamental epoch J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !
    !  FUNDAMENTAL ARGUMENTS in the FK5 reference system
    !

    !  Mean longitude of the Moon minus mean longitude of the Moon's
    !  perigee.
    el = ANPM ( ( 485866.733_wp + ( 715922.633_wp + &
                      ( 31.310_wp + 0.064_wp * t ) * t ) * t ) * das2r &
                    + mod(1325.0_wp*t, 1.0_wp) * d2pi )

    !  Mean longitude of the Sun minus mean longitude of the Sun's perigee.
    elp = ANPM ( ( 1287099.804_wp + ( 1292581.224_wp + &
                       ( -0.577_wp -0.012_wp * t ) * t ) * t ) * das2r &
                     + mod(99.0_wp*t, 1.0_wp) * d2pi )

    !  Mean longitude of the Moon minus mean longitude of the Moon's node.
    f = ANPM ( ( 335778.877_wp + ( 295263.137_wp + &
                     ( -13.257_wp + 0.011_wp * t ) * t ) * t ) * das2r &
                   + mod(1342.0_wp*t, 1.0_wp) * d2pi )

    !  Mean elongation of the Moon from the Sun.
    d = ANPM ( ( 1072261.307_wp + ( 1105601.328_wp + &
                     ( -6.891_wp + 0.019_wp * t ) * t ) * t ) * das2r &
                   + mod(1236.0_wp*t, 1.0_wp) * d2pi )

    !  Longitude of the mean ascending node of the lunar orbit on the
    !  ecliptic, measured from the mean equinox of date.
    om = ANPM( ( 450160.280_wp + ( -482890.539_wp + &
                     ( 7.455_wp + 0.008_wp * t ) * t ) * t ) * das2r &
                   + mod( -5.0_wp*t, 1.0_wp) * d2pi )

    !  ---------------
    !  Nutation series
    !  ---------------

    !  Change time argument from centuries to millennia.
    t = t / 10.0_wp

    !  Initialize nutation components.
    dp = 0.0_wp
    de = 0.0_wp

    !  Sum the nutation terms, ending with the biggest.
    do j=106,1,-1

       !  Form argument for current term.
       arg = x(1,j) * el &
           + x(2,j) * elp &
           + x(3,j) * f &
           + x(4,j) * d &
           + x(5,j) * om

       !  Accumulate current nutation term.
       s = x(6,j) + x(7,j) * t
       c = x(8,j) + x(9,j) * t
       if ( s /= 0.0_wp ) dp = dp + s * sin(arg)
       if ( c /= 0.0_wp ) de = de + c * cos(arg)

       !  Next term.
    end do

    !  Convert results from 0.1 mas units to radians.
    dpsi = dp * u2r
    deps = de * u2r

    end subroutine NUT80
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of nutation for a given date, IAU 1980 model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  2. The matrix operates in the sense V(true) = RMATN * V(mean),
!     where the p-vector V(true) is with respect to the true
!     equatorial triad of date and the p-vector V(mean) is with
!     respect to the mean equatorial triad of date.
!
!### History
!  * IAU SOFA revision: 2012 September 5

    subroutine NUTM80 ( date1, date2, rmatn )

    implicit none

    real(wp),intent(in) :: date1 !! TDB date (Note 1)
    real(wp),intent(in) :: date2 !! TDB date (Note 1)
    real(wp),dimension(3,3),intent(out) :: rmatn !! nutation matrix

    real(wp) :: dpsi, deps, epsa

    !  Nutation components and mean obliquity.
    call NUT80 ( date1, date2, dpsi, deps )
    epsa = OBL80 ( date1, date2 )

    !  Build the rotation matrix.
    call NUMAT ( epsa, dpsi, deps, rmatn )

    end subroutine NUTM80
!***********************************************************************

!***********************************************************************
!>
!  Mean obliquity of the ecliptic, IAU 2006 precession model.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The 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.
!
!  2. The result is the angle between the ecliptic and mean equator of
!     date DATE1+DATE2.
!
!### Reference
!
!  * Hilton, J. et al., 2006, Celest.Mech.Dyn.Astron. 94, 351
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function OBL06 ( date1, date2 ) result(obl)

    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) :: obl !! obliquity of the ecliptic (radians, Note 2)

    real(wp) :: t

    !  Interval between fundamental date J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Mean obliquity.
    obl = ( 84381.406_wp       + &
          (   -46.836769_wp    + &
          (    -0.0001831_wp   + &
          (     0.00200340_wp  + &
          (    -0.000000576_wp + &
          (    -0.0000000434_wp ) &
                      * t ) * t ) * t ) * t ) * t ) * das2r

    end function OBL06
!***********************************************************************

!***********************************************************************
!>
!  Mean obliquity of the ecliptic, IAU 1980 model.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  2. The result is the angle between the ecliptic and mean equator of
!     date DATE1+DATE2.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Expression 3.222-1 (p114).
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function OBL80 ( date1, date2 ) result(obl)

    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) :: obl !! obliquity of the ecliptic (radians, Note 2)

    real(wp) :: t

    !  Interval between fundamental epoch J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Mean obliquity of date.
    obl = das2r * ( 84381.448_wp + &
                    ( -46.8150_wp + &
                     ( -0.00059_wp + &
                        0.001813_wp * t ) * t ) * t )

    end function OBL80
!***********************************************************************

!***********************************************************************
!>
!  Precession angles, IAU 2006, equinox based.
!
!  Status:  canonical models.
!
!### Notes
!
!  1. 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.
!
!  2. This routine returns the set of equinox based angles for the
!     Capitaine et al. "P03" precession theory, adopted by the IAU in
!     2006.  The angles are set out in Table 1 of Hilton et al. (2006):
!
!      EPS0   epsilon_0   obliquity at J2000.0
!      PSIA   psi_A       luni-solar precession
!      OMA    omega_A     inclination of equator wrt J2000.0 ecliptic
!      BPA    P_A         ecliptic pole x, J2000.0 ecliptic triad
!      BQA    Q_A         ecliptic pole -y, J2000.0 ecliptic triad
!      PIA    pi_A        angle between moving and J2000.0 ecliptics
!      BPIA   Pi_A        longitude of ascending node of the ecliptic
!      EPSA   epsilon_A   obliquity of the ecliptic
!      CHIA   chi_A       planetary precession
!      ZA     z_A         equatorial precession: -3rd 323 Euler angle
!      ZETAA  zeta_A      equatorial precession: -1st 323 Euler angle
!      THETAA theta_A     equatorial precession: 2nd 323 Euler angle
!      PA     p_A         general precession
!      GAM    gamma_J2000 J2000.0 RA difference of ecliptic poles
!      PHI    phi_J2000   J2000.0 codeclination of ecliptic pole
!      PSI    psi_J2000   longitude difference of equator poles, J2000.0
!
!     The returned values are all radians.
!
!  3. Hilton et al. (2006) Table 1 also contains angles that depend on
!     models distinct from the P03 precession theory itself, namely the
!     IAU 2000A frame bias and nutation.  The quoted polynomials are
!     used in other SOFA routines:
!
!     * XY06 contains the polynomial parts of the X and Y series.
!
!     * S06 contains the polynomial part of the s+XY/2 series.
!
!     * PFW06 implements the series for the Fukushima-Williams
!       angles that are with respect to the GCRS pole (i.e. the variants
!       that include frame bias).
!
!  4. The IAU resolution stipulated that the choice of parameterization
!     was left to the user, and so an IAU compliant precession
!     implementation can be constructed using various combinations of
!     the angles returned by the present routine.
!
!  5. The parameterization used by SOFA is the version of the Fukushima-
!     Williams angles that refers directly to the GCRS pole.  These
!     angles may be calculated by calling the routine PFW06.  SOFA
!     also supports the direct computation of the CIP GCRS X,Y by
!     series, available by calling XY06.
!
!  6. The agreement between the different parameterizations is at the
!     1 microarcsecond level in the present era.
!
!  7. When constructing a precession formulation that refers to the GCRS
!     pole rather than the dynamical pole, it may (depending on the
!     choice of angles) be necessary to introduce the frame bias
!     explicitly.
!
!### Reference
!
!  * Hilton, J. et al., 2006, Celest.Mech.Dyn.Astron. 94, 351
!
!### History
!  * IAU SOFA revision: 2011 December 6

    subroutine P06E ( date1, date2, &
                      eps0, psia, oma, bpa, bqa, pia, bpia, &
                      epsa, chia, za, zetaa, thetaa, pa, &
                      gam, phi, psi )

    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(out) :: eps0 !! epsilon_0 [see Note 2]
    real(wp),intent(out) :: psia !! psi_A [see Note 2]
    real(wp),intent(out) :: oma !! omega_A [see Note 2]
    real(wp),intent(out) :: bpa !! P_A [see Note 2]
    real(wp),intent(out) :: bqa !! Q_A [see Note 2]
    real(wp),intent(out) :: pia !! pi_A [see Note 2]
    real(wp),intent(out) :: bpia !! Pi_A [see Note 2]
    real(wp),intent(out) :: epsa !! obliquity epsilon_A [see Note 2]
    real(wp),intent(out) :: chia !! chi_A [see Note 2]
    real(wp),intent(out) :: za !! z_A [see Note 2]
    real(wp),intent(out) :: zetaa !! zeta_A [see Note 2]
    real(wp),intent(out) :: thetaa !! theta_A [see Note 2]
    real(wp),intent(out) :: pa !! p_A [see Note 2]
    real(wp),intent(out) :: gam !! F-W angle gamma_J2000 [see Note 2]
    real(wp),intent(out) :: phi !! F-W angle phi_J2000 [see Note 2]
    real(wp),intent(out) :: psi !! F-W angle psi_J2000 [see Note 2]

    real(wp) :: t

    !  Interval between fundamental date J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Obliquity at J2000.0.

    eps0 = 84381.406_wp * das2r

    !  Luni-solar precession.

    psia = ( 5038.481507_wp     + &
           (   -1.0790069_wp    + &
           (   -0.00114045_wp   + &
           (    0.000132851_wp  + &
           (   -0.0000000951_wp ) &
           * t ) * t ) * t ) * t ) * t * das2r

    !  Inclination of mean equator with respect to the J2000.0 ecliptic.

    oma = eps0 + ( -0.025754_wp     + &
                 (  0.0512623_wp    + &
                 ( -0.00772503_wp   + &
                 ( -0.000000467_wp  + &
                 (  0.0000003337_wp ) &
                 * t ) * t ) * t ) * t ) * t * das2r

    !  Ecliptic pole x, J2000.0 ecliptic triad.

    bpa = (  4.199094_wp     + &
          (  0.1939873_wp    + &
          ( -0.00022466_wp   + &
          ( -0.000000912_wp  + &
          (  0.0000000120_wp ) &
          * t ) * t ) * t ) * t ) * t * das2r

    !  Ecliptic pole -y, J2000.0 ecliptic triad.

    bqa = ( -46.811015_wp     + &
          (   0.0510283_wp    + &
          (   0.00052413_wp   + &
          (  -0.000000646_wp  + &
          (  -0.0000000172_wp ) &
          * t ) * t ) * t ) * t ) * t * das2r

    !  Angle between moving and J2000.0 ecliptics.

    pia = ( 46.998973_wp     + &
          ( -0.0334926_wp    + &
          ( -0.00012559_wp   + &
          (  0.000000113_wp  + &
          ( -0.0000000022_wp ) &
          * t ) * t ) * t ) * t ) * t * das2r

    !  Longitude of ascending node of the moving ecliptic.

    bpia = ( 629546.7936_wp      + &
           (   -867.95758_wp     + &
           (      0.157992_wp    + &
           (     -0.0005371_wp   + &
           (     -0.00004797_wp  + &
           (      0.000000072_wp ) &
           * t ) * t ) * t ) * t ) * t ) * das2r

    !  Mean obliquity of the ecliptic.

    epsa = OBL06 ( date1, date2 )

    !  Planetary precession.

    chia = ( 10.556403_wp     + &
           ( -2.3814292_wp    + &
           ( -0.00121197_wp   + &
           (  0.000170663_wp  + &
           ( -0.0000000560_wp ) &
           * t ) * t ) * t ) * t ) * t * das2r

    !  Equatorial precession: minus the third of the 323 Euler angles.

    za = (   -2.650545_wp     + &
         ( 2306.077181_wp     + &
         (    1.0927348_wp    + &
         (    0.01826837_wp   + &
         (   -0.000028596_wp  + &
         (   -0.0000002904_wp ) &
         * t ) * t ) * t ) * t ) * t ) * das2r

    !  Equatorial precession: minus the first of the 323 Euler angles.

    zetaa = (    2.650545_wp     + &
            ( 2306.083227_wp     + &
            (    0.2988499_wp    + &
            (    0.01801828_wp   + &
            (   -0.000005971_wp  + &
            (   -0.0000003173_wp ) &
            * t ) * t ) * t ) * t ) * t ) * das2r

    !  Equatorial precession: second of the 323 Euler angles.

    thetaa = ( 2004.191903_wp     + &
             (   -0.4294934_wp    + &
             (   -0.04182264_wp   + &
             (   -0.000007089_wp  + &
             (   -0.0000001274_wp ) &
             * t ) * t ) * t ) * t ) * t * das2r

    !  General precession.

    pa = ( 5028.796195_wp     + &
         (    1.1054348_wp    + &
         (    0.00007964_wp   + &
         (   -0.000023857_wp  + &
         (    0.0000000383_wp ) &
         * t ) * t ) * t ) * t ) * t * das2r

    !  Fukushima-Williams angles for precession.

    gam = ( 10.556403_wp     + &
          (  0.4932044_wp    + &
          ( -0.00031238_wp   + &
          ( -0.000002788_wp  + &
          (  0.0000000260_wp ) &
          * t ) * t ) * t ) * t ) * t * das2r

    phi = eps0 + ( -46.811015_wp     + &
                 (   0.0511269_wp    + &
                 (   0.00053289_wp   + &
                 (  -0.000000440_wp  + &
                 (  -0.0000000176_wp ) &
                 * t ) * t ) * t ) * t ) * t * das2r

    psi = ( 5038.481507_wp     + &
          (    1.5584176_wp    + &
          (   -0.00018522_wp   + &
          (   -0.000026452_wp  + &
          (   -0.0000000148_wp ) &
          * t ) * t ) * t ) * t ) * t * das2r

    end subroutine P06E
!***********************************************************************

!***********************************************************************
!>
!  Extend a p-vector to a pv-vector by appending a zero velocity.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine P2PV ( p, pv )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),dimension(3,2),intent(out) :: pv !! pv-vector

    call CP ( p, pv(1,1) )
    call ZP ( pv(1,2) )

    end subroutine P2PV
!***********************************************************************

!***********************************************************************
!>
!  P-vector to spherical polar coordinates.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. If P is null, zero THETA, PHI and R are returned.
!
!  2. At either pole, zero THETA is returned.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine P2S ( p, theta, phi, r )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),intent(out) :: theta !! longitude angle (radians)
    real(wp),intent(out) :: phi !! latitude angle (radians)
    real(wp),intent(out) :: r !! radial distance

    call C2S ( p, theta, phi )
    call PM ( p, r )

    end subroutine P2S
!***********************************************************************

!***********************************************************************
!>
!  Position-angle from two p-vectors.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. The result is the position angle, in radians, of direction B with
!     respect to direction A.  It is in the range -pi to +pi.  The sense
!     is such that if B is a small distance "north" of A the position
!     angle is approximately zero, and if B is a small distance "east" of
!     A the position angle is approximately +pi/2.
!
!  2. A and B need not be unit vectors.
!
!  3. Zero is returned if the two directions are the same or if either
!     vector is null.
!
!  4. If A is at a pole, the result is ill-defined.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine PAP ( a, b, theta )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! direction of reference point
    real(wp),dimension(3),intent(in) :: b !! direction of point whose PA is required
    real(wp),intent(out) :: theta !! position angle of B with respect to A (radians)

    real(wp) :: am, au(3), bm, st, ct, xa, ya, za, eta(3), &
                xi(3), a2b(3)

    !  Modulus and direction of the A vector.
    call PN ( a, am, au )

    !  Modulus of the B vector.
    call PM ( b, bm )

    !  Deal with the case of a null vector.
    if ( am==0.0_wp .or. bm==0.0_wp ) then
       st = 0.0_wp
       ct = 1.0_wp
    else

       !  The "north" axis tangential from A (arbitrary length).
       xa = a(1)
       ya = a(2)
       za = a(3)
       eta(1) = - xa * za
       eta(2) = - ya * za
       eta(3) = xa*xa + ya*ya

       !  The "east" axis tangential from A (same length).
       call PXP ( eta, au, xi )

       !  The vector from A to B.
       call PMP ( b, a, a2b )

       !  Resolve into components along the north and east axes.
       call PDP ( a2b, xi, st )
       call PDP ( a2b, eta, ct )

       !  Deal with degenerate cases.
       if ( st==0.0_wp .and. ct==0.0_wp ) ct = 1.0_wp

    end if

    !  Position angle.
    theta = atan2(st,ct)

    end subroutine PAP
!***********************************************************************

!***********************************************************************
!>
!  Position-angle from spherical coordinates.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. The result is the bearing (position angle), in radians, of point
!     B with respect to point A.  It is in the range -pi to +pi.  The
!     sense is such that if B is a small distance "east" of point A,
!     the bearing is approximately +pi/2.
!
!  2. Zero is returned if the two points are coincident.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PAS ( al, ap, bl, bp, theta )

    implicit none

    real(wp),intent(in) :: al !! longitude of point A (e.g. RA) in radians
    real(wp),intent(in) :: ap !! latitude of point A (e.g. Dec) in radians
    real(wp),intent(in) :: bl !! longitude of point B
    real(wp),intent(in) :: bp !! latitude of point B
    real(wp),intent(out) :: theta !! position angle of B with respect to A

    real(wp) :: dl, x, y

    dl = bl - al
    y = sin(dl)*cos(bp)
    x = sin(bp)*cos(ap) - cos(bp)*sin(ap)*cos(dl)
    if ( x/=0.0_wp .or. y/=0.0_wp ) then
       theta = atan2(y,x)
    else
       theta = 0.0_wp
    end if

    end subroutine PAS
!***********************************************************************

!***********************************************************************
!>
!  This routine forms three Euler angles which implement general
!  precession from epoch J2000.0, using the IAU 2006 model.  Frame
!  bias (the offset between ICRS and mean J2000.0) is included.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the arguments DATE1 and DATE2.  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.
!
!  2. The traditional accumulated precession angles zeta_A, z_A, theta_A
!     cannot be obtained in the usual way, namely through polynomial
!     expressions, because of the frame bias.  The latter means that two
!     of the angles undergo rapid changes near this date.  They are
!     instead the results of decomposing the precession-bias matrix
!     obtained by using the Fukushima-Williams method, which does not
!     suffer from the problem.  The decomposition returns values which
!     can be used in the conventional formulation and which include
!     frame bias.
!
!  3. The three angles are returned in the conventional order, which
!     is not the same as the order of the corresponding Euler rotations.
!     The precession-bias matrix is R_3(-z) x R_2(+theta) x R_3(-zeta).
!
!  4. Should zeta_A, z_A, theta_A angles be required that do not contain
!     frame bias, they are available by calling the SOFA routine
!     P06E.
!
!### History
!  * IAU SOFA revision: 2007 June 8

    subroutine PB06 ( date1, date2, bzeta, bz, btheta )

    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(out) :: bzeta !! 1st rotation: radians clockwise around z
    real(wp),intent(out) :: bz !! 3rd rotation: radians clockwise around z
    real(wp),intent(out) :: btheta !! 2nd rotation: radians counterclockwise around y

    real(wp) :: r(3,3), r31, r32

    !  Precession matrix via Fukushima-Williams angles.
    call PMAT06 ( date1, date2, r )

    !  Solve for z.
    bz = atan2 ( r(2,3), r(1,3) )

    !  Remove it from the matrix.
    call RZ ( bz, r )

    !  Solve for the remaining two angles.
    bzeta = atan2 ( r(2,1), r(2,2) )
    r31 = r(3,1)
    r32 = r(3,2)
    btheta = atan2 ( -sign(sqrt(r31*r31+r32*r32),r(1,3)), r(3,3) )

    end subroutine PB06
!***********************************************************************

!***********************************************************************
!>
!  p-vector inner (=scalar=dot) product.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PDP ( a, b, adb )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! first p-vector
    real(wp),dimension(3),intent(in) :: b !! second p-vector
    real(wp),intent(out) :: adb !! A . B

    real(wp) :: w
    integer :: i

    w = 0.0_wp
    do i=1,3
       w = w + a(i)*b(i)
    end do
    adb = w

    end subroutine PDP
!***********************************************************************

!***********************************************************************
!>
!  Precession angles, IAU 2006 (Fukushima-Williams 4-angle formulation).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. Naming the following points:
!
!           e = J2000.0 ecliptic pole,
!           p = GCRS pole,
!           E = mean ecliptic pole of date,
!     and   P = mean pole of date,
!
!     the four Fukushima-Williams angles are as follows:
!
!        GAMB = gamma_bar = epE
!        PHIB = phi_bar = pE
!        PSIB = psi_bar = pEP
!        EPSA = epsilon_A = EP
!
!  3. The matrix representing the combined effects of frame bias and
!     precession is:
!
!        PxB = R_1(-EPSA).R_3(-PSIB).R_1(PHIB).R_3(GAMB)
!
!  4. The matrix representing the combined effects of frame bias,
!     precession and nutation is simply:
!
!        NxPxB = R_1(-EPSA-dE).R_3(-PSIB-dP).R_1(PHIB).R_3(GAMB)
!
!     where dP and dE are the nutation components with respect to the
!     ecliptic of date.
!
!### Reference
!
!  * Hilton, J. et al., 2006, Celest.Mech.Dyn.Astron. 94, 351
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine PFW06 ( date1, date2, gamb, phib, psib, epsa )

    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(out) :: gamb !! F-W angle gamma_bar (radians)
    real(wp),intent(out) :: phib !! F-W angle phi_bar (radians)
    real(wp),intent(out) :: psib !! F-W angle psi_bar (radians)
    real(wp),intent(out) :: epsa !! F-W angle epsilon_A (radians)

    real(wp) :: t

    !  Interval between fundamental date J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  P03 bias+precession angles.
    gamb =        (    -0.052928_wp    + &
                  (    10.556378_wp    + &
                  (     0.4932044_wp   + &
                  (    -0.00031238_wp  + &
                  (    -0.000002788_wp + &
                  (     0.0000000260_wp ) &
                                 * t ) * t ) * t ) * t ) * t ) * das2r
    phib =        ( 84381.412819_wp    + &
                  (   -46.811016_wp    + &
                  (     0.0511268_wp   + &
                  (     0.00053289_wp  + &
                  (    -0.000000440_wp + &
                  (    -0.0000000176_wp ) &
                                 * t ) * t ) * t ) * t ) * t ) * das2r
    psib =        (    -0.041775_wp    + &
                  (  5038.481484_wp    + &
                  (     1.5584175_wp   + &
                  (    -0.00018522_wp  + &
                  (    -0.000026452_wp + &
                  (    -0.0000000148_wp ) &
                                 * t ) * t ) * t ) * t ) * t ) * das2r
    epsa = OBL06 ( date1, date2 )

    end subroutine PFW06
!***********************************************************************

!***********************************************************************
!>
!  Approximate heliocentric position and velocity of a nominated major
!  planet:  Mercury, Venus, EMB, Mars, Jupiter, Saturn, Uranus or
!  Neptune (but not the Earth itself).
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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 limited accuracy of the present algorithm is such that any
!     of the methods is satisfactory.
!
!  2. If an NP value outside the range 1-8 is supplied, an error
!     status (J = -1) is returned and the PV vector set to zeroes.
!
!  3. For NP=3 the result is for the Earth-Moon Barycenter.  To
!     obtain the heliocentric position and velocity of the Earth,
!     use instead the SOFA routine EPV00.
!
!  4. On successful return, the array PV contains the following:
!
!        PV(1,1)  x       }
!        PV(2,1)  y       } heliocentric position, au
!        PV(3,1)  z       }
!
!        PV(1,2)  xdot    }
!        PV(2,2)  ydot    } heliocentric velocity, au/d
!        PV(3,2)  zdot    }
!
!     The reference frame is equatorial and is with respect to the
!     mean equator and equinox of epoch J2000.0.
!
!  5. The algorithm is due to J.L. Simon, P. Bretagnon, J. Chapront,
!     M. Chapront-Touze, G. Francou and J. Laskar (Bureau des
!     Longitudes, Paris, France).  From comparisons with JPL
!     ephemeris DE102, they quote the following maximum errors
!     over the interval 1800-2050:
!
!                     L (arcsec)    B (arcsec)      R (km)
!
!        Mercury          4             1             300
!        Venus            5             1             800
!        EMB              6             1            1000
!        Mars            17             1            7700
!        Jupiter         71             5           76000
!        Saturn          81            13          267000
!        Uranus          86             7          712000
!        Neptune         11             1          253000
!
!     Over the interval 1000-3000, they report that the accuracy is no
!     worse than 1.5 times that over 1800-2050.  Outside 1000-3000 the
!     accuracy declines.
!
!     Comparisons of the present routine with the JPL DE200 ephemeris
!     give the following RMS errors over the interval 1960-2025:
!
!                      position (km)     velocity (m/s)
!
!        Mercury            334               0.437
!        Venus             1060               0.855
!        EMB               2010               0.815
!        Mars              7690               1.98
!        Jupiter          71700               7.70
!        Saturn          199000              19.4
!        Uranus          564000              16.4
!        Neptune         158000              14.4
!
!     Comparisons against DE200 over the interval 1800-2100 gave the
!     following maximum absolute differences.  (The results using
!     DE406 were essentially the same.)
!
!                   L (arcsec)   B (arcsec)     R (km)   Rdot (m/s)
!
!        Mercury        7            1            500       0.7
!        Venus          7            1           1100       0.9
!        EMB            9            1           1300       1.0
!        Mars          26            1           9000       2.5
!        Jupiter       78            6          82000       8.2
!        Saturn        87           14         263000      24.6
!        Uranus        86            7         661000      27.4
!        Neptune       11            2         248000      21.4
!
!  6. The present SOFA re-implementation of the original Simon et al.
!     Fortran code differs from the original in the following respects:
!
!       *  The date is supplied in two parts.
!
!       *  The result is returned only in equatorial Cartesian form;
!          the ecliptic longitude, latitude and radius vector are not
!          returned.
!
!       *  The result is in the J2000.0 equatorial frame, not ecliptic.
!
!       *  More is done in-line:  there are fewer calls to other
!          routines.
!
!       *  Different error/warning status values are used.
!
!       *  A different Kepler's-equation-solver is used (avoiding
!          use of COMPLEX*16).
!
!       *  Polynomials in T are nested to minimize rounding errors.
!
!       *  Explicit double-precision constants are used to avoid
!          mixed-mode expressions.
!
!       *  There are other, cosmetic, changes to comply with SOFA
!          style conventions.
!
!     None of the above changes affects the result significantly.
!
!  7. The returned status, J, indicates the most serious condition
!     encountered during execution of the routine.  Illegal NP is
!     considered the most serious, overriding failure to converge,
!     which in turn takes precedence over the remote epoch warning.
!
!### Reference
!  * Simon, J.L, Bretagnon, P., Chapront, J.,
!    Chapront-Touze, M., Francou, G., and Laskar, J.,
!    Astron.Astrophys., 282, 663 (1994).
!
!### History
!  * IAU SOFA revision: 2017 October 12

    subroutine PLAN94 ( date1, date2, np, pv, j )

    implicit none

    real(wp),intent(in) :: date1 !! TDB date part A (Note 1)
    real(wp),intent(in) :: date2 !! TDB date part B (Note 1)
    integer,intent(in) :: np !! planet (1=Mercury, 2=Venus, 3=EMB ... 8=Neptune)
    real(wp),dimension(3,2),intent(out) :: pv !! planet pos,vel (heliocentric, J2000.0, au, au/d)
    integer,intent(out) :: j !! status:
                             !! * -1 = illegal NP (outside 1-8)
                             !! *  0 = OK
                             !! * +1 = warning: date outside 1000-3000 AD
                             !! * +2 = warning: solution failed to converge

    !  Maximum number of iterations allowed to solve Kepler's equation
    integer,parameter :: kmax = 10

    !  Days per Julian millennium
    real(wp),parameter :: djm = 365250.0_wp

    !  Sin and cos of J2000.0 mean obliquity (IAU 1976)
    real(wp),parameter :: sineps = 0.3977771559319137_wp
    real(wp),parameter :: coseps = 0.9174820620691818_wp

    !  Gaussian constant
    real(wp),parameter :: gk = 0.017202098950_wp

    integer :: jstat, i, k
    real(wp) :: t, da, dl, de, dp, di, dom, dmu, arga, argl, am, &
                ae, dae, ae2, at, r, v, si2, xq, xp, tl, xsw, &
                xcw, xm2, xf, ci2, xms, xmc, xpxq2, x, y, z

    !  Planetary inverse masses
    real(wp),dimension(8),parameter :: amas = [ &
                6023600.0_wp, 408523.5_wp, 328900.5_wp, 3098710.0_wp, &
                1047.355_wp, 3498.5_wp, 22869.0_wp, 19314.0_wp ]

    !
    !  Tables giving the mean Keplerian elements, limited to T**2 terms:
    !
    real(wp),dimension(3,8),parameter :: a = reshape([&
      0.3870983098_wp,            0.0_wp,        0.0_wp, &
      0.7233298200_wp,            0.0_wp,        0.0_wp, &
      1.0000010178_wp,            0.0_wp,        0.0_wp, &
      1.5236793419_wp,        3.0e-10_wp,        0.0_wp, &
      5.2026032092_wp,    19132.0e-10_wp,  -39.0e-10_wp, &
      9.5549091915_wp,  -0.0000213896_wp,  444.0e-10_wp, &
     19.2184460618_wp,      -3716e-10_wp,  979.0e-10_wp, &
     30.1103868694_wp,     -16635e-10_wp,  686.0e-10_wp ], [3,8]) !! semi-major axis (au)
    !
    real(wp),dimension(3,8),parameter :: dlm = reshape([&
     252.25090552_wp, 5381016286.88982_wp,  -1.92789_wp, &
     181.97980085_wp, 2106641364.33548_wp,   0.59381_wp, &
     100.46645683_wp, 1295977422.83429_wp,  -2.04411_wp, &
     355.43299958_wp,  689050774.93988_wp,   0.94264_wp, &
      34.35151874_wp,  109256603.77991_wp, -30.60378_wp, &
      50.07744430_wp,   43996098.55732_wp,  75.61614_wp, &
     314.05500511_wp,   15424811.93933_wp,  -1.75083_wp, &
     304.34866548_wp,    7865503.20744_wp,   0.21103_wp ], [3,8]) !! mean longitude (degree and arcsecond)
    !
    real(wp),dimension(3,8),parameter :: e = reshape([&
     0.2056317526_wp,  0.0002040653_wp,    -28349e-10_wp, &
     0.0067719164_wp, -0.0004776521_wp,     98127e-10_wp, &
     0.0167086342_wp, -0.0004203654_wp, -0.0000126734_wp, &
     0.0934006477_wp,  0.0009048438_wp,    -80641e-10_wp, &
     0.0484979255_wp,  0.0016322542_wp, -0.0000471366_wp, &
     0.0555481426_wp, -0.0034664062_wp, -0.0000643639_wp, &
     0.0463812221_wp, -0.0002729293_wp,  0.0000078913_wp, &
     0.0094557470_wp,  0.0000603263_wp,            0.0_wp ], [3,8]) !! eccentricity
    !
    real(wp),dimension(3,8),parameter :: pi = reshape([&
      77.45611904_wp,  5719.11590_wp,   -4.83016_wp, &
     131.56370300_wp,   175.48640_wp, -498.48184_wp, &
     102.93734808_wp, 11612.35290_wp,   53.27577_wp, &
     336.06023395_wp, 15980.45908_wp,  -62.32800_wp, &
      14.33120687_wp,  7758.75163_wp,  259.95938_wp, &
      93.05723748_wp, 20395.49439_wp,  190.25952_wp, &
     173.00529106_wp,  3215.56238_wp,  -34.09288_wp, &
      48.12027554_wp,  1050.71912_wp,   27.39717_wp ], [3,8]) !! longitude of the perihelion (degree and arcsecond)
    !
    real(wp),dimension(3,8),parameter :: dinc = reshape([&
     7.00498625_wp, -214.25629_wp,   0.28977_wp, &
     3.39466189_wp,  -30.84437_wp, -11.67836_wp, &
            0.0_wp,  469.97289_wp,  -3.35053_wp, &
     1.84972648_wp, -293.31722_wp,  -8.11830_wp, &
     1.30326698_wp,  -71.55890_wp,  11.95297_wp, &
     2.48887878_wp,   91.85195_wp, -17.66225_wp, &
     0.77319689_wp,  -60.72723_wp,   1.25759_wp, &
     1.76995259_wp,    8.12333_wp,   0.08135_wp ], [3,8]) !! inclination (degree and arcsecond)
    !
    real(wp),dimension(3,8),parameter :: omega = reshape([&
      48.33089304_wp,  -4515.21727_wp,  -31.79892_wp, &
      76.67992019_wp, -10008.48154_wp,  -51.32614_wp, &
     174.87317577_wp,  -8679.27034_wp,   15.34191_wp, &
      49.55809321_wp, -10620.90088_wp, -230.57416_wp, &
     100.46440702_wp,   6362.03561_wp,  326.52178_wp, &
     113.66550252_wp,  -9240.19942_wp,  -66.23743_wp, &
      74.00595701_wp,   2669.15033_wp,  145.93964_wp, &
     131.78405702_wp,   -221.94322_wp,   -0.78728_wp ], [3,8]) !! longitude of the ascending node (degree and arcsecond)

    !
    !  Tables for trigonometric terms to be added to the mean elements
    !  of the semi-major axes.
    !
    real(wp),dimension(9,8),parameter :: kp = reshape([&
     69613, 75645, 88306, 59899, 15746, 71087, 142173,  3086,    0, &
     21863, 32794, 26934, 10931, 26250, 43725,  53867, 28939,    0, &
     16002, 21863, 32004, 10931, 14529, 16368,  15318, 32794,    0, &
     6345,   7818, 15636,  7077,  8184, 14163,   1107,  4872,    0, &
     1760,   1454,  1167,   880,   287,  2640,     19,  2047, 1454, &
      574,      0,   880,   287,    19,  1760,   1167,   306,  574, &
      204,      0,   177,  1265,     4,   385,    200,   208,  204, &
        0,    102,   106,     4,    98,  1367,    487,   204,    0 ], [9,8])
    !
    real(wp),dimension(9,8),parameter :: ca = reshape([&
          4,    -13,    11,    -9,    -9,    -3,    -1,     4,    0, &
       -156,     59,   -42,     6,    19,   -20,   -10,   -12,    0, &
         64,   -152,    62,    -8,    32,   -41,    19,   -11,    0, &
        124,    621,  -145,   208,    54,   -57,    30,    15,    0, &
     -23437,  -2634,  6601,  6259, -1507, -1821,  2620, -2115,-1489, &
      62911,-119919, 79336, 17814,-24241, 12068,  8306, -4893, 8902, &
     389061,-262125,-44088,  8387,-22976, -2093,  -615, -9720, 6633, &
    -412235,-157046,-31430, 37817, -9740,   -13, -7449,  9644,    0 ], [9,8])
    !
    real(wp),dimension(9,8),parameter :: sa = reshape([&
         -29,    -1,     9,     6,    -6,     5,     4,     0,    0, &
         -48,  -125,   -26,   -37,    18,   -13,   -20,    -2,    0, &
        -150,   -46,    68,    54,    14,    24,   -28,    22,    0, &
        -621,   532,  -694,   -20,   192,   -94,    71,   -73,    0, &
      -14614,-19828, -5869,  1881, -4372, -2255,   782,   930,  913, &
      139737,     0, 24667, 51123, -5102,  7429, -4095, -1976,-9566, &
     -138081,     0, 37205,-49039,-41901,-33872,-27037,-12474,18797, &
           0, 28492,133236, 69654, 52322,-49577,-26430, -3593,    0 ], [9,8])
    !
    !  Tables giving the trigonometric terms to be added to the mean
    !  elements of the mean longitudes.
    !
    real(wp),dimension(10,8),parameter :: kq = reshape([&
      3086, 15746, 69613, 59899, 75645, 88306, 12661, 2658,  0,   0, &
     21863, 32794, 10931,    73,  4387, 26934,  1473, 2157,  0,   0, &
        10, 16002, 21863, 10931,  1473, 32004,  4387,   73,  0,   0, &
        10,  6345,  7818,  1107, 15636,  7077,  8184,  532, 10,   0, &
        19,  1760,  1454,   287,  1167,   880,   574, 2640, 19,1454, &
        19,   574,   287,   306,  1760,    12,    31,   38, 19, 574, &
         4,   204,   177,     8,    31,   200,  1265,  102,  4, 204, &
         4,   102,   106,     8,    98,  1367,   487,  204,  4, 102 ], [10,8])
    !
    real(wp),dimension(10,8),parameter :: cl = reshape([&
         21,   -95, -157,   41,   -5,   42,   23,   30,     0,    0, &
       -160,  -313, -235,   60,  -74,  -76,  -27,   34,     0,    0, &
       -325,  -322,  -79,  232,  -52,   97,   55,  -41,     0,    0, &
       2268,  -979,  802,  602, -668,  -33,  345,  201,   -55,    0, &
       7610, -4997,-7689,-5841,-2617, 1115, -748, -607,  6074,  354, &
     -18549, 30125,20012, -730,  824,   23, 1289, -352,-14767,-2062, &
    -135245,-14594, 4197,-4030,-5630,-2898, 2540, -306,  2939, 1986, &
      89948,  2103, 8963, 2695, 3682, 1648,  866, -154, -1963, -283 ], [10,8])
    !
    real(wp),dimension(10,8),parameter :: sl = reshape([&
       -342,   136,  -23,   62,   66,  -52,  -33,   17,     0,    0, &
        524,  -149,  -35,  117,  151,  122,  -71,  -62,     0,    0, &
       -105,  -137,  258,   35, -116,  -88, -112,  -80,     0,    0, &
        854,  -205, -936, -240,  140, -341,  -97, -232,   536,    0, &
     -56980,  8016, 1012, 1448,-3024,-3710,  318,  503,  3767,  577, &
     138606,-13478,-4964, 1441,-1319,-1482,  427, 1236, -9167,-1918, &
      71234,-41116, 5334,-4935,-1848,   66,  434,-1748,  3780, -701, &
     -47645, 11647, 2166, 3194,  679,    0, -244, -419, -2531,   48 ], [10,8])

    !  Validate the planet number.
    if ( np<1 .or. np>8 ) then
       jstat = -1

       !  Reset the result in case of failure.
       do k=1,2
          do i=1,3
             pv(i,k) = 0.0_wp
          end do
       end do
    else

       !  Time: Julian millennia since J2000.0.
       t = ( ( date1-dj00 ) + date2 ) / djm

       !  OK status unless remote epoch.
       if ( abs(t) <= 1.0_wp ) then
          jstat = 0
       else
          jstat = 1
       end if

       !  Compute the mean elements.
       da = a(1,np) + &
          ( a(2,np) + &
            a(3,np) * t ) * t
       dl = ( 3600.0_wp * dlm(1,np) + &
                     ( dlm(2,np) + &
                       dlm(3,np) * t ) * t ) * das2r
       de = e(1,np) + &
          ( e(2,np) + &
            e(3,np) * t ) * t
       dp = ANPM ( ( 3600.0_wp * pi(1,np) + &
                                ( pi(2,np) + &
                                  pi(3,np) * t ) * t ) * das2r )
       di = ( 3600.0_wp * dinc(1,np) + &
                     ( dinc(2,np) + &
                       dinc(3,np) * t ) * t ) * das2r
       dom = ANPM ( ( 3600.0_wp * omega(1,np) &
                               + ( omega(2,np) &
                                 + omega(3,np) * t ) * t ) * das2r )

       !  Apply the trigonometric terms.
       dmu = 0.35953620_wp * t
       do k=1,8
          arga = kp(k,np) * dmu
          argl = kq(k,np) * dmu
          da = da + ( ca(k,np) * cos(arga) + &
                      sa(k,np) * sin(arga) ) * 1.0e-7_wp
          dl = dl + ( cl(k,np) * cos(argl) + &
                      sl(k,np) * sin(argl) ) * 1.0e-7_wp
       end do
       arga = kp(9,np) * dmu
       da = da + t * ( ca(9,np) * cos(arga) + &
                       sa(9,np) * sin(arga) ) * 1.0e-7_wp
       do k=9,10
          argl = kq(k,np) * dmu
          dl = dl + t * ( cl(k,np) * cos(argl) + &
                          sl(k,np) * sin(argl) ) * 1.0e-7_wp
       end do
       dl = mod(dl, d2pi)

       !  Iterative solution of Kepler's equation to get eccentric anomaly.
       am = dl - dp
       ae = am + de*sin(am)
       k = 0
       do
          dae = ( am - ae + de*sin(ae) ) / ( 1.0_wp - de*cos(ae) )
          ae = ae + dae
          k = k + 1
          if ( k>=kmax ) jstat = 2
          if ( k==kmax .or. abs(dae) <= 1.0e-12_wp ) exit
       end do
       !  True anomaly.
       ae2 = ae / 2.0_wp
       at = 2.0_wp * atan2(sqrt((1.0_wp+de)/(1.0_wp-de)) * sin(ae2), &
                                                  cos(ae2))

       !  Distance (au) and speed (radians per day).
       r = da * ( 1.0_wp - de*cos(ae) )
       v = gk * sqrt( ( 1.0_wp + 1.0_wp/amas(np) ) / (da*da*da))

       si2 = sin(di/2.0_wp)
       xq = si2 * cos(dom)
       xp = si2 * sin(dom)
       tl = at + dp
       xsw = sin(tl)
       xcw = cos(tl)
       xm2 = 2.0_wp * ( xp*xcw - xq*xsw )
       xf = da / sqrt(1.0_wp - de*de)
       ci2 = cos(di/2.0_wp)
       xms = ( de * sin(dp) + xsw ) * xf
       xmc = ( de * cos(dp) + xcw ) * xf
       xpxq2 = 2.0_wp * xp * xq

       !  Position (J2000.0 ecliptic x,y,z in au).
       x = r * ( xcw - xm2*xp )
       y = r * ( xsw + xm2*xq )
       z = r * ( -xm2 * ci2 )

       !  Rotate to equatorial.
       pv(1,1) = x
       pv(2,1) = y*coseps - z*sineps
       pv(3,1) = y*sineps + z*coseps

       !  Velocity (J2000.0 ecliptic xdot,ydot,zdot in au/d).
       x = v * ( ( -1.0_wp + 2.0_wp*xp*xp ) * xms + xpxq2 * xmc )
       y = v * ( ( 1.0_wp - 2.0_wp*xq*xq ) * xmc - xpxq2 * xms )
       z = v * ( 2.0_wp * ci2 * ( xp*xms + xq*xmc ) )

       !  Rotate to equatorial.
       pv(1,2) = x
       pv(2,2) = y*coseps - z*sineps
       pv(3,2) = y*sineps + z*coseps

    end if

    !  Return the status.
    j = jstat

    end subroutine PLAN94
!***********************************************************************

!***********************************************************************
!>
!  Modulus of p-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PM ( p, r )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),intent(out) :: r !! modulus

    integer :: i
    real(wp) :: w, c

    w = 0.0_wp
    do i=1,3
       c = p(i)
       w = w + c*c
    end do
    r = sqrt(w)

    end subroutine PM
!***********************************************************************

!***********************************************************************
!>
!  Precession matrix (including frame bias) from GCRS to a specified
!  date, IAU 2000 model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the arguments DATE1 and DATE2.  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.
!
!  2. The matrix operates in the sense V(date) = RBP * V(GCRS), where
!     the p-vector V(GCRS) is with respect to the Geocentric Celestial
!     Reference System (IAU, 2000) and the p-vector V(date) is with
!     respect to the mean equatorial triad of the given date.
!
!### Reference
!
!  * IAU: Trans. International Astronomical Union, Vol. XXIVB;  Proc.
!    24th General Assembly, Manchester, UK.  Resolutions B1.3, B1.6.
!    (2000)
!
!### History
!  * IAU SOFA revision: 2009 December 21

    subroutine PMAT00 ( date1, date2, rbp )

    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),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 2)

    real(wp) :: rb(3,3), rp(3,3)

    !  Obtain the required matrix (discarding others).
    call BP00 ( date1, date2, rb, rp, rbp )

    end subroutine PMAT00
!***********************************************************************

!***********************************************************************
!>
!  Precession matrix (including frame bias) from GCRS to a specified
!  date, IAU 2006 model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TT date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the arguments DATE1 and DATE2.  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.
!
!  2. The matrix operates in the sense V(date) = RBP * V(GCRS), where
!     the p-vector V(GCRS) is with respect to the Geocentric Celestial
!     Reference System (IAU, 2000) and the p-vector V(date) is with
!     respect to the mean equatorial triad of the given date.
!
!### References
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2009 December 21

    subroutine PMAT06 ( date1, date2, rbp )

    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),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 2)

    real(wp) :: gamb, phib, psib, epsa

    !  Bias-precession Fukushima-Williams angles.
    call PFW06 ( date1, date2, gamb, phib, psib, epsa )

    !  Form the matrix.
    call FW2M ( gamb, phib, psib, epsa, rbp )

    end subroutine PMAT06
!***********************************************************************

!***********************************************************************
!>
!  Precession matrix from J2000.0 to a specified date, IAU 1976 model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The ending date DATE1+DATE2 is a Julian Date, apportioned
!     in any convenient way between the arguments DATE1 and DATE2.
!     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.
!
!  2. The matrix operates in the sense V(date) = RMATP * V(J2000),
!     where the p-vector V(J2000) is with respect to the mean
!     equatorial triad of epoch J2000.0 and the p-vector V(date)
!     is with respect to the mean equatorial triad of the given
!     date.
!
!  3. Though the matrix method itself is rigorous, the precession
!     angles are expressed through canonical polynomials which are
!     valid only for a limited time span.  In addition, the IAU 1976
!     precession rate is known to be imperfect.  The absolute accuracy
!     of the present formulation is better than 0.1 arcsec from
!     1960AD to 2040AD, better than 1 arcsec from 1640AD to 2360AD,
!     and remains below 3 arcsec for the whole of the period
!     500BC to 3000AD.  The errors exceed 10 arcsec outside the
!     range 1200BC to 3900AD, exceed 100 arcsec outside 4200BC to
!     5600AD and exceed 1000 arcsec outside 6800BC to 8200AD.
!
!### References
!
!  * Lieske, J.H., 1979, Astron.Astrophys. 73, 282.
!    equations (6) & (7), p283.
!
!  * Kaplan, G.H., 1981, USNO circular no. 163, pA2.
!
!### History
!  * IAU SOFA revision: 2009 December 18

    subroutine PMAT76 ( date1, date2, rmatp )

    implicit none

    real(wp),intent(in) :: date1 !! ending date, TT (Note 1)
    real(wp),intent(in) :: date2 !! ending date, TT (Note 1)
    real(wp),dimension(3,3),intent(out) :: rmatp !! precession matrix, J2000.0 -> DATE1+DATE2

    real(wp) :: zeta, z, theta, wmat(3,3)

    !  Precession Euler angles, J2000.0 to specified date.
    call PREC76 ( dj00, 0.0_wp, date1, date2, zeta, z, theta )

    !  Form the rotation matrix.
    call IR ( wmat )
    call RZ ( -zeta, wmat )
    call RY ( theta, wmat )
    call RZ ( -z, wmat )
    call CR ( wmat, rmatp )

    end subroutine PMAT76
!***********************************************************************

!***********************************************************************
!>
!  P-vector subtraction.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PMP ( a, b, amb )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! first p-vector
    real(wp),dimension(3),intent(in) :: b !! second p-vector
    real(wp),dimension(3),intent(out) :: amb !! A - B

    integer :: i

    do i=1,3
       amb(i) = a(i) - b(i)
    end do

    end subroutine PMP
!***********************************************************************

!***********************************************************************
!>
!  Proper motion and parallax.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.
!
!  2. The proper motion time interval is for when the starlight
!     reaches the solar system barycenter.
!
!  3. To avoid the need for iteration, the Roemer effect (i.e. the
!     small annual modulation of the proper motion coming from the
!     changing light time) is applied approximately, using the
!     direction of the star at the catalog epoch.
!
!### References
!
!  * 1984 Astronomical Almanac, pp B39-B41.
!
!  * Urban, S. & Seidelmann, P. K. (eds), Explanatory Supplement to
!    the Astronomical Almanac, 3rd ed., University Science Books
!    (2013), Section 7.2.
!
!### History
!  * IAU SOFA revision:  2017 March 11

    subroutine PMPX ( rc, dc, pr, pd, px, rv, pmt, pob, pco )

    implicit none

    real(wp),intent(in) :: rc !! ICRS RA at catalog epoch (radians)
    real(wp),intent(in) :: dc !! ICRS Dec at catalog epoch (radians)
    real(wp),intent(in) :: pr !! RA proper motion (radians/year; Note 1)
    real(wp),intent(in) :: pd !! Dec proper motion (radians/year)
    real(wp),intent(in) :: px !! parallax (arcsec)
    real(wp),intent(in) :: rv !! radial velocity (km/s, +ve if receding)
    real(wp),intent(in) :: pmt !! proper motion time interval (SSB, Julian years)
    real(wp),dimension(3),intent(in) :: pob !! SSB to observer vector (au)
    real(wp),dimension(3),intent(out) :: pco !! coordinate direction (BCRS unit vector)

    !  Days per Julian millennium
    real(wp),parameter :: djm = 365250.0_wp

    !  Astronomical unit (m, IAU 2012)
    real(wp),parameter :: aum = 149597870.7e3_wp

    !  Light time for 1 au, Julian years
    real(wp),parameter :: aulty = aum/cmps/d2s/djy

    !  Km/s to au/year
    real(wp),parameter :: vf = d2s*djm/aum

    integer :: i
    real(wp) :: sr, cr, sd, cd, x, y, z, p(3), pdb, &
                dt, pxr, w, pdz, pm(3)

    !  Catalog spherical coordinates to unit vector (and useful functions).
    sr = sin(rc)
    cr = cos(rc)
    sd = sin(dc)
    cd = cos(dc)
    x = cr*cd
    y = sr*cd
    z = sd
    p(1) = x
    p(2) = y
    p(3) = z

    !  Component of observer vector in star direction.
    call PDP ( p, pob, pdb )

    !  Proper motion time interval (y), including Roemer effect.
    dt = pmt + pdb*aulty

    !  Space motion (radians per year).
    pxr = px*das2r
    w = vf*rv*pxr
    pdz = pd*z
    pm(1) = - pr*y - pdz*cr + w*x
    pm(2) =   pr*x - pdz*sr + w*y
    pm(3) =          pd*cd  + w*z

    !  Coordinate direction of star (unit vector, BCRS).
    do i=1,3
       p(i) = p(i) + dt*pm(i) - pxr*pob(i)
    end do
    call PN ( p, w, pco )

    end subroutine PMPX
!***********************************************************************

!***********************************************************************
!>
!  Star proper motion:  update star catalog data for space motion, with
!  special handling to handle the zero parallax case.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The starting and ending TDB epochs EP1A+EP1B and EP2A+EP2B are
!     Julian Dates, apportioned in any convenient way between the two
!     parts (A and B).  For example, JD(TDB)=2450123.7 could be
!     expressed in any of these ways, among others:
!
!             EPnA          EPnB
!
!         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.
!
!  2. In accordance with normal star-catalog conventions, the object's
!     right ascension and declination are freed from the effects of
!     secular aberration.  The frame, which is aligned to the catalog
!     equator and equinox, is Lorentzian and centered on the SSB.
!
!     The proper motions are the rate of change of the right ascension
!     and declination at the catalog epoch and are in radians per TDB
!     Julian year.
!
!     The parallax and radial velocity are in the same frame.
!
!  3. Care is needed with units.  The star coordinates are in radians
!     and the proper motions in radians per Julian year, but the
!     parallax is in arcseconds.
!
!  4. The RA proper motion is in terms of coordinate angle, not true
!     angle.  If the catalog uses arcseconds for both RA and Dec proper
!     motions, the RA proper motion will need to be divided by cos(Dec)
!     before use.
!
!  5. Straight-line motion at constant speed, in the inertial frame, is
!     assumed.
!
!  6. An extremely small (or zero or negative) parallax is overridden to
!     ensure that the object is at a finite but very large distance, but
!     not so large that the proper motion is equivalent to a large but
!     safe speed (about 0.1c using the chosen constant).  A warning
!     status of 1 is added to the status if this action has been taken.
!
!  7. If the space velocity is a significant fraction of c (see the
!     constant VMAX in the routine STARPV), it is arbitrarily set to
!     zero.  When this action occurs, 2 is added to the status.
!
!  8. The relativistic adjustment carried out in the STARPV routine
!     involves an iterative calculation.  If the process fails to
!     converge within a set number of iterations, 4 is added to the
!     status.
!
!### History
!  * IAU SOFA revision:  2013 June 6

    subroutine PMSAFE ( ra1, dec1, pmr1, pmd1, px1, rv1, &
                        ep1a, ep1b, ep2a, ep2b, &
                        ra2, dec2, pmr2, pmd2, px2, rv2, j )

    implicit none

    real(wp),intent(in) :: ra1 !! right ascension (radians), before
    real(wp),intent(in) :: dec1 !! declination (radians), before
    real(wp),intent(in) :: pmr1 !! RA proper motion (radians/year), before
    real(wp),intent(in) :: pmd1 !! Dec proper motion (radians/year), before
    real(wp),intent(in) :: px1 !! parallax (arcseconds), before
    real(wp),intent(in) :: rv1 !! radial velocity (km/s, +ve = receding), before
    real(wp),intent(in) :: ep1a !! "before" epoch, part A (Note 1)
    real(wp),intent(in) :: ep1b !! "before" epoch, part B (Note 1)
    real(wp),intent(in) :: ep2a !! "after" epoch, part A (Note 1)
    real(wp),intent(in) :: ep2b !! "after" epoch, part B (Note 1)
    real(wp),intent(out) :: ra2 !! right ascension (radians), after
    real(wp),intent(out) :: dec2 !! declination (radians), after
    real(wp),intent(out) :: pmr2 !! RA proper motion (radians/year), after
    real(wp),intent(out) :: pmd2 !! Dec proper motion (radians/year), after
    real(wp),intent(out) :: px2 !! parallax (arcseconds), after
    real(wp),intent(out) :: rv2 !! radial velocity (km/s, +ve = receding), after
    integer,intent(out) :: j !! status:
                             !!  * -1 = system error (should not occur)
                             !!  *  0 = no warnings or errors
                             !!  *  1 = distance overridden (Note 6)
                             !!  *  2 = excessive velocity (Note 7)
                             !!  *  4 = solution didn't converge (Note 8)
                             !!  *  else = binary logical OR of the above warnings

    !  Minimum allowed parallax (arcsec)
    real(wp),parameter :: pxmin = 5.0e-7_wp

    !  Factor giving maximum allowed transverse speed of about 1% c
    real(wp),parameter :: f = 326.0_wp

    integer :: jpx
    real(wp) :: pm, px1a

    !  Proper motion in one year (radians).
    call SEPS ( ra1, dec1, ra1+pmr1, dec1+pmd1, pm )

    !  Override the parallax to reduce the chances of a warning status.
    jpx = 0
    px1a = px1
    pm = pm * f
    if ( px1a < pm ) then
       jpx = 1
       px1a = pm
    end if
    if ( px1a < pxmin ) then
       jpx = 1
       px1a = pxmin
    end if

    !  Carry out the transformation using the modified parallax.
    call STARPM ( ra1, dec1, pmr1, pmd1, px1a, rv1, &
                  ep1a, ep1b, ep2a, ep2b, &
                  ra2, dec2, pmr2, pmd2, px2, rv2, j )

    !  Revise the status.
    if ( mod(j,2) == 0 ) j = j + jpx

    end subroutine PMSAFE
!***********************************************************************

!***********************************************************************
!>
!  Convert a p-vector into modulus and unit vector.
!
!  Status:  vector/matrix support routine.
!
!### Note
!     If P is null, the result is null.  Otherwise the result is
!     a unit vector.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine PN ( p, r, u )

    implicit none

    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),intent(out) :: r !! modulus
    real(wp),dimension(3),intent(out) :: u !! unit vector

    real(wp) :: w

    !  Obtain the modulus and test for zero.
    call PM ( p, w )
    if ( w == 0.0_wp ) then
       !  Null vector.
       call ZP ( u )
    else
       !  Unit vector.
       call SXP ( 1.0_wp/w, p, u )
    end if

    !  Return the modulus.
    r = w

    end subroutine PN
!***********************************************************************

!***********************************************************************
!>
!  Precession-nutation, IAU 2000 model:  a multi-purpose routine,
!  supporting classical (equinox-based) use directly and CIO-based
!  use indirectly.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The caller is responsible for providing the nutation components;
!     they are in longitude and obliquity, in radians and are with
!     respect to the equinox and ecliptic of date.  For high-accuracy
!     applications, free core nutation should be included as well as
!     any other relevant corrections to the position of the CIP.
!
!  3. The returned mean obliquity is consistent with the IAU 2000
!     precession-nutation models.
!
!  4. The matrix RB transforms vectors from GCRS to J2000.0 mean equator
!     and equinox by applying frame bias.
!
!  5. The matrix RP transforms vectors from J2000.0 mean equator and
!     equinox to mean equator and equinox of date by applying
!     precession.
!
!  6. The matrix RBP transforms vectors from GCRS to mean equator and
!     equinox of date by applying frame bias then precession.  It is the
!     product RP x RB.
!
!  7. The matrix RN transforms vectors from mean equator and equinox of
!     date to true equator and equinox of date by applying the nutation
!     (luni-solar + planetary).
!
!  8. The matrix RBPN transforms vectors from GCRS to true equator and
!     equinox of date.  It is the product RN x RBP, applying frame bias,
!     precession and nutation in that order.
!
!### Reference
!
!  * 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.
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine PN00 ( date1, date2, dpsi, deps, &
                      epsa, rb, rp, rbp, rn, rbpn )

    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) :: dpsi !! nutation (Note 2)
    real(wp),intent(in) :: deps !! nutation (Note 2)
    real(wp),intent(out) :: epsa !! mean obliquity (Note 3)
    real(wp),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 4)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 5)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 6)
    real(wp),dimension(3,3),intent(out) :: rn !! nutation matrix (Note 7)
    real(wp),dimension(3,3),intent(out) :: rbpn !! GCRS-to-true matrix (Note 8)

    real(wp) :: dpsipr, depspr

    !  IAU 2000 precession-rate adjustments.
    call PR00 ( date1, date2, dpsipr, depspr )

    !  Mean obliquity, consistent with IAU 2000 precession-nutation.
    epsa = OBL80 ( date1, date2 ) + depspr

    !  Frame bias and precession matrices and their product.
    call BP00 ( date1, date2, rb, rp, rbp )

    !  Nutation matrix.
    call NUMAT ( epsa, dpsi, deps, rn )

    !  Bias-precession-nutation matrix (classical).
    call RXR ( rn, rbp, rbpn )

    end subroutine PN00
!***********************************************************************

!***********************************************************************
!>
!  Precession-nutation, IAU 2000A model:  a multi-purpose routine,
!  supporting classical (equinox-based) use directly and CIO-based
!  use indirectly.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The nutation components (luni-solar + planetary, IAU 2000A) in
!     longitude and obliquity are in radians and with respect to the
!     equinox and ecliptic of date.  Free core nutation is omitted;  for
!     the utmost accuracy, use the PN00 routine, where the nutation
!     components are caller-specified.  For faster but slightly less
!     accurate results, use the PN00B routine.
!
!  3. The mean obliquity is consistent with the IAU 2000 precession.
!
!  4. The matrix RB transforms vectors from GCRS to J2000.0 mean equator
!     and equinox by applying frame bias.
!
!  5. The matrix RP transforms vectors from J2000.0 mean equator and
!     equinox to mean equator and equinox of date by applying
!     precession.
!
!  6. The matrix RBP transforms vectors from GCRS to mean equator and
!     equinox of date by applying frame bias then precession.  It is the
!     product RP x RB.
!
!  7. The matrix RN transforms vectors from mean equator and equinox of
!     date to true equator and equinox of date by applying the nutation
!     (luni-solar + planetary).
!
!  8. The matrix RBPN transforms vectors from GCRS to true equator and
!     equinox of date.  It is the product RN x RBP, applying frame bias,
!     precession and nutation in that order.
!
!  9. The X,Y,Z coordinates of the IAU 2000A Celestial Intermediate Pole
!     are elements (3,1-3) of the matrix RBPN.
!
!### Reference
!
!  * 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.
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine PN00A ( date1, date2, &
                       dpsi, deps, epsa, rb, rp, rbp, rn, rbpn )

    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(out) :: dpsi !! nutation (Note 2)
    real(wp),intent(out) :: deps !! nutation (Note 2)
    real(wp),intent(out) :: epsa !! mean obliquity (Note 3)
    real(wp),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 4)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 5)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 6)
    real(wp),dimension(3,3),intent(out) :: rn !! nutation matrix (Note 7)
    real(wp),dimension(3,3),intent(out) :: rbpn !! GCRS-to-true matrix (Notes 8,9)

    !  Nutation.
    call NUT00A ( date1, date2, dpsi, deps )

    !  Remaining results.
    call PN00 ( date1, date2, dpsi, deps, &
                    epsa, rb, rp, rbp, rn, rbpn )

    end subroutine PN00A
!***********************************************************************

!***********************************************************************
!>
!  Precession-nutation, IAU 2000B model:  a multi-purpose routine,
!  supporting classical (equinox-based) use directly and CIO-based
!  use indirectly.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The nutation components (luni-solar + planetary, IAU 2000B) in
!     longitude and obliquity are in radians and with respect to the
!     equinox and ecliptic of date.  For more accurate results, but
!     at the cost of increased computation, use the PN00A routine.
!     For the utmost accuracy, use the PN00 routine, where the
!     nutation components are caller-specified.
!
!  3. The mean obliquity is consistent with the IAU 2000 precession.
!
!  4. The matrix RB transforms vectors from GCRS to J2000.0 mean equator
!     and equinox by applying frame bias.
!
!  5. The matrix RP transforms vectors from J2000.0 mean equator and
!     equinox to mean equator and equinox of date by applying
!     precession.
!
!  6. The matrix RBP transforms vectors from GCRS to mean equator and
!     equinox of date by applying frame bias then precession.  It is the
!     product RP x RB.
!
!  7. The matrix RN transforms vectors from mean equator and equinox of
!     date to true equator and equinox of date by applying the nutation
!     (luni-solar + planetary).
!
!  8. The matrix RBPN transforms vectors from GCRS to true equator and
!     equinox of date.  It is the product RN x RBP, applying frame bias,
!     precession and nutation in that order.
!
!  9. The X,Y,Z coordinates of the IAU 2000B Celestial Intermediate Pole
!     are elements (3,1-3) of the matrix RBPN.
!
!### Reference
!
!  * 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.
!
!### History
!  * IAU SOFA revision: 2010 January 18

    subroutine PN00B ( date1, date2, &
                       dpsi, deps, epsa, rb, rp, rbp, rn, rbpn )

    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(out) :: dpsi !! nutation (Note 2)
    real(wp),intent(out) :: deps !! nutation (Note 2)
    real(wp),intent(out) :: epsa !! mean obliquity (Note 3)
    real(wp),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 4)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 5)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 6)
    real(wp),dimension(3,3),intent(out) :: rn !! nutation matrix (Note 7)
    real(wp),dimension(3,3),intent(out) :: rbpn !! GCRS-to-true matrix (Notes 8,9)

    !  Nutation.
    call NUT00B ( date1, date2, dpsi, deps )

    !  Remaining results.
    call PN00 ( date1, date2, dpsi, deps, &
                epsa, rb, rp, rbp, rn, rbpn )

    end subroutine PN00B
!***********************************************************************

!***********************************************************************
!>
!  Precession-nutation, IAU 2006 model:  a multi-purpose routine,
!  supporting classical (equinox-based) use directly and CIO-based use
!  indirectly.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The caller is responsible for providing the nutation components;
!     they are in longitude and obliquity, in radians and are with
!     respect to the equinox and ecliptic of date.  For high-accuracy
!     applications, free core nutation should be included as well as
!     any other relevant corrections to the position of the CIP.
!
!  3. The returned mean obliquity is consistent with the IAU 2006
!     precession.
!
!  4. The matrix RB transforms vectors from GCRS to mean J2000.0 by
!     applying frame bias.
!
!  5. The matrix RP transforms vectors from mean J2000.0 to mean of date
!     by applying precession.
!
!  6. The matrix RBP transforms vectors from GCRS to mean of date by
!     applying frame bias then precession.  It is the product RP x RB.
!
!  7. The matrix RN transforms vectors from mean of date to true of date
!     by applying the nutation (luni-solar + planetary).
!
!  8. The matrix RBPN transforms vectors from GCRS to true of date
!     (CIP/equinox).  It is the product RN x RBP, applying frame bias,
!     precession and nutation in that order.
!
!  9. The X,Y,Z coordinates of the Celestial Intermediate Pole are
!     elements (3,1-3) of the matrix RBPN.
!
!### References
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2013 November 14

    subroutine PN06 ( date1, date2, dpsi, deps, &
                      epsa, rb, rp, rbp, rn, rbpn )

    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) :: dpsi !! nutation (Note 2)
    real(wp),intent(in) :: deps !! nutation (Note 2)
    real(wp),intent(out) :: epsa !! mean obliquity (Note 3)
    real(wp),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 4)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 5)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 6)
    real(wp),dimension(3,3),intent(out) :: rn !! nutation matrix (Note 7)
    real(wp),dimension(3,3),intent(out) :: rbpn !! GCRS-to-true matrix (Note 8)

    !  JD for MJD 0
    real(wp),parameter :: djm0 = 2400000.5_wp

    !  Reference epoch (J2000.0), MJD
    real(wp),parameter :: djm00 = 51544.5_wp

    real(wp) :: gamb, phib, psib, eps, rt(3,3)

    !  Bias-precession Fukushima-Williams angles of J2000.0 = frame bias.
    call PFW06 ( djm0, djm00, gamb, phib, psib, eps )

    !  B matrix.
    call FW2M ( gamb, phib, psib, eps, rb )

    !  Bias-precession Fukushima-Williams angles of date.
    call PFW06 ( date1, date2, gamb, phib, psib, eps )

    !  Bias-precession matrix.
    call FW2M ( gamb, phib, psib, eps, rbp )

    !  Solve for precession matrix.
    call TR ( rb, rt )
    call RXR ( rbp, rt, rp )

    !  Equinox-based bias-precession-nutation matrix.
    call FW2M ( gamb, phib, psib+dpsi, eps+deps, rbpn )

    !  Solve for nutation matrix.
    call TR ( rbp, rt )
    call RXR ( rbpn, rt, rn )

    !  Obliquity, mean of date.
    epsa = eps

    end subroutine PN06
!***********************************************************************

!***********************************************************************
!>
!  Precession-nutation, IAU 2006/2000A models:  a multi-purpose routine,
!  supporting classical (equinox-based) use directly and CIO-based use
!  indirectly.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The nutation components (luni-solar + planetary, IAU 2000A) in
!     longitude and obliquity are in radians and with respect to the
!     equinox and ecliptic of date.  Free core nutation is omitted;  for
!     the utmost accuracy, use the PN06 routine, where the nutation
!     components are caller-specified.
!
!  3. The mean obliquity is consistent with the IAU 2006 precession.
!
!  4. The matrix RB transforms vectors from GCRS to mean J2000.0 by
!     applying frame bias.
!
!  5. The matrix RP transforms vectors from mean J2000.0 to mean of date
!     by applying precession.
!
!  6. The matrix RBP transforms vectors from GCRS to mean of date by
!     applying frame bias then precession.  It is the product RP x RB.
!
!  7. The matrix RN transforms vectors from mean of date to true of date
!     by applying the nutation (luni-solar + planetary).
!
!  8. The matrix RBPN transforms vectors from GCRS to true of date
!     (CIP/equinox).  It is the product RN x RBP, applying frame bias,
!     precession and nutation in that order.
!
!  9. The X,Y,Z coordinates of the IAU 2006/2000A Celestial Intermediate
!     Pole are elements (3,1-3) of the matrix RBPN.
!
!### Reference
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine PN06A ( date1, date2, &
                       dpsi, deps, epsa, rb, rp, rbp, rn, rbpn )

    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(out) :: dpsi !! nutation (Note 2)
    real(wp),intent(out) :: deps !! nutation (Note 2)
    real(wp),intent(out) :: epsa !! mean obliquity (Note 3)
    real(wp),dimension(3,3),intent(out) :: rb !! frame bias matrix (Note 4)
    real(wp),dimension(3,3),intent(out) :: rp !! precession matrix (Note 5)
    real(wp),dimension(3,3),intent(out) :: rbp !! bias-precession matrix (Note 6)
    real(wp),dimension(3,3),intent(out) :: rn !! nutation matrix (Note 7)
    real(wp),dimension(3,3),intent(out) :: rbpn !! GCRS-to-true matrix (Notes 8,9)

    !  Nutation.
    call NUT06A ( date1, date2, dpsi, deps )

    !  Remaining results.
    call PN06 ( date1, date2, dpsi, deps, &
                epsa, rb, rp, rbp, rn, rbpn )

    end subroutine PN06A
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of precession-nutation for a given date (including
!  frame bias), equinox-based, IAU 2000A model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix operates in the sense V(date) = RBPN * V(GCRS), where
!     the p-vector V(date) is with respect to the true equatorial triad
!     of date DATE1+DATE2 and the p-vector V(GCRS) is with respect to
!     the Geocentric Celestial Reference System (IAU, 2000).
!
!  3. A faster, but slightly less accurate result (about 1 mas), can be
!     obtained by using instead the PNM00B routine.
!
!### Reference
!
!  * IAU: Trans. International Astronomical Union, Vol. XXIVB;  Proc.
!    24th General Assembly, Manchester, UK.  Resolutions B1.3, B1.6.
!    (2000)
!
!### History
!  * IAU SOFA revision: 2009 December 21

    subroutine PNM00A ( date1, date2, rbpn )

    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),dimension(3,3),intent(out) :: rbpn !! classical NPB matrix (Note 2)

    real(wp) :: dpsi, deps, epsa, rb(3,3), rp(3,3), rbp(3,3), &
                rn(3,3)

    !  Obtain the required matrix (discarding other results).
    call PN00A ( date1, date2, &
                 dpsi, deps, epsa, rb, rp, rbp, rn, rbpn )

    end subroutine PNM00A
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of precession-nutation for a given date (including
!  frame bias), equinox-based, IAU 2000B model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix operates in the sense V(date) = RBPN * V(GCRS), where
!     the p-vector V(date) is with respect to the true equatorial triad
!     of date DATE1+DATE2 and the p-vector V(GCRS) is with respect to
!     the Geocentric Celestial Reference System (IAU, 2000).
!
!  3. The present routine is faster, but slightly less accurate (about
!     1 mas), than the PNM00A routine.
!
!### Reference
!
!  * IAU: Trans. International Astronomical Union, Vol. XXIVB;  Proc.
!    24th General Assembly, Manchester, UK.  Resolutions B1.3, B1.6.
!    (2000)
!
!### History
!  * IAU SOFA revision: 2009 December 21

    subroutine PNM00B ( date1, date2, rbpn )

    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),dimension(3,3),intent(out) :: rbpn !! bias-precession-nutation matrix (Note 2)

    real(wp) ::  dpsi, deps, epsa, &
                 rb(3,3), rp(3,3), rbp(3,3), rn(3,3)

    !  Obtain the required matrix (discarding other results).
    call PN00B ( date1, date2, &
                 dpsi, deps, epsa, rb, rp, rbp, rn, rbpn )

    end subroutine PNM00B
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of precession-nutation for a given date (including
!  frame bias), IAU 2006 precession and IAU 2000A nutation models.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The matrix operates in the sense V(date) = RNPB * V(GCRS), where
!     the p-vector V(date) is with respect to the true equatorial triad
!     of date DATE1+DATE2 and the p-vector V(GCRS) is with respect to
!     the Geocentric Celestial Reference System (IAU, 2000).
!
!### Reference
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855.
!
!### History
!  * IAU SOFA revision: 2009 December 21

    subroutine PNM06A ( date1, date2, rnpb )

    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),dimension(3,3),intent(out) :: rnpb !! bias-precession-nutation matrix (Note 2)

    real(wp) :: gamb, phib, psib, epsa, dp, de

    !  Fukushima-Williams angles for frame bias and precession.
    call PFW06 ( date1, date2, gamb, phib, psib, epsa )

    !  Nutation components.
    call NUT06A ( date1, date2, dp, de )

    !  Equinox based nutation x precession x bias matrix.
    call FW2M ( gamb, phib, psib+dp, epsa+de, rnpb )

    end subroutine PNM06A
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of precession/nutation for a given date, IAU 1976
!  precession model, IAU 1980 nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The TDB date DATE1+DATE2 is a Julian Date, apportioned in any
!     convenient way between the two arguments.  For example,
!     JD(TDB)=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.
!
!  2. The matrix operates in the sense V(date) = RMATPN * V(J2000),
!     where the p-vector V(date) is with respect to the true
!     equatorial triad of date DATE1+DATE2 and the p-vector
!     V(J2000) is with respect to the mean equatorial triad of
!     epoch J2000.0.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992),
!    Section 3.3 (p145).
!
!### History
!  * IAU SOFA revision: 2012 September 5

    subroutine PNM80 ( date1, date2, rmatpn )

    implicit none

    real(wp),intent(in) :: date1 !! TDB date (Note 1)
    real(wp),intent(in) :: date2 !! TDB date (Note 1)
    real(wp),dimension(3,3),intent(out) :: rmatpn !! combined precession/nutation matrix

    real(wp) :: rmatp(3,3), rmatn(3,3)

    !  Precession matrix, J2000.0 to date.
    call PMAT76 ( date1, date2, rmatp )

    !  Nutation matrix.
    call NUTM80 ( date1, date2, rmatn )

    !  Combine the matrices:  PN = N x P.
    call RXR ( rmatn, rmatp, rmatpn )

    end subroutine PNM80
!***********************************************************************

!***********************************************************************
!>
!  Form the matrix of polar motion for a given date, IAU 2000.
!
!  Status:  support routine.
!
!### Notes
!
!  1. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians to 0 and 90 deg west respectively.
!
!  2. SP is the TIO locator s', in radians, which positions the
!     Terrestrial Intermediate Origin on the equator.  It is obtained
!     from polar motion observations by numerical integration, and so is
!     in essence unpredictable.  However, it is dominated by a secular
!     drift of about 47 microarcseconds per century, and so can be taken
!     into account by using s' = -47*t, where t is centuries since
!     J2000.0.  The routine SP00 implements this approximation.
!
!  3. The matrix operates in the sense V(TRS) = RPOM * V(CIP), meaning
!     that it is the final rotation when computing the pointing
!     direction to a celestial source.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine POM00 ( xp, yp, sp, rpom )

    implicit none

    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 1)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 1)
    real(wp),intent(in) :: sp !! the TIO locator s' (radians, Note 2)
    real(wp),dimension(3,3),intent(out) :: rpom !! polar-motion matrix (Note 3)

    !  Construct the matrix.
    call IR ( rpom )
    call RZ ( sp, rpom )
    call RY ( -xp, rpom )
    call RX ( -yp, rpom )

    end subroutine POM00
!***********************************************************************

!***********************************************************************
!>
!  P-vector addition.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PPP ( a, b, apb )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! first p-vector
    real(wp),dimension(3),intent(in) :: b !! second p-vector
    real(wp),dimension(3),intent(out) :: apb !! A + B

    integer :: i

    do i=1,3
       apb(i) = a(i) + b(i)
    end do

    end subroutine PPP
!***********************************************************************

!***********************************************************************
!>
!  P-vector plus scaled p-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2007 August 18

    subroutine PPSP ( a, s, b, apsb )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! first p-vector
    real(wp),intent(in) :: s !! scalar (multiplier for B)
    real(wp),dimension(3),intent(in) :: b !! second p-vector
    real(wp),dimension(3),intent(out) :: apsb !! A + S*B

    integer :: i

    do i=1,3
       apsb(i) = a(i) + s*b(i)
    end do

    end subroutine PPSP
!***********************************************************************

!***********************************************************************
!>
!  Precession-rate part of the IAU 2000 precession-nutation models
!  (part of MHB2000).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The precession adjustments are expressed as "nutation components",
!     corrections in longitude and obliquity with respect to the J2000.0
!     equinox and ecliptic.
!
!  3. Although the precession adjustments are stated to be with respect
!     to Lieske et al. (1977), the MHB2000 model does not specify which
!     set of Euler angles are to be used and how the adjustments are to
!     be applied.  The most literal and straightforward procedure is to
!     adopt the 4-rotation epsilon_0, psi_A, omega_A, xi_A option, and
!     to add DPSIPR to psi_A and DEPSPR to both omega_A and eps_A.
!
!  4. This is an implementation of one aspect of the IAU 2000A nutation
!     model, formally adopted by the IAU General Assembly in 2000,
!     namely MHB2000 (Mathews et al. 2002).
!
!### References
!
!  * Lieske, J.H., Lederle, T., Fricke, W. & Morando, B., "Expressions
!    for the precession quantities based upon the IAU (1976) System of
!    Astronomical Constants", Astron.Astrophys., 58, 1-16 (1977)
!
!  * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation
!    and precession   New nutation series for nonrigid Earth and
!    insights into the Earth's interior", J.Geophys.Res., 107, B4,
!    2002.  The MHB2000 code itself was obtained on 9th September 2002
!    from ftp://maia.usno.navy.mil/conv2000/chapter5/IAU2000A.
!
!  * Wallace, P.T., "Software for Implementing the IAU 2000
!    Resolutions", in IERS Workshop 5.1 (2002).
!
!### History
!  * IAU SOFA revision: 2009 December 15

    subroutine PR00 ( date1, date2, dpsipr, depspr )

    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(out) :: dpsipr !! precession corrections (Notes 2,3)
    real(wp),intent(out) :: depspr !! precession corrections (Notes 2,3)

    real(wp) :: t

    !  ------------------------------------
    !  Precession and obliquity corrections (radians per century)
    !  ------------------------------------

    real(wp),parameter :: precor = -0.29965_wp * das2r
    real(wp),parameter :: oblcor = -0.02524_wp * das2r

    !  Interval between fundamental epoch J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Precession rate contributions with respect to IAU 1976/80.
    dpsipr = precor * t
    depspr = oblcor * t

    end subroutine PR00
!***********************************************************************

!***********************************************************************
!>
!  IAU 1976 precession model.
!
!  This routine forms the three Euler angles which implement general
!  precession between two dates, using the IAU 1976 model (as for
!  the FK5 catalog).
!
!  Status:  canonical model.
!
!### Notes
!
!  1. The dates DATE01+DATE02 and DATE11+DATE12 are Julian Dates,
!     apportioned in any convenient way between the arguments DATEn1 and
!     DATEn2.  For example, JD(TDB)=2450123.7 could be expressed in any
!     of these ways, among others:
!
!           DATEn1         DATEn2
!
!         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
!     optimum resolution.  The MJD method and the date & time methods
!     are both good compromises between resolution and convenience.
!     The two dates may be expressed using different methods, but at
!     the risk of losing some resolution.
!
!  2. The accumulated precession angles zeta, z, theta are expressed
!     through canonical polynomials which are valid only for a limited
!     time span.  In addition, the IAU 1976 precession rate is known to
!     be imperfect.  The absolute accuracy of the present formulation is
!     better than 0.1 arcsec from 1960AD to 2040AD, better than 1 arcsec
!     from 1640AD to 2360AD, and remains below 3 arcsec for the whole of
!     the period 500BC to 3000AD.  The errors exceed 10 arcsec outside
!     the range 1200BC to 3900AD, exceed 100 arcsec outside 4200BC to
!     5600AD and exceed 1000 arcsec outside 6800BC to 8200AD.
!
!  3. The three angles are returned in the conventional order, which
!     is not the same as the order of the corresponding Euler rotations.
!     The precession matrix is R_3(-z) x R_2(+theta) x R_3(-zeta).
!
!### Reference
!
!  * Lieske, J.H., 1979, Astron.Astrophys. 73, 282.
!    equations (6) & (7), p283.
!
!### History
!  * IAU SOFA revision: 2013 November 19

    subroutine PREC76 ( date01, date02, date11, date12, &
                        zeta, z, theta )

    implicit none

    real(wp),intent(in) :: date01 !! TDB starting date (Note 1)
    real(wp),intent(in) :: date02 !! TDB starting date (Note 1)
    real(wp),intent(in) :: date11 !! TDB ending date (Note 1)
    real(wp),intent(in) :: date12 !! TDB ending date (Note 1)
    real(wp),intent(out) :: zeta !! 1st rotation: radians clockwise around z
    real(wp),intent(out) :: z !! 3rd rotation: radians clockwise around z
    real(wp),intent(out) :: theta !! 2nd rotation: radians counterclockwise around y

    real(wp) :: t0, t, tas2r, w

    !  Interval between fundamental epoch J2000.0 and start date (JC).
    t0 = ( ( date01-dj00 ) + date02 ) / djc

    !  Interval over which precession required (JC).
    t = ( ( date11-date01 ) + ( date12-date02 ) ) / djc

    !  Euler angles.
    tas2r = t * das2r
    w = 2306.2181_wp + ( &
           1.39656_wp &
         - 0.000139_wp * t0 ) * t0

    zeta = ( w + ( ( 0.30188_wp &
                   - 0.000344_wp * t0 ) &
                   + 0.017998_wp * t ) * t ) * tas2r

    z = ( w + ( ( 1.09468_wp &
                + 0.000066_wp * t0 ) &
                + 0.018203_wp * t ) * t ) * tas2r

    theta = ( ( 2004.3109_wp + ( &
                 - 0.85330_wp &
                 - 0.000217_wp * t0 ) * t0 ) + ( ( &
                 - 0.42665_wp &
                 - 0.000217_wp * t0 ) &
                 - 0.041833_wp * t ) * t ) * tas2r

    end subroutine PREC76
!***********************************************************************

!***********************************************************************
!>
!  Discard velocity component of a pv-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PV2P ( pv, p )

    implicit none

    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3),intent(out) :: p !! p-vector

    call CP ( pv, p )

    end subroutine PV2P
!***********************************************************************

!***********************************************************************
!>
!  Convert position/velocity from Cartesian to spherical coordinates.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. If the position part of PV is null, THETA, PHI, TD and PD
!     are indeterminate.  This is handled by extrapolating the
!     position through unit time by using the velocity part of
!     PV.  This moves the origin without changing the direction
!     of the velocity component.  If the position and velocity
!     components of PV are both null, zeroes are returned for all
!     six results.
!
!  2. If the position is a pole, THETA, TD and PD are indeterminate.
!     In such cases zeroes are returned for all three.
!
!### History
!  * IAU SOFA revision: 2008 May 10

    subroutine PV2S ( pv, theta, phi, r, td, pd, rd )

    implicit none

    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),intent(out) :: theta !! longitude angle (radians)
    real(wp),intent(out) :: phi !! latitude angle (radians)
    real(wp),intent(out) :: r !! radial distance
    real(wp),intent(out) :: td !! rate of change of THETA
    real(wp),intent(out) :: pd !! rate of change of PHI
    real(wp),intent(out) :: rd !! rate of change of R

    real(wp) :: x, y, z, xd, yd, zd, rxy2, rxy, r2, &
                rtrue, rw, xyp

    !  Components of position/velocity vector.
    x =  pv(1,1)
    y =  pv(2,1)
    z =  pv(3,1)
    xd = pv(1,2)
    yd = pv(2,2)
    zd = pv(3,2)

    !  Component of R in XY plane squared.
    rxy2 = x*x + y*y

    !  Modulus squared.
    r2 = rxy2 + z*z

    !  Modulus.
    rtrue = sqrt(r2)

    !  If null vector, move the origin along the direction of movement.
    rw = rtrue
    if ( rtrue == 0.0_wp ) then
       x = xd
       y = yd
       z = zd
       rxy2 = x*x + y*y
       r2 = rxy2 + z*z
       rw = sqrt(r2)
    end if

    !  Position and velocity in spherical coordinates.
    rxy = sqrt(rxy2)
    xyp = x*xd + y*yd
    if ( rxy2 /= 0.0_wp ) then
       theta = atan2(y,x)
       phi = atan2(z,rxy)
       td = ( x*yd - y*xd ) / rxy2
       pd = ( zd*rxy2 - z*xyp ) / ( r2*rxy )
    else
       theta = 0.0_wp
       if ( z/=0.0_wp ) then
          phi = atan2(z,rxy)
       else
          phi = 0.0_wp
       end if
       td = 0.0_wp
       pd = 0.0_wp
    end if
    r = rtrue
    if ( rw/=0.0_wp ) then
       rd = ( xyp + z*zd ) / rw
    else
       rd = 0.0_wp
    end if

    end subroutine PV2S
!***********************************************************************

!***********************************************************************
!>
!  Inner (=scalar=dot) product of two pv-vectors.
!
!  Status:  vector/matrix support routine.
!
!### Note
!
!  If the position and velocity components of the two pv-vectors are
!  ( Ap, Av ) and ( Bp, Bv ), the result, A . B, is the pair of
!  numbers ( Ap . Bp , Ap . Bv + Av . Bp ).  The two numbers are the
!  dot-product of the two p-vectors and its derivative.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine PVDPV ( a, b, adb )

    implicit none

    real(wp),dimension(3,2),intent(in) :: a !! first pv-vector
    real(wp),dimension(3,2),intent(in) :: b !! second pv-vector
    real(wp),dimension(2),intent(out) :: adb !! A . B (see note)

    real(wp) :: adbd, addb

    !  A . B = constant part of result.
    call PDP ( a(1,1), b(1,1), adb(1) )

    !  A . Bdot
    call PDP ( a(1,1), b(1,2), adbd )

    !  Adot . B
    call PDP ( a(1,2), b(1,1), addb )

    !  Velocity part of result.
    adb(2) = adbd + addb

    end subroutine PVDPV
!***********************************************************************

!***********************************************************************
!>
!  Modulus of pv-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PVM ( pv, r, s )

    implicit none

    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),intent(out) :: r !! modulus of position component
    real(wp),intent(out) :: s !! modulus of velocity component

    !  Distance.
    call PM ( pv(1,1), r )

    !  Speed.
    call PM ( pv(1,2), s )

    end subroutine PVM
!***********************************************************************

!***********************************************************************
!>
!  Subtract one pv-vector from another.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine PVMPV ( a, b, amb )

    implicit none

    real(wp),dimension(3,2),intent(in) :: a !! first pv-vector
    real(wp),dimension(3,2),intent(in) :: b !! second pv-vector
    real(wp),dimension(3,2),intent(out) :: amb !! A - B

    integer :: i

    do i=1,2
       call PMP ( a(1,i), b(1,i), amb(1,i) )
    end do

    end subroutine PVMPV
!***********************************************************************

!***********************************************************************
!>
!  Add one pv-vector to another.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine PVPPV ( a, b, apb )

    implicit none

    real(wp),dimension(3,2),intent(in) :: a !! first pv-vector
    real(wp),dimension(3,2),intent(in) :: b !! second pv-vector
    real(wp),dimension(3,2),intent(out) :: apb !! A + B

    integer :: i

    do i=1,2
       call PPP ( a(1,i), b(1,i), apb(1,i) )
    end do

    end subroutine PVPPV
!***********************************************************************

!***********************************************************************
!>
!  Convert star position+velocity vector to catalog coordinates.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The specified pv-vector is the coordinate direction (and its rate
!     of change) for the epoch at which the light leaving the star
!     reached the solar-system barycenter.
!
!  2. The star data returned by this routine are "observables" for an
!     imaginary observer at the solar-system barycenter.  Proper motion
!     and radial velocity are, strictly, in terms of barycentric
!     coordinate time, TCB.  For most practical applications, it is
!     permissible to neglect the distinction between TCB and ordinary
!     "proper" time on Earth (TT/TAI).  The result will, as a rule, be
!     limited by the intrinsic accuracy of the proper-motion and radial-
!     velocity data;  moreover, the supplied pv-vector is likely to be
!     merely an intermediate result (for example generated by the
!     routine STARPV), so that a change of time unit will cancel
!     out overall.
!
!     In accordance with normal star-catalog conventions, the object's
!     right ascension and declination are freed from the effects of
!     secular aberration.  The frame, which is aligned to the catalog
!     equator and equinox, is Lorentzian and centered on the SSB.
!
!     Summarizing, the specified pv-vector is for most stars almost
!     identical to the result of applying the standard geometrical
!     "space motion" transformation to the catalog data.  The
!     differences, which are the subject of the Stumpff paper cited
!     below, are:
!
!     (i) In stars with significant radial velocity and proper motion,
!     the constantly changing light-time distorts the apparent proper
!     motion.  Note that this is a classical, not a relativistic,
!     effect.
!
!     (ii) The transformation complies with special relativity.
!
!  3. Care is needed with units.  The star coordinates are in radians
!     and the proper motions in radians per Julian year, but the
!     parallax is in arcseconds; the radial velocity is in km/s, but
!     the pv-vector result is in au and au/day.
!
!  4. The proper motions are the rate of change of the right ascension
!     and declination at the catalog epoch and are in radians per Julian
!     year.  The RA proper motion is in terms of coordinate angle, not
!     true angle, and will thus be numerically larger at high
!     declinations.
!
!  5. Straight-line motion at constant speed in the inertial frame is
!     assumed.  If the speed is greater than or equal to the speed of
!     light, the routine aborts with an error status.
!
!  6. The inverse transformation is performed by the routine STARPV.
!
!### Reference
!
!  * Stumpff, P., Astron.Astrophys. 144, 232-240 (1985).
!
!### History
!  * IAU SOFA revision: 2017 March 16
!
!@warning The `pv` argument is documented as an input in the IAU routine,
!         But the velocity components are changed by this routine. In this
!         version, it is declared as `intent(inout)`.

    subroutine PVSTAR ( pv, ra, dec, pmr, pmd, px, rv, j )

    implicit none

    real(wp),dimension(3,2),intent(inout) :: pv !! pv-vector (au, au/day) [see Note 1]
    real(wp),intent(out) :: ra !! right ascension (radians) [see Note 2]
    real(wp),intent(out) :: dec !! declination (radians) [see Note 2]
    real(wp),intent(out) :: pmr !! RA proper motion (radians/year) [see Note 2]
    real(wp),intent(out) :: pmd !! Dec proper motion (radians/year) [see Note 2]
    real(wp),intent(out) :: px !! parallax (arcsec) [see Note 2]
    real(wp),intent(out) :: rv !! radial velocity (km/s, positive = receding) [see Note 2]
    integer,intent(out) :: j !! status [see Note 2]:
                             !! *  0 = OK
                             !! * -1 = superluminal speed (Note 5)
                             !! * -2 = null position vector

    !  Julian years to days
    real(wp),parameter :: y2d = 365.25_wp

    !  Radians to arcseconds
    real(wp),parameter :: dr2as = 206264.8062470963551564734_wp

    !  Astronomical unit (m, IAU 2012)
    real(wp),parameter :: aum = 149597870.7e3_wp

    !  Speed of light (au per day)
    real(wp),parameter :: c = d2s*cmps/aum

    real(wp) :: r, x(3), vr, ur(3), vt, ut(3), bett, betr, d, w, &
                del, usr(3), ust(3), a, rad, decd, rd

    !  Isolate the radial component of the velocity (au/day, inertial).
    call PN ( pv(1,1), r, x )
    call PDP ( x, pv(1,2), vr )
    call SXP ( vr, x, ur )

    !  Isolate the transverse component of the velocity (au/day, inertial).
    call PMP ( pv(1,2), ur, ut )
    call PM ( ut, vt )

    !  Special-relativity dimensionless parameters.
    bett = vt / c
    betr = vr / c

    !  The inertial-to-observed correction terms.
    d = 1.0_wp + betr
    w = betr*betr + bett*bett
    if ( d==0.0_wp .or. w>=1.0_wp ) then
       j = -1
       return
    end if
    del = - w / ( sqrt(1.0_wp-w) + 1.0_wp )

    !  Apply relativistic correction factor to radial velocity component.
    if ( betr/=0.0_wp ) then
       w = ( betr-del ) / ( betr*d )
    else
       w = 1.0_wp
    end if
    call SXP ( w, ur, usr )

    !  Apply relativistic correction factor to tangential velocity component.
    call SXP ( 1.0_wp/d, ut, ust )

    !  Combine the two to obtain the observed velocity vector (au/day).
    call PPP ( usr, ust, pv(1,2) )

    !  Cartesian to spherical.
    call PV2S ( pv, a, dec, r, rad, decd, rd )
    if ( r == 0.0_wp ) then
       j = -2
       return
    end if

    !  Return RA in range 0 to 2pi.
    ra = ANP ( a )

    !  Return proper motions in radians per year.
    pmr = rad * y2d
    pmd = decd * y2d

    !  Return parallax in arcsec.
    px = dr2as / r

    !  Return radial velocity in km/s.
    rv = 1.0e-3_wp * rd * aum / d2s

    !  OK status.
    j = 0

    end subroutine PVSTAR
!***********************************************************************

!***********************************************************************
!>
!  Position and velocity of a terrestrial observing station.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The terrestrial coordinates are with respect to the WGS84
!     reference ellipsoid.
!
!  2. XP and YP are the coordinates (in radians) of the Celestial
!     Intermediate Pole with respect to the International Terrestrial
!     Reference System (see IERS Conventions 2003), measured along the
!     meridians 0 and 90 deg west respectively.  SP is the TIO locator
!     s', in radians, which positions the Terrestrial Intermediate
!     Origin on the equator.  For many applications, XP, YP and
!     (especially) SP can be set to zero.
!
!  3. If THETA is Greenwich apparent sidereal time instead of Earth
!     rotation angle, the result is with respect to the true equator
!     and equinox of date, i.e. with the x-axis at the equinox rather
!     than the celestial intermediate origin.
!
!  4. The velocity units are meters per UT1 second, not per SI second.
!     This is unlikely to have any practical consequences in the modern
!     era.
!
!  5. No validation is performed on the arguments.  Error cases that
!     could lead to arithmetic exceptions are trapped by the GD2GC
!     routine, and the result set to zeros.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Urban, S. & Seidelmann, P. K. (eds), Explanatory Supplement to
!    the Astronomical Almanac, 3rd ed., University Science Books
!    (2013), Section 7.4.3.3.
!
!### History
!  * IAU SOFA revision:  2013 June 25

    subroutine PVTOB ( elong, phi, hm, xp, yp, sp, theta, pv )

    implicit none

    real(wp),intent(in) :: elong !! longitude (radians, east +ve, Note 1)
    real(wp),intent(in) :: phi !! latitude (geodetic, radians, Note 1)
    real(wp),intent(in) :: hm !! height above reference ellipsoid (geodetic, m)
    real(wp),intent(in) :: xp !! coordinates of the pole (radians, Note 2)
    real(wp),intent(in) :: yp !! coordinates of the pole (radians, Note 2)
    real(wp),intent(in) :: sp !! the TIO locator s' (radians, Note 2)
    real(wp),intent(in) :: theta !! Earth rotation angle (radians, Note 3)
    real(wp),dimension(3,2),intent(out) :: pv !! position/velocity vector (m, m/s, CIRS)

    !  Earth rotation rate in radians per UT1 second
    real(wp),parameter :: om = 1.00273781191135448_wp * d2pi / d2s

    integer :: j
    real(wp) :: xyzm(3), rpm(3,3), xyz(3), x, y, z, s, c

    !  Geodetic to geocentric transformation (WGS84).
    call GD2GC ( 1, elong, phi, hm, xyzm, j )

    !  Polar motion and TIO position.
    call POM00 ( xp, yp, sp, rpm )
    call TRXP ( rpm, xyzm, xyz )
    x = xyz(1)
    y = xyz(2)
    z = xyz(3)

    !  routines of ERA.
    s = sin(theta)
    c = cos(theta)

    !  Position.
    pv(1,1) = c*x - s*y
    pv(2,1) = s*x + c*y
    pv(3,1) = z

    !  Velocity.
    pv(1,2) = om * ( -s*x - c*y )
    pv(2,2) = om * (  c*x - s*y )
    pv(3,2) = 0.0_wp

    end subroutine PVTOB
!***********************************************************************

!***********************************************************************
!>
!  Update a pv-vector.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. "Update" means "refer the position component of the vector
!     to a new epoch DT time units from the existing epoch".
!
!  2. The time units of DT must match those of the velocity.
!
!### History
!  * IAU SOFA revision: 2003 January 14

    subroutine PVU ( dt, pv, upv )

    implicit none

    real(wp),intent(in) :: dt !! time interval
    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3,2),intent(out) :: upv !! p updated, v unchanged

    call PPSP ( pv(1,1), dt, pv(1,2), upv(1,1) )
    call CP ( pv(1,2), upv(1,2) )

    end subroutine PVU
!***********************************************************************

!***********************************************************************
!>
!  Update a pv-vector, discarding the velocity component.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. "Update" means "refer the position component of the vector to a
!     new date DT time units from the existing date".
!
!  2. The time units of DT must match those of the velocity.
!
!### History
!  * IAU SOFA revision: 2008 May 8

    subroutine PVUP ( dt, pv, p )

    implicit none

    real(wp),intent(in) :: dt !! time interval
    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3),intent(out) :: p !! p-vector

    integer :: i

    do i=1,3
       p(i) = pv(i,1) + pv(i,2)*dt
    end do

    end subroutine PVUP
!***********************************************************************

!***********************************************************************
!>
!  Outer (=vector=cross) product of two pv-vectors.
!
!  Status:  vector/matrix support routine.
!
!### Note
!
!  If the position and velocity components of the two pv-vectors are
!  ( Ap, Av ) and ( Bp, Bv ), the result, A x B, is the pair of
!  vectors ( Ap x Bp, Ap x Bv + Av x Bp ).  The two vectors are the
!  cross-product of the two p-vectors and its derivative.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine PVXPV ( a, b, axb )

    implicit none

    real(wp),dimension(3,2),intent(in) :: a !! first pv-vector
    real(wp),dimension(3,2),intent(in) :: b !! second pv-vector
    real(wp),dimension(3,2),intent(out) :: axb !! A x B

    real(wp) :: wa(3,2), wb(3,2), axbd(3), adxb(3)

    !  Make copies of the inputs.
    call CPV ( a, wa )
    call CPV ( b, wb )

    !  A x B = position part of result.
    call PXP ( wa(1,1), wb(1,1), axb(1,1) )

    !  A x Bdot + Adot x B = velocity part of result.
    call PXP ( wa(1,1), wb(1,2), axbd )
    call PXP ( wa(1,2), wb(1,1), adxb )
    call PPP ( axbd, adxb, axb(1,2) )

    end subroutine PVXPV
!***********************************************************************

!***********************************************************************
!>
!  p-vector outer (=vector=cross) product.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine PXP ( a, b, axb )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! first p-vector
    real(wp),dimension(3),intent(in) :: b !! second p-vector
    real(wp),dimension(3),intent(out) :: axb !! A x B

    real(wp) :: xa, ya, za, xb, yb, zb

    xa = a(1)
    ya = a(2)
    za = a(3)
    xb = b(1)
    yb = b(2)
    zb = b(3)
    axb(1) = ya*zb - za*yb
    axb(2) = za*xb - xa*zb
    axb(3) = xa*yb - ya*xb

    end subroutine PXP
!***********************************************************************

!***********************************************************************
!>
!  Determine the constants A and B in the atmospheric refraction model
!  dZ = A tan Z + B tan^3 Z.
!
!  Z is the "observed" zenith distance (i.e. affected by refraction)
!  and dZ is what to add to Z to give the "topocentric" (i.e. in vacuo)
!  zenith distance.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The model balances speed and accuracy to give good results in
!     applications where performance at low altitudes is not paramount.
!     Performance is maintained across a range of conditions, and
!     applies to both optical/IR and radio.
!
!  2. The model omits the effects of (i) height above sea level (apart
!     from the reduced pressure itself), (ii) latitude (i.e. the
!     flattening of the Earth), (iii) variations in tropospheric lapse
!     rate and (iv) dispersive effects in the radio.
!
!     The model was tested using the following range of conditions:
!
!     * lapse rates 0.0055, 0.0065, 0.0075 deg/meter
!     * latitudes 0, 25, 50, 75 degrees
!     * heights 0, 2500, 5000 meters ASL
!     * pressures mean for height -10% to +5% in steps of 5%
!     * temperatures -10 deg to +20 deg with respect to 280 deg at SL
!     * relative humidity 0, 0.5, 1
!     * wavelengths 0.4, 0.6, ... 2 micron, + radio
!     * zenith distances 15, 45, 75 degrees
!
!     The accuracy with respect to raytracing through a model
!     atmosphere was as follows:
!```
!                            worst         RMS
!
!       optical/IR           62 mas       8 mas
!       radio               319 mas      49 mas
!```
!     For this particular set of conditions:
!
!     * lapse rate 0.0065 K/meter
!     * latitude 50 degrees
!     * sea level
!     * pressure 1005 mb
!     * temperature 280.15 K
!     * humidity 80%
!     * wavelength 5740 Angstroms
!
!     the results were as follows:
!```
!       ZD       raytrace     REFCO  Saastamoinen
!
!       10         10.27        10.27        10.27
!       20         21.19        21.20        21.19
!       30         33.61        33.61        33.60
!       40         48.82        48.83        48.81
!       45         58.16        58.18        58.16
!       50         69.28        69.30        69.27
!       55         82.97        82.99        82.95
!       60        100.51       100.54       100.50
!       65        124.23       124.26       124.20
!       70        158.63       158.68       158.61
!       72        177.32       177.37       177.31
!       74        200.35       200.38       200.32
!       76        229.45       229.43       229.42
!       78        267.44       267.29       267.41
!       80        319.13       318.55       319.10
!
!      deg        arcsec       arcsec       arcsec
!```
!     The values for Saastamoinen's formula (which includes terms
!     up to tan^5) are taken from Hohenkerk and Sinclair (1985).
!
!  3. A WL value in the range 0-100 selects the optical/IR case and is
!     wavelength in micrometers.  Any value outside this range selects
!     the radio case.
!
!  4. Outlandish input parameters are silently limited to mathematically
!     safe values.  Zero pressure is permissible, and causes zeroes to
!     be returned.
!
!  5. The algorithm draws on several sources, as follows:
!
!     a) The formula for the saturation vapour pressure of water as
!        a function of temperature and temperature is taken from
!        Equations (A4.5-A4.7) of Gill (1982).
!
!     b) The formula for the water vapour pressure, given the
!        saturation pressure and the relative humidity, is from
!        Crane (1976), Equation (2.5.5).
!
!     c) The refractivity of air is a function of temperature,
!        total pressure, water-vapour pressure and, in the case
!        of optical/IR, wavelength.  The formulae for the two cases are
!        developed from Hohenkerk & Sinclair (1985) and Rueger (2002).
!
!     d) The formula for beta, the ratio of the scale height of the
!        atmosphere to the geocentric distance of the observer, is
!        an adaption of Equation (9) from Stone (1996).  The
!        adaptations, arrived at empirically, consist of (i) a small
!        adjustment to the coefficient and (ii) a humidity term for the
!        radio case only.
!
!     e) The formulae for the refraction constants as a function of
!        n-1 and beta are from Green (1987), Equation (4.31).
!
!### References
!
!  * Crane, R.K., Meeks, M.L. (ed), "Refraction Effects in the Neutral
!    Atmosphere", Methods of Experimental Physics: Astrophysics 12B,
!    Academic Press, 1976.
!
!  * Gill, Adrian E., "Atmosphere-Ocean Dynamics", Academic Press,
!    1982.
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987.
!
!  * Hohenkerk, C.Y., & Sinclair, A.T., NAO Technical Note No. 63,
!    1985.
!
!  * Rueger, J.M., "Refractive Index Formulae for Electronic Distance
!    Measurement with Radio and Millimetre Waves", in Unisurv Report
!    S-68, School of Surveying and Spatial Information Systems,
!    University of New South Wales, Sydney, Australia, 2002.
!
!  * Stone, Ronald C., P.A.S.P. 108, 1051-1058, 1996.
!
!### History
!  * IAU SOFA revision: 2016 December 20

    subroutine REFCO ( phpa, tc, rh, wl, refa, refb )

    implicit none

    real(wp),intent(in) :: phpa !! pressure at the observer (hPa = millibar)
    real(wp),intent(in) :: tc !! ambient temperature at the observer (deg C)
    real(wp),intent(in) :: rh !! relative humidity at the observer (range 0-1)
    real(wp),intent(in) :: wl !! wavelength (micrometers)
    real(wp),intent(out) :: refa !! tan Z coefficient (radians)
    real(wp),intent(out) :: refb !! tan^3 Z coefficient (radians)

    logical :: optic
    real(wp) :: p, t, r, w, ps, pw, tk, wlsq, gamma, beta

    !  Decide whether optical/IR or radio case:  switch at 100 microns.
    optic = wl<=100.0_wp

    !  Restrict parameters to safe values.
    t = min(max(tc,-150.0_wp),200.0_wp)
    p = min(max(phpa,0.0_wp),10000.0_wp)
    r = min(max(rh,0.0_wp),1.0_wp)
    w = min(max(wl,0.1_wp),1.0e6_wp)

    !  Water vapour pressure at the observer.
    if (p>0.0_wp) then
       ps = 10.0_wp**((0.7859_wp+0.03477_wp*t)/(1.0_wp+0.00412_wp*t))* &
                                        (1.0_wp+p*(4.5e-6_wp+6e-10_wp*t*t))
       pw = r*ps/(1.0_wp-(1.0_wp-r)*ps/p)
    else
       pw = 0.0_wp
    end if

    !  Refractive index minus 1 at the observer.
    tk = t + 273.15_wp
    if (optic) then
       wlsq = w*w
       gamma = ((77.53484e-6_wp+(4.39108e-7_wp+3.666e-9_wp/wlsq)/wlsq)*p &
                                                    -11.2684e-6_wp*pw)/tk
    else
       gamma = (77.6890e-6_wp*p-(6.3938e-6_wp-0.375463_wp/tk)*pw)/tk
    end if

    !  Formula for beta adapted from Stone, with empirical adjustments.
    beta=4.4474e-6_wp*tk
    if (.not.optic) beta=beta-0.0074_wp*pw*beta

    !  Refraction constants from Green.
    refa = gamma*(1.0_wp-beta)
    refb = -gamma*(beta-gamma/2.0_wp)

    end subroutine REFCO
!***********************************************************************

!***********************************************************************
!>
!  Express an r-matrix as an r-vector.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. A rotation matrix describes a rotation through some angle about
!     some arbitrary axis called the Euler axis.  The "rotation vector"
!     returned by this routine has the same direction as the Euler axis,
!     and its magnitude is the angle in radians.  (The magnitude and
!     direction can be separated by means of the routine PN.)
!
!  2. If R is null, so is the result.  If R is not a rotation matrix
!     the result is undefined.  R must be proper (i.e. have a positive
!     determinant) and real orthogonal (inverse = transpose).
!
!  3. The reference frame rotates clockwise as seen looking along
!     the rotation vector from the origin.
!
!### History
!  * IAU SOFA revision: 2015 January 30

    subroutine RM2V ( r, w )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! rotation matrix
    real(wp),dimension(3),intent(out) :: w !! rotation vector (Note 1)

    real(wp) :: x, y, z, s2, c2, phi, f

    x = r(2,3) - r(3,2)
    y = r(3,1) - r(1,3)
    z = r(1,2) - r(2,1)
    s2 = sqrt(x*x + y*y + z*z)
    if ( s2 > 0.0_wp ) then
       c2 = r(1,1) + r(2,2) + r(3,3) - 1.0_wp
       phi = atan2(s2,c2)
       f = phi / s2
       w(1) = x * f
       w(2) = y * f
       w(3) = z * f
    else
       w(1) = 0.0_wp
       w(2) = 0.0_wp
       w(3) = 0.0_wp
    end if

    end subroutine RM2V
!***********************************************************************

!***********************************************************************
!>
!  Form the r-matrix corresponding to a given r-vector.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. A rotation matrix describes a rotation through some angle about
!     some arbitrary axis called the Euler axis.  The "rotation vector"
!     supplied to this routine has the same direction as the Euler axis,
!     and its magnitude is the angle in radians.
!
!  2. If W is null, the unit matrix is returned.
!
!  3. The reference frame rotates clockwise as seen looking along the
!     rotation vector from the origin.
!
!### History
!  * IAU SOFA revision: 2015 January 30

    subroutine RV2M ( w, r )

    implicit none

    real(wp),dimension(3),intent(in) :: w !! rotation vector (Note 1)
    real(wp),dimension(3,3),intent(out) :: r !! rotation matrix

    real(wp) :: x, y, z, phi, s, c, f

    !  Euler angle (magnitude of rotation vector) and functions.
    x = w(1)
    y = w(2)
    z = w(3)
    phi = sqrt(x*x + y*y + z*z)
    s = sin(phi)
    c = cos(phi)
    f = 1.0_wp - c

    !  Euler axis (direction of rotation vector), perhaps null.
    if ( phi > 0.0_wp ) then
       x = x / phi
       y = y / phi
       z = z / phi
    end if

    !  Form the rotation matrix.
    r(1,1) = x*x*f + c
    r(1,2) = x*y*f + z*s
    r(1,3) = x*z*f - y*s
    r(2,1) = y*x*f - z*s
    r(2,2) = y*y*f + c
    r(2,3) = y*z*f + x*s
    r(3,1) = z*x*f + y*s
    r(3,2) = z*y*f - x*s
    r(3,3) = z*z*f + c

    end subroutine RV2M
!***********************************************************************

!***********************************************************************
!>
!  Rotate an r-matrix about the x-axis.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. Calling this routine with positive PHI incorporates in the
!     supplied r-matrix R an additional rotation, about the x-axis,
!     anticlockwise as seen looking towards the origin from positive x.
!
!  2. The additional rotation can be represented by this matrix:
!```
!         (  1        0            0      )
!         (                               )
!         (  0   + cos(PHI)   + sin(PHI)  )
!         (                               )
!         (  0   - sin(PHI)   + cos(PHI)  )
!```
!
!### History
!  * IAU SOFA revision: 2012 April 3

    subroutine RX ( phi, r )

    implicit none

    real(wp),intent(in) :: phi !! angle (radians)
    real(wp),dimension(3,3),intent(out) :: r !! r-matrix, rotated

    real(wp) :: s, c, a21, a22, a23, a31, a32, a33

    s = sin(phi)
    c = cos(phi)

    a21 =   c*r(2,1) + s*r(3,1)
    a22 =   c*r(2,2) + s*r(3,2)
    a23 =   c*r(2,3) + s*r(3,3)
    a31 = - s*r(2,1) + c*r(3,1)
    a32 = - s*r(2,2) + c*r(3,2)
    a33 = - s*r(2,3) + c*r(3,3)

    r(2,1) = a21
    r(2,2) = a22
    r(2,3) = a23
    r(3,1) = a31
    r(3,2) = a32
    r(3,3) = a33

    end subroutine RX
!***********************************************************************

!***********************************************************************
!>
!  Multiply a p-vector by an r-matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine RXP ( r, p, rp )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! r-matrix
    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),dimension(3),intent(out) :: rp !! R * P

    real(wp) :: w, wrp(3)

    integer :: i, j

    !  Matrix R * vector P.
    do j=1,3
       w = 0.0_wp
       do i=1,3
          w = w + r(j,i)*p(i)
       end do
       wrp(j) = w
    end do

    !  Return the result.
    call CP ( wrp, rp )

    end subroutine RXP
!***********************************************************************

!***********************************************************************
!>
!  Multiply a pv-vector by an r-matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine RXPV ( r, pv, rpv )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! r-matrix
    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3,2),intent(out) :: rpv !! R * PV

    call RXP ( r, pv(1,1), rpv(1,1) )
    call RXP ( r, pv(1,2), rpv(1,2) )

    end subroutine RXPV
!***********************************************************************

!***********************************************************************
!>
!  Multiply two r-matrices.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine RXR ( a, b, atb )

    implicit none

    real(wp),dimension(3,3),intent(in) :: a !! first r-matrix
    real(wp),dimension(3,3),intent(in) :: b !! second r-matrix
    real(wp),dimension(3,3),intent(out) :: atb !! A * B

    integer :: i, j, k
    real(wp) :: w, wm(3,3)

    do i=1,3
       do j=1,3
          w = 0.0_wp
          do k=1,3
             w = w + a(i,k)*b(k,j)
          end do
          wm(i,j) = w
       end do
    end do
    call CR ( wm, atb )

    end subroutine RXR
!***********************************************************************

!***********************************************************************
!>
!  Rotate an r-matrix about the y-axis.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. Calling this routine with positive THETA incorporates in the
!     supplied r-matrix R an additional rotation, about the y-axis,
!     anticlockwise as seen looking towards the origin from positive y.
!
!  2. The additional rotation can be represented by this matrix:
!```
!         (  + cos(THETA)     0      - sin(THETA)  )
!         (                                        )
!         (       0           1           0        )
!         (                                        )
!         (  + sin(THETA)     0      + cos(THETA)  )
!```
!
!### History
!  * IAU SOFA revision: 2012 April 3

    subroutine RY ( theta, r )

    implicit none

    real(wp),intent(in) :: theta !! angle (radians)
    real(wp),dimension(3,3),intent(out) :: r !! r-matrix, rotated

    real(wp) :: s, c, a11, a12, a13, a31, a32, a33

    s = sin(theta)
    c = cos(theta)

    a11 = c*r(1,1) - s*r(3,1)
    a12 = c*r(1,2) - s*r(3,2)
    a13 = c*r(1,3) - s*r(3,3)
    a31 = s*r(1,1) + c*r(3,1)
    a32 = s*r(1,2) + c*r(3,2)
    a33 = s*r(1,3) + c*r(3,3)

    r(1,1) = a11
    r(1,2) = a12
    r(1,3) = a13
    r(3,1) = a31
    r(3,2) = a32
    r(3,3) = a33

    end subroutine RY
!***********************************************************************

!***********************************************************************
!>
!  Rotate an r-matrix about the z-axis.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. Calling this routine with positive PSI incorporates in the
!     supplied r-matrix R an additional rotation, about the z-axis,
!     anticlockwise as seen looking towards the origin from positive z.
!
!  2. The additional rotation can be represented by this matrix:
!```
!         (  + cos(PSI)   + sin(PSI)     0  )
!         (                                 )
!         (  - sin(PSI)   + cos(PSI)     0  )
!         (                                 )
!         (       0            0         1  )
!```
!
!### History
!  * IAU SOFA revision: 2012 April 3

    subroutine RZ ( psi, r )

    implicit none

    real(wp),intent(in) :: psi !! angle (radians)
    real(wp),dimension(3,3),intent(out) :: r !! r-matrix, rotated

    real(wp) :: s, c, a11, a12, a13, a21, a22, a23

    s = sin(psi)
    c = cos(psi)

    a11 =   c*r(1,1) + s*r(2,1)
    a12 =   c*r(1,2) + s*r(2,2)
    a13 =   c*r(1,3) + s*r(2,3)
    a21 = - s*r(1,1) + c*r(2,1)
    a22 = - s*r(1,2) + c*r(2,2)
    a23 = - s*r(1,3) + c*r(2,3)

    r(1,1) = a11
    r(1,2) = a12
    r(1,3) = a13
    r(2,1) = a21
    r(2,2) = a22
    r(2,3) = a23

    end subroutine RZ
!***********************************************************************

!***********************************************************************
!>
!  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.
!
!### Notes
!
!  1. 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.
!
!  2. 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.
!
!  3. 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.
!
!  4. The model is consistent with the IAU 2000A precession-nutation.
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2010 January 18

    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
!***********************************************************************

!***********************************************************************
!>
!  The CIO locator s, positioning the Celestial Intermediate Origin on
!  the equator of the Celestial Intermediate Pole, using the IAU 2000A
!  precession-nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. 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 CIO locator s remains a small fraction of
!     1 arcsecond throughout 1900-2100.
!
!  3. 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.  The present
!     routine uses the full IAU 2000A nutation model when predicting the
!     CIP position.  Faster results, with no significant loss of
!     accuracy, can be obtained via the routine S00B, which uses
!     instead the IAU 2000B truncated model.
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2010 January 18

    function S00A ( date1, date2 ) 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) :: s !! the CIO locator s in radians (Note 2)

    real(wp) :: rbpn(3,3), x, y

    !  Bias-precession-nutation-matrix, IAU 2000A.
    call PNM00A ( date1, date2, rbpn )

    !  Extract the CIP coordinates.
    call BPN2XY ( rbpn, x, y )

    !  Compute the CIO locator s, given the CIP coordinates.
    s = S00 ( date1, date2, x, y )

    end function S00A
!***********************************************************************

!***********************************************************************
!>
!  The CIO locator s, positioning the Celestial Intermediate Origin on
!  the equator of the Celestial Intermediate Pole, using the IAU 2000B
!  precession-nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. 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 CIO locator s remains a small fraction of
!     1 arcsecond throughout 1900-2100.
!
!  3. 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.  The present
!     routine uses the IAU 2000B truncated nutation model when
!     predicting the CIP position.  The routine S00A uses instead
!     the full IAU 2000A model, but with no significant increase in
!     accuracy and at some cost in speed.
!
!### References
!
!  * 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)
!
!### History
!  * IAU SOFA revision: 2010 January 18

    function S00B ( date1, date2 ) 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) :: s !! the CIO locator s in radians (Note 2)

    real(wp) :: rbpn(3,3), x, y

    !  Bias-precession-nutation-matrix, IAU 2000B.
    call PNM00B ( date1, date2, rbpn )

    !  Extract the CIP coordinates.
    call BPN2XY ( rbpn, x, y )

    !  Compute the CIO locator s, given the CIP coordinates.
    s = S00 ( date1, date2, x, y )

    end function S00B
!***********************************************************************

!***********************************************************************
!>
!  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 2006/2000A precession-nutation.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. 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.
!
!  3. 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.
!
!  4. The model is consistent with the "P03" precession (Capitaine et
!     al. 2003), adopted by IAU 2006 Resolution 1, 2006, and the
!     IAU 2000A nutation (with P03 adjustments).
!
!### References
!
!  * Capitaine, N., Wallace, P.T. & Chapront, J., 2003, Astron.
!    Astrophys. 432, 355
!
!  * McCarthy, D.D., Petit, G. (eds.) 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!### History
!  * IAU SOFA revision:  2009 December 15

    function S06 ( 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.65e-6_wp, &
               -122.68e-6_wp, &
             -72574.11e-6_wp, &
                 27.98e-6_wp, &
                 15.62e-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.73e-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.52e-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.42e-6_wp, &
                   -0.03e-6_wp,          -1.46e-6_wp, &
                   -0.01e-6_wp,          -0.25e-6_wp, &
                    0.00e-6_wp,          +0.23e-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 S06
!***********************************************************************

!***********************************************************************
!>
!  The CIO locator s, positioning the Celestial Intermediate Origin on
!  the equator of the Celestial Intermediate Pole, using the IAU 2006
!  precession and IAU 2000A nutation models.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. 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 CIO locator s remains a small fraction of
!     1 arcsecond throughout 1900-2100.
!
!  3. 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.  The present
!     routine uses the full IAU 2000A nutation model when predicting the
!     CIP position.
!
!### References
!
!  * 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.
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * McCarthy, D. D., Petit, G. (eds.), 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2010 January 18

    function S06A ( date1, date2 ) 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) :: s !! the CIO locator s in radians (Note 2)

    real(wp) :: rnpb(3,3), x, y

    !  Bias-precession-nutation-matrix, IAU 20006/2000A.
    call PNM06A ( date1, date2, rnpb )

    !  Extract the CIP coordinates.
    call BPN2XY ( rnpb, x, y )

    !  Compute the CIO locator s, given the CIP coordinates.
    s = S06 ( date1, date2, x, y )

    end function S06A
!***********************************************************************

!***********************************************************************
!>
!  Convert spherical coordinates to Cartesian.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine S2C ( theta, phi, c )

    implicit none

    real(wp),intent(in) :: theta !!  longitude angle (radians)
    real(wp),intent(in) :: phi !!  latitude angle (radians)
    real(wp),dimension(3),intent(out) :: c !! direction cosines

    real(wp) :: cp

    cp = cos(phi)
    c(1) = cos(theta) * cp
    c(2) = sin(theta) * cp
    c(3) = sin(phi)

    end subroutine S2C
!***********************************************************************

!***********************************************************************
!>
!  Convert spherical polar coordinates to p-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine S2P ( theta, phi, r, p )

    implicit none

    real(wp),intent(in) :: theta !! longitude angle (radians)
    real(wp),intent(in) :: phi !! latitude angle (radians)
    real(wp),intent(in) :: r !! radial distance
    real(wp),dimension(3),intent(out) :: p !! Cartesian coordinates

    real(wp) :: u(3)

    call S2C ( theta, phi, u )
    call SXP ( r, u, p )

    end subroutine S2P
!***********************************************************************

!***********************************************************************
!>
!  Convert position/velocity from spherical to Cartesian coordinates.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine S2PV ( theta, phi, r, td, pd, rd, pv )

    implicit none

    real(wp),intent(in) :: theta !! longitude angle (radians)
    real(wp),intent(in) :: phi !! latitude angle (radians)
    real(wp),intent(in) :: r !! radial distance
    real(wp),intent(in) :: td !! rate of change of THETA
    real(wp),intent(in) :: pd !! rate of change of PHI
    real(wp),intent(in) :: rd !! rate of change of R
    real(wp),dimension(3,2),intent(out) :: pv !! pv-vector

    real(wp) :: st, ct, sp, cp, rcp, x, y, rpd, w

    st = sin(theta)
    ct = cos(theta)
    sp = sin(phi)
    cp = cos(phi)
    rcp = r*cp
    x = rcp*ct
    y = rcp*st
    rpd = r*pd
    w = rpd*sp - cp*rd

    pv(1,1) = x
    pv(2,1) = y
    pv(3,1) = r*sp
    pv(1,2) = - y*td - w*ct
    pv(2,2) =   x*td - w*st
    pv(3,2) = rpd*cp + sp*rd

    end subroutine S2PV
!***********************************************************************

!***********************************************************************
!>
!  Multiply a pv-vector by two scalars.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine S2XPV ( s1, s2, pv, spv )

    implicit none

    real(wp),intent(in) :: s1 !! scalar to multiply position component by
    real(wp),intent(in) :: s2 !! scalar to multiply velocity component by
    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3,2),intent(out) :: spv !! pv-vector: p scaled by S1, v scaled by S2

    call SXP ( s1, pv(1,1), spv(1,1) )
    call SXP ( s2, pv(1,2), spv(1,2) )

    end subroutine S2XPV
!***********************************************************************

!***********************************************************************
!>
!  Angular separation between two p-vectors.
!
!  Status:  vector/matrix support routine.
!
!### Notes
!
!  1. If either vector is null, a zero result is returned.
!
!  2. The angular separation is most simply formulated in terms of
!     scalar product.  However, this gives poor accuracy for angles
!     near zero and pi.  The present algorithm uses both cross product
!     and dot product, to deliver full accuracy whatever the size of
!     the angle.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine SEPP ( a, b, s )

    implicit none

    real(wp),dimension(3),intent(in) :: a !! first p-vector (not necessarily unit length)
    real(wp),dimension(3),intent(in) :: b !! second p-vector (not necessarily unit length)
    real(wp),intent(out) :: s !! angular separation (radians, always positive)

    real(wp) :: axb(3), ss, cs

    !  Sine of the angle between the vectors, multiplied by the two moduli.
    call PXP ( a, b, axb )
    call PM ( axb, ss )

    !  Cosine of the angle, multiplied by the two moduli.
    call PDP ( a, b, cs )

    !  The angle.
    if ( ss/=0.0_wp .or. cs/=0.0_wp ) then
       s = atan2(ss,cs)
    else
       s = 0.0_wp
    end if

    end subroutine SEPP
!***********************************************************************

!***********************************************************************
!>
!  Angular separation between two sets of spherical coordinates.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine SEPS ( al, ap, bl, bp, s )

    implicit none

    real(wp),intent(in) :: al !! first longitude (radians)
    real(wp),intent(in) :: ap !! first latitude (radians)
    real(wp),intent(in) :: bl !! second longitude (radians)
    real(wp),intent(in) :: bp !! second latitude (radians)
    real(wp),intent(out) :: s !! angular separation (radians)

    real(wp) :: ac(3), bc(3)

    !  Spherical to Cartesian.
    call S2C ( al, ap, ac )
    call S2C ( bl, bp, bc )

    !  Angle between the vectors.
    call SEPP ( ac, bc, s )

    end subroutine SEPS
!***********************************************************************

!***********************************************************************
!>
!  The TIO locator s', positioning the Terrestrial Intermediate Origin
!  on the equator of the Celestial Intermediate Pole.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The TIO locator s' is obtained from polar motion observations by
!     numerical integration, and so is in essence unpredictable.
!     However, it is dominated by a secular drift of about
!     47 microarcseconds per century, which is the approximation
!     evaluated by the present routine.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2009 December 15

    function SP00 ( date1, date2 ) result(sp)

    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) :: sp !! the TIO locator s' in radians (Note 2)

    !  Time since J2000.0, in Julian centuries
    real(wp) :: t

    !  Interval between fundamental epoch J2000.0 and current date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Approximate s'.
    sp = -47.0e-6_wp * t * das2r

    end function SP00
!***********************************************************************

!***********************************************************************
!>
!  Star proper motion:  update star catalog data for space motion.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The starting and ending TDB epochs EP1A+EP1B and EP2A+EP2B are
!     Julian Dates, apportioned in any convenient way between the two
!     parts (A and B).  For example, JD(TDB)=2450123.7 could be
!     expressed in any of these ways, among others:
!
!             EPnA          EPnB
!
!         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.
!
!  2. In accordance with normal star-catalog conventions, the object's
!     right ascension and declination are freed from the effects of
!     secular aberration.  The frame, which is aligned to the catalog
!     equator and equinox, is Lorentzian and centered on the SSB.
!
!     The proper motions are the rate of change of the right ascension
!     and declination at the catalog epoch and are in radians per TDB
!     Julian year.
!
!     The parallax and radial velocity are in the same frame.
!
!  3. Care is needed with units.  The star coordinates are in radians
!     and the proper motions in radians per Julian year, but the
!     parallax is in arcseconds.
!
!  4. The RA proper motion is in terms of coordinate angle, not true
!     angle.  If the catalog uses arcseconds for both RA and Dec proper
!     motions, the RA proper motion will need to be divided by cos(Dec)
!     before use.
!
!  5. Straight-line motion at constant speed, in the inertial frame,
!     is assumed.
!
!  6. An extremely small (or zero or negative) parallax is interpreted
!     to mean that the object is on the "celestial sphere", the radius
!     of which is an arbitrary (large) value (see the STARPV routine
!     for the value used).  When the distance is overridden in this way,
!     the status, initially zero, has 1 added to it.
!
!  7. If the space velocity is a significant fraction of c (see the
!     constant VMAX in the routine STARPV), it is arbitrarily set to
!     zero.  When this action occurs, 2 is added to the status.
!
!  8. The relativistic adjustment carried out in the STARPV routine
!     involves an iterative calculation.  If the process fails to
!     converge within a set number of iterations, 4 is added to the
!     status.
!
!### History
!  * IAU SOFA revision: 2017 March 16

    subroutine STARPM ( ra1, dec1, pmr1, pmd1, px1, rv1, &
                        ep1a, ep1b, ep2a, ep2b, &
                        ra2, dec2, pmr2, pmd2, px2, rv2, j )

    implicit none

    real(wp),intent(in) :: ra1 !! right ascension (radians), before
    real(wp),intent(in) :: dec1 !! declination (radians), before
    real(wp),intent(in) :: pmr1 !! RA proper motion (radians/year), before
    real(wp),intent(in) :: pmd1 !! Dec proper motion (radians/year), before
    real(wp),intent(in) :: px1 !! parallax (arcseconds), before
    real(wp),intent(in) :: rv1 !! radial velocity (km/s, +ve = receding), before
    real(wp),intent(in) :: ep1a !! "before" epoch, part A (Note 1)
    real(wp),intent(in) :: ep1b !! "before" epoch, part B (Note 1)
    real(wp),intent(in) :: ep2a !! "after" epoch, part A (Note 1)
    real(wp),intent(in) :: ep2b !! "after" epoch, part B (Note 1)
    real(wp),intent(out) :: ra2 !! right ascension (radians), after
    real(wp),intent(out) :: dec2 !! declination (radians), after
    real(wp),intent(out) :: pmr2 !! RA proper motion (radians/year), after
    real(wp),intent(out) :: pmd2 !! Dec proper motion (radians/year), after
    real(wp),intent(out) :: px2 !! parallax (arcseconds), after
    real(wp),intent(out) :: rv2 !! radial velocity (km/s, +ve = receding), after
    integer,intent(out) :: j !! status:
                             !! * -1 = system error (should not occur)
                             !! * 0 = no warnings or errors
                             !! * 1 = distance overridden (Note 6)
                             !! * 2 = excessive velocity (Note 7)
                             !! * 4 = solution didn't converge (Note 8)
                             !! * else = binary logical OR of the above warnings

    !  Astronomical unit (m, IAU 2012)
    real(wp),parameter :: aum = 149597870.7d3

    !  Speed of light (au per day)
    real(wp),parameter :: c = d2s*cmps/aum

    real(wp) :: pv1(3,2), r, tl1, dt, pv(3,2), r2, rdv, v2, &
                c2mv2, tl2, pv2(3,2)
    integer :: j1, j2

    !  RA,Dec etc. at the "before" epoch to space motion pv-vector.
    call STARPV ( ra1, dec1, pmr1, pmd1, px1, rv1, pv1, j1 )

    !  Light time when observed (days).
    call PM ( pv1, r )
    tl1 = r / c

    !  Time interval, "before" to "after" (days).
    dt = ( ep2a-ep1a ) + ( ep2b-ep1b )

    !  Move star along track from the "before" observed position to the
    !  "after" geometric position.
    call PVU ( dt+tl1, pv1, pv )

    !  From this geometric position, deduce the observed light time (days)
    !  at the "after" epoch (with theoretically unneccessary error check).
    call PDP ( pv(1,1), pv(1,1), r2 )
    call PDP ( pv(1,1), pv(1,2), rdv )
    call PDP ( pv(1,2), pv(1,2), v2 )
    c2mv2 = c*c - v2
    if ( c2mv2 <= 0.0_wp ) then
       j = -1
       return
    end if
    tl2 = ( - rdv + sqrt(rdv*rdv + c2mv2*r2) ) / c2mv2

    !  Move the position along track from the observed place at the
    !  "before" epoch to the observed place at the "after" epoch.
    call PVU ( dt + ( tl1-tl2 ), pv1, pv2 )

    !  Space motion pv-vector to RA,Dec etc. at the "after" epoch.
    call PVSTAR ( pv2, ra2, dec2, pmr2, pmd2, px2, rv2, j2 )

    !  Return the status.
    if ( j2 /= 0 ) j1 = -1
    j = j1

    end subroutine STARPM
!***********************************************************************

!***********************************************************************
!>
!  Convert star catalog coordinates to position+velocity vector.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The star data accepted by this routine are "observables" for an
!     imaginary observer at the solar-system barycenter.  Proper motion
!     and radial velocity are, strictly, in terms of barycentric
!     coordinate time, TCB.  For most practical applications, it is
!     permissible to neglect the distinction between TCB and ordinary
!     "proper" time on Earth (TT/TAI).  The result will, as a rule, be
!     limited by the intrinsic accuracy of the proper-motion and radial-
!     velocity data;  moreover, the pv-vector is likely to be merely an
!     intermediate result, so that a change of time unit would cancel
!     out overall.
!
!     In accordance with normal star-catalog conventions, the object's
!     right ascension and declination are freed from the effects of
!     secular aberration.  The frame, which is aligned to the catalog
!     equator and equinox, is Lorentzian and centered on the SSB.
!
!  2. The resulting position and velocity pv-vector is with respect to
!     the same frame and, like the catalog coordinates, is freed from
!     the effects of secular aberration.  Should the "coordinate
!     direction", where the object was located at the catalog epoch, be
!     required, it may be obtained by calculating the magnitude of the
!     position vector PV(1-3,1) dividing by the speed of light in au/day
!     to give the light-time, and then multiplying the space velocity
!     PV(1-3,2) by this light-time and adding the result to PV(1-3,1).
!
!     Summarizing, the pv-vector returned is for most stars almost
!     identical to the result of applying the standard geometrical
!     "space motion" transformation.  The differences, which are the
!     subject of the Stumpff paper referenced below, are:
!
!     (i) In stars with significant radial velocity and proper motion,
!     the constantly changing light-time distorts the apparent proper
!     motion.  Note that this is a classical, not a relativistic,
!     effect.
!
!     (ii) The transformation complies with special relativity.
!
!  3. Care is needed with units.  The star coordinates are in radians
!     and the proper motions in radians per Julian year, but the
!     parallax is in arcseconds; the radial velocity is in km/s, but
!     the pv-vector result is in au and au/day.
!
!  4. The RA proper motion is in terms of coordinate angle, not true
!     angle.  If the catalog uses arcseconds for both RA and Dec proper
!     motions, the RA proper motion will need to be divided by cos(Dec)
!     before use.
!
!  5. Straight-line motion at constant speed, in the inertial frame,
!     is assumed.
!
!  6. An extremely small (or zero or negative) parallax is interpreted
!     to mean that the object is on the "celestial sphere", the radius
!     of which is an arbitrary (large) value (see the constant PXMIN).
!     When the distance is overridden in this way, the status, initially
!     zero, has 1 added to it.
!
!  7. If the space velocity is a significant fraction of c (see the
!     constant VMAX), it is arbitrarily set to zero.  When this action
!     occurs, 2 is added to the status.
!
!  8. The relativistic adjustment involves an iterative calculation.
!     If the process fails to converge within a set number (IMAX) of
!     iterations, 4 is added to the status.
!
!  9. The inverse transformation is performed by the routine PVSTAR.
!
!### Reference
!
!  * Stumpff, P., Astron.Astrophys. 144, 232-240 (1985).
!
!### History
!  * IAU SOFA revision: 2017 March 16

    subroutine STARPV ( ra, dec, pmr, pmd, px, rv, pv, j )

    implicit none

    real(wp),intent(in) :: ra !! right ascension (radians) [see Note 1]
    real(wp),intent(in) :: dec !! declination (radians) [see Note 1]
    real(wp),intent(in) :: pmr !! RA proper motion (radians/year) [see Note 1]
    real(wp),intent(in) :: pmd !! Dec proper motion (radians/year) [see Note 1]
    real(wp),intent(in) :: px !! parallax (arcseconds) [see Note 1]
    real(wp),intent(in) :: rv !! radial velocity (km/s, positive = receding) [see Note 1]
    real(wp),dimension(3,2),intent(out) :: pv !! pv-vector (au, au/day) [see Note 2]
    integer,intent(out) :: j !! status [see Note 2]:
                             !! * 0 = no warnings
                             !! * 1 = distance overridden (Note 6)
                             !! * 2 = excessive velocity (Note 7)
                             !! * 4 = solution didn't converge (Note 8)
                             !! * else = binary logical OR of the above

    !  Smallest allowed parallax
    real(wp),parameter :: pxmin = 1.0e-7_wp

    !  Largest allowed speed (fraction of c)
    real(wp),parameter :: vmax = 0.5_wp

    !  Julian years to days
    real(wp),parameter :: y2d = 365.25_wp

    !  Radians to arcseconds
    real(wp),parameter :: dr2as = 206264.8062470963551564734_wp

    !  Astronomical unit (m, IAU 2012)
    real(wp),parameter :: aum = 149597870.7e3_wp

    !  Speed of light (au per day)
    real(wp),parameter :: c = d2s*cmps/aum

    !  Maximum number of iterations for relativistic solution
    integer,parameter :: imax = 100

    integer :: i
    integer :: iwarn
    real(wp) :: w, r, rd, rad, decd, v, x(3), usr(3), ust(3), &
                vsr, vst, betst, betsr, bett, betr, od, odel, &
                dd, ddel, odd, oddel, d, del, ur(3), ut(3)

    !  Distance (au).
    if ( px>=pxmin ) then
       w = px
       iwarn = 0
    else
       w = pxmin
       iwarn = 1
    end if
    r = dr2as / w

    !  Radial velocity (au/day).
    rd = d2s * rv * 1.0e3_wp / aum

    !  Proper motion (radian/day).
    rad = pmr / y2d
    decd = pmd / y2d

    !  To pv-vector (au,au/day).
    call S2PV ( ra, dec, r, rad, decd, rd, pv )

    !  If excessive velocity, arbitrarily set it to zero.
    call PM ( pv(1,2), v )
    if ( v/c > vmax ) then
       call ZP ( pv(1,2) )
       iwarn = iwarn + 2
    end if

    !  Isolate the radial component of the velocity (au/day).
    call PN ( pv(1,1), w, x )
    call PDP ( x, pv(1,2), vsr )
    call SXP ( vsr, x, usr )

    !  Isolate the transverse component of the velocity (au/day).
    call PMP ( pv(1,2), usr, ust )
    call PM ( ust, vst )

    !  Special-relativity dimensionless parameters.
    betsr = vsr / c
    betst = vst / c

    !  Determine the inertial-to-observed relativistic correction terms.
    od = 0.0_wp
    odel = 0.0_wp
    odd = 0.0_wp
    oddel = 0.0_wp
    bett = betst
    betr = betsr
    do i=1,imax
       d = 1.0_wp + betr
       w = betr*betr + bett*bett
       del = - w / ( sqrt(1.0_wp-w) + 1.0_wp )
       betr = d*betsr + del
       bett = d*betst
       if ( i > 1 ) then
          dd = abs(d-od)
          ddel = abs(del-odel)
          if ( i>2 .and. &
               dd>=odd .and. &
               ddel>=oddel ) exit
          if ( i >= imax ) iwarn = iwarn + 4
          odd = dd
          oddel = ddel
       end if
       od = d
       odel = del
    end do

    !  Replace observed radial velocity with inertial value.
    if ( betsr /= 0.0_wp ) then
       w = d + del/betsr
    else
       w = 1.0_wp
    end if
    call SXP ( w, usr, ur )

    !  Replace observed tangential velocity with inertial value.
    call SXP ( d, ust, ut )

    !  Combine the two to obtain the inertial space velocity.
    call PPP ( ur, ut, pv(1,2) )

    !  Return the status.
    j = iwarn

    end subroutine STARPV
!***********************************************************************

!***********************************************************************
!>
!  Multiply a p-vector by a scalar.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine SXP ( s, p, sp )

    implicit none

    real(wp),intent(in) :: s !! scalar
    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),dimension(3),intent(out) :: sp !! S * P

    integer :: i

    do i=1,3
       sp(i) = s * p(i)
    end do

    end subroutine SXP
!***********************************************************************

!***********************************************************************
!>
!  Multiply a pv-vector by a scalar.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine SXPV ( s, pv, spv )

    implicit none

    real(wp),intent(in) :: s !! scalar
    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3,2),intent(out) :: spv !! S * PV

    call S2XPV ( s, s, pv, spv )

    end subroutine SXPV
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  International Atomic Time, TAI, to
!  Terrestrial Time, TT.
!
!  Status:  canonical.
!
!### Note
!
!  TAI1+TAI2 is Julian Date, apportioned in any convenient way
!  between the two arguments, for example where TAI1 is the Julian
!  Day Number and TAI2 is the fraction of a day.  The returned
!  TT1,TT2 follow suit.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TAITT ( tai1, tai2, tt1, tt2, j )

    implicit none

    real(wp),intent(in) :: tai1 !! TAI as a 2-part Julian Date
    real(wp),intent(in) :: tai2 !! TAI as a 2-part Julian Date
    real(wp),intent(out) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(out) :: tt2 !! TT as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    !  TT minus TAI (days).
    real(wp),parameter :: dtat = 32.184_wp/86400.0_wp

    !  Result, safeguarding precision.
    if ( abs(tai1)>abs(tai2) ) then
       tt1 = tai1
       tt2 = tai2 + dtat
    else
       tt1 = tai1 + dtat
       tt2 = tai2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TAITT
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  International Atomic Time, TAI, to
!  Universal Time, UT1.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TAI1+TAI2 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where TAI1 is the Julian
!     Day Number and TAI2 is the fraction of a day.  The returned
!     UT11,UT12 follow suit.
!
!  2. The argument DTA, i.e. UT1-TAI, is an observed quantity, and is
!     available from IERS tabulations.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TAIUT1 ( tai1, tai2, dta, ut11, ut12, j )

    implicit none

    real(wp),intent(in) :: tai1 !! TAI as a 2-part Julian Date
    real(wp),intent(in) :: tai2 !! TAI as a 2-part Julian Date
    real(wp),intent(in) :: dta !! UT1-TAI in seconds
    real(wp),intent(out) :: ut11 !! UT1 as a 2-part Julian Date
    real(wp),intent(out) :: ut12 !! UT1 as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    real(wp) :: dtad

    !  Result, safeguarding precision.
    dtad = dta/d2s
    if ( abs(tai1)>abs(tai2) ) then
       ut11 = tai1
       ut12 = tai2 + dtad
    else
       ut11 = tai1 + dtad
       ut12 = tai2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TAIUT1
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  International Atomic Time, TAI, to
!  Coordinated Universal Time, UTC.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TAI1+TAI2 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where TAI1 is the Julian
!     Day Number and TAI2 is the fraction of a day.  The returned UTC1
!     and UTC2 form an analogous pair, except that a special convention
!     is used, to deal with the problem of leap seconds - see the next
!     note.
!
!  2. JD cannot unambiguously represent UTC during a leap second unless
!     special measures are taken.  The convention in the present routine
!     is that the JD day represents UTC days whether the length is
!     86399, 86400 or 86401 SI seconds.  In the 1960-1972 era there were
!     smaller jumps (in either direction) each time the linear UTC(TAI)
!     expression was changed, and these "mini-leaps" are also included
!     in the SOFA convention.
!
!  3. The routine D2DTF can be used to transform the UTC quasi-JD
!     into calendar date and clock time, including UTC leap second
!     handling.
!
!  4. The warning status "dubious year" flags UTCs that predate the
!     introduction of the time scale or that are too far in the future
!     to be trusted.  See DAT for further details.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TAIUTC ( tai1, tai2, utc1, utc2, j )

    implicit none

    real(wp),intent(in) :: tai1 !! TAI as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: tai2 !! TAI as a 2-part Julian Date (Note 1)
    real(wp),intent(out) :: utc1 !! UTC as a 2-part quasi Julian Date (Notes 1-3)
    real(wp),intent(out) :: utc2 !! UTC as a 2-part quasi Julian Date (Notes 1-3)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 4)
                             !! * 0 = OK
                             !! * -1 = unacceptable date

    logical :: big1
    integer :: i, js
    real(wp) :: a1, a2, u1, u2, g1, g2

    !  Put the two parts of the TAI into big-first order.
    big1 = abs(tai1) >= abs(tai2)
    if ( big1 ) then
       a1 = tai1
       a2 = tai2
    else
       a1 = tai2
       a2 = tai1
    end if

    !  Initial guess for UTC.
    u1 = a1
    u2 = a2

    !  Iterate (though in most cases just once is enough).
    do i=1,3

       !  Guessed UTC to TAI.
       call UTCTAI ( u1, u2, g1, g2, js )
       if ( js<0 ) then
        j = js
        return
       end if

       !  Adjust guessed UTC.
       u2 = u2 + (a1-g1)
       u2 = u2 + (a2-g2)

    end do

    !  Return the UTC result, preserving the TAI order.
    if ( big1 ) then
       utc1 = u1
       utc2 = u2
    else
       utc1 = u2
       utc2 = u1
    end if

    !  Status.
    j = js

    end subroutine TAIUTC
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Barycentric Coordinate Time, TCB, to
!  Barycentric Dynamical Time, TDB.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TCB1+TCB2 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where TCB1 is the Julian
!     Day Number and TCB2 is the fraction of a day.  The returned
!     TDB1,TDB2 follow suit.
!
!  2. The 2006 IAU General Assembly introduced a conventional linear
!     transformation between TDB and TCB.  This transformation
!     compensates for the drift between TCB and terrestrial time TT,
!     and keeps TDB approximately centered on TT.  Because the
!     relationship between TT and TCB depends on the adopted solar
!     system ephemeris, the degree of alignment between TDB and TT over
!     long intervals will vary according to which ephemeris is used.
!     Former definitions of TDB attempted to avoid this problem by
!     stipulating that TDB and TT should differ only by periodic
!     effects.  This is a good description of the nature of the
!     relationship but eluded precise mathematical formulation.  The
!     conventional linear relationship adopted in 2006 sidestepped
!     these difficulties whilst delivering a TDB that in practice was
!     consistent with values before that date.
!
!  3. TDB is essentially the same as Teph, the time argument for the
!     JPL solar system ephemerides.
!
!### Reference
!
!  * IAU 2006 Resolution B3
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TCBTDB ( tcb1, tcb2, tdb1, tdb2, j )

    implicit none

    real(wp),intent(in) :: tcb1 !! TCB as a 2-part Julian Date
    real(wp),intent(in) :: tcb2 !! TCB as a 2-part Julian Date
    real(wp),intent(out) :: tdb1 !! TDB as a 2-part Julian Date
    real(wp),intent(out) :: tdb2 !! TDB as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    !  1977 Jan 1.0 TAI = 1977/1/1 00:00:32.184 TCB, as two-part JD
    real(wp),parameter :: t77td = 2443144.0_wp
    real(wp),parameter :: t77tf = 0.5003725_wp

    !  L_B, and TDB0 (d)
    real(wp),parameter :: elb = 1.550519768e-8_wp
    real(wp),parameter :: tdb0 = -6.55e-5_wp/86400.0_wp

    real(wp) :: d

    !  Result, safeguarding precision.
    if ( abs(tcb1)>abs(tcb2) ) then
       d = tcb1 - t77td
       tdb1 = tcb1
       tdb2 = tcb2 + tdb0 - ( d + ( tcb2-t77tf ) ) * elb
    else
       d = tcb2 - t77td
       tdb1 = tcb1 + tdb0 - ( d + ( tcb1-t77tf ) ) * elb
       tdb2 = tcb2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TCBTDB
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Geocentric Coordinate Time, TCG, to
!  Terrestrial Time, TT.
!
!  Status:  canonical.
!
!### Note
!
!  TCG1+TCG2 is Julian Date, apportioned in any convenient way
!  between the two arguments, for example where TCG1 is the Julian
!  Day Number and TCG2 is the fraction of a day.  The returned
!  TT1,TT2 follow suit.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),.
!     IERS Technical Note No. 32, BKG (2004)
!
!  * IAU 2000 Resolution B1.9
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TCGTT ( tcg1, tcg2, tt1, tt2, j )

    implicit none

    real(wp),intent(in) :: tcg1 !! TCG as a 2-part Julian Date
    real(wp),intent(in) :: tcg2 !! TCG as a 2-part Julian Date
    real(wp),intent(out) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(out) :: tt2 !! TT as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    !  JD for MJD 0
    real(wp),parameter :: djm0 = 2400000.5_wp

    !  1977 Jan 1 00:00:32.184 TT, as MJD
    real(wp),parameter :: t77t = 43144.0003725_wp

    !  L_G = 1 - dTT/dTCG
    real(wp),parameter :: elg = 6.969290134e-10_wp

    !  Result, safeguarding precision.
    if ( abs(tcg1)>abs(tcg2) ) then
       tt1 = tcg1
       tt2 = tcg2 - ( ( tcg1-djm0 ) + ( tcg2-t77t ) ) * elg
    else
       tt1 = tcg1 - ( ( tcg2-djm0 ) + ( tcg1-t77t ) ) * elg
       tt2 = tcg2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TCGTT
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Barycentric Dynamical Time, TDB, to
!  Barycentric Coordinate Time, TCB.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TDB1+TDB2 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where TDB1 is the Julian
!     Day Number and TDB2 is the fraction of a day.  The returned
!     TCB1,TCB2 follow suit.
!
!  2. The 2006 IAU General Assembly introduced a conventional linear
!     transformation between TDB and TCB.  This transformation
!     compensates for the drift between TCB and terrestrial time TT,
!     and keeps TDB approximately centered on TT.  Because the
!     relationship between TT and TCB depends on the adopted solar
!     system ephemeris, the degree of alignment between TDB and TT over
!     long intervals will vary according to which ephemeris is used.
!     Former definitions of TDB attempted to avoid this problem by
!     stipulating that TDB and TT should differ only by periodic
!     effects.  This is a good description of the nature of the
!     relationship but eluded precise mathematical formulation.  The
!     conventional linear relationship adopted in 2006 sidestepped
!     these difficulties whilst delivering a TDB that in practice was
!     consistent with values before that date.
!
!  3. TDB is essentially the same as Teph, the time argument for the
!     JPL solar system ephemerides.
!
!### Reference
!
!  * IAU 2006 Resolution B3
!
!### History
!  * IAU SOFA revision: 2019 June 20


    subroutine TDBTCB ( tdb1, tdb2, tcb1, tcb2, j )

    implicit none

    real(wp),intent(in) :: tdb1 !! TDB as a 2-part Julian Date
    real(wp),intent(in) :: tdb2 !! TDB as a 2-part Julian Date
    real(wp),intent(out) :: tcb1 !! TCB as a 2-part Julian Date
    real(wp),intent(out) :: tcb2 !! TCB as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    !  1977 Jan 1.0 TAI = 1977/1/1 00:00:32.184 TCB, as two-part JD
    real(wp),parameter :: t77td = 2443144.0_wp
    real(wp),parameter :: t77tf = 0.5003725_wp

    !  L_B, and TDB0 (d)
    real(wp),parameter :: elb = 1.550519768e-8_wp
    real(wp),parameter :: tdb0 = -6.55e-5_wp/86400.0_wp

    !  TDB to TCB rate
    real(wp),parameter :: elbb = elb/(1.0_wp-elb)

    real(wp) :: d, f

    !  Result, preserving date format but safeguarding precision.
    if ( abs(tdb1)>abs(tdb2) ) then
       d = t77td - tdb1
       f = tdb2 - tdb0
       tcb1 = tdb1
       tcb2 = f - ( d - ( f - t77tf ) ) * elbb
    else
       d = t77td - tdb2
       f = tdb1 - tdb0
       tcb1 = f - ( d - ( f - t77tf ) ) * elbb
       tcb2 = tdb2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TDBTCB
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Barycentric Dynamical Time, TDB, to
!  Terrestrial Time, TT.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TDB1+TDB2 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where TDB1 is the Julian
!     Day Number and TDB2 is the fraction of a day.  The returned
!     TT1,TT2 follow suit.
!
!  2. The argument DTR represents the quasi-periodic component of the
!     GR transformation between TT and TCB.  It is dependent upon the
!     adopted solar-system ephemeris, and can be obtained by numerical
!     integration, by interrogating a precomputed time ephemeris or by
!     evaluating a model such as that implemented in the SOFA routine
!     DTDB.  The quantity is dominated by an annual term of 1.7 ms
!     amplitude.
!
!  3. TDB is essentially the same as Teph, the time argument for the
!     JPL solar system ephemerides.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * IAU 2006 Resolution 3
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TDBTT ( tdb1, tdb2, dtr, tt1, tt2, j )

    implicit none

    real(wp),intent(in) :: tdb1 !! TDB as a 2-part Julian Date
    real(wp),intent(in) :: tdb2 !! TDB as a 2-part Julian Date
    real(wp),intent(in) :: dtr !! TDB-TT in seconds
    real(wp),intent(out) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(out) :: tt2 !! TT as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    real(wp) :: dtrd

    !  Result, safeguarding precision.
    dtrd = dtr/d2s
    if ( abs(tdb1)>abs(tdb2) ) then
       tt1 = tdb1
       tt2 = tdb2 - dtrd
    else
       tt1 = tdb1 - dtrd
       tt2 = tdb2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TDBTT
!***********************************************************************

!***********************************************************************
!>
!  Convert hours, minutes, seconds to radians.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  If the s argument is a string, only the leftmost character is
!      used and no warning status is provided.
!
!  2.  The result is computed even if any of the range checks fail.
!
!  3.  Negative IHOUR, IMIN and/or SEC produce a warning status, but the
!      absolute value is used in the conversion.
!
!  4.  If there are multiple errors, the status value reflects only the
!      first, the smallest taking precedence.
!
!### History
!  * IAU SOFA revision: 2013 December 2

    subroutine TF2A ( s, ihour, imin, sec, rad, j )

    implicit none

    character(len=1),intent(in) :: s !! sign:  '-' = negative, otherwise positive
    integer,intent(in) :: ihour !! hours
    integer,intent(in) :: imin !! minutes
    real(wp),intent(in) :: sec !! seconds
    real(wp),intent(out) :: rad !! angle in radians
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * 1 = IHOUR outside range 0-23
                             !! * 2 = IMIN outside range 0-59
                             !! * 3 = SEC outside range 0-59.999...

    real(wp) :: w

    !  Preset the status.
    j = 0

    !  Validate seconds, minutes, hours.
    if ( sec<0.0_wp .or. sec>=60.0_wp ) j=3
    if ( imin<0 .or. imin>59 ) j=2
    if ( ihour<0 .or. ihour>23 ) j=1

    !  Compute the angle.
    w = ( 60.0_wp * ( 60.0_wp * real( abs(ihour), wp ) + &
                                real( abs(imin), wp ) ) + &
                                      abs(sec) ) * ds2r

    !  Apply the sign.
    if ( s == '-' ) w = -w

    !  Return the result.
    rad = w

    end subroutine TF2A
!***********************************************************************

!***********************************************************************
!>
!  Convert hours, minutes, seconds to days.
!
!  Status:  support routine.
!
!### Notes
!
!  1.  If the s argument is a string, only the leftmost character is
!      used and no warning status is provided.
!
!  2.  The result is computed even if any of the range checks fail.
!
!  3.  Negative IHOUR, IMIN and/or SEC produce a warning status, but the
!      absolute value is used in the conversion.
!
!  4.  If there are multiple errors, the status value reflects only the
!      first, the smallest taking precedence.
!
!### History
!  * IAU SOFA revision: 2013 December 2

    subroutine TF2D ( s, ihour, imin, sec, days, j )

    implicit none

    character(len=1),intent(in) :: s !! sign:  '-' = negative, otherwise positive
    integer,intent(in) :: ihour !! hours
    integer,intent(in) :: imin !! minutes
    real(wp),intent(in) :: sec !! seconds
    real(wp),intent(out) :: days !! interval in days
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * 1 = IHOUR outside range 0-23
                             !! * 2 = IMIN outside range 0-59
                             !! * 3 = SEC outside range 0-59.999...

    real(wp) :: w

    !  Preset the status.
    j = 0

    !  Validate seconds, minutes, hours.
    if ( sec<0.0_wp .or. sec>=60.0_wp ) j=3
    if ( imin<0 .or. imin>59 ) j=2
    if ( ihour<0 .or. ihour>23 ) j=1

    !  Compute the interval.
    w = ( 60.0_wp * ( 60.0_wp * real( abs(ihour), wp ) + &
                                real( abs(imin), wp ) ) + &
                                      abs(sec) ) / d2s

    !  Apply the sign.
    if ( s == '-' ) w = -w

    !  Return the result.
    days = w

    end subroutine TF2D
!***********************************************************************

!***********************************************************************
!>
!  In the tangent plane projection, given the rectangular coordinates
!  of a star and its spherical coordinates, determine the spherical
!  coordinates of the tangent point.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The tangent plane projection is also called the "gnomonic
!     projection" and the "central projection".
!
!  2. The eta axis points due north in the adopted coordinate system.
!     If the spherical coordinates are observed (RA,Dec), the tangent
!     plane coordinates (xi,eta) are conventionally called the "standard
!     coordinates".  If the spherical coordinates are with respect to a
!     right-handed triad, (xi,eta) are also right-handed.  The units of
!     (xi,eta) are, effectively, radians at the tangent point.
!
!  3. All angular arguments are in radians.
!
!  4. The angles A01 and A02 are returned in the range 0-2pi.  The
!     angles B01 and B02 are returned in the range +/-pi, but in the
!     usual, non-pole-crossing, case, the range is +/-pi/2.
!
!  5. Cases where there is no solution can arise only near the poles.
!     For example, it is clearly impossible for a star at the pole
!     itself to have a non-zero xi value, and hence it is meaningless
!     to ask where the tangent point would have to be to bring about
!     this combination of xi and dec.
!
!  6. Also near the poles, cases can arise where there are two useful
!     solutions.  The returned value N indicates whether the second of
!     the two solutions returned is useful;  N=1 indicates only one
!     useful solution, the usual case.
!
!  7. The basis of the algorithm is to solve the spherical triangle PSC,
!     where P is the north celestial pole, S is the star and C is the
!     tangent point.  The spherical coordinates of the tangent point are
!     [a0,b0];  writing rho^2 = (xi^2+eta^2) and r^2 = (1+rho^2), side c
!     is then (pi/2-b), side p is sqrt(xi^2+eta^2) and side s (to be
!     found) is (pi/2-b0).  Angle C is given by sin(C) = xi/rho and
!     cos(C) = eta/rho.  Angle P (to be found) is the longitude
!     difference between star and tangent point (a-a0).
!
!  8. This routine is a member of the following set:
!
!         spherical       vector       solve for
!
!         TPXES      TPXEV      xi,eta
!         TPSTS      TPSTV       star
!       > TPORS <    TPORV      origin
!
!### References
!
!  * Calabretta M.R. & Greisen, E.W., 2002, "Representations of
!    celestial coordinates in FITS", Astron.Astrophys. 395, 1077
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987, Chapter 13.
!
!### History
!  * IAU SOFA revision:  2018 January 2

    subroutine TPORS ( xi, eta, a, b, a01, b01, a02, b02, n )

    implicit none

    real(wp),intent(in) :: xi !! rectangular coordinates of star image (Note 2)
    real(wp),intent(in) :: eta !! rectangular coordinates of star image (Note 2)
    real(wp),intent(in) :: a !! star's spherical coordinates (Note 3)
    real(wp),intent(in) :: b !! star's spherical coordinates (Note 3)
    real(wp),intent(out) :: a01 !! tangent point's spherical coordinates, Soln. 1
    real(wp),intent(out) :: b01 !! tangent point's spherical coordinates, Soln. 1
    real(wp),intent(out) :: a02 !! tangent point's spherical coordinates, Soln. 2
    real(wp),intent(out) :: b02 !! tangent point's spherical coordinates, Soln. 2
    integer,intent(out) :: n !! number of solutions:
                             !! * 0 = no solutions returned (Note 5)
                             !! * 1 = only the first solution is useful (Note 6)
                             !! * 2 = both solutions are useful (Note 6)

    real(wp) :: xi2, r, sb, cb, rsb, rcb, w2, w, s, c

    xi2 = xi*xi
    r = sqrt(1.0_wp+xi2+eta*eta)
    sb = sin(b)
    cb = cos(b)
    rsb = r*sb
    rcb = r*cb
    w2 = rcb*rcb - xi2
    if ( w2 >= 0.0_wp ) then
       w = sqrt(w2)
       s = rsb - eta*w
       c = rsb*eta + w
       if ( xi == 0.0_wp .and. w == 0.0_wp ) w = 1.0_wp
       a01 = ANP(a - atan2(xi,w))
       b01 = atan2(s,c)
       w = -w
       s = rsb - eta*w
       c = rsb*eta + w
       a02 = ANP(a - atan2(xi,w))
       b02 = atan2(s,c)
       if ( abs(rsb) < 1.0_wp ) then
          n = 1
       else
          n = 2
       end if
    else
       n = 0
    end if

    end subroutine TPORS
!***********************************************************************

!***********************************************************************
!>
!  In the tangent plane projection, given the rectangular coordinates
!  of a star and its direction cosines, determine the direction
!  cosines of the tangent point.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The tangent plane projection is also called the "gnomonic
!     projection" and the "central projection".
!
!  2. The eta axis points due north in the adopted coordinate system.
!     If the direction cosines represent observed (RA,Dec), the tangent
!     plane coordinates (xi,eta) are conventionally called the "standard
!     coordinates".  If the direction cosines are with respect to a
!     right-handed triad, (xi,eta) are also right-handed.  The units of
!     (xi,eta) are, effectively, radians at the tangent point.
!
!  3. The vector V must be of unit length or the result will be wrong.
!
!  4. Cases where there is no solution can arise only near the poles.
!     For example, it is clearly impossible for a star at the pole
!     itself to have a non-zero xi value, and hence it is meaningless
!     to ask where the tangent point would have to be.
!
!  5. Also near the poles, cases can arise where there are two useful
!     solutions.  The returned value N indicates whether the second of
!     the two solutions returned is useful;  N=1 indicates only one
!     useful solution, the usual case.
!
!  6. The basis of the algorithm is to solve the spherical triangle PSC,
!     where P is the north celestial pole, S is the star and C is the
!     tangent point.  Calling the celestial spherical coordinates of the
!     star and tangent point (a,b) and (a0,b0) respectively, and writing
!     rho^2 = (xi^2+eta^2) and r^2 = (1+rho^2), and transforming the
!     vector V into (a,b) in the normal way, side c is then (pi/2-b),
!     side p is sqrt(xi^2+eta^2) and side s (to be found) is (pi/2-b0),
!     while angle C is given by sin(C) = xi/rho and cos(C) = eta/rho;
!     angle P (to be found) is (a-a0).  After solving the spherical
!     triangle, the result (a0,b0) can be expressed in vector form as
!     V0.
!
!  7. This routine is a member of the following set:
!
!         spherical       vector       solve for
!
!         TPXES      TPXEV      xi,eta
!         TPSTS      TPSTV       star
!         TPORS    > TPORV <    origin
!
!### References
!
!  * Calabretta M.R. & Greisen, E.W., 2002, "Representations of
!    celestial coordinates in FITS", Astron.Astrophys. 395, 1077
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987, Chapter 13.
!
!### History
!  * IAU SOFA revision:  2018 January 2

    subroutine TPORV ( xi, eta, v, v01, v02, n )

    implicit none

    real(wp),intent(in) :: xi !! rectangular coordinates of star image (Note 2)
    real(wp),intent(in) :: eta !! rectangular coordinates of star image (Note 2)
    real(wp),dimension(3),intent(in) :: v !! star's direction cosines (Note 3)
    real(wp),dimension(3),intent(out) :: v01 !! tangent point's direction cosines, Solution 1
    real(wp),dimension(3),intent(out) :: v02 !! tangent point's direction cosines, Solution 2
    integer,intent(out) :: n !! number of solutions:
                             !! * 0 = no solutions returned (Note 4)
                             !! * 1 = only the first solution is useful (Note 5)
                             !! * 2 = both solutions are useful (Note 5)

    real(wp) :: x, y, z, rxy2, xi2, eta2p1, r, rsb, rcb, w2, w, c

    x = v(1)
    y = v(2)
    z = v(3)
    rxy2 = x*x+y*y
    xi2 = xi*xi
    eta2p1 = eta*eta+1.0_wp
    r = sqrt(xi2+eta2p1)
    rsb = r*z
    rcb = r*sqrt(x*x+y*y)
    w2 = rcb*rcb-xi2
    if ( w2 > 0.0_wp ) then
       w = sqrt(w2)
       c = (rsb*eta+w) / (eta2p1*sqrt(rxy2*(w2+xi2)))
       v01(1) = c * (x*w+y*xi)
       v01(2) = c * (y*w-x*xi)
       v01(3) = (rsb-eta*w) / eta2p1
       w = -w
       c = (rsb*eta+w) / (eta2p1*sqrt(rxy2*(w2+xi2)))
       v02(1) = c * (x*w+y*xi)
       v02(2) = c * (y*w-x*xi)
       v02(3) = (rsb-eta*w) / eta2p1
       if ( abs(rsb) < 1.0_wp ) then
          n = 1
       else
          n = 2
       end if
    else
       n = 0
    end if

    end subroutine TPORV
!***********************************************************************

!***********************************************************************
!>
!  In the tangent plane projection, given the star's rectangular
!  coordinates and the spherical coordinates of the tangent point,
!  solve for the spherical coordinates of the star.
!
!  Status:  support routine.
!
!  1. The tangent plane projection is also called the "gnomonic
!     projection" and the "central projection".
!
!  2. The eta axis points due north in the adopted coordinate system.
!     If the spherical coordinates are observed (RA,Dec), the tangent
!     plane coordinates (xi,eta) are conventionally called the "standard
!     coordinates".  If the direction cosines are with respect to a
!     right-handed triad, (xi,eta) are also right-handed.  The units of
!     (xi,eta) are, effectively, radians at the tangent point.
!
!  3. All angular arguments are in radians.
!
!  4. This routine is a member of the following set:
!
!         spherical       vector       solve for
!
!         TPXES      TPXEV      xi,eta
!       > TPSTS <    TPSTV       star
!         TPORS      TPORV      origin
!
!### References
!
!  * Calabretta M.R. & Greisen, E.W., 2002, "Representations of
!    celestial coordinates in FITS", Astron.Astrophys. 395, 1077
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987, Chapter 13.
!
!### History
!  * IAU SOFA revision:  2018 January 2

    subroutine TPSTS ( xi, eta, a0, b0, a, b )

    implicit none

    real(wp),intent(in) :: xi !! rectangular coordinates of star image (Note 2)
    real(wp),intent(in) :: eta !! rectangular coordinates of star image (Note 2)
    real(wp),intent(in) :: a0 !! tangent point's spherical coordinates
    real(wp),intent(in) :: b0 !! tangent point's spherical coordinates
    real(wp),intent(out) :: a !! star's spherical coordinates
    real(wp),intent(out) :: b !! star's spherical coordinates

    real(wp) :: sb0, cb0, d

    sb0 = sin(b0)
    cb0 = cos(b0)
    d = cb0 - eta*sb0
    a = ANP(atan2(xi,d)+a0)
    b = atan2(sb0+eta*cb0,sqrt(xi*xi+d*d))

    end subroutine TPSTS
!***********************************************************************

!***********************************************************************
!>
!  In the tangent plane projection, given the star's rectangular
!  coordinates and the direction cosines of the tangent point, solve
!  for the direction cosines of the star.
!
!  Status:  support routine.
!
!  1. The tangent plane projection is also called the "gnomonic
!     projection" and the "central projection".
!
!  2. The eta axis points due north in the adopted coordinate system.
!     If the direction cosines represent observed (RA,Dec), the tangent
!     plane coordinates (xi,eta) are conventionally called the "standard
!     coordinates".  If the direction cosines are with respect to a
!     right-handed triad, (xi,eta) are also right-handed.  The units of
!     (xi,eta) are, effectively, radians at the tangent point.
!
!  3. The method used is to complete the star vector in the (xi,eta)
!     based triad and normalize it, then rotate the triad to put the
!     tangent point at the pole with the x-axis aligned to zero
!     longitude.  Writing (a0,b0) for the celestial spherical
!     coordinates of the tangent point, the sequence of rotations is
!     (b0-pi/2) around the x-axis followed by (-a0-pi/2) around the
!     z-axis.
!
!  4. If vector V0 is not of unit length, the returned vector V will
!     be wrong.
!
!  5. If vector V0 points at a pole, the returned vector V will be
!     based on the arbitrary assumption that the longitude coordinate
!     of the tangent point is zero.
!
!  6. This routine is a member of the following set:
!
!         spherical       vector       solve for
!
!         TPXES      TPXEV      xi,eta
!         TPSTS    > TPSTV <     star
!         TPORS      TPORV      origin
!
!### References
!
!  * Calabretta M.R. & Greisen, E.W., 2002, "Representations of
!    celestial coordinates in FITS", Astron.Astrophys. 395, 1077
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987, Chapter 13.
!
!### History
!  * IAU SOFA revision:  2018 January 2

    subroutine TPSTV ( xi, eta, v0, v )

    implicit none

    real(wp),intent(in) :: xi !! rectangular coordinates of star image (Note 2)
    real(wp),intent(in) :: eta !! rectangular coordinates of star image (Note 2)
    real(wp),dimension(3),intent(in) :: v0 !! tangent point's direction cosines (Note 4)
    real(wp),dimension(3),intent(out) :: v !! star's direction cosines

    real(wp) :: x, y, z, r, f

    !  Tangent point.
    x = v0(1)
    y = v0(2)
    z = v0(3)

    !  Deal with polar case.
    r = sqrt(x*x+y*y)
    if ( r == 0.0_wp ) then
       r = 1e-20_wp
       x = r
    end if

    !  Star vector length to tangent plane.
    f = sqrt(1.0_wp+xi*xi+eta*eta)

    !  Apply the transformation and normalize.
    v(1) = ( x - (xi*y+eta*x*z) / r ) / f
    v(2) = ( y + (xi*x-eta*y*z) / r ) / f
    v(3) = ( z + eta*r ) / f

    end subroutine TPSTV
!***********************************************************************

!***********************************************************************
!>
!  In the tangent plane projection, given celestial spherical
!  coordinates for a star and the tangent point, solve for the star's
!  rectangular coordinates in the tangent plane.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The tangent plane projection is also called the "gnomonic
!     projection" and the "central projection".
!
!  2. The eta axis points due north in the adopted coordinate system.
!     If the spherical coordinates are observed (RA,Dec), the tangent
!     plane coordinates (xi,eta) are conventionally called the "standard
!     coordinates".  For right-handed spherical coordinates, (xi,eta)
!     are also right-handed.  The units of (xi,eta) are, effectively,
!     radians at the tangent point.
!
!  3. All angular arguments are in radians.
!
!  4. This routine is a member of the following set:
!
!         spherical       vector       solve for
!
!       > TPXES <    TPXEV       xi,eta
!         TPSTS      TPSTV        star
!         TPORS      TPORV       origin
!
!### References
!
!  * Calabretta M.R. & Greisen, E.W., 2002, "Representations of
!    celestial coordinates in FITS", Astron.Astrophys. 395, 1077
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987, Chapter 13.
!
!### History
!  * IAU SOFA revision:  2018 January 2

    subroutine TPXES ( a, b, a0, b0, xi, eta, j )

    implicit none

    real(wp),intent(in) :: a !! star's spherical coordinates
    real(wp),intent(in) :: b !! star's spherical coordinates
    real(wp),intent(in) :: a0 !! tangent point's spherical coordinates
    real(wp),intent(in) :: b0 !! tangent point's spherical coordinates
    real(wp),intent(out) :: xi !! rectangular coordinates of star image (Note 2)
    real(wp),intent(out) :: eta !! rectangular coordinates of star image (Note 2)
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * 1 = star too far from axis
                             !! * 2 = antistar on tangent plane
                             !! * 3 = antistar too far from axis

    real(wp),parameter :: tiny = 1.0e-6_wp

    real(wp) :: sb0, sb, cb0, cb, da, sda, cda, d

    !  Functions of the spherical coordinates.
    sb0 = sin(b0)
    sb = sin(b)
    cb0 = cos(b0)
    cb = cos(b)
    da = a - a0
    sda = sin(da)
    cda = cos(da)

    !  Reciprocal of star vector length to tangent plane.
    d = sb*sb0 + cb*cb0*cda

    !  Check for error cases.
    if ( d > tiny ) then
       j = 0
    else if ( d >= 0.0_wp ) then
       j = 1
       d = tiny
    else if ( d > -tiny ) then
       j = 2
       d = -tiny
    else
       j = 3
    end if

    !  Return the tangent plane coordinates (even in dubious cases).
    xi = cb*sda / d
    eta = ( sb*cb0 - cb*sb0*cda ) / d

    end subroutine TPXES
!***********************************************************************

!***********************************************************************
!>
!  In the tangent plane projection, given celestial direction cosines
!  for a star and the tangent point, solve for the star's rectangular
!  coordinates in the tangent plane.
!
!  Status:  support routine.
!
!### Notes
!
!  1. The tangent plane projection is also called the "gnomonic
!     projection" and the "central projection".
!
!  2. The eta axis points due north in the adopted coordinate system.
!     If the direction cosines represent observed (RA,Dec), the tangent
!     plane coordinates (xi,eta) are conventionally called the "standard
!     coordinates".  If the direction cosines are with respect to a
!     right-handed triad, (xi,eta) are also right-handed.  The units of
!     (xi,eta) are, effectively, radians at the tangent point.
!
!  3. The method used is to extend the star vector to the tangent
!     plane and then rotate the triad so that (x,y) becomes (xi,eta).
!     Writing (a,b) for the celestial spherical coordinates of the
!     star, the sequence of rotations is (a+pi/2) around the z-axis
!     followed by (pi/2-b) around the x-axis.
!
!  4. If vector V0 is not of unit length, or if vector V is of zero
!     length, the results will be wrong.
!
!  5. If V0 points at a pole, the returned (XI,ETA) will be based on the
!     arbitrary assumption that the longitude coordinate of the tangent
!     point is zero.
!
!  6. This routine is a member of the following set:
!
!         spherical       vector       solve for
!
!         TPXES    > TPXEV <    xi,eta
!         TPSTS      TPSTV       star
!         TPORS      TPORV      origin
!
!### References
!
!  * Calabretta M.R. & Greisen, E.W., 2002, "Representations of
!    celestial coordinates in FITS", Astron.Astrophys. 395, 1077
!
!  * Green, R.M., "Spherical Astronomy", Cambridge University Press,
!    1987, Chapter 13.
!
!### History
!  * IAU SOFA revision:  2018 January 2

    subroutine TPXEV ( v, v0, xi, eta, j )

    implicit none

    real(wp),dimension(3),intent(in) :: v !! direction cosines of star (Note 4)
    real(wp),dimension(3),intent(in) :: v0 !! direction cosines of tangent point (Note 4)
    real(wp),intent(out) :: xi !! tangent plane coordinates of star
    real(wp),intent(out) :: eta !! tangent plane coordinates of star
    integer,intent(out) :: j !! status:
                             !! * 0 = OK
                             !! * 1 = star too far from axis
                             !! * 2 = antistar on tangent plane
                             !! * 3 = antistar too far from axis

    real(wp),parameter :: tiny = 1.0e-6_wp

    real(wp) :: x, y, z, x0, y0, z0, r2, r, w, d

    !  Star and tangent point.
    x = v(1)
    y = v(2)
    z = v(3)
    x0 = v0(1)
    y0 = v0(2)
    z0 = v0(3)

    !  Deal with polar case.
    r2 = x0*x0 + y0*y0
    r = sqrt(r2)
    if ( r == 0.0_wp ) then
       r = 1e-20_wp
       x0 = r
    end if

    !  Reciprocal of star vector length to tangent plane.
    w = x*x0 + y*y0
    d = w + z*z0

    !  Check for error cases.
    if ( d > tiny ) then
       j = 0
    else if ( d >= 0.0_wp ) then
       j = 1
       d = tiny
    else if ( d > -tiny ) then
       j = 2
       d = -tiny
    else
       j = 3
    end if

    !  Return the tangent plane coordinates (even in dubious cases).
    d = r*d
    xi = ( y*x0 - x*y0 ) / d
    eta = ( z*r2 - z0*w ) / d

    end subroutine TPXEV
!***********************************************************************

!***********************************************************************
!>
!  Transpose an r-matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine TR ( r, rt )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! r-matrix
    real(wp),dimension(3,3),intent(out) :: rt !! transpose

    real(wp) :: wm(3,3)
    integer :: i, j

    do i=1,3
       do j=1,3
          wm(i,j) = r(j,i)
       end do
    end do
    call CR ( wm, rt )

    end subroutine TR
!***********************************************************************

!***********************************************************************
!>
!  Multiply a p-vector by the transpose of an r-matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2009 July 11

    subroutine TRXP ( r, p, trp )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! r-matrix
    real(wp),dimension(3),intent(in) :: p !! p-vector
    real(wp),dimension(3),intent(out) :: trp !! R * P

    real(wp) :: ri(3,3)

    !  Transpose of matrix R.
    call TR ( r, ri )

    !  Matrix RI * vector P -> vector TRP.
    call RXP ( ri, p, trp )

    end subroutine TRXP
!***********************************************************************

!***********************************************************************
!>
!  Multiply a pv-vector by the transpose of an r-matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2009 July 11

    subroutine TRXPV ( r, pv, trpv )

    implicit none

    real(wp),dimension(3,3),intent(in) :: r !! r-matrix
    real(wp),dimension(3,2),intent(in) :: pv !! pv-vector
    real(wp),dimension(3,2),intent(out) :: trpv !! R * PV

    real(wp) :: ri(3,3)

    !  Transpose of matrix R.
    call TR ( r, ri )

    !  Matrix RI * vector PV -> vector TRPV.
    call RXPV ( ri, pv, trpv )

    end subroutine TRXPV
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Terrestrial Time, TT, to International
!  Atomic Time, TAI.
!
!  Status:  canonical.
!
!### Note
!
!  TT1+TT2 is Julian Date, apportioned in any convenient way between
!  the two arguments, for example where TT1 is the Julian Day Number
!  and TT2 is the fraction of a day.  The returned TAI1,TAI2 follow
!  suit.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TTTAI ( tt1, tt2, tai1, tai2, j )

    implicit none

    real(wp),intent(in) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(in) :: tt2 !! TT as a 2-part Julian Date
    real(wp),intent(out) :: tai1 !! TAI as a 2-part Julian Date
    real(wp),intent(out) :: tai2 !! TAI as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    !  TT minus TAI (days).
    real(wp),parameter :: dtat = 32.184_wp/86400.0_wp

    !  Result, safeguarding precision.
    if ( abs(tt1)>abs(tt2) ) then
       tai1 = tt1
       tai2 = tt2 - dtat
    else
       tai1 = tt1 - dtat
       tai2 = tt2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TTTAI
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Terrestrial Time, TT, to Geocentric
!  Coordinate Time, TCG.
!
!  Status:  canonical.
!
!### Note
!
!  TT1+TT2 is Julian Date, apportioned in any convenient way between
!  the two arguments, for example where TT1 is the Julian Day Number
!  and TT2 is the fraction of a day.  The returned TCG1,TCG2 follow
!  suit.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * IAU 2000 Resolution B1.9
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TTTCG ( tt1, tt2, tcg1, tcg2, j )

    implicit none

    real(wp),intent(in) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(in) :: tt2 !! TT as a 2-part Julian Date
    real(wp),intent(out) :: tcg1 !! TCG as a 2-part Julian Date
    real(wp),intent(out) :: tcg2 !! TCG as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    !  JD for MJD 0
    real(wp),parameter :: djm0 = 2400000.5_wp

    !  1977 Jan 1 00:00:32.184 TT, as MJD
    real(wp),parameter :: t77t = 43144.0003725_wp

    !  L_G = 1 - dTT/dTCG
    real(wp),parameter :: elg = 6.969290134e-10_wp

    !  TT to TCG rate
    real(wp),parameter :: elgg = elg/(1.0_wp-elg)

    !  Result, safeguarding precision.
    if ( abs(tt1)>abs(tt2) ) then
       tcg1 = tt1
       tcg2 = tt2 + ( ( tt1-djm0 ) + ( tt2-t77t ) ) * elgg
    else
       tcg1 = tt1 + ( ( tt2-djm0 ) + ( tt1-t77t ) ) * elgg
       tcg2 = tt2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TTTCG
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Terrestrial Time, TT, to Barycentric
!  Dynamical Time, TDB.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TT1+TT2 is Julian Date, apportioned in any convenient way between
!     the two arguments, for example where TT1 is the Julian Day Number
!     and TT2 is the fraction of a day.  The returned TDB1,TDB2 follow
!     suit.
!
!  2. The argument DTR represents the quasi-periodic component of the
!     GR transformation between TT and TCB.  It is dependent upon the
!     adopted solar-system ephemeris, and can be obtained by numerical
!     integration, by interrogating a precomputed time ephemeris or by
!     evaluating a model such as that implemented in the SOFA routine
!     DTDB.  The quantity is dominated by an annual term of 1.7 ms
!     amplitude.
!
!  3. TDB is essentially the same as Teph, the time argument for the JPL
!     solar system ephemerides.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * IAU 2006 Resolution 3
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TTTDB ( tt1, tt2, dtr, tdb1, tdb2, j )

    implicit none

    real(wp),intent(in) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(in) :: tt2 !! TT as a 2-part Julian Date
    real(wp),intent(in) :: dtr !! TDB-TT in seconds
    real(wp),intent(out) :: tdb1 !! TDB as a 2-part Julian Date
    real(wp),intent(out) :: tdb2 !! TDB as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    real(wp) :: dtrd

    !  Result, safeguarding precision.
    dtrd = dtr/d2s
    if ( abs(tt1)>abs(tt2) ) then
       tdb1 = tt1
       tdb2 = tt2 + dtrd
    else
       tdb1 = tt1 + dtrd
       tdb2 = tt2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TTTDB
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Terrestrial Time, TT, to Universal Time,
!  UT1.
!
!  Status:  canonical.
!
!### Notes
!
!  1. TT1+TT2 is Julian Date, apportioned in any convenient way between
!     the two arguments, for example where TT1 is the Julian Day Number
!     and TT2 is the fraction of a day.  The returned UT11,UT12 follow
!     suit.
!
!  2. The argument DT is classical Delta T.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine TTUT1 ( tt1, tt2, dt, ut11, ut12, j )

    implicit none

    real(wp),intent(in) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(in) :: tt2 !! TT as a 2-part Julian Date
    real(wp),intent(in) :: dt !! TT-UT1 in seconds
    real(wp),intent(out) :: ut11 !! UT1 as a 2-part Julian Date
    real(wp),intent(out) :: ut12 !! UT1 as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    real(wp) :: dtd

    !  Result, safeguarding precision.
    dtd = dt/d2s
    if ( abs(tt1)>abs(tt2) ) then
       ut11 = tt1
       ut12 = tt2 - dtd
    else
       ut11 = tt1 - dtd
       ut12 = tt2
    end if

    !  Status (always OK).
    j = 0

    end subroutine TTUT1
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Universal Time, UT1, to International
!  Atomic Time, TAI.
!
!  Status:  canonical.
!
!### Notes
!
!  1. UT11+UT12 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where UT11 is the Julian
!     Day Number and UT12 is the fraction of a day.  The returned
!     TAI1,TAI2 follow suit.
!
!  2. The argument DTA, i.e. UT1-TAI, is an observed quantity, and is
!     available from IERS tabulations.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine UT1TAI ( ut11, ut12, dta, tai1, tai2, j )

    implicit none

    real(wp),intent(in) :: ut11 !! UT1 as a 2-part Julian Date
    real(wp),intent(in) :: ut12 !! UT1 as a 2-part Julian Date
    real(wp),intent(in) :: dta !! UT1-TAI in seconds
    real(wp),intent(out) :: tai1 !! TAI as a 2-part Julian Date
    real(wp),intent(out) :: tai2 !! TAI as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    real(wp) :: dtad

    !  Result, safeguarding precision.
    dtad = dta/d2s
    if ( abs(ut11)>abs(ut12) ) then
       tai1 = ut11
       tai2 = ut12 - dtad
    else
       tai1 = ut11 - dtad
       tai2 = ut12
    end if

    !  Status (always OK).
    j = 0

    end subroutine UT1TAI
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Universal Time, UT1, to Terrestrial Time,
!  TT.
!
!  Status:  canonical.
!
!### Notes
!
!  1. UT11+UT12 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where UT11 is the Julian
!     Day Number and UT12 is the fraction of a day.  The returned
!     TT1,TT2 follow suit.
!
!  2. The argument DT is classical Delta T.
!
!### Reference
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine UT1TT ( ut11, ut12, dt, tt1, tt2, j )

    implicit none

    real(wp),intent(in) :: ut11 !! UT1 as a 2-part Julian Date
    real(wp),intent(in) :: ut12 !! UT1 as a 2-part Julian Date
    real(wp),intent(in) :: dt !! TT-UT1 in seconds
    real(wp),intent(out) :: tt1 !! TT as a 2-part Julian Date
    real(wp),intent(out) :: tt2 !! TT as a 2-part Julian Date
    integer,intent(out) :: j !! status:  0 = OK

    real(wp) :: dtd

    !  Result, safeguarding precision.
    dtd = dt/d2s
    if ( abs(ut11)>abs(ut12) ) then
       tt1 = ut11
       tt2 = ut12 + dtd
    else
       tt1 = ut11 + dtd
       tt2 = ut12
    end if

    !  Status (always OK).
    j = 0

    end subroutine UT1TT
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Universal Time, UT1, to Coordinated
!  Universal Time, UTC.
!
!  Status:  canonical.
!
!### Notes
!
!  1. UT11+UT12 is Julian Date, apportioned in any convenient way
!     between the two arguments, for example where UT11 is the Julian
!     Day Number and UT12 is the fraction of a day.  The returned UTC1
!     and UTC2 form an analogous pair, except that a special convention
!     is used, to deal with the problem of leap seconds - see Note 3.
!
!  2. Delta UT1 can be obtained from tabulations provided by the
!     International Earth Rotation and Reference Systems Service.  The
!     value changes abruptly by 1s at a leap second;  however, close to
!     a leap second the algorithm used here is tolerant of the "wrong"
!     choice of value being made.
!
!  3. JD cannot unambiguously represent UTC during a leap second unless
!     special measures are taken.  The convention in the present routine
!     is that the returned quasi JD day UTC1+UTC2 represents UTC days
!     whether the length is 86399, 86400 or 86401 SI seconds.
!
!  4. The routine D2DTF can be used to transform the UTC quasi-JD
!     into calendar date and clock time, including UTC leap second
!     handling.
!
!  5. The warning status "dubious year" flags UTCs that predate the
!     introduction of the time scale or that are too far in the future
!     to be trusted.  See DAT for further details.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine UT1UTC ( ut11, ut12, dut1, utc1, utc2, j )

    implicit none

    real(wp),intent(in) :: ut11 !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: ut12 !! UT1 as a 2-part Julian Date (Note 1)
    real(wp),intent(in) :: dut1 !! Delta UT1: UT1-UTC in seconds (Note 2)
    real(wp),intent(out) :: utc1 !! UTC as a 2-part quasi Julian Date (Notes 3,4)
    real(wp),intent(out) :: utc2 !! UTC as a 2-part quasi Julian Date (Notes 3,4)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 5)
                             !! *  0 = OK
                             !! * -1 = unacceptable date

    logical :: big1
    integer :: i, iy, im, id, js
    real(wp) :: duts, u1, u2, d1, dats1, d2, fd, dats2, ddats, &
                us1, us2, du

    !  UT1-UTC in seconds.
    duts = dut1

    !  Put the two parts of the UT1 into big-first order.
    big1 = abs(ut11) >= abs(ut12)
    if ( big1 ) then
       u1 = ut11
       u2 = ut12
    else
       u1 = ut12
       u2 = ut11
    end if

    !  See if the UT1 can possibly be in a leap-second day.
    d1 = u1
    dats1 = 0.0_wp
    do i=-1,3
       d2 = u2 + real(i,wp)
       call JD2CAL ( d1, d2, iy, im, id, fd, js )
       if ( js/=0 ) then
          j = js
          return
       end if
       call DAT ( iy, im, id, 0.0_wp, dats2, js )
       if ( js<0 ) then
          j = js
          return
       end if
       if ( i==-1 ) dats1 = dats2
       ddats = dats2 - dats1
       if ( abs(ddats)>=0.5_wp ) then

          !  Yes, leap second nearby: ensure UT1-UTC is "before" value.
          if ( ddats*duts>=0.0_wp ) duts = duts-ddats

          !  UT1 for the start of the UTC day that ends in a leap.
          call CAL2JD ( iy, im, id, d1, d2, js )
          us1 = d1
          us2 = d2 - 1.0_wp + duts/d2s

          !  Is the UT1 after this point?
          du = u1 - us1
          du = du + ( u2 - us2 )
          if ( du>0.0_wp ) then

             !  Yes:  fraction of the current UTC day that has elapsed.
             fd = du * d2s / ( d2s + ddats )

             !  Ramp UT1-UTC to bring about SOFA's JD(UTC) convention.
             duts = duts + ddats*min(fd,1.0_wp)
          end if

          !  Break.
          exit
       end if
       dats1 = dats2
    end do

    !  Subtract the (possibly adjusted) UT1-UTC from UT1 to give UTC.
    u2 = u2 - duts/d2s

    !  Result, safeguarding precision.
    if ( big1 ) then
       utc1 = u1
       utc2 = u2
    else
       utc1 = u2
       utc2 = u1
    end if

    !  Return the status.
    j = js

    end subroutine UT1UTC
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Coordinated Universal Time, UTC, to
!  International Atomic Time, TAI.
!
!  Status:  canonical.
!
!### Notes
!
!  1. UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!     convenient way between the two arguments, for example where UTC1
!     is the Julian Day Number and UTC2 is the fraction of a day.
!
!  2. JD cannot unambiguously represent UTC during a leap second unless
!     special measures are taken.  The convention in the present routine
!     is that the JD day represents UTC days whether the length is
!     86399, 86400 or 86401 SI seconds.  In the 1960-1972 era there were
!     smaller jumps (in either direction) each time the linear UTC(TAI)
!     expression was changed, and these "mini-leaps" are also included
!     in the SOFA convention.
!
!  3. The warning status "dubious year" flags UTCs that predate the
!     introduction of the time scale or that are too far in the future
!     to be trusted.  See DAT for further details.
!
!  4. The routine DTF2D converts from calendar date and time of day
!     into 2-part Julian Date, and in the case of UTC implements the
!     leap-second-ambiguity convention described above.
!
!  5. The returned TAI1,TAI2 are such that their sum is the TAI Julian
!     Date.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2019 June 20

    subroutine UTCTAI ( utc1, utc2, tai1, tai2, j )

    implicit none

    real(wp),intent(in) :: utc1 !! UTC as a 2-part quasi Julian Date (Notes 1-4)
    real(wp),intent(in) :: utc2 !! UTC as a 2-part quasi Julian Date (Notes 1-4)
    real(wp),intent(out) :: tai1 !! TAI as a 2-part Julian Date (Note 5)
    real(wp),intent(out) :: tai2 !! TAI as a 2-part Julian Date (Note 5)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 3)
                             !! * 0 = OK
                             !! * -1 = unacceptable date

    logical :: big1
    integer :: iy, im, id, js, iyt, imt, idt
    real(wp) :: u1, u2, fd, dat0, dat12, w, dat24, dlod, dleap, &
                z1, z2, a2

    !  Put the two parts of the UTC into big-first order.
    big1 = abs(utc1) >= abs(utc2)
    if ( big1 ) then
       u1 = utc1
       u2 = utc2
    else
       u1 = utc2
       u2 = utc1
    end if

    !  Get TAI-UTC at 0h today.
    call JD2CAL ( u1, u2, iy, im, id, fd, js )
    if ( js==0 ) then

      call DAT ( iy, im, id, 0.0_wp, dat0, js )
      if ( js>=0 ) then

        !  Get TAI-UTC at 12h today (to detect drift).
        call DAT ( iy, im, id, 0.5_wp, dat12, js )
        if ( js>=0 ) then

          !  Get TAI-UTC at 0h tomorrow (to detect jumps).
          call JD2CAL ( u1+1.5_wp, u2-fd, iyt, imt, idt, w, js )
          if ( js==0 ) then

            call DAT ( iyt, imt, idt, 0.0_wp, dat24, js )
            if ( js>=0 ) then

              !  Separate TAI-UTC change into per-day (DLOD) and any jump (DLEAP).
              dlod = 2.0_wp * ( dat12 - dat0 )
              dleap = dat24 - ( dat0 + dlod )

              !  Remove any scaling applied to spread leap into preceding day.
              fd = fd * (d2s+dleap)/d2s

              !  Scale from (pre-1972) UTC seconds to SI seconds.
              fd = fd * (d2s+dlod)/d2s

              !  Today's calendar date to 2-part JD.
              call CAL2JD ( iy, im, id, z1, z2, js )
              if ( js==0 ) then

                !  Assemble the TAI result, preserving the UTC split and order.
                a2 = z1 - u1
                a2 = ( a2 + z2 ) + ( fd + dat0/d2s )
                if ( big1 ) then
                  tai1 = u1
                  tai2 = a2
                else
                  tai1 = a2
                  tai2 = u1
                end if

              end if
            end if
          end if
        end if
      end if
    end if

    !  Status.
    j = js

    end subroutine UTCTAI
!***********************************************************************

!***********************************************************************
!>
!  Time scale transformation:  Coordinated Universal Time, UTC, to
!  Universal Time, UT1.
!
!  Status:  canonical.
!
!### Notes
!
!  1. UTC1+UTC2 is quasi Julian Date (see Note 2), apportioned in any
!     convenient way between the two arguments, for example where UTC1
!     is the Julian Day Number and UTC2 is the fraction of a day.
!
!  2. JD cannot unambiguously represent UTC during a leap second unless
!     special measures are taken.  The convention in the present routine
!     is that the JD day represents UTC days whether the length is
!     86399, 86400 or 86401 SI seconds.
!
!  3. The warning status "dubious year" flags UTCs that predate the
!     introduction of the time scale or that are too far in the future
!     to be trusted.  See DAT for further details.
!
!  4. The routine DTF2D converts from calendar date and time of day
!     into 2-part Julian Date, and in the case of UTC implements the
!     leap-second-ambiguity convention described above.
!
!  5. Delta UT1 can be obtained from tabulations provided by the
!     International Earth Rotation and Reference Systems Service.
!     It is the caller's responsibility to supply a DUT1 argument
!     containing the UT1-UTC value that matches the given UTC.
!
!  6. The returned UT11,UT12 are such that their sum is the UT1 Julian
!     Date.
!
!### References
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!  * Explanatory Supplement to the Astronomical Almanac,
!    P. Kenneth Seidelmann (ed), University Science Books (1992)
!
!### History
!  * IAU SOFA revision: 2013 August 12
!  * 11/21/2019: for astro_module, renamed the local variable
!    'dat' to 'd' so as not to conflict with the subroutine DAT.

    subroutine UTCUT1 ( utc1, utc2, dut1, ut11, ut12, j )

    implicit none

    real(wp),intent(in) :: utc1 !! UTC as a 2-part quasi Julian Date (Notes 1-4)
    real(wp),intent(in) :: utc2 !! UTC as a 2-part quasi Julian Date (Notes 1-4)
    real(wp),intent(in) :: dut1 !! Delta UT1 = UT1-UTC in seconds (Note 5)
    real(wp),intent(out) :: ut11 !! UT1 as a 2-part Julian Date (Note 6)
    real(wp),intent(out) :: ut12 !! UT1 as a 2-part Julian Date (Note 6)
    integer,intent(out) :: j !! status:
                             !! * +1 = dubious year (Note 3)
                             !! * 0 = OK
                             !! * -1 = unacceptable date

    integer :: iy, im, id, js, jw
    real(wp) :: w, d, dta, tai1, tai2

    !  Look up TAI-UTC.
    call JD2CAL ( utc1, utc2, iy, im, id, w, js )
    if ( js==0 ) then

      call DAT ( iy, im, id, 0.0_wp, d, js )
      if ( js>=0 ) then

        !  Form UT1-TAI.
        dta = dut1 - d

        !  UTC to TAI to UT1.
        call UTCTAI ( utc1, utc2, tai1, tai2, jw )
        if ( jw<0 ) then
          js = jw
        else
          call TAIUT1 ( tai1, tai2, dta, ut11, ut12, jw )
        end if

      end if

    end if

    !  Return the status.
    j = js

    end subroutine UTCUT1
!***********************************************************************

!***********************************************************************
!>
!  X,Y coordinates of celestial intermediate pole from series based
!  on IAU 2006 precession and IAU 2000A nutation.
!
!  Status:  canonical model.
!
!### Notes
!
!  1. 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.
!
!  2. The X,Y coordinates are those of the unit vector towards the
!     celestial intermediate pole.  They represent the combined effects
!     of frame bias, precession and nutation.
!
!  3. The fundamental arguments used are as adopted in IERS Conventions
!     (2003) and are from Simon et al. (1994) and Souchay et al. (1999).
!
!  4. This is an alternative to the angles-based method, via the SOFA
!     routine FW2XY and as used in XYS06A for example.  The
!     two methods agree at the 1 microarcsecond level (at present),
!     a negligible amount compared with the intrinsic accuracy of the
!     models.  However, it would be unwise to mix the two methods
!     (angles-based and series-based) in a single application.
!
!### References
!
!  * Capitaine, N., Wallace, P.T. & Chapront, J., 2003,
!    Astron.Astrophys., 412, 567
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * McCarthy, D. D., Petit, G. (eds.), 2004, IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG
!
!  * Simon, J.L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
!    Francou, G. & Laskar, J., Astron.Astrophys., 1994, 282, 663
!
!  * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M., 1999,
!    Astron.Astrophys.Supp.Ser. 135, 111
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2013 December 2

    subroutine XY06 ( date1, date2, x, y )

    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(out) :: x !! CIP X coordinate (Note 2)
    real(wp),intent(out) :: y !! CIP Y coordinate (Note 2)

    !  Maximum power of T in the polynomials for X and Y
    integer,parameter :: maxpt = 5

    !  Numbers of frequencies:  luni-solar, planetary, total
    integer,parameter :: nfls = 653
    integer,parameter :: nfpl = 656
    integer,parameter :: nf = nfls+nfpl

    !  Number of amplitude coefficients
    integer,parameter :: na = 4755

    !  Polynomial coefficients (arcsec).
    real(wp),dimension(0:maxpt,0:1),parameter :: xyp = reshape([   -0.016617_wp, &
                                                                +2004.191898_wp, &
                                                                   -0.4297829_wp, &
                                                                   -0.19861834_wp, &
                                                                   +0.000007578_wp, &
                                                                   +0.0000059285_wp, &
                                                                   -0.006951_wp, &
                                                                   -0.025896_wp, &
                                                                   -22.4072747_wp, &
                                                                   +0.00190059_wp, &
                                                                   +0.001112526_wp, &
                                                                   +0.0000001358_wp ], [maxpt+1,2])

    !  Amplitude usage: X or Y, sin or cos, power of T.
    integer,dimension(0:maxpt*4-1),parameter :: jaxy = [ 0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1 ]
    integer,dimension(0:maxpt*4-1),parameter :: jasc = [ 0,1,1,0,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0 ]
    integer,dimension(0:maxpt*4-1),parameter :: japt = [ 0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4 ]

    !  Miscellaneous
    real(wp) :: t, w, pt(0:maxpt), fa(14), xypr(0:1), xypl(0:1), &
                xyls(0:1), arg, sc(0:1)
    integer :: jpt, i, j, jxy, ialast, ifreq, m, ia, jsc

    !  Fundamental-argument multipliers:  luni-solar terms.
    integer,dimension(5,nfls),parameter :: mfals = reshape( &
                [   0,  0,  0,  0,  1, &
                    0,  0,  2, -2,  2, &
                    0,  0,  2,  0,  2, &
                    0,  0,  0,  0,  2, &
                    0,  1,  0,  0,  0, &
                    0,  1,  2, -2,  2, &
                    1,  0,  0,  0,  0, &
                    0,  0,  2,  0,  1, &
                    1,  0,  2,  0,  2, &
                    0,  1, -2,  2, -2, &
                    0,  0,  2, -2,  1, &
                    1,  0, -2,  0, -2, &
                    1,  0,  0, -2,  0, &
                    1,  0,  0,  0,  1, &
                    1,  0,  0,  0, -1, &
                    1,  0, -2, -2, -2, &
                    1,  0,  2,  0,  1, &
                    2,  0, -2,  0, -1, &
                    0,  0,  0,  2,  0, &
                    0,  0,  2,  2,  2, &
                    2,  0,  0, -2,  0, &
                    0,  2, -2,  2, -2, &
                    2,  0,  2,  0,  2, &
                    1,  0,  2, -2,  2, &
                    1,  0, -2,  0, -1, &
                    2,  0,  0,  0,  0, &
                    0,  0,  2,  0,  0, &
                    0,  1,  0,  0,  1, &
                    1,  0,  0, -2, -1, &
                    0,  2,  2, -2,  2, &
                    0,  0,  2, -2,  0, &
                    1,  0,  0, -2,  1, &
                    0,  1,  0,  0, -1, &
                    0,  2,  0,  0,  0, &
                    1,  0, -2, -2, -1, &
                    1,  0,  2,  2,  2, &
                    0,  1,  2,  0,  2, &
                    2,  0, -2,  0,  0, &
                    0,  0,  2,  2,  1, &
                    0,  1, -2,  0, -2, &
                    0,  0,  0,  2,  1, &
                    1,  0,  2, -2,  1, &
                    2,  0,  0, -2, -1, &
                    2,  0,  2, -2,  2, &
                    2,  0,  2,  0,  1, &
                    0,  0,  0,  2, -1, &
                    0,  1, -2,  2, -1, &
                    1,  1,  0, -2,  0, &
                    2,  0,  0, -2,  1, &
                    1,  0,  0,  2,  0, &
                    0,  1,  2, -2,  1, &
                    1, -1,  0,  0,  0, &
                    0,  1, -1,  1, -1, &
                    2,  0, -2,  0, -2, &
                    0,  1,  0, -2,  0, &
                    1,  0,  0, -1,  0, &
                    3,  0,  2,  0,  2, &
                    0,  0,  0,  1,  0, &
                    1, -1,  2,  0,  2, &
                    1,  1, -2, -2, -2, &
                    1,  0, -2,  0,  0, &
                    2,  0,  0,  0, -1, &
                    0,  1, -2, -2, -2, &
                    1,  1,  2,  0,  2, &
                    2,  0,  0,  0,  1, &
                    1,  1,  0,  0,  0, &
                    1,  0, -2,  2, -1, &
                    1,  0,  2,  0,  0, &
                    1, -1,  0, -1,  0, &
                    1,  0,  0,  0,  2, &
                    1,  0, -1,  0, -1, &
                    0,  0,  2,  1,  2, &
                    1,  0, -2, -4, -2, &
                    1, -1,  0, -1, -1, &
                    1,  0,  2,  2,  1, &
                    0,  2, -2,  2, -1, &
                    1,  0,  0,  0, -2, &
                    2,  0, -2, -2, -2, &
                    1,  1,  2, -2,  2, &
                    2,  0, -2, -4, -2, &
                    1,  0, -4,  0, -2, &
                    2,  0,  2, -2,  1, &
                    1,  0,  0, -1, -1, &
                    2,  0,  2,  2,  2, &
                    3,  0,  0,  0,  0, &
                    1,  0,  0,  2,  1, &
                    0,  0,  2, -2, -1, &
                    3,  0,  2, -2,  2, &
                    0,  0,  4, -2,  2, &
                    1,  0,  0, -4,  0, &
                    0,  1,  2,  0,  1, &
                    2,  0,  0, -4,  0, &
                    1,  1,  0, -2, -1, &
                    2,  0, -2,  0,  1, &
                    0,  0,  2,  0, -1, &
                    0,  1, -2,  0, -1, &
                    0,  1,  0,  0,  2, &
                    0,  0,  2, -1,  2, &
                    0,  0,  2,  4,  2, &
                    2,  1,  0, -2,  0, &
                    1,  1,  0, -2,  1, &
                    1, -1,  0, -2,  0, &
                    1, -1,  0, -1, -2, &
                    1, -1,  0,  0,  1, &
                    0,  1, -2,  2,  0, &
                    0,  1,  0,  0, -2, &
                    1, -1,  2,  2,  2, &
                    1,  0,  0,  2, -1, &
                    1, -1, -2, -2, -2, &
                    3,  0,  2,  0,  1, &
                    0,  1,  2,  2,  2, &
                    1,  0,  2, -2,  0, &
                    1,  1, -2, -2, -1, &
                    1,  0,  2, -4,  1, &
                    0,  1, -2, -2, -1, &
                    2, -1,  2,  0,  2, &
                    0,  0,  0,  2,  2, &
                    1, -1,  2,  0,  1, &
                    1, -1, -2,  0, -2, &
                    0,  1,  0,  2,  0, &
                    0,  1,  2, -2,  0, &
                    0,  0,  0,  1,  1, &
                    1,  0, -2, -2,  0, &
                    0,  3,  2, -2,  2, &
                    2,  1,  2,  0,  2, &
                    1,  1,  0,  0,  1, &
                    2,  0,  0,  2,  0, &
                    1,  1,  2,  0,  1, &
                    1,  0,  0, -2, -2, &
                    1,  0, -2,  2,  0, &
                    1,  0, -1,  0, -2, &
                    0,  1,  0, -2,  1, &
                    0,  1,  0,  1,  0, &
                    0,  0,  0,  1, -1, &
                    1,  0, -2,  2, -2, &
                    1, -1,  0,  0, -1, &
                    0,  0,  0,  4,  0, &
                    1, -1,  0,  2,  0, &
                    1,  0,  2,  1,  2, &
                    1,  0,  2, -1,  2, &
                    0,  0,  2,  1,  1, &
                    1,  0,  0, -2,  2, &
                    1,  0, -2,  0,  1, &
                    1,  0, -2, -4, -1, &
                    0,  0,  2,  2,  0, &
                    1,  1,  2, -2,  1, &
                    1,  0, -2,  1, -1, &
                    0,  0,  1,  0,  1, &
                    2,  0, -2, -2, -1, &
                    4,  0,  2,  0,  2, &
                    2, -1,  0,  0,  0, &
                    2,  1,  2, -2,  2, &
                    0,  1,  2,  1,  2, &
                    1,  0,  4, -2,  2, &
                    1,  1,  0,  0, -1, &
                    2,  0,  2,  0,  0, &
                    2,  0, -2, -4, -1, &
                    1,  0, -1,  0,  0, &
                    1,  0,  0,  1,  0, &
                    0,  1,  0,  2,  1, &
                    1,  0, -4,  0, -1, &
                    1,  0,  0, -4, -1, &
                    2,  0,  2,  2,  1, &
                    2,  1,  0,  0,  0, &
                    0,  0,  2, -3,  2, &
                    1,  2,  0, -2,  0, &
                    0,  3,  0,  0,  0, &
                    0,  0,  4,  0,  2, &
                    0,  0,  2, -4,  1, &
                    2,  0,  0, -2, -2, &
                    1,  1, -2, -4, -2, &
                    0,  1,  0, -2, -1, &
                    0,  0,  0,  4,  1, &
                    3,  0,  2, -2,  1, &
                    1,  0,  2,  4,  2, &
                    1,  1, -2,  0, -2, &
                    0,  0,  4, -2,  1, &
                    2, -2,  0, -2,  0, &
                    2,  1,  0, -2, -1, &
                    0,  2,  0, -2,  0, &
                    1,  0,  0, -1,  1, &
                    1,  1,  2,  2,  2, &
                    3,  0,  0,  0, -1, &
                    2,  0,  0, -4, -1, &
                    3,  0,  2,  2,  2, &
                    0,  0,  2,  4,  1, &
                    0,  2, -2, -2, -2, &
                    1, -1,  0, -2, -1, &
                    0,  0,  2, -1,  1, &
                    2,  0,  0,  2,  1, &
                    1, -1, -2,  2, -1, &
                    0,  0,  0,  2, -2, &
                    2,  0,  0, -4,  1, &
                    1,  0,  0, -4,  1, &
                    2,  0,  2, -4,  1, &
                    4,  0,  2, -2,  2, &
                    2,  1, -2,  0, -1, &
                    2,  1, -2, -4, -2, &
                    3,  0,  0, -4,  0, &
                    1, -1,  2,  2,  1, &
                    1, -1, -2,  0, -1, &
                    0,  2,  0,  0,  1, &
                    1,  2, -2, -2, -2, &
                    1,  1,  0, -4,  0, &
                    2,  0,  0, -2,  2, &
                    0,  2,  2, -2,  1, &
                    1,  0,  2,  0, -1, &
                    2,  1,  0, -2,  1, &
                    2, -1, -2,  0, -1, &
                    1, -1, -2, -2, -1, &
                    0,  1, -2,  1, -2, &
                    1,  0, -4,  2, -2, &
                    0,  1,  2,  2,  1, &
                    3,  0,  0,  0,  1, &
                    2, -1,  2,  2,  2, &
                    0,  1, -2, -4, -2, &
                    1,  0, -2, -3, -2, &
                    2,  0,  0,  0,  2, &
                    1, -1,  0, -2, -2, &
                    2,  0, -2,  2, -1, &
                    0,  2, -2,  0, -2, &
                    3,  0, -2,  0, -1, &
                    2, -1,  2,  0,  1, &
                    1,  0, -2, -1, -2, &
                    0,  0,  2,  0,  3, &
                    2,  0, -4,  0, -2, &
                    2,  1,  0, -4,  0, &
                    1,  1, -2,  1, -1, &
                    0,  2,  2,  0,  2, &
                    1, -1,  2, -2,  2, &
                    1, -1,  0, -2,  1, &
                    2,  1,  2,  0,  1, &
                    1,  0,  2, -4,  2, &
                    1,  1, -2,  0, -1, &
                    1,  1,  0,  2,  0, &
                    1,  0,  0, -3,  0, &
                    2,  0,  2, -1,  2, &
                    0,  2,  0,  0, -1, &
                    2, -1,  0, -2,  0, &
                    4,  0,  0,  0,  0, &
                    2,  1, -2, -2, -2, &
                    0,  2, -2,  2,  0, &
                    1,  0,  2,  1,  1, &
                    1,  0, -1,  0, -3, &
                    3, -1,  2,  0,  2, &
                    2,  0,  2, -2,  0, &
                    1, -2,  0,  0,  0, &
                    2,  0,  0,  0, -2, &
                    1,  0,  0,  4,  0, &
                    0,  1,  0,  1,  1, &
                    1,  0,  2,  2,  0, &
                    0,  1,  0,  2, -1, &
                    0,  1,  0,  1, -1, &
                    0,  0,  2, -2,  3, &
                    3,  1,  2,  0,  2, &
                    1,  1,  2,  1,  2, &
                    1,  1, -2,  2, -1, &
                    2, -1,  2, -2,  2, &
                    1, -2,  2,  0,  2, &
                    1,  0,  2, -4,  0, &
                    0,  0,  1,  0,  0, &
                    1,  0,  2, -3,  1, &
                    1, -2,  0, -2,  0, &
                    2,  0,  0,  2, -1, &
                    1,  1,  2, -4,  1, &
                    4,  0,  2,  0,  1, &
                    0,  1,  2,  1,  1, &
                    1,  2,  2, -2,  2, &
                    2,  0,  2,  1,  2, &
                    2,  1,  2, -2,  1, &
                    1,  0,  2, -1,  1, &
                    1,  0,  4, -2,  1, &
                    1, -1,  2, -2,  1, &
                    0,  1,  0, -4,  0, &
                    3,  0, -2, -2, -2, &
                    0,  0,  4, -4,  2, &
                    2,  0, -4, -2, -2, &
                    2, -2,  0, -2, -1, &
                    1,  0,  2, -2, -1, &
                    2,  0, -2, -6, -2, &
                    1,  0, -2,  1, -2, &
                    1,  0, -2,  2,  1, &
                    1, -1,  0,  2, -1, &
                    1,  0, -2,  1,  0, &
                    2, -1,  0, -2,  1, &
                    1, -1,  0,  2,  1, &
                    2,  0, -2, -2,  0, &
                    1,  0,  2, -3,  2, &
                    0,  0,  0,  4, -1, &
                    2, -1,  0,  0,  1, &
                    2,  0,  4, -2,  2, &
                    0,  0,  2,  3,  2, &
                    0,  1,  4, -2,  2, &
                    0,  1, -2,  2,  1, &
                    1,  1,  0,  2,  1, &
                    1,  0,  0,  4,  1, &
                    0,  0,  4,  0,  1, &
                    2,  0,  0, -3,  0, &
                    1,  0,  0, -1, -2, &
                    1, -2, -2, -2, -2, &
                    3,  0,  0,  2,  0, &
                    2,  0,  2, -4,  2, &
                    1,  1, -2, -4, -1, &
                    1,  0, -2, -6, -2, &
                    2, -1,  0,  0, -1, &
                    2, -1,  0,  2,  0, &
                    0,  1,  2, -2, -1, &
                    1,  1,  0,  1,  0, &
                    1,  2,  0, -2, -1, &
                    1,  0,  0,  1, -1, &
                    0,  0,  1,  0,  2, &
                    3,  1,  2, -2,  2, &
                    1,  0, -4, -2, -2, &
                    1,  0,  2,  4,  1, &
                    1, -2,  2,  2,  2, &
                    1, -1, -2, -4, -2, &
                    0,  0,  2, -4,  2, &
                    0,  0,  2, -3,  1, &
                    2,  1, -2,  0,  0, &
                    3,  0, -2, -2, -1, &
                    2,  0,  2,  4,  2, &
                    0,  0,  0,  0,  3, &
                    2, -1, -2, -2, -2, &
                    2,  0,  0, -1,  0, &
                    3,  0,  2, -4,  2, &
                    2,  1,  2,  2,  2, &
                    0,  0,  3,  0,  3, &
                    1,  1,  2,  2,  1, &
                    2,  1,  0,  0, -1, &
                    1,  2,  0, -2,  1, &
                    3,  0,  2,  2,  1, &
                    1, -1, -2,  2, -2, &
                    1,  1,  0, -1,  0, &
                    1,  2,  0,  0,  0, &
                    1,  0,  4,  0,  2, &
                    1, -1,  2,  4,  2, &
                    2,  1,  0,  0,  1, &
                    1,  0,  0,  2,  2, &
                    1, -1, -2,  2,  0, &
                    0,  2, -2, -2, -1, &
                    2,  0, -2,  0,  2, &
                    5,  0,  2,  0,  2, &
                    3,  0, -2, -6, -2, &
                    1, -1,  2, -1,  2, &
                    3,  0,  0, -4, -1, &
                    1,  0,  0,  1,  1, &
                    1,  0, -4,  2, -1, &
                    0,  1,  2, -4,  1, &
                    1,  2,  2,  0,  2, &
                    0,  1,  0, -2, -2, &
                    0,  0,  2, -1,  0, &
                    1,  0,  1,  0,  1, &
                    0,  2,  0, -2,  1, &
                    3,  0,  2,  0,  0, &
                    1,  1, -2,  1,  0, &
                    2,  1, -2, -4, -1, &
                    3, -1,  0,  0,  0, &
                    2, -1, -2,  0,  0, &
                    4,  0,  2, -2,  1, &
                    2,  0, -2,  2,  0, &
                    1,  1,  2, -2,  0, &
                    1,  0, -2,  4, -1, &
                    1,  0, -2, -2,  1, &
                    2,  0,  2, -4,  0, &
                    1,  1,  0, -2, -2, &
                    1,  1, -2, -2,  0, &
                    1,  0,  1, -2,  1, &
                    2, -1, -2, -4, -2, &
                    3,  0, -2,  0, -2, &
                    0,  1, -2, -2,  0, &
                    3,  0,  0, -2, -1, &
                    1,  0, -2, -3, -1, &
                    0,  1,  0, -4, -1, &
                    1, -2,  2, -2,  1, &
                    0,  1, -2,  1, -1, &
                    1, -1,  0,  0,  2, &
                    2,  0,  0,  1,  0, &
                    1, -2,  0,  2,  0, &
                    1,  2, -2, -2, -1, &
                    0,  0,  4, -4,  1, &
                    0,  1,  2,  4,  2, &
                    0,  1, -4,  2, -2, &
                    3,  0, -2,  0,  0, &
                    2, -1,  2,  2,  1, &
                    0,  1, -2, -4, -1, &
                    4,  0,  2,  2,  2, &
                    2,  0, -2, -3, -2, &
                    2,  0,  0, -6,  0, &
                    1,  0,  2,  0,  3, &
                    3,  1,  0,  0,  0, &
                    3,  0,  0, -4,  1, &
                    1, -1,  2,  0,  0, &
                    1, -1,  0, -4,  0, &
                    2,  0, -2,  2, -2, &
                    1,  1,  0, -2,  2, &
                    4,  0,  0, -2,  0, &
                    2,  2,  0, -2,  0, &
                    0,  1,  2,  0,  0, &
                    1,  1,  0, -4,  1, &
                    1,  0,  0, -4, -2, &
                    0,  0,  0,  1,  2, &
                    3,  0,  0,  2,  1, &
                    1,  1,  0, -4, -1, &
                    0,  0,  2,  2, -1, &
                    1,  1,  2,  0,  0, &
                    1, -1,  2, -4,  1, &
                    1,  1,  0,  0,  2, &
                    0,  0,  2,  6,  2, &
                    4,  0, -2, -2, -1, &
                    2,  1,  0, -4, -1, &
                    0,  0,  0,  3,  1, &
                    1, -1, -2,  0,  0, &
                    0,  0,  2,  1,  0, &
                    1,  0,  0,  2, -2, &
                    3, -1,  2,  2,  2, &
                    3, -1,  2, -2,  2, &
                    1,  0,  0, -1,  2, &
                    1, -2,  2, -2,  2, &
                    0,  1,  0,  2,  2, &
                    0,  1, -2, -1, -2, &
                    1,  1, -2,  0,  0, &
                    0,  2,  2, -2,  0, &
                    3, -1, -2, -1, -2, &
                    1,  0,  0, -6,  0, &
                    1,  0, -2, -4,  0, &
                    2,  1,  0, -4,  1, &
                    2,  0,  2,  0, -1, &
                    2,  0, -4,  0, -1, &
                    0,  0,  3,  0,  2, &
                    2,  1, -2, -2, -1, &
                    1, -2,  0,  0,  1, &
                    2, -1,  0, -4,  0, &
                    0,  0,  0,  3,  0, &
                    5,  0,  2, -2,  2, &
                    1,  2, -2, -4, -2, &
                    1,  0,  4, -4,  2, &
                    0,  0,  4, -1,  2, &
                    3,  1,  0, -4,  0, &
                    3,  0,  0, -6,  0, &
                    2,  0,  0,  2,  2, &
                    2, -2,  2,  0,  2, &
                    1,  0,  0, -3,  1, &
                    1, -2, -2,  0, -2, &
                    1, -1, -2, -3, -2, &
                    0,  0,  2, -2, -2, &
                    2,  0, -2, -4,  0, &
                    1,  0, -4,  0,  0, &
                    0,  1,  0, -1,  0, &
                    4,  0,  0,  0, -1, &
                    3,  0,  2, -1,  2, &
                    3, -1,  2,  0,  1, &
                    2,  0,  2, -1,  1, &
                    1,  2,  2, -2,  1, &
                    1,  1,  0,  2, -1, &
                    0,  2,  2,  0,  1, &
                    3,  1,  2,  0,  1, &
                    1,  1,  2,  1,  1, &
                    1,  1,  0, -1,  1, &
                    1, -2,  0, -2, -1, &
                    4,  0,  0, -4,  0, &
                    2,  1,  0,  2,  0, &
                    1, -1,  0,  4,  0, &
                    0,  1,  0, -2,  2, &
                    0,  0,  2,  0, -2, &
                    1,  0, -1,  0,  1, &
                    3,  0,  2, -2,  0, &
                    2,  0,  2,  2,  0, &
                    1,  2,  0, -4,  0, &
                    1, -1,  0, -3,  0, &
                    0,  1,  0,  4,  0, &
                    0,  1, -2,  0,  0, &
                    2,  2,  2, -2,  2, &
                    0,  0,  0,  1, -2, &
                    0,  2, -2,  0, -1, &
                    4,  0,  2, -4,  2, &
                    2,  0, -4,  2, -2, &
                    2, -1, -2,  0, -2, &
                    1,  1,  4, -2,  2, &
                    1,  1,  2, -4,  2, &
                    1,  0,  2,  3,  2, &
                    1,  0,  0,  4, -1, &
                    0,  0,  0,  4,  2, &
                    2,  0,  0,  4,  0, &
                    1,  1, -2,  2,  0, &
                    2,  1,  2,  1,  2, &
                    2,  1,  2, -4,  1, &
                    2,  0,  2,  1,  1, &
                    2,  0, -4, -2, -1, &
                    2,  0, -2, -6, -1, &
                    2, -1,  2, -1,  2, &
                    1, -2,  2,  0,  1, &
                    1, -2,  0, -2,  1, &
                    1, -1,  0, -4, -1, &
                    0,  2,  2,  2,  2, &
                    0,  2, -2, -4, -2, &
                    0,  1,  2,  3,  2, &
                    0,  1,  0, -4,  1, &
                    3,  0,  0, -2,  1, &
                    2,  1, -2,  0,  1, &
                    2,  0,  4, -2,  1, &
                    2,  0,  0, -3, -1, &
                    2, -2,  0, -2,  1, &
                    2, -1,  2, -2,  1, &
                    1,  0,  0, -6, -1, &
                    1, -2,  0,  0, -1, &
                    1, -2, -2, -2, -1, &
                    0,  1,  4, -2,  1, &
                    0,  0,  2,  3,  1, &
                    2, -1,  0, -1,  0, &
                    1,  3,  0, -2,  0, &
                    0,  3,  0, -2,  0, &
                    2, -2,  2, -2,  2, &
                    0,  0,  4, -2,  0, &
                    4, -1,  2,  0,  2, &
                    2,  2, -2, -4, -2, &
                    4,  1,  2,  0,  2, &
                    4, -1, -2, -2, -2, &
                    2,  1,  0, -2, -2, &
                    2,  1, -2, -6, -2, &
                    2,  0,  0, -1,  1, &
                    2, -1, -2,  2, -1, &
                    1,  1, -2,  2, -2, &
                    1,  1, -2, -3, -2, &
                    1,  0,  3,  0,  3, &
                    1,  0, -2,  1,  1, &
                    1,  0, -2,  0,  2, &
                    1, -1,  2,  1,  2, &
                    1, -1,  0,  0, -2, &
                    1, -1, -4,  2, -2, &
                    0,  3, -2, -2, -2, &
                    0,  1,  0,  4,  1, &
                    0,  0,  4,  2,  2, &
                    3,  0, -2, -2,  0, &
                    2, -2,  0,  0,  0, &
                    1,  1,  2, -4,  0, &
                    1,  1,  0, -3,  0, &
                    1,  0,  2, -3,  0, &
                    1, -1,  2, -2,  0, &
                    0,  2,  0,  2,  0, &
                    0,  0,  2,  4,  0, &
                    1,  0,  1,  0,  0, &
                    3,  1,  2, -2,  1, &
                    3,  0,  4, -2,  2, &
                    3,  0,  2,  1,  2, &
                    3,  0,  0,  2, -1, &
                    3,  0,  0,  0,  2, &
                    3,  0, -2,  2, -1, &
                    2,  0,  4, -4,  2, &
                    2,  0,  2, -3,  2, &
                    2,  0,  0,  4,  1, &
                    2,  0,  0, -3,  1, &
                    2,  0, -4,  2, -1, &
                    2,  0, -2, -2,  1, &
                    2, -2,  2,  2,  2, &
                    2, -2,  0, -2, -2, &
                    2, -1,  0,  2,  1, &
                    2, -1,  0,  2, -1, &
                    1,  1,  2,  4,  2, &
                    1,  1,  0,  1,  1, &
                    1,  1,  0,  1, -1, &
                    1,  1, -2, -6, -2, &
                    1,  0,  0, -3, -1, &
                    1,  0, -4, -2, -1, &
                    1,  0, -2, -6, -1, &
                    1, -2,  2,  2,  1, &
                    1, -2, -2,  2, -1, &
                    1, -1, -2, -4, -1, &
                    0,  2,  0,  0,  2, &
                    0,  1,  2, -4,  2, &
                    0,  1, -2,  4, -1, &
                    5,  0,  0,  0,  0, &
                    3,  0,  0, -3,  0, &
                    2,  2,  0, -4,  0, &
                    1, -1,  2,  2,  0, &
                    0,  1,  0,  3,  0, &
                    4,  0, -2,  0, -1, &
                    3,  0, -2, -6, -1, &
                    3,  0, -2, -1, -1, &
                    2,  1,  2,  2,  1, &
                    2,  1,  0,  2,  1, &
                    2,  0,  2,  4,  1, &
                    2,  0,  2, -6,  1, &
                    2,  0,  2, -2, -1, &
                    2,  0,  0, -6, -1, &
                    2, -1, -2, -2, -1, &
                    1,  2,  2,  0,  1, &
                    1,  2,  0,  0,  1, &
                    1,  0,  4,  0,  1, &
                    1,  0,  2, -6,  1, &
                    1,  0,  2, -4, -1, &
                    1,  0, -1, -2, -1, &
                    1, -1,  2,  4,  1, &
                    1, -1,  2, -3,  1, &
                    1, -1,  0,  4,  1, &
                    1, -1, -2,  1, -1, &
                    0,  1,  2, -2,  3, &
                    3,  0,  0, -2,  0, &
                    1,  0,  1, -2,  0, &
                    0,  2,  0, -4,  0, &
                    0,  0,  2, -4,  0, &
                    0,  0,  1, -1,  0, &
                    0,  0,  0,  6,  0, &
                    0,  2,  0,  0, -2, &
                    0,  1, -2,  2, -3, &
                    4,  0,  0,  2,  0, &
                    3,  0,  0, -1,  0, &
                    3, -1,  0,  2,  0, &
                    2,  1,  0,  1,  0, &
                    2,  1,  0, -6,  0, &
                    2, -1,  2,  0,  0, &
                    1,  0,  2, -1,  0, &
                    1, -1,  0,  1,  0, &
                    1, -1, -2, -2,  0, &
                    0,  1,  2,  2,  0, &
                    0,  0,  2, -3,  0, &
                    2,  2,  0, -2, -1, &
                    2, -1, -2,  0,  1, &
                    1,  2,  2, -4,  1, &
                    0,  1,  4, -4,  2, &
                    0,  0,  0,  3,  2, &
                    5,  0,  2,  0,  1, &
                    4,  1,  2, -2,  2, &
                    4,  0, -2, -2,  0, &
                    3,  1,  2,  2,  2, &
                    3,  1,  0, -2,  0, &
                    3,  1, -2, -6, -2, &
                    3,  0,  0,  0, -2, &
                    3,  0, -2, -4, -2, &
                    3, -1,  0, -3,  0, &
                    3, -1,  0, -2,  0, &
                    2,  1,  2,  0,  0, &
                    2,  1,  2, -4,  2, &
                    2,  1,  2, -2,  0, &
                    2,  1,  0, -3,  0, &
                    2,  1, -2,  0, -2, &
                    2,  0,  0, -4,  2, &
                    2,  0,  0, -4, -2, &
                    2,  0, -2, -5, -2, &
                    2, -1,  2,  4,  2, &
                    2, -1,  0, -2,  2, &
                    1,  3, -2, -2, -2, &
                    1,  1,  0,  0, -2, &
                    1,  1,  0, -6,  0, &
                    1,  1, -2,  1, -2, &
                    1,  1, -2, -1, -2, &
                    1,  0,  2,  1,  0, &
                    1,  0,  0,  3,  0, &
                    1,  0,  0, -4,  2, &
                    1,  0, -2,  4, -2, &
                    1, -2,  0, -1,  0, &
                    0,  1, -4,  2, -1, &
                    1,  0, -2,  0, -3, &
                    0,  0,  4, -4,  4  ], [5,nfls])

    !  Fundamental-argument multipliers:  planetary terms.
    integer,dimension(14,nfpl),parameter :: mfapl = reshape( [ &
       0,  0,  1, -1,  1,  0,  0, -1,  0, -2,  5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  1,  0, -8, 12,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  8,-16,  4,  5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -1,  2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-13,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  2, -5,  0,  0,  0, &
       0,  0,  2, -2,  1,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -1,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2, -8,  3,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  6, -8,  3,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  1,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  2, &
       0,  0,  1, -1,  1,  0,  0,  0, -2,  0,  0,  0,  0,  0, &
       2,  0,  0, -2, -1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  1, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-13,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  1, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0, -1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  0,  0,  0,  0, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4,  0, -2,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  8,-13,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2, -1,  0,  0,  0,  0,  0,  2, &
       1,  0,  0,  0,  0,  0,-18, 16,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  1,  0,  0,  0,  2, &
       0,  0,  1, -1,  1,  0, -5,  7,  0,  0,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,-10,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  0,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -1,  0,  0,  0,  2, &
       1,  0,  2,  0,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  1, &
       1,  0, -2,  0, -2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  2,  0,  0,  0, &
       0,  0,  2, -2,  1,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  8,-16,  4,  5,  0,  0, -2, &
       0,  0,  1, -1,  1,  0,  0,  3, -8,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-11,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  8,-16,  4,  5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -3,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6, -8,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  8,-15,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -2,  0,  0,  0,  2, &
       0,  0,  1, -1,  1,  0,  0, -5,  8, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  2,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0,  0, -1, &
       2,  0,  0, -2,  0,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  8,-13,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  0,  0, -2,  5,  0,  0,  0, &
       1,  0,  0, -1,  0,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  2, &
       1,  0,  0,  0, -1,  0,-18, 16,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  0,  0,  2, -5,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  0,  0,  1,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0, 19,-21,  3,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -8, 13,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7, -9,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  2, &
       1,  0,  0,  0,  1,  0,-18, 16,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  6,-16,  4,  5,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  4, -7,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  3, -7,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  1, &
       2,  0,  0, -2,  1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0,  0, &
       2,  0,  0, -2, -1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  2,  0,  0,  0,  2, &
       0,  0,  0,  0,  1,  0,  0,  1, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  2, &
       0,  0,  2, -2,  1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0, -1,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0, -6,  8,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  1, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-10,  0,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0,  0, -2, &
       1,  0,  0, -1,  1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  4,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4,  0, -3,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  1,  0,  2, -3,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -1,  0,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  5, -4,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  9,-11,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  8,-15,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -4,  5,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4,  0, -1,  0,  0,  0,  2, &
       1,  0,  0, -1,  1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  1,  1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0, -4, 10,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0,  0, -1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -4,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0, -2, &
       0,  0,  2, -2,  1,  0, -4,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3,  0,  0, -1,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -3,  0,  0,  0,  0,  2, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  0,  2,  0, &
       0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  1,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -9, 13,  0,  0,  0,  0,  0, &
       2,  0,  2,  0,  2,  0,  0,  2,  0, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  2,  0,  0, -1,  0,  0,  2,  0,  0,  0, &
       1,  0,  0, -1, -1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  1, &
       1,  0,  2,  0,  1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       1,  0, -2,  0, -1,  0,  0, -1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -2,  4,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  1, &
       0,  0,  2,  0,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -8,  3,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  6,-10,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  7, -8,  3,  0,  0,  0,  2, &
       0,  0,  0,  0,  1,  0, -3,  5,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -1,  0,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0, -5,  7,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7,-10,  0,  0,  0,  0,  0, -2, &
       1,  0,  0, -2,  0,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  2, -5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6, -8,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  1,  0,  0, -9, 15,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -2,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -4,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -1,  0,  0,  2, &
       2,  0,  0, -2,  1,  0, -6,  8,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  1,  0,  3, -6,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  8,-14,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  8,-15,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7, -7,  0,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  1,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  1,  0,  0,  2, &
       2,  0, -1, -1,  0,  0,  0,  3, -7,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4, -7,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -3,  4,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -6,  8,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -5,  6,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  0,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  1,  2,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  1,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -9,  4,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -4,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  1, &
       0,  0,  0,  0,  0,  0,  7,-11,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  3, -5,  4,  0,  0,  0,  0,  2, &
       0,  0,  1, -1,  0,  0,  0, -1,  0, -1,  1,  0,  0,  0, &
       2,  0,  0,  0,  0,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  8,-15,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  2,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  1,  0,  0, -1,  0, -1,  1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  4, -7,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -8,  3,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  2, -4,  0, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  3, -5,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -3,  0,  0,  0,  2, &
       0,  0,  2, -2,  2,  0, -8, 11,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5, -8,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -2,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  1,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  5, -9,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  7, -9,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  4, -7,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  2, -1,  0,  0,  0,  0,  0,  0, &
       1,  0, -2, -2, -2,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  3, -3,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  2, -5,  0,  0,  2, &
       2,  0,  0, -2, -1,  0,  0, -2,  0,  0,  5,  0,  0,  0, &
       2,  0,  0, -2, -1,  0, -6,  8,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8, -8,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3,  0,  2, -5,  0,  0,  2, &
       0,  0,  0,  0,  1,  0,  3, -7,  4,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0, -2,  5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0, 11,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  6,-15,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0,  1,  0,  0,  0,  2, &
       1,  0,  0, -1,  0,  0,  0, -3,  4,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -3,  7, -4,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5,  0, -2,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0,  0,  1, &
       0,  0,  2, -2,  2,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  2,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  6,-11,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  3,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  9,-12,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0,  1, &
       0,  0,  1, -1,  0,  0, -8, 12,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -2,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7, -7,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  1,  0, -4,  0,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1, -1,  0,  0,  0, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -5,  0,  0,  0,  0, -2, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  3, -1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -2,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5, -9,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  9, -9,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  3,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  2, -4,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -3,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  1, &
       0,  0,  1, -1,  2,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -9,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  5, -3,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  4,  0,  0,  0,  2, &
       0,  0,  2,  0,  2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5,  0, -3,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  0,  0, &
       2,  0, -1, -1, -1,  0,  0, -1,  0,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  4, -3,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  5,-10,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  8,-13,  0,  0,  0,  0,  0,  1, &
       0,  0,  2, -2,  1, -1,  0,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  2,  0,  0, &
       0,  0,  0,  0,  1,  0,  3, -5,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       0,  0,  2, -2,  0,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  9, -9,  0,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -8, 11,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -2,  0,  0,  2,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0, -1,  2,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  2, -6,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  8,-15,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  5, -2,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  7,-13,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  3,  0,  0,  0,  2, &
       0,  0,  2, -2,  1,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8, -8,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  8,-10,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -4,  0,  0,  0,  0, &
       2,  0,  0, -2, -1,  0,  0, -5,  6,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  0,  0, -2, &
       2,  0, -1, -1, -1,  0,  0,  3, -7,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  4, -3,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  6,-11,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  1,  0,  0, -6,  8,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  1,  5,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  6, -5,  0,  0,  0,  0,  2, &
       1,  0, -2, -2, -2,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  2,  0,  0,  0, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       0,  0,  0,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  6,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  6, -7,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4,  0,  0, -2,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0,  0, -2,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  1, -6,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  2, &
       0,  0,  0,  0,  0,  0,  3, -5,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  7,-13,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -2,  0,  0,  0,  2, &
       0,  0,  1, -1,  0,  0,  0, -1,  0,  0,  2,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -8, 15,  0,  0,  0,  0,  0, &
       2,  0,  0, -2, -2,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       2,  0, -1, -1, -1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       1,  0,  2, -2,  2,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       1,  0, -1,  1, -1,  0,-18, 17,  0,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  2, -2, -1,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  2,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-16,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  2, &
       0,  0,  0,  0,  2,  0,  0, -1,  2,  0,  0,  0,  0,  0, &
       2,  0, -1, -1, -2,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6,-10,  0,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  1,  0,  0, -1,  0, -2,  4,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2,  2,  0,  0,  0,  0,  2, &
       2,  0,  0, -2, -1,  0,  0, -2,  0,  4, -5,  0,  0,  0, &
       2,  0,  0, -2, -1,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       2,  0, -1, -1, -1,  0,  0, -1,  0,  0,  0,  0,  0,  0, &
       1,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -1, -1,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
       1,  0, -1, -1, -1,  0, 20,-20,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  1, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -2,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  5, -8,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  0,  0,  0, -1,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  9,-11,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  5, -3,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -3,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  1, &
       0,  0,  0,  0,  0,  0,  6, -7,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0, -2, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0, -2,  0,  0,  0, &
       0,  0,  1, -1,  2,  0,  0, -1,  0, -2,  5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5, -8,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2, -6,  0,  0,  0,  0, -2, &
       1,  0,  0, -2,  0,  0, 20,-21,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-12,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4, -4,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  2,  0,  0, -1,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8,-12,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  9,-17,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  1,  5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -6,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2, -7,  0,  0,  0,  0, -2, &
       1,  0,  0, -1,  1,  0,  0, -3,  4,  0,  0,  0,  0,  0, &
       1,  0, -2,  0, -2,  0,-10,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -9, 17,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -4,  0,  0,  0,  0,  0, -2, &
       1,  0, -2, -2, -2,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       1,  0, -1,  1, -1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  2,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  1, -1,  2,  0,  0, -1,  0,  0,  1,  0,  0,  0, &
       0,  0,  1, -1,  2,  0, -5,  7,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  2, -2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5,-10,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  4,  0, -4,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0, -5,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -5,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -2,  5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -2,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -3,  0,  0,  0,  0,  0,  1, &
       1,  0,  0, -2,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -7,  4,  0,  0,  0,  0,  0, &
       2,  0,  2,  0,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1, -1,  0,  0, -1,  0, -1,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  1,  0, -2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  6,-10,  0,  0,  0,  0, -2, &
       1,  0,  0, -1,  1,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -3,  0,  3,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0, -5,  5,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  1, -3,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -4,  6,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  0,  0, -1,  0,  0, &
       0,  0,  1, -1,  1,  0, -5,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  3, -4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7,-10,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  5, -5,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  3, -8,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  2, -5,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  7, -9,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  7, -8,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  3, -8,  3,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -2,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  2, -4,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0, -1, &
       2,  0,  0, -2, -1,  0,  0, -6,  8,  0,  0,  0,  0,  0, &
       2,  0, -1, -1,  1,  0,  0,  3, -7,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -7,  9,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0,  0, -1, &
       0,  0,  1, -1,  2,  0, -8, 12,  0,  0,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7, -8,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  1,  0,  0, -5,  6,  0,  0,  0,  0,  0, &
       2,  0,  0, -2, -1,  0,  0, -2,  0,  3, -1,  0,  0,  0, &
       1,  0,  1,  1,  1,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -2,  1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       1,  0,  0, -2, -1,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       1,  0,  0, -1, -1,  0,  0, -3,  4,  0,  0,  0,  0,  0, &
       1,  0, -1,  0, -1,  0, -3,  5,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -4,  4,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0, -8, 11,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  0,  0,  0, -9, 13,  0,  0,  0,  0,  0, &
       0,  0,  1,  1,  2,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0,  1, -4,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0,  0, -1,  0,  1, -3,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  7,-13,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  1,  0, -4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  7,-11,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  6, -6,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  6, -4,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  4, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -4,  0,  0,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  1, -4,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  9,-17,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  7, -7,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  4, -8,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4, -7,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  0,  1, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -4,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0, 17,-16,  0, -2,  0,  0,  0,  0, &
       1,  0,  0, -1,  0,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  0,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -4,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1, -2, -2, &
       0,  0,  0,  0,  0,  0,  0,  2,  1,  0,  0,  0,  0,  2, &
       2,  0,  0, -2,  0,  0,  0, -4,  4,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  2,  2,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  0,  0, -4,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  1,  1,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  3, -6,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -2,  2,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0,  0,  1,  0,  0,  0, &
       0,  0,  1, -1,  0,  0, -4,  5,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  2,  0,  0,  0, -1,  0,  1,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  8, -9,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -6,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  3, -5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -2,  0,  0,  0, &
       2,  0, -2, -2, -2,  0,  0, -2,  0,  2,  0,  0,  0,  0, &
       1,  0,  0,  0,  1,  0,-10,  3,  0,  0,  0,  0,  0,  0, &
       1,  0,  0,  0, -1,  0,-10,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0,  2, -3,  0,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0,  2, -2,  0,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0, -2,  3,  0,  0,  0,  0,  0,  0, &
       0,  0,  2,  0,  2,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  2,  0,  0,  0,  0,  1,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0,  0, -1,  0,  2,  0,  0,  0,  0, &
       2,  0,  2, -2,  2,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       2,  0,  1, -3,  1,  0, -6,  7,  0,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  2, -5,  0,  0,  0,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  5, -5,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  1,  5,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  0,  5,  0,  0,  0, &
       2,  0,  0, -2,  0,  0,  0, -2,  0,  0,  2,  0,  0,  0, &
       2,  0,  0, -2,  0,  0, -4,  4,  0,  0,  0,  0,  0,  0, &
       2,  0, -2,  0, -2,  0,  0,  5, -9,  0,  0,  0,  0,  0, &
       2,  0, -1, -1,  0,  0,  0, -1,  0,  3,  0,  0,  0,  0, &
       1,  0,  2,  0,  2,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       1,  0,  2,  0,  2,  0,  0,  4, -8,  3,  0,  0,  0,  0, &
       1,  0,  2,  0,  2,  0,  0, -4,  8, -3,  0,  0,  0,  0, &
       1,  0,  2,  0,  2,  0, -1,  1,  0,  0,  0,  0,  0,  0, &
       1,  0,  2, -2,  2,  0, -3,  3,  0,  0,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       1,  0,  0,  0,  0,  0,  0, -2,  0,  3,  0,  0,  0,  0, &
       1,  0,  0, -2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
       1,  0, -2, -2, -2,  0,  0,  1,  0, -1,  0,  0,  0,  0, &
       1,  0, -1,  1,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       1,  0, -1, -1,  0,  0,  0,  8,-15,  0,  0,  0,  0,  0, &
       0,  0,  2,  2,  2,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  1, -1,  0,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0, -2,  0,  1,  0,  0,  0,  0, &
       0,  0,  2, -2,  1,  0,  0,-10, 15,  0,  0,  0,  0,  0, &
       0,  0,  2, -2,  0, -1,  0,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  2,  0,  0, -1,  0,  0, -1,  0,  0,  0, &
       0,  0,  1, -1,  2,  0, -3,  4,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -4,  6,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  1,  0, -1,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0,  1,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0,  0, -1,  0,  0, -2,  0,  0,  0, &
       0,  0,  1, -1,  0,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1,  0,  0, -1,  0,  0,  0,  0,  0,  0,  0, &
       0,  0,  1, -1, -1,  0, -5,  7,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  2,  0,  0,  0,  2,  0, -2,  0,  0,  0,  0, &
       0,  0,  0,  2,  0,  0, -2,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  2,  0, -3,  5,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  1,  0, -1,  2,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  9,-13,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  8,-14,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  8,-11,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6, -8,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  6, -7,  0,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  5, -6, -4,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  5, -4,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  4, -8,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  4, -5,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  3, -3,  0,  2,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  3, -1,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  1, -1,  0,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  7,-12,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  6, -9,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  6, -8,  1,  5,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  6, -4,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  6,-10,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5,  0, -4,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  5, -9,  0,  0,  0,  0, -1, &
       0,  0,  0,  0,  0,  0,  0,  5, -8,  3,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  5, -7,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  5, -6,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  5,-16,  4,  5,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  5,-13,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3,  0, -5,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3, -9,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  3, -7,  0,  0,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  2,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  2,  0,  0, -3,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  2, -8,  1,  5,  0,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  1, -5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  2,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  1,  0,  0, -3,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1,  0, -3,  5,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  1, -3,  0,  0,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  2, -6,  3,  0, -2, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  1, -2,  0,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0, &
       0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2, &
       0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0 ], [14,nfpl])

    !  Pointers into amplitudes array, one pointer per frequency.
    integer,dimension(nf),parameter :: nc = [ &
        1,   21,   37,   51,   65,   79,   91,  103,  115,  127, &
      139,  151,  163,  172,  184,  196,  207,  219,  231,  240, &
      252,  261,  273,  285,  297,  309,  318,  327,  339,  351, &
      363,  372,  384,  396,  405,  415,  423,  435,  444,  452, &
      460,  467,  474,  482,  490,  498,  506,  513,  521,  528, &
      536,  543,  551,  559,  566,  574,  582,  590,  597,  605, &
      613,  620,  628,  636,  644,  651,  658,  666,  674,  680, &
      687,  695,  702,  710,  717,  725,  732,  739,  746,  753, &
      760,  767,  774,  782,  790,  798,  805,  812,  819,  826, &
      833,  840,  846,  853,  860,  867,  874,  881,  888,  895, &
      901,  908,  914,  921,  928,  934,  941,  948,  955,  962, &
      969,  976,  982,  989,  996, 1003, 1010, 1017, 1024, 1031, &
     1037, 1043, 1050, 1057, 1064, 1071, 1078, 1084, 1091, 1098, &
     1104, 1112, 1118, 1124, 1131, 1138, 1145, 1151, 1157, 1164, &
     1171, 1178, 1185, 1192, 1199, 1205, 1212, 1218, 1226, 1232, &
     1239, 1245, 1252, 1259, 1266, 1272, 1278, 1284, 1292, 1298, &
     1304, 1310, 1316, 1323, 1329, 1335, 1341, 1347, 1353, 1359, &
     1365, 1371, 1377, 1383, 1389, 1396, 1402, 1408, 1414, 1420, &
     1426, 1434, 1440, 1446, 1452, 1459, 1465, 1471, 1477, 1482, &
     1488, 1493, 1499, 1504, 1509, 1514, 1520, 1527, 1532, 1538, &
     1543, 1548, 1553, 1558, 1564, 1569, 1574, 1579, 1584, 1589, &
     1594, 1596, 1598, 1600, 1602, 1605, 1608, 1610, 1612, 1617, &
     1619, 1623, 1625, 1627, 1629, 1632, 1634, 1640, 1642, 1644, &
     1646, 1648, 1650, 1652, 1654, 1658, 1660, 1662, 1664, 1668, &
     1670, 1672, 1673, 1675, 1679, 1681, 1683, 1684, 1686, 1688, &
     1690, 1693, 1695, 1697, 1701, 1703, 1705, 1707, 1709, 1711, &
     1712, 1715, 1717, 1721, 1723, 1725, 1727, 1729, 1731, 1733, &
     1735, 1737, 1739, 1741, 1743, 1745, 1747, 1749, 1751, 1753, &
     1755, 1757, 1759, 1761, 1762, 1764, 1766, 1768, 1769, 1771, &
     1773, 1775, 1777, 1779, 1781, 1783, 1785, 1787, 1788, 1790, &
     1792, 1794, 1796, 1798, 1800, 1802, 1804, 1806, 1807, 1809, &
     1811, 1815, 1817, 1819, 1821, 1823, 1825, 1827, 1829, 1831, &
     1833, 1835, 1837, 1839, 1840, 1842, 1844, 1848, 1850, 1852, &
     1854, 1856, 1858, 1859, 1860, 1862, 1864, 1866, 1868, 1869, &
     1871, 1873, 1875, 1877, 1879, 1881, 1883, 1885, 1887, 1889, &
     1891, 1892, 1896, 1898, 1900, 1901, 1903, 1905, 1907, 1909, &
     1910, 1911, 1913, 1915, 1919, 1921, 1923, 1927, 1929, 1931, &
     1933, 1935, 1937, 1939, 1943, 1945, 1947, 1948, 1949, 1951, &
     1953, 1955, 1957, 1958, 1960, 1962, 1964, 1966, 1968, 1970, &
     1971, 1973, 1974, 1975, 1977, 1979, 1980, 1981, 1982, 1984, &
     1986, 1988, 1990, 1992, 1994, 1995, 1997, 1999, 2001, 2003, &
     2005, 2007, 2008, 2009, 2011, 2013, 2015, 2017, 2019, 2021, &
     2023, 2024, 2025, 2027, 2029, 2031, 2033, 2035, 2037, 2041, &
     2043, 2045, 2046, 2047, 2049, 2051, 2053, 2055, 2056, 2057, &
     2059, 2061, 2063, 2065, 2067, 2069, 2070, 2071, 2072, 2074, &
     2076, 2078, 2080, 2082, 2084, 2086, 2088, 2090, 2092, 2094, &
     2095, 2096, 2097, 2099, 2101, 2105, 2106, 2107, 2108, 2109, &
     2110, 2111, 2113, 2115, 2119, 2121, 2123, 2125, 2127, 2129, &
     2131, 2133, 2135, 2136, 2137, 2139, 2141, 2143, 2145, 2147, &
     2149, 2151, 2153, 2155, 2157, 2159, 2161, 2163, 2165, 2167, &
     2169, 2171, 2173, 2175, 2177, 2179, 2181, 2183, 2185, 2186, &
     2187, 2188, 2192, 2193, 2195, 2197, 2199, 2201, 2203, 2205, &
     2207, 2209, 2211, 2213, 2217, 2219, 2221, 2223, 2225, 2227, &
     2229, 2231, 2233, 2234, 2235, 2236, 2237, 2238, 2239, 2240, &
     2241, 2244, 2246, 2248, 2250, 2252, 2254, 2256, 2258, 2260, &
     2262, 2264, 2266, 2268, 2270, 2272, 2274, 2276, 2278, 2280, &
     2282, 2284, 2286, 2288, 2290, 2292, 2294, 2296, 2298, 2300, &
     2302, 2303, 2304, 2305, 2306, 2307, 2309, 2311, 2313, 2315, &
     2317, 2319, 2321, 2323, 2325, 2327, 2329, 2331, 2333, 2335, &
     2337, 2341, 2343, 2345, 2347, 2349, 2351, 2352, 2355, 2356, &
     2357, 2358, 2359, 2361, 2363, 2364, 2365, 2366, 2367, 2368, &
     2369, 2370, 2371, 2372, 2373, 2374, 2376, 2378, 2380, 2382, &
     2384, 2385, 2386, 2387, 2388, 2389, 2390, 2391, 2392, 2393, &
     2394, 2395, 2396, 2397, 2398, 2399, 2400, 2401, 2402, 2403, &
     2404, 2405, 2406, 2407, 2408, 2409, 2410, 2411, 2412, 2413, &
     2414, 2415, 2417, 2418, 2430, 2438, 2445, 2453, 2460, 2468, &
     2474, 2480, 2488, 2496, 2504, 2512, 2520, 2527, 2535, 2543, &
     2550, 2558, 2566, 2574, 2580, 2588, 2596, 2604, 2612, 2619, &
     2627, 2634, 2642, 2648, 2656, 2664, 2671, 2679, 2685, 2693, &
     2701, 2709, 2717, 2725, 2733, 2739, 2747, 2753, 2761, 2769, &
     2777, 2785, 2793, 2801, 2809, 2817, 2825, 2833, 2841, 2848, &
     2856, 2864, 2872, 2878, 2884, 2892, 2898, 2906, 2914, 2922, &
     2930, 2938, 2944, 2952, 2958, 2966, 2974, 2982, 2988, 2996, &
     3001, 3009, 3017, 3025, 3032, 3039, 3045, 3052, 3059, 3067, &
     3069, 3076, 3083, 3090, 3098, 3105, 3109, 3111, 3113, 3120, &
     3124, 3128, 3132, 3136, 3140, 3144, 3146, 3150, 3158, 3161, &
     3165, 3166, 3168, 3172, 3176, 3180, 3182, 3185, 3189, 3193, &
     3194, 3197, 3200, 3204, 3208, 3212, 3216, 3219, 3221, 3222, &
     3226, 3230, 3234, 3238, 3242, 3243, 3247, 3251, 3254, 3258, &
     3262, 3266, 3270, 3274, 3275, 3279, 3283, 3287, 3289, 3293, &
     3296, 3300, 3303, 3307, 3311, 3315, 3319, 3321, 3324, 3327, &
     3330, 3334, 3338, 3340, 3342, 3346, 3350, 3354, 3358, 3361, &
     3365, 3369, 3373, 3377, 3381, 3385, 3389, 3393, 3394, 3398, &
     3402, 3406, 3410, 3413, 3417, 3421, 3425, 3429, 3433, 3435, &
     3439, 3443, 3446, 3450, 3453, 3457, 3458, 3461, 3464, 3468, &
     3472, 3476, 3478, 3481, 3485, 3489, 3493, 3497, 3501, 3505, &
     3507, 3511, 3514, 3517, 3521, 3524, 3525, 3527, 3529, 3533, &
     3536, 3540, 3541, 3545, 3548, 3551, 3555, 3559, 3563, 3567, &
     3569, 3570, 3574, 3576, 3578, 3582, 3586, 3590, 3593, 3596, &
     3600, 3604, 3608, 3612, 3616, 3620, 3623, 3626, 3630, 3632, &
     3636, 3640, 3643, 3646, 3648, 3652, 3656, 3660, 3664, 3667, &
     3669, 3671, 3675, 3679, 3683, 3687, 3689, 3693, 3694, 3695, &
     3699, 3703, 3705, 3707, 3710, 3713, 3717, 3721, 3725, 3729, &
     3733, 3736, 3740, 3744, 3748, 3752, 3754, 3757, 3759, 3763, &
     3767, 3770, 3773, 3777, 3779, 3783, 3786, 3790, 3794, 3798, &
     3801, 3805, 3809, 3813, 3817, 3821, 3825, 3827, 3831, 3835, &
     3836, 3837, 3840, 3844, 3848, 3852, 3856, 3859, 3863, 3867, &
     3869, 3871, 3875, 3879, 3883, 3887, 3890, 3894, 3898, 3901, &
     3905, 3909, 3913, 3917, 3921, 3922, 3923, 3924, 3926, 3930, &
     3932, 3936, 3938, 3940, 3944, 3948, 3952, 3956, 3959, 3963, &
     3965, 3969, 3973, 3977, 3979, 3981, 3982, 3986, 3989, 3993, &
     3997, 4001, 4004, 4006, 4009, 4012, 4016, 4020, 4024, 4026, &
     4028, 4032, 4036, 4040, 4044, 4046, 4050, 4054, 4058, 4060, &
     4062, 4063, 4064, 4068, 4071, 4075, 4077, 4081, 4083, 4087, &
     4089, 4091, 4095, 4099, 4101, 4103, 4105, 4107, 4111, 4115, &
     4119, 4123, 4127, 4129, 4131, 4135, 4139, 4141, 4143, 4145, &
     4149, 4153, 4157, 4161, 4165, 4169, 4173, 4177, 4180, 4183, &
     4187, 4191, 4195, 4198, 4201, 4205, 4209, 4212, 4213, 4216, &
     4217, 4221, 4223, 4226, 4230, 4234, 4236, 4240, 4244, 4248, &
     4252, 4256, 4258, 4262, 4264, 4266, 4268, 4270, 4272, 4276, &
     4279, 4283, 4285, 4287, 4289, 4293, 4295, 4299, 4300, 4301, &
     4305, 4309, 4313, 4317, 4319, 4323, 4325, 4329, 4331, 4333, &
     4335, 4337, 4341, 4345, 4349, 4351, 4353, 4357, 4361, 4365, &
     4367, 4369, 4373, 4377, 4381, 4383, 4387, 4389, 4391, 4395, &
     4399, 4403, 4407, 4411, 4413, 4414, 4415, 4418, 4419, 4421, &
     4423, 4427, 4429, 4431, 4433, 4435, 4437, 4439, 4443, 4446, &
     4450, 4452, 4456, 4458, 4460, 4462, 4466, 4469, 4473, 4477, &
     4481, 4483, 4487, 4489, 4491, 4493, 4497, 4499, 4501, 4504, &
     4506, 4510, 4513, 4514, 4515, 4518, 4521, 4522, 4525, 4526, &
     4527, 4530, 4533, 4534, 4537, 4541, 4542, 4543, 4544, 4545, &
     4546, 4547, 4550, 4553, 4554, 4555, 4558, 4561, 4564, 4567, &
     4568, 4571, 4574, 4575, 4578, 4581, 4582, 4585, 4586, 4588, &
     4590, 4592, 4596, 4598, 4602, 4604, 4608, 4612, 4613, 4616, &
     4619, 4622, 4623, 4624, 4625, 4626, 4629, 4632, 4633, 4636, &
     4639, 4640, 4641, 4642, 4643, 4644, 4645, 4648, 4649, 4650, &
     4651, 4652, 4653, 4656, 4657, 4660, 4661, 4664, 4667, 4670, &
     4671, 4674, 4675, 4676, 4677, 4678, 4681, 4682, 4683, 4684, &
     4687, 4688, 4689, 4692, 4693, 4696, 4697, 4700, 4701, 4702, &
     4703, 4704, 4707, 4708, 4711, 4712, 4715, 4716, 4717, 4718, &
     4719, 4720, 4721, 4722, 4723, 4726, 4729, 4730, 4733, 4736, &
     4737, 4740, 4741, 4742, 4745, 4746, 4749, 4752, 4753]

    !  Amplitude coefficients (microarcsec);  indexed using the NC array
    real(wp), dimension(na), parameter :: a = [ &
        -6844318.44_wp, 9205236.26_wp, 1328.67_wp, 1538.18_wp, 205833.11_wp, &
        153041.79_wp, -3309.73_wp, 853.32_wp, 2037.98_wp, -2301.27_wp, 81.46_wp, &
        120.56_wp, -20.39_wp, -15.22_wp, 1.73_wp, -1.61_wp, -0.1_wp, 0.11_wp, -0.02_wp, &
        -0.02_wp, -523908.04_wp, 573033.42_wp, -544.75_wp, -458.66_wp, 12814.01_wp, &
        11714.49_wp, 198.97_wp, -290.91_wp, 155.74_wp, -143.27_wp, -2.75_wp, -1.03_wp, &
        -1.27_wp, -1.16_wp, 0.0_wp, -0.01_wp, -90552.22_wp, 97846.69_wp, 111.23_wp, &
        137.41_wp, 2187.91_wp, 2024.68_wp, 41.44_wp, -51.26_wp, 26.92_wp, -24.46_wp, &
        -0.46_wp, -0.28_wp, -0.22_wp, -0.2_wp, 82168.76_wp, -89618.24_wp, -27.64_wp, &
        -29.05_wp, -2004.36_wp, -1837.32_wp, -36.07_wp, 48.0_wp, -24.43_wp, 22.41_wp, &
        0.47_wp, 0.24_wp, 0.2_wp, 0.18_wp, 58707.02_wp, 7387.02_wp, 470.05_wp, &
        -192.4_wp, 164.33_wp, -1312.21_wp, -179.73_wp, -28.93_wp, -17.36_wp, -1.83_wp, &
        -0.5_wp, 3.57_wp, 0.0_wp, 0.13_wp, -20557.78_wp, 22438.42_wp, -20.84_wp, &
        -17.4_wp, 501.82_wp, 459.68_wp, 59.2_wp, -67.3_wp, 6.08_wp, -5.61_wp, -1.36_wp, &
        -1.19_wp, 28288.28_wp, -674.99_wp, -34.69_wp, 35.8_wp, -15.07_wp, -632.54_wp, &
        -11.19_wp, 0.78_wp, -8.41_wp, 0.17_wp, 0.01_wp, 0.07_wp, -15406.85_wp, &
        20069.5_wp, 15.12_wp, 31.8_wp, 448.76_wp, 344.5_wp, -5.77_wp, 1.41_wp, 4.59_wp, &
        -5.02_wp, 0.17_wp, 0.24_wp, -11991.74_wp, 12902.66_wp, 32.46_wp, 36.7_wp, &
        288.49_wp, 268.14_wp, 5.7_wp, -7.06_wp, 3.57_wp, -3.23_wp, -0.06_wp, -0.04_wp, &
        -8584.95_wp, -9592.72_wp, 4.42_wp, -13.2_wp, -214.5_wp, 192.06_wp, 23.87_wp, &
        29.83_wp, 2.54_wp, 2.4_wp, 0.6_wp, -0.48_wp, 5095.5_wp, -6918.22_wp, &
        7.19_wp, 3.92_wp, -154.91_wp, -113.94_wp, 2.86_wp, -1.04_wp, -1.52_wp, &
        1.73_wp, -0.07_wp, -0.1_wp, -4910.93_wp, -5331.13_wp, 0.76_wp, 0.4_wp, &
        -119.21_wp, 109.81_wp, 2.16_wp, 3.2_wp, 1.46_wp, 1.33_wp, 0.04_wp, -0.02_wp, &
        -6245.02_wp, -123.48_wp, -6.68_wp, -8.2_wp, -2.76_wp, 139.64_wp, 2.71_wp, &
        0.15_wp, 1.86_wp, 2511.85_wp, -3323.89_wp, 1.07_wp, -0.9_wp, -74.33_wp, &
        -56.17_wp, 1.16_wp, -0.01_wp, -0.75_wp, 0.83_wp, -0.02_wp, -0.04_wp, &
        2307.58_wp, 3143.98_wp, -7.52_wp, 7.5_wp, 70.31_wp, -51.6_wp, 1.46_wp, 0.16_wp, &
        -0.69_wp, -0.79_wp, 0.02_wp, -0.05_wp, 2372.58_wp, 2554.51_wp, 5.93_wp, &
        -6.6_wp, 57.12_wp, -53.05_wp, -0.96_wp, -1.24_wp, -0.71_wp, -0.64_wp, -0.01_wp, &
        -2053.16_wp, 2636.13_wp, 5.13_wp, 7.8_wp, 58.94_wp, 45.91_wp, -0.42_wp, &
        -0.12_wp, 0.61_wp, -0.66_wp, 0.02_wp, 0.03_wp, -1825.49_wp, -2423.59_wp, &
        1.23_wp, -2.0_wp, -54.19_wp, 40.82_wp, -1.07_wp, -1.02_wp, 0.54_wp, 0.61_wp, &
        -0.04_wp, 0.04_wp, 2521.07_wp, -122.28_wp, -5.97_wp, 2.9_wp, -2.73_wp, &
        -56.37_wp, -0.82_wp, 0.13_wp, -0.75_wp, -1534.09_wp, 1645.01_wp, 6.29_wp, &
        6.8_wp, 36.78_wp, 34.3_wp, 0.92_wp, -1.25_wp, 0.46_wp, -0.41_wp, -0.02_wp, &
        -0.01_wp, 1898.27_wp, 47.7_wp, -0.72_wp, 2.5_wp, 1.07_wp, -42.45_wp, -0.94_wp, &
        0.02_wp, -0.56_wp, -1292.02_wp, -1387.0_wp, 0.0_wp, 0.0_wp, -31.01_wp, 28.89_wp, &
        0.68_wp, 0.0_wp, 0.38_wp, 0.35_wp, -0.01_wp, -0.01_wp, -1234.96_wp, &
        1323.81_wp, 5.21_wp, 5.9_wp, 29.6_wp, 27.61_wp, 0.74_wp, -1.22_wp, 0.37_wp, &
        -0.33_wp, -0.02_wp, -0.01_wp, 1137.48_wp, -1233.89_wp, -0.04_wp, -0.3_wp, &
        -27.59_wp, -25.43_wp, -0.61_wp, 1.0_wp, -0.34_wp, 0.31_wp, 0.01_wp, 0.01_wp, &
        -813.13_wp, -1075.6_wp, 0.4_wp, 0.3_wp, -24.05_wp, 18.18_wp, -0.4_wp, -0.01_wp, &
        0.24_wp, 0.27_wp, -0.01_wp, 0.01_wp, 1163.22_wp, -60.9_wp, -2.94_wp, 1.3_wp, &
        -1.36_wp, -26.01_wp, -0.58_wp, 0.07_wp, -0.35_wp, 1029.7_wp, -55.55_wp, &
        -2.63_wp, 1.1_wp, -1.25_wp, -23.02_wp, -0.52_wp, 0.06_wp, -0.31_wp, &
        -556.26_wp, 852.85_wp, 3.16_wp, -4.48_wp, 19.06_wp, 12.44_wp, -0.81_wp, &
        -0.27_wp, 0.17_wp, -0.21_wp, 0.0_wp, 0.02_wp, -603.52_wp, -800.34_wp, &
        0.44_wp, 0.1_wp, -17.9_wp, 13.49_wp, -0.08_wp, -0.01_wp, 0.18_wp, 0.2_wp, &
        -0.01_wp, 0.01_wp, -628.24_wp, 684.99_wp, -0.64_wp, -0.5_wp, 15.32_wp, &
        14.05_wp, 3.18_wp, -4.19_wp, 0.19_wp, -0.17_wp, -0.09_wp, -0.07_wp, &
        -866.48_wp, -16.26_wp, 0.52_wp, -1.3_wp, -0.36_wp, 19.37_wp, 0.43_wp, -0.01_wp, &
        0.26_wp, -512.37_wp, 695.54_wp, -1.47_wp, -1.4_wp, 15.55_wp, 11.46_wp, &
        -0.16_wp, 0.03_wp, 0.15_wp, -0.17_wp, 0.01_wp, 0.01_wp, 506.65_wp, &
        643.75_wp, 2.54_wp, -2.62_wp, 14.4_wp, -11.33_wp, -0.77_wp, -0.06_wp, -0.15_wp, &
        -0.16_wp, 0.0_wp, 0.01_wp, 664.57_wp, 16.81_wp, -0.4_wp, 1.0_wp, 0.38_wp, &
        -14.86_wp, -3.71_wp, -0.09_wp, -0.2_wp, 405.91_wp, 522.11_wp, 0.99_wp, -1.5_wp, &
        11.67_wp, -9.08_wp, -0.25_wp, -0.02_wp, -0.12_wp, -0.13_wp, -305.78_wp, &
        326.6_wp, 1.75_wp, 1.9_wp, 7.3_wp, 6.84_wp, 0.2_wp, -0.04_wp, 300.99_wp, &
        -325.03_wp, -0.44_wp, -0.5_wp, -7.27_wp, -6.73_wp, -1.01_wp, 0.01_wp, 0.0_wp, &
        0.08_wp, 0.0_wp, 0.02_wp, 438.51_wp, 10.47_wp, -0.56_wp, -0.2_wp, 0.24_wp, &
        -9.81_wp, -0.24_wp, 0.01_wp, -0.13_wp, -264.02_wp, 335.24_wp, 0.99_wp, 1.4_wp, &
        7.49_wp, 5.9_wp, -0.27_wp, -0.02_wp, 284.09_wp, 307.03_wp, 0.32_wp, -0.4_wp, &
        6.87_wp, -6.35_wp, -0.99_wp, -0.01_wp, -250.54_wp, 327.11_wp, 0.08_wp, 0.4_wp, &
        7.31_wp, 5.6_wp, -0.3_wp, 230.72_wp, -304.46_wp, 0.08_wp, -0.1_wp, -6.81_wp, &
        -5.16_wp, 0.27_wp, 229.78_wp, 304.17_wp, -0.6_wp, 0.5_wp, 6.8_wp, -5.14_wp, &
        0.33_wp, 0.01_wp, 256.3_wp, -276.81_wp, -0.28_wp, -0.4_wp, -6.19_wp, -5.73_wp, &
        -0.14_wp, 0.01_wp, -212.82_wp, 269.45_wp, 0.84_wp, 1.2_wp, 6.02_wp, 4.76_wp, &
        0.14_wp, -0.02_wp, 196.64_wp, 272.05_wp, -0.84_wp, 0.9_wp, 6.08_wp, -4.4_wp, &
        0.35_wp, 0.02_wp, 188.95_wp, 272.22_wp, -0.12_wp, 0.3_wp, 6.09_wp, -4.22_wp, &
        0.34_wp, -292.37_wp, -5.1_wp, -0.32_wp, -0.4_wp, -0.11_wp, 6.54_wp, 0.14_wp, &
        0.01_wp, 161.79_wp, -220.67_wp, 0.24_wp, 0.1_wp, -4.93_wp, -3.62_wp, -0.08_wp, &
        261.54_wp, -19.94_wp, -0.95_wp, 0.2_wp, -0.45_wp, -5.85_wp, -0.13_wp, 0.02_wp, &
        142.16_wp, -190.79_wp, 0.2_wp, 0.1_wp, -4.27_wp, -3.18_wp, -0.07_wp, 187.95_wp, &
        -4.11_wp, -0.24_wp, 0.3_wp, -0.09_wp, -4.2_wp, -0.09_wp, 0.01_wp, 0.0_wp, &
        0.0_wp, -79.08_wp, 167.9_wp, 0.04_wp, 0.0_wp, 3.75_wp, 1.77_wp, 121.98_wp, &
        131.04_wp, -0.08_wp, 0.1_wp, 2.93_wp, -2.73_wp, -0.06_wp, -172.95_wp, &
        -8.11_wp, -0.4_wp, -0.2_wp, -0.18_wp, 3.87_wp, 0.09_wp, 0.01_wp, &
        -160.15_wp, -55.3_wp, -14.04_wp, 13.9_wp, -1.23_wp, 3.58_wp, 0.4_wp, 0.31_wp, &
        -115.4_wp, 123.2_wp, 0.6_wp, 0.7_wp, 2.75_wp, 2.58_wp, 0.08_wp, -0.01_wp, &
        -168.26_wp, -2.0_wp, 0.2_wp, -0.2_wp, -0.04_wp, 3.76_wp, 0.08_wp, &
        -114.49_wp, 123.2_wp, 0.32_wp, 0.4_wp, 2.75_wp, 2.56_wp, 0.07_wp, -0.01_wp, &
        112.14_wp, 120.7_wp, 0.28_wp, -0.3_wp, 2.7_wp, -2.51_wp, -0.07_wp, -0.01_wp, &
        161.34_wp, 4.03_wp, 0.2_wp, 0.2_wp, 0.09_wp, -3.61_wp, -0.08_wp, 91.31_wp, &
        126.64_wp, -0.4_wp, 0.4_wp, 2.83_wp, -2.04_wp, -0.04_wp, 0.01_wp, 105.29_wp, &
        112.9_wp, 0.44_wp, -0.5_wp, 2.52_wp, -2.35_wp, -0.07_wp, -0.01_wp, 98.69_wp, &
        -106.2_wp, -0.28_wp, -0.3_wp, -2.37_wp, -2.21_wp, -0.06_wp, 0.01_wp, 86.74_wp, &
        -112.94_wp, -0.08_wp, -0.2_wp, -2.53_wp, -1.94_wp, -0.05_wp, -134.81_wp, &
        3.51_wp, 0.2_wp, -0.2_wp, 0.08_wp, 3.01_wp, 0.07_wp, 79.03_wp, 107.31_wp, &
        -0.24_wp, 0.2_wp, 2.4_wp, -1.77_wp, -0.04_wp, 0.01_wp, 132.81_wp, &
        -10.77_wp, -0.52_wp, 0.1_wp, -0.24_wp, -2.97_wp, -0.07_wp, 0.01_wp, &
        -130.31_wp, -0.9_wp, 0.04_wp, 0.0_wp, 0.0_wp, 2.91_wp, -78.56_wp, 85.32_wp, &
        0.0_wp, 0.0_wp, 1.91_wp, 1.76_wp, 0.04_wp, 0.0_wp, 0.0_wp, -41.53_wp, &
        89.1_wp, 0.02_wp, 0.0_wp, 1.99_wp, 0.93_wp, 66.03_wp, -71.0_wp, -0.2_wp, &
        -0.2_wp, -1.59_wp, -1.48_wp, -0.04_wp, 60.5_wp, 64.7_wp, 0.36_wp, -0.4_wp, &
        1.45_wp, -1.35_wp, -0.04_wp, -0.01_wp, -52.27_wp, -70.01_wp, 0.0_wp, 0.0_wp, &
        -1.57_wp, 1.17_wp, 0.03_wp, -52.95_wp, 66.29_wp, 0.32_wp, 0.4_wp, 1.48_wp, &
        1.18_wp, 0.04_wp, -0.01_wp, 51.02_wp, 67.25_wp, 0.0_wp, 0.0_wp, 1.5_wp, &
        -1.14_wp, -0.03_wp, -55.66_wp, -60.92_wp, 0.16_wp, -0.2_wp, -1.36_wp, 1.24_wp, &
        0.03_wp, -54.81_wp, -59.2_wp, -0.08_wp, 0.2_wp, -1.32_wp, 1.23_wp, 0.03_wp, &
        51.32_wp, -55.6_wp, 0.0_wp, 0.0_wp, -1.24_wp, -1.15_wp, -0.03_wp, 48.29_wp, &
        51.8_wp, 0.2_wp, -0.2_wp, 1.16_wp, -1.08_wp, -0.03_wp, -45.59_wp, -49.0_wp, &
        -0.12_wp, 0.1_wp, -1.1_wp, 1.02_wp, 0.03_wp, 40.54_wp, -52.69_wp, -0.04_wp, &
        -0.1_wp, -1.18_wp, -0.91_wp, -0.02_wp, -40.58_wp, -49.51_wp, -1.0_wp, 1.0_wp, &
        -1.11_wp, 0.91_wp, 0.04_wp, 0.02_wp, -43.76_wp, 46.5_wp, 0.36_wp, 0.4_wp, &
        1.04_wp, 0.98_wp, 0.03_wp, -0.01_wp, 62.65_wp, -5.0_wp, -0.24_wp, 0.0_wp, &
        -0.11_wp, -1.4_wp, -0.03_wp, 0.01_wp, -38.57_wp, 49.59_wp, 0.08_wp, 0.1_wp, &
        1.11_wp, 0.86_wp, 0.02_wp, -33.22_wp, -44.04_wp, 0.08_wp, -0.1_wp, -0.98_wp, &
        0.74_wp, 0.02_wp, 37.15_wp, -39.9_wp, -0.12_wp, -0.1_wp, -0.89_wp, -0.83_wp, &
        -0.02_wp, 36.68_wp, -39.5_wp, -0.04_wp, -0.1_wp, -0.88_wp, -0.82_wp, -0.02_wp, &
        -53.22_wp, -3.91_wp, -0.2_wp, 0.0_wp, -0.09_wp, 1.19_wp, 0.03_wp, 32.43_wp, &
        -42.19_wp, -0.04_wp, -0.1_wp, -0.94_wp, -0.73_wp, -0.02_wp, -51.0_wp, -2.3_wp, &
        -0.12_wp, -0.1_wp, 0.0_wp, 1.14_wp, -29.53_wp, -39.11_wp, 0.04_wp, 0.0_wp, &
        -0.87_wp, 0.66_wp, 0.02_wp, 28.5_wp, -38.92_wp, -0.08_wp, -0.1_wp, -0.87_wp, &
        -0.64_wp, -0.02_wp, 26.54_wp, 36.95_wp, -0.12_wp, 0.1_wp, 0.83_wp, -0.59_wp, &
        -0.01_wp, 26.54_wp, 34.59_wp, 0.04_wp, -0.1_wp, 0.77_wp, -0.59_wp, -0.02_wp, &
        28.35_wp, -32.55_wp, -0.16_wp, 0.2_wp, -0.73_wp, -0.63_wp, -0.01_wp, -28.0_wp, &
        30.4_wp, 0.0_wp, 0.0_wp, 0.68_wp, 0.63_wp, 0.01_wp, -27.61_wp, 29.4_wp, &
        0.2_wp, 0.2_wp, 0.66_wp, 0.62_wp, 0.02_wp, 40.33_wp, 0.4_wp, -0.04_wp, &
        0.1_wp, 0.0_wp, -0.9_wp, -23.28_wp, 31.61_wp, -0.08_wp, -0.1_wp, 0.71_wp, &
        0.52_wp, 0.01_wp, 37.75_wp, 0.8_wp, 0.04_wp, 0.1_wp, 0.0_wp, -0.84_wp, &
        23.66_wp, 25.8_wp, 0.0_wp, 0.0_wp, 0.58_wp, -0.53_wp, -0.01_wp, 21.01_wp, &
        -27.91_wp, 0.0_wp, 0.0_wp, -0.62_wp, -0.47_wp, -0.01_wp, -34.81_wp, 2.89_wp, &
        0.04_wp, 0.0_wp, 0.0_wp, 0.78_wp, -23.49_wp, -25.31_wp, 0.0_wp, 0.0_wp, &
        -0.57_wp, 0.53_wp, 0.01_wp, -23.47_wp, 25.2_wp, 0.16_wp, 0.2_wp, 0.56_wp, &
        0.52_wp, 0.02_wp, 19.58_wp, 27.5_wp, -0.12_wp, 0.1_wp, 0.62_wp, -0.44_wp, &
        -0.01_wp, -22.67_wp, -24.4_wp, -0.08_wp, 0.1_wp, -0.55_wp, 0.51_wp, 0.01_wp, &
        -19.97_wp, 25.0_wp, 0.12_wp, 0.2_wp, 0.56_wp, 0.45_wp, 0.01_wp, 21.28_wp, &
        -22.8_wp, -0.08_wp, -0.1_wp, -0.51_wp, -0.48_wp, -0.01_wp, -30.47_wp, 0.91_wp, &
        0.04_wp, 0.0_wp, 0.0_wp, 0.68_wp, 18.58_wp, 24.0_wp, 0.04_wp, -0.1_wp, &
        0.54_wp, -0.42_wp, -0.01_wp, -18.02_wp, 24.4_wp, -0.04_wp, -0.1_wp, 0.55_wp, &
        0.4_wp, 0.01_wp, 17.74_wp, 22.5_wp, 0.08_wp, -0.1_wp, 0.5_wp, -0.4_wp, &
        -0.01_wp, -19.41_wp, 20.7_wp, 0.08_wp, 0.1_wp, 0.46_wp, 0.43_wp, 0.01_wp, &
        -18.64_wp, 20.11_wp, 0.0_wp, 0.0_wp, 0.45_wp, 0.42_wp, 0.01_wp, -16.75_wp, &
        21.6_wp, 0.04_wp, 0.1_wp, 0.48_wp, 0.37_wp, 0.01_wp, -18.42_wp, -20.0_wp, &
        0.0_wp, 0.0_wp, -0.45_wp, 0.41_wp, 0.01_wp, -26.77_wp, 1.41_wp, 0.08_wp, &
        0.0_wp, 0.0_wp, 0.6_wp, -26.17_wp, -0.19_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
        0.59_wp, -15.52_wp, 20.51_wp, 0.0_wp, 0.0_wp, 0.46_wp, 0.35_wp, 0.01_wp, &
        -25.42_wp, -1.91_wp, -0.08_wp, 0.0_wp, -0.04_wp, 0.57_wp, 0.45_wp, -17.42_wp, &
        18.1_wp, 0.0_wp, 0.0_wp, 0.4_wp, 0.39_wp, 0.01_wp, 16.39_wp, -17.6_wp, &
        -0.08_wp, -0.1_wp, -0.39_wp, -0.37_wp, -0.01_wp, -14.37_wp, 18.91_wp, 0.0_wp, &
        0.0_wp, 0.42_wp, 0.32_wp, 0.01_wp, 23.39_wp, -2.4_wp, -0.12_wp, 0.0_wp, &
        0.0_wp, -0.52_wp, 14.32_wp, -18.5_wp, -0.04_wp, -0.1_wp, -0.41_wp, -0.32_wp, &
        -0.01_wp, 15.69_wp, 17.08_wp, 0.0_wp, 0.0_wp, 0.38_wp, -0.35_wp, -0.01_wp, &
        -22.99_wp, 0.5_wp, 0.04_wp, 0.0_wp, 0.0_wp, 0.51_wp, 0.0_wp, 0.0_wp, &
        14.47_wp, -17.6_wp, -0.01_wp, 0.0_wp, -0.39_wp, -0.32_wp, -13.33_wp, 18.4_wp, &
        -0.04_wp, -0.1_wp, 0.41_wp, 0.3_wp, 22.47_wp, -0.6_wp, -0.04_wp, 0.0_wp, &
        0.0_wp, -0.5_wp, -12.78_wp, -17.41_wp, 0.04_wp, 0.0_wp, -0.39_wp, 0.29_wp, &
        0.01_wp, -14.1_wp, -15.31_wp, 0.04_wp, 0.0_wp, -0.34_wp, 0.32_wp, 0.01_wp, &
        11.98_wp, 16.21_wp, -0.04_wp, 0.0_wp, 0.36_wp, -0.27_wp, -0.01_wp, 19.65_wp, &
        -1.9_wp, -0.08_wp, 0.0_wp, 0.0_wp, -0.44_wp, 19.61_wp, -1.5_wp, -0.08_wp, &
        0.0_wp, 0.0_wp, -0.44_wp, 13.41_wp, -14.3_wp, -0.04_wp, -0.1_wp, -0.32_wp, &
        -0.3_wp, -0.01_wp, -13.29_wp, 14.4_wp, 0.0_wp, 0.0_wp, 0.32_wp, 0.3_wp, &
        0.01_wp, 11.14_wp, -14.4_wp, -0.04_wp, 0.0_wp, -0.32_wp, -0.25_wp, -0.01_wp, &
        12.24_wp, -13.38_wp, 0.04_wp, 0.0_wp, -0.3_wp, -0.27_wp, -0.01_wp, 10.07_wp, &
        -13.81_wp, 0.04_wp, 0.0_wp, -0.31_wp, -0.23_wp, -0.01_wp, 10.46_wp, 13.1_wp, &
        0.08_wp, -0.1_wp, 0.29_wp, -0.23_wp, -0.01_wp, 16.55_wp, -1.71_wp, -0.08_wp, &
        0.0_wp, 0.0_wp, -0.37_wp, 9.75_wp, -12.8_wp, 0.0_wp, 0.0_wp, -0.29_wp, &
        -0.22_wp, -0.01_wp, 9.11_wp, 12.8_wp, 0.0_wp, 0.0_wp, 0.29_wp, -0.2_wp, &
        0.0_wp, 0.0_wp, -6.44_wp, -13.8_wp, 0.0_wp, 0.0_wp, -0.31_wp, 0.14_wp, &
        -9.19_wp, -12.0_wp, 0.0_wp, 0.0_wp, -0.27_wp, 0.21_wp, -10.3_wp, 10.9_wp, &
        0.08_wp, 0.1_wp, 0.24_wp, 0.23_wp, 0.01_wp, 14.92_wp, -0.8_wp, -0.04_wp, &
        0.0_wp, 0.0_wp, -0.33_wp, 10.02_wp, -10.8_wp, 0.0_wp, 0.0_wp, -0.24_wp, &
        -0.22_wp, -0.01_wp, -9.75_wp, 10.4_wp, 0.04_wp, 0.0_wp, 0.23_wp, 0.22_wp, &
        0.01_wp, 9.67_wp, -10.4_wp, -0.04_wp, 0.0_wp, -0.23_wp, -0.22_wp, -0.01_wp, &
        -8.28_wp, -11.2_wp, 0.04_wp, 0.0_wp, -0.25_wp, 0.19_wp, 13.32_wp, -1.41_wp, &
        -0.08_wp, 0.0_wp, 0.0_wp, -0.3_wp, 8.27_wp, 10.5_wp, 0.04_wp, 0.0_wp, &
        0.23_wp, -0.19_wp, 0.0_wp, 0.0_wp, 13.13_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
        0.0_wp, -0.29_wp, -12.93_wp, 0.7_wp, 0.04_wp, 0.0_wp, 0.0_wp, 0.29_wp, &
        7.91_wp, -10.2_wp, 0.0_wp, 0.0_wp, -0.23_wp, -0.18_wp, -7.84_wp, -10.0_wp, &
        -0.04_wp, 0.0_wp, -0.22_wp, 0.18_wp, 7.44_wp, 9.6_wp, 0.0_wp, 0.0_wp, &
        0.21_wp, -0.17_wp, -7.64_wp, 9.4_wp, 0.08_wp, 0.1_wp, 0.21_wp, 0.17_wp, &
        0.01_wp, -11.38_wp, 0.6_wp, 0.04_wp, 0.0_wp, 0.0_wp, 0.25_wp, -7.48_wp, &
        8.3_wp, 0.0_wp, 0.0_wp, 0.19_wp, 0.17_wp, -10.98_wp, -0.2_wp, 0.0_wp, &
        0.0_wp, 0.0_wp, 0.25_wp, 10.98_wp, 0.2_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
        -0.25_wp, 7.4_wp, -7.9_wp, -0.04_wp, 0.0_wp, -0.18_wp, -0.17_wp, -6.09_wp, &
        8.4_wp, -0.04_wp, 0.0_wp, 0.19_wp, 0.14_wp, -6.94_wp, -7.49_wp, 0.0_wp, &
        0.0_wp, -0.17_wp, 0.16_wp, 6.92_wp, 7.5_wp, 0.04_wp, 0.0_wp, 0.17_wp, &
        -0.15_wp, 6.2_wp, 8.09_wp, 0.0_wp, 0.0_wp, 0.18_wp, -0.14_wp, -6.12_wp, &
        7.8_wp, 0.04_wp, 0.0_wp, 0.17_wp, 0.14_wp, 5.85_wp, -7.5_wp, 0.0_wp, &
        0.0_wp, -0.17_wp, -0.13_wp, -6.48_wp, 6.9_wp, 0.08_wp, 0.1_wp, 0.15_wp, &
        0.14_wp, 0.01_wp, 6.32_wp, 6.9_wp, 0.0_wp, 0.0_wp, 0.15_wp, -0.14_wp, &
        5.61_wp, -7.2_wp, 0.0_wp, 0.0_wp, -0.16_wp, -0.13_wp, 9.07_wp, 0.0_wp, &
        0.0_wp, 0.0_wp, 0.0_wp, -0.2_wp, 5.25_wp, 6.9_wp, 0.0_wp, 0.0_wp, &
        0.15_wp, -0.12_wp, -8.47_wp, -0.4_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.19_wp, &
        6.32_wp, -5.39_wp, -1.11_wp, 1.1_wp, -0.12_wp, -0.14_wp, 0.02_wp, 0.02_wp, &
        5.73_wp, -6.1_wp, -0.04_wp, 0.0_wp, -0.14_wp, -0.13_wp, 4.7_wp, 6.6_wp, &
        -0.04_wp, 0.0_wp, 0.15_wp, -0.11_wp, -4.9_wp, -6.4_wp, 0.0_wp, 0.0_wp, &
        -0.14_wp, 0.11_wp, -5.33_wp, 5.6_wp, 0.04_wp, 0.1_wp, 0.13_wp, 0.12_wp, &
        0.01_wp, -4.81_wp, 6.0_wp, 0.04_wp, 0.0_wp, 0.13_wp, 0.11_wp, 5.13_wp, &
        5.5_wp, 0.04_wp, 0.0_wp, 0.12_wp, -0.11_wp, 4.5_wp, 5.9_wp, 0.0_wp, &
        0.0_wp, 0.13_wp, -0.1_wp, -4.22_wp, 6.1_wp, 0.0_wp, 0.0_wp, 0.14_wp, &
        -4.53_wp, 5.7_wp, 0.0_wp, 0.0_wp, 0.13_wp, 0.1_wp, 4.18_wp, 5.7_wp, &
        0.0_wp, 0.0_wp, 0.13_wp, -4.75_wp, -5.19_wp, 0.0_wp, 0.0_wp, -0.12_wp, &
        0.11_wp, -4.06_wp, 5.6_wp, 0.0_wp, 0.0_wp, 0.13_wp, -3.98_wp, 5.6_wp, &
        -0.04_wp, 0.0_wp, 0.13_wp, 4.02_wp, -5.4_wp, 0.0_wp, 0.0_wp, -0.12_wp, &
        4.49_wp, -4.9_wp, -0.04_wp, 0.0_wp, -0.11_wp, -0.1_wp, -3.62_wp, -5.4_wp, &
        -0.16_wp, 0.2_wp, -0.12_wp, 0.0_wp, 0.01_wp, 4.38_wp, 4.8_wp, 0.0_wp, &
        0.0_wp, 0.11_wp, -6.4_wp, -0.1_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.14_wp, &
        -3.98_wp, 5.0_wp, 0.04_wp, 0.0_wp, 0.11_wp, -3.82_wp, -5.0_wp, 0.0_wp, &
        0.0_wp, -0.11_wp, -3.71_wp, 5.07_wp, 0.0_wp, 0.0_wp, 0.11_wp, 4.14_wp, &
        4.4_wp, 0.0_wp, 0.0_wp, 0.1_wp, -6.01_wp, -0.5_wp, -0.04_wp, 0.0_wp, &
        0.0_wp, 0.13_wp, -4.04_wp, 4.39_wp, 0.0_wp, 0.0_wp, 0.1_wp, 3.45_wp, &
        -4.72_wp, 0.0_wp, 0.0_wp, -0.11_wp, 3.31_wp, 4.71_wp, 0.0_wp, 0.0_wp, &
        0.11_wp, 3.26_wp, -4.5_wp, 0.0_wp, 0.0_wp, -0.1_wp, -3.26_wp, -4.5_wp, &
        0.0_wp, 0.0_wp, -0.1_wp, -3.34_wp, -4.4_wp, 0.0_wp, 0.0_wp, -0.1_wp, &
        -3.74_wp, -4.0_wp, 3.7_wp, 4.0_wp, 3.34_wp, -4.3_wp, 3.3_wp, -4.3_wp, &
        -3.66_wp, 3.9_wp, 0.04_wp, 3.66_wp, 3.9_wp, 0.04_wp, -3.62_wp, -3.9_wp, &
        -3.61_wp, 3.9_wp, -0.2_wp, 5.3_wp, 0.0_wp, 0.0_wp, 0.12_wp, 3.06_wp, &
        4.3_wp, 3.3_wp, 4.0_wp, 0.4_wp, 0.2_wp, 3.1_wp, 4.1_wp, -3.06_wp, &
        3.9_wp, -3.3_wp, -3.6_wp, -3.3_wp, 3.36_wp, 0.01_wp, 3.14_wp, 3.4_wp, &
        -4.57_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.1_wp, -2.7_wp, -3.6_wp, &
        2.94_wp, -3.2_wp, -2.9_wp, 3.2_wp, 2.47_wp, -3.4_wp, 2.55_wp, -3.3_wp, &
        2.8_wp, -3.08_wp, 2.51_wp, 3.3_wp, -4.1_wp, 0.3_wp, -0.12_wp, -0.1_wp, &
        4.1_wp, 0.2_wp, -2.74_wp, 3.0_wp, 2.46_wp, 3.23_wp, -3.66_wp, 1.2_wp, &
        -0.2_wp, 0.2_wp, 3.74_wp, -0.4_wp, -2.51_wp, -2.8_wp, -3.74_wp, 2.27_wp, &
        -2.9_wp, 0.0_wp, 0.0_wp, -2.5_wp, 2.7_wp, -2.51_wp, 2.6_wp, -3.5_wp, &
        0.2_wp, 3.38_wp, -2.22_wp, -2.5_wp, 3.26_wp, -0.4_wp, 1.95_wp, -2.6_wp, &
        3.22_wp, -0.4_wp, -0.04_wp, -1.79_wp, -2.6_wp, 1.91_wp, 2.5_wp, 0.74_wp, &
        3.05_wp, -0.04_wp, 0.08_wp, 2.11_wp, -2.3_wp, -2.11_wp, 2.2_wp, -1.87_wp, &
        -2.4_wp, 2.03_wp, -2.2_wp, -2.03_wp, 2.2_wp, 2.98_wp, 0.0_wp, 0.0_wp, &
        2.98_wp, -1.71_wp, 2.4_wp, 2.94_wp, -0.1_wp, -0.12_wp, 0.1_wp, 1.67_wp, &
        2.4_wp, -1.79_wp, 2.3_wp, -1.79_wp, 2.2_wp, -1.67_wp, 2.2_wp, 1.79_wp, &
        -2.0_wp, 1.87_wp, -1.9_wp, 1.63_wp, -2.1_wp, -1.59_wp, 2.1_wp, 1.55_wp, &
        -2.1_wp, -1.55_wp, 2.1_wp, -2.59_wp, -0.2_wp, -1.75_wp, -1.9_wp, -1.75_wp, &
        1.9_wp, -1.83_wp, -1.8_wp, 1.51_wp, 2.0_wp, -1.51_wp, -2.0_wp, 1.71_wp, &
        1.8_wp, 1.31_wp, 2.1_wp, -1.43_wp, 2.0_wp, 1.43_wp, 2.0_wp, -2.43_wp, &
        -1.51_wp, 1.9_wp, -1.47_wp, 1.9_wp, 2.39_wp, 0.2_wp, -2.39_wp, 1.39_wp, &
        1.9_wp, 1.39_wp, -1.8_wp, 1.47_wp, -1.6_wp, 1.47_wp, -1.6_wp, 1.43_wp, &
        -1.5_wp, -1.31_wp, 1.6_wp, 1.27_wp, -1.6_wp, -1.27_wp, 1.6_wp, 1.27_wp, &
        -1.6_wp, 2.03_wp, 1.35_wp, 1.5_wp, -1.39_wp, -1.4_wp, 1.95_wp, -0.2_wp, &
        -1.27_wp, 1.49_wp, 1.19_wp, 1.5_wp, 1.27_wp, 1.4_wp, 1.15_wp, 1.5_wp, &
        1.87_wp, -0.1_wp, -1.12_wp, -1.5_wp, 1.87_wp, -1.11_wp, -1.5_wp, -1.11_wp, &
        -1.5_wp, 0.0_wp, 0.0_wp, 1.19_wp, 1.4_wp, 1.27_wp, -1.3_wp, -1.27_wp, &
        -1.3_wp, -1.15_wp, 1.4_wp, -1.23_wp, 1.3_wp, -1.23_wp, -1.3_wp, 1.22_wp, &
        -1.29_wp, 1.07_wp, -1.4_wp, 1.75_wp, -0.2_wp, -1.03_wp, -1.4_wp, -1.07_wp, &
        1.2_wp, -1.03_wp, 1.15_wp, 1.07_wp, 1.1_wp, 1.51_wp, -1.03_wp, 1.1_wp, &
        1.03_wp, -1.1_wp, 0.0_wp, 0.0_wp, -1.03_wp, -1.1_wp, 0.91_wp, -1.2_wp, &
        -0.88_wp, -1.2_wp, -0.88_wp, 1.2_wp, -0.95_wp, 1.1_wp, -0.95_wp, -1.1_wp, &
        1.43_wp, -1.39_wp, 0.95_wp, -1.0_wp, -0.95_wp, 1.0_wp, -0.8_wp, 1.1_wp, &
        0.91_wp, -1.0_wp, -1.35_wp, 0.88_wp, 1.0_wp, -0.83_wp, 1.0_wp, -0.91_wp, &
        0.9_wp, 0.91_wp, 0.9_wp, 0.88_wp, -0.9_wp, -0.76_wp, -1.0_wp, -0.76_wp, &
        1.0_wp, 0.76_wp, 1.0_wp, -0.72_wp, 1.0_wp, 0.84_wp, -0.9_wp, 0.84_wp, &
        0.9_wp, 1.23_wp, 0.0_wp, 0.0_wp, -0.52_wp, -1.1_wp, -0.68_wp, 1.0_wp, &
        1.19_wp, -0.2_wp, 1.19_wp, 0.76_wp, 0.9_wp, 1.15_wp, -0.1_wp, 1.15_wp, &
        -0.1_wp, 0.72_wp, -0.9_wp, -1.15_wp, -1.15_wp, 0.68_wp, 0.9_wp, -0.68_wp, &
        0.9_wp, -1.11_wp, 0.0_wp, 0.0_wp, 0.2_wp, 0.79_wp, 0.8_wp, -1.11_wp, &
        -0.1_wp, 0.0_wp, 0.0_wp, -0.48_wp, -1.0_wp, -0.76_wp, -0.8_wp, -0.72_wp, &
        -0.8_wp, -1.07_wp, -0.1_wp, 0.64_wp, 0.8_wp, -0.64_wp, -0.8_wp, 0.64_wp, &
        0.8_wp, 0.4_wp, 0.6_wp, 0.52_wp, -0.5_wp, -0.6_wp, -0.8_wp, -0.71_wp, &
        0.7_wp, -0.99_wp, 0.99_wp, 0.56_wp, 0.8_wp, -0.56_wp, 0.8_wp, 0.68_wp, &
        -0.7_wp, 0.68_wp, 0.7_wp, -0.95_wp, -0.64_wp, 0.7_wp, 0.64_wp, 0.7_wp, &
        -0.6_wp, 0.7_wp, -0.6_wp, -0.7_wp, -0.91_wp, -0.1_wp, -0.51_wp, 0.76_wp, &
        -0.91_wp, -0.56_wp, 0.7_wp, 0.88_wp, 0.88_wp, -0.63_wp, -0.6_wp, 0.55_wp, &
        -0.6_wp, -0.8_wp, 0.8_wp, -0.8_wp, -0.52_wp, 0.6_wp, 0.52_wp, 0.6_wp, &
        0.52_wp, -0.6_wp, -0.48_wp, 0.6_wp, 0.48_wp, 0.6_wp, 0.48_wp, 0.6_wp, &
        -0.76_wp, 0.44_wp, -0.6_wp, 0.52_wp, -0.5_wp, -0.52_wp, 0.5_wp, 0.4_wp, &
        0.6_wp, -0.4_wp, -0.6_wp, 0.4_wp, -0.6_wp, 0.72_wp, -0.72_wp, -0.51_wp, &
        -0.5_wp, -0.48_wp, 0.5_wp, 0.48_wp, -0.5_wp, -0.48_wp, 0.5_wp, -0.48_wp, &
        0.5_wp, 0.48_wp, -0.5_wp, -0.48_wp, -0.5_wp, -0.68_wp, -0.68_wp, 0.44_wp, &
        0.5_wp, -0.64_wp, -0.1_wp, -0.64_wp, -0.1_wp, -0.4_wp, 0.5_wp, 0.4_wp, &
        0.5_wp, 0.4_wp, 0.5_wp, 0.0_wp, 0.0_wp, -0.4_wp, -0.5_wp, -0.36_wp, &
        -0.5_wp, 0.36_wp, -0.5_wp, 0.6_wp, -0.6_wp, 0.4_wp, -0.4_wp, 0.4_wp, &
        0.4_wp, -0.4_wp, 0.4_wp, -0.4_wp, 0.4_wp, -0.56_wp, -0.56_wp, 0.36_wp, &
        -0.4_wp, -0.36_wp, 0.4_wp, 0.36_wp, -0.4_wp, -0.36_wp, -0.4_wp, 0.36_wp, &
        0.4_wp, 0.36_wp, 0.4_wp, -0.52_wp, 0.52_wp, 0.52_wp, 0.32_wp, 0.4_wp, &
        -0.32_wp, 0.4_wp, -0.32_wp, 0.4_wp, -0.32_wp, 0.4_wp, 0.32_wp, -0.4_wp, &
        -0.32_wp, -0.4_wp, 0.32_wp, -0.4_wp, 0.28_wp, -0.4_wp, -0.28_wp, 0.4_wp, &
        0.28_wp, -0.4_wp, 0.28_wp, 0.4_wp, 0.48_wp, -0.48_wp, 0.48_wp, 0.36_wp, &
        -0.3_wp, -0.36_wp, -0.3_wp, 0.0_wp, 0.0_wp, 0.2_wp, 0.4_wp, -0.44_wp, &
        0.44_wp, -0.44_wp, -0.44_wp, -0.44_wp, -0.44_wp, 0.32_wp, -0.3_wp, 0.32_wp, &
        0.3_wp, 0.24_wp, 0.3_wp, -0.12_wp, -0.1_wp, -0.28_wp, 0.3_wp, 0.28_wp, &
        0.3_wp, 0.28_wp, 0.3_wp, 0.28_wp, -0.3_wp, 0.28_wp, -0.3_wp, 0.28_wp, &
        -0.3_wp, 0.28_wp, 0.3_wp, -0.28_wp, 0.3_wp, 0.4_wp, 0.4_wp, -0.24_wp, &
        0.3_wp, 0.24_wp, -0.3_wp, 0.24_wp, -0.3_wp, -0.24_wp, -0.3_wp, 0.24_wp, &
        0.3_wp, 0.24_wp, -0.3_wp, -0.24_wp, 0.3_wp, 0.24_wp, -0.3_wp, -0.24_wp, &
        -0.3_wp, 0.24_wp, -0.3_wp, 0.24_wp, 0.3_wp, -0.24_wp, 0.3_wp, -0.24_wp, &
        0.3_wp, 0.2_wp, -0.3_wp, 0.2_wp, -0.3_wp, 0.2_wp, -0.3_wp, 0.2_wp, &
        0.3_wp, 0.2_wp, -0.3_wp, 0.2_wp, -0.3_wp, 0.2_wp, 0.3_wp, 0.2_wp, &
        0.3_wp, -0.2_wp, -0.3_wp, 0.2_wp, -0.3_wp, 0.2_wp, -0.3_wp, -0.36_wp, &
        -0.36_wp, -0.36_wp, -0.04_wp, 0.3_wp, 0.12_wp, -0.1_wp, -0.32_wp, -0.24_wp, &
        0.2_wp, 0.24_wp, 0.2_wp, 0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, &
        -0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp, -0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp, &
        0.2_wp, -0.2_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.2_wp, -0.2_wp, -0.2_wp, &
        0.2_wp, -0.2_wp, 0.2_wp, 0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, 0.2_wp, &
        0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp, -0.2_wp, 0.2_wp, -0.2_wp, 0.28_wp, &
        0.28_wp, 0.28_wp, 0.28_wp, 0.28_wp, 0.28_wp, -0.28_wp, 0.28_wp, 0.12_wp, &
        0.0_wp, 0.24_wp, 0.16_wp, -0.2_wp, 0.16_wp, -0.2_wp, 0.16_wp, -0.2_wp, &
        0.16_wp, 0.2_wp, -0.16_wp, 0.2_wp, 0.16_wp, 0.2_wp, -0.16_wp, 0.2_wp, &
        -0.16_wp, 0.2_wp, -0.16_wp, 0.2_wp, 0.16_wp, -0.2_wp, 0.16_wp, 0.2_wp, &
        0.16_wp, -0.2_wp, -0.16_wp, 0.2_wp, -0.16_wp, -0.2_wp, -0.16_wp, 0.2_wp, &
        0.16_wp, 0.2_wp, 0.16_wp, -0.2_wp, 0.16_wp, -0.2_wp, 0.16_wp, 0.2_wp, &
        0.16_wp, 0.2_wp, 0.16_wp, 0.2_wp, -0.16_wp, -0.2_wp, 0.16_wp, 0.2_wp, &
        -0.16_wp, 0.2_wp, 0.16_wp, 0.2_wp, -0.16_wp, -0.2_wp, 0.16_wp, -0.2_wp, &
        0.16_wp, -0.2_wp, -0.16_wp, -0.2_wp, 0.24_wp, -0.24_wp, -0.24_wp, 0.24_wp, &
        0.24_wp, 0.12_wp, 0.2_wp, 0.12_wp, 0.2_wp, -0.12_wp, -0.2_wp, 0.12_wp, &
        -0.2_wp, 0.12_wp, -0.2_wp, -0.12_wp, 0.2_wp, -0.12_wp, 0.2_wp, -0.12_wp, &
        -0.2_wp, 0.12_wp, 0.2_wp, 0.12_wp, 0.2_wp, 0.12_wp, -0.2_wp, -0.12_wp, &
        0.2_wp, 0.12_wp, -0.2_wp, -0.12_wp, 0.2_wp, 0.12_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, -0.12_wp, 0.2_wp, -0.12_wp, 0.2_wp, 0.12_wp, -0.2_wp, -0.12_wp, &
        0.2_wp, 0.12_wp, 0.2_wp, 0.0_wp, -0.21_wp, -0.2_wp, 0.0_wp, 0.0_wp, &
        0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, 0.2_wp, -0.16_wp, -0.1_wp, 0.0_wp, &
        0.17_wp, 0.16_wp, 0.16_wp, 0.16_wp, 0.16_wp, -0.16_wp, 0.16_wp, 0.16_wp, &
        -0.16_wp, 0.16_wp, -0.16_wp, 0.16_wp, 0.12_wp, 0.1_wp, 0.12_wp, -0.1_wp, &
        -0.12_wp, 0.1_wp, -0.12_wp, 0.1_wp, 0.12_wp, -0.1_wp, -0.12_wp, 0.12_wp, &
        -0.12_wp, 0.12_wp, -0.12_wp, 0.12_wp, -0.12_wp, -0.12_wp, -0.12_wp, -0.12_wp, &
        -0.12_wp, -0.12_wp, -0.12_wp, 0.12_wp, 0.12_wp, 0.12_wp, 0.12_wp, -0.12_wp, &
        -0.12_wp, 0.12_wp, 0.12_wp, 0.12_wp, -0.12_wp, 0.12_wp, -0.12_wp, -0.12_wp, &
        -0.12_wp, 0.12_wp, -0.12_wp, -0.12_wp, 0.12_wp, 0.0_wp, 0.11_wp, 0.11_wp, &
        -122.67_wp, 164.7_wp, 203.78_wp, 273.5_wp, 3.58_wp, 2.74_wp, 6.18_wp, -4.56_wp, &
        0.0_wp, -0.04_wp, 0.0_wp, -0.07_wp, 57.44_wp, -77.1_wp, 95.82_wp, 128.6_wp, &
        -1.77_wp, -1.28_wp, 2.85_wp, -2.14_wp, 82.14_wp, 89.5_wp, 0.0_wp, 0.0_wp, &
        2.0_wp, -1.84_wp, -0.04_wp, 47.73_wp, -64.1_wp, 23.79_wp, 31.9_wp, -1.45_wp, &
        -1.07_wp, 0.69_wp, -0.53_wp, -46.38_wp, 50.5_wp, 0.0_wp, 0.0_wp, 1.13_wp, &
        1.04_wp, 0.02_wp, -18.38_wp, 0.0_wp, 63.8_wp, 0.0_wp, 0.0_wp, 0.41_wp, &
        0.0_wp, -1.43_wp, 59.07_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, -1.32_wp, &
        57.28_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, -1.28_wp, -48.65_wp, 0.0_wp, &
        -1.15_wp, 0.0_wp, 0.0_wp, 1.09_wp, 0.0_wp, 0.03_wp, -18.3_wp, 24.6_wp, &
        -17.3_wp, -23.2_wp, 0.56_wp, 0.41_wp, -0.51_wp, 0.39_wp, -16.91_wp, 26.9_wp, &
        8.43_wp, 13.3_wp, 0.6_wp, 0.38_wp, 0.31_wp, -0.19_wp, 1.23_wp, -1.7_wp, &
        -19.13_wp, -25.7_wp, -0.03_wp, -0.03_wp, -0.58_wp, 0.43_wp, -0.72_wp, 0.9_wp, &
        -17.34_wp, -23.3_wp, 0.03_wp, 0.02_wp, -0.52_wp, 0.39_wp, -19.49_wp, -21.3_wp, &
        0.0_wp, 0.0_wp, -0.48_wp, 0.44_wp, 0.01_wp, 20.57_wp, -20.1_wp, 0.64_wp, &
        0.7_wp, -0.45_wp, -0.46_wp, 0.0_wp, -0.01_wp, 4.89_wp, 5.9_wp, -16.55_wp, &
        19.9_wp, 0.14_wp, -0.11_wp, 0.44_wp, 0.37_wp, 18.22_wp, 19.8_wp, 0.0_wp, &
        0.0_wp, 0.44_wp, -0.41_wp, -0.01_wp, 4.89_wp, -5.3_wp, -16.51_wp, -18.0_wp, &
        -0.11_wp, -0.11_wp, -0.41_wp, 0.37_wp, -17.86_wp, 0.0_wp, 17.1_wp, 0.0_wp, &
        0.0_wp, 0.4_wp, 0.0_wp, -0.38_wp, 0.32_wp, 0.0_wp, 24.42_wp, 0.0_wp, &
        0.0_wp, -0.01_wp, 0.0_wp, -0.55_wp, -23.79_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
        0.0_wp, 0.53_wp, 14.72_wp, -16.0_wp, -0.32_wp, 0.0_wp, -0.36_wp, -0.33_wp, &
        -0.01_wp, 0.01_wp, 3.34_wp, -4.5_wp, 11.86_wp, 15.9_wp, -0.11_wp, -0.07_wp, &
        0.35_wp, -0.27_wp, -3.26_wp, 4.4_wp, 11.62_wp, 15.6_wp, 0.09_wp, 0.07_wp, &
        0.35_wp, -0.26_wp, -19.53_wp, 0.0_wp, 5.09_wp, 0.0_wp, 0.0_wp, 0.44_wp, &
        0.0_wp, -0.11_wp, -13.48_wp, 14.7_wp, 0.0_wp, 0.0_wp, 0.33_wp, 0.3_wp, &
        0.01_wp, 10.86_wp, -14.6_wp, 3.18_wp, 4.3_wp, -0.33_wp, -0.24_wp, 0.09_wp, &
        -0.07_wp, -11.3_wp, -15.1_wp, 0.0_wp, 0.0_wp, -0.34_wp, 0.25_wp, 0.01_wp, &
        2.03_wp, -2.7_wp, 10.82_wp, 14.5_wp, -0.07_wp, -0.05_wp, 0.32_wp, -0.24_wp, &
        17.46_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, -0.39_wp, 16.43_wp, 0.0_wp, &
        0.52_wp, 0.0_wp, 0.0_wp, -0.37_wp, 0.0_wp, -0.01_wp, 9.35_wp, 0.0_wp, &
        13.29_wp, 0.0_wp, 0.0_wp, -0.21_wp, 0.0_wp, -0.3_wp, -10.42_wp, 11.4_wp, &
        0.0_wp, 0.0_wp, 0.25_wp, 0.23_wp, 0.01_wp, 0.44_wp, 0.5_wp, -10.38_wp, &
        11.3_wp, 0.02_wp, -0.01_wp, 0.25_wp, 0.23_wp, -14.64_wp, 0.0_wp, 0.0_wp, &
        0.0_wp, 0.0_wp, 0.33_wp, 0.56_wp, 0.8_wp, -8.67_wp, 11.7_wp, 0.02_wp, &
        -0.01_wp, 0.26_wp, 0.19_wp, 13.88_wp, 0.0_wp, -2.47_wp, 0.0_wp, 0.0_wp, &
        -0.31_wp, 0.0_wp, 0.06_wp, -1.99_wp, 2.7_wp, 7.72_wp, 10.3_wp, 0.06_wp, &
        0.04_wp, 0.23_wp, -0.17_wp, -0.2_wp, 0.0_wp, 13.05_wp, 0.0_wp, 0.0_wp, &
        0.0_wp, 0.0_wp, -0.29_wp, 6.92_wp, -9.3_wp, 3.34_wp, 4.5_wp, -0.21_wp, &
        -0.15_wp, 0.1_wp, -0.07_wp, -6.6_wp, 0.0_wp, 10.7_wp, 0.0_wp, 0.0_wp, &
        0.15_wp, 0.0_wp, -0.24_wp, -8.04_wp, -8.7_wp, 0.0_wp, 0.0_wp, -0.19_wp, &
        0.18_wp, -10.58_wp, 0.0_wp, -3.1_wp, 0.0_wp, 0.0_wp, 0.24_wp, 0.0_wp, &
        0.07_wp, -7.32_wp, 8.0_wp, -0.12_wp, -0.1_wp, 0.18_wp, 0.16_wp, 1.63_wp, &
        1.7_wp, 6.96_wp, -7.6_wp, 0.03_wp, -0.04_wp, -0.17_wp, -0.16_wp, -3.62_wp, &
        0.0_wp, 9.86_wp, 0.0_wp, 0.0_wp, 0.08_wp, 0.0_wp, -0.22_wp, 0.2_wp, &
        -0.2_wp, -6.88_wp, -7.5_wp, 0.0_wp, 0.0_wp, -0.17_wp, 0.15_wp, -8.99_wp, &
        0.0_wp, 4.02_wp, 0.0_wp, 0.0_wp, 0.2_wp, 0.0_wp, -0.09_wp, -1.07_wp, &
        1.4_wp, -5.69_wp, -7.7_wp, 0.03_wp, 0.02_wp, -0.17_wp, 0.13_wp, 6.48_wp, &
        -7.2_wp, -0.48_wp, -0.5_wp, -0.16_wp, -0.14_wp, -0.01_wp, 0.01_wp, 5.57_wp, &
        -7.5_wp, 1.07_wp, 1.4_wp, -0.17_wp, -0.12_wp, 0.03_wp, -0.02_wp, 8.71_wp, &
        0.0_wp, 3.54_wp, 0.0_wp, 0.0_wp, -0.19_wp, 0.0_wp, -0.08_wp, 0.4_wp, &
        0.0_wp, 9.27_wp, 0.0_wp, 0.0_wp, -0.01_wp, 0.0_wp, -0.21_wp, -6.13_wp, &
        6.7_wp, -1.19_wp, -1.3_wp, 0.15_wp, 0.14_wp, -0.03_wp, 0.03_wp, 5.21_wp, &
        -5.7_wp, -2.51_wp, -2.6_wp, -0.13_wp, -0.12_wp, -0.06_wp, 0.06_wp, 5.69_wp, &
        -6.2_wp, -0.12_wp, -0.1_wp, -0.14_wp, -0.13_wp, -0.01_wp, 2.03_wp, -2.7_wp, &
        4.53_wp, 6.1_wp, -0.06_wp, -0.05_wp, 0.14_wp, -0.1_wp, 5.01_wp, 5.5_wp, &
        -2.51_wp, 2.7_wp, 0.12_wp, -0.11_wp, 0.06_wp, 0.06_wp, -1.91_wp, 2.6_wp, &
        -4.38_wp, -5.9_wp, 0.06_wp, 0.04_wp, -0.13_wp, 0.1_wp, 4.65_wp, -6.3_wp, &
        0.0_wp, 0.0_wp, -0.14_wp, -0.1_wp, -5.29_wp, 5.7_wp, 0.0_wp, 0.0_wp, &
        0.13_wp, 0.12_wp, -2.23_wp, -4.0_wp, -4.65_wp, 4.2_wp, -0.09_wp, 0.05_wp, &
        0.1_wp, 0.1_wp, -4.53_wp, 6.1_wp, 0.0_wp, 0.0_wp, 0.14_wp, 0.1_wp, &
        2.47_wp, 2.7_wp, -4.46_wp, 4.9_wp, 0.06_wp, -0.06_wp, 0.11_wp, 0.1_wp, &
        -5.05_wp, 5.5_wp, 0.84_wp, 0.9_wp, 0.12_wp, 0.11_wp, 0.02_wp, -0.02_wp, &
        4.97_wp, -5.4_wp, -1.71_wp, 0.0_wp, -0.12_wp, -0.11_wp, 0.0_wp, 0.04_wp, &
        -0.99_wp, -1.3_wp, 4.22_wp, -5.7_wp, -0.03_wp, 0.02_wp, -0.13_wp, -0.09_wp, &
        0.99_wp, 1.4_wp, 4.22_wp, -5.6_wp, 0.03_wp, -0.02_wp, -0.13_wp, -0.09_wp, &
        -4.69_wp, -5.2_wp, 0.0_wp, 0.0_wp, -0.12_wp, 0.1_wp, -3.42_wp, 0.0_wp, &
        6.09_wp, 0.0_wp, 0.0_wp, 0.08_wp, 0.0_wp, -0.14_wp, -4.65_wp, -5.1_wp, &
        0.0_wp, 0.0_wp, -0.11_wp, 0.1_wp, 0.0_wp, 0.0_wp, -4.53_wp, -5.0_wp, &
        0.0_wp, 0.0_wp, -0.11_wp, 0.1_wp, -2.43_wp, -2.7_wp, -3.82_wp, 4.2_wp, &
        -0.06_wp, 0.05_wp, 0.1_wp, 0.09_wp, 0.0_wp, 0.0_wp, -4.53_wp, 4.9_wp, &
        0.0_wp, 0.0_wp, 0.11_wp, 0.1_wp, -4.49_wp, -4.9_wp, 0.0_wp, 0.0_wp, &
        -0.11_wp, 0.1_wp, 2.67_wp, -2.9_wp, -3.62_wp, -3.9_wp, -0.06_wp, -0.06_wp, &
        -0.09_wp, 0.08_wp, 3.94_wp, -5.3_wp, 0.0_wp, 0.0_wp, -0.12_wp, -3.38_wp, &
        3.7_wp, -2.78_wp, -3.1_wp, 0.08_wp, 0.08_wp, -0.07_wp, 0.06_wp, 3.18_wp, &
        -3.5_wp, -2.82_wp, -3.1_wp, -0.08_wp, -0.07_wp, -0.07_wp, 0.06_wp, -5.77_wp, &
        0.0_wp, 1.87_wp, 0.0_wp, 0.0_wp, 0.13_wp, 0.0_wp, -0.04_wp, 3.54_wp, &
        -4.8_wp, -0.64_wp, -0.9_wp, -0.11_wp, 0.0_wp, -0.02_wp, -3.5_wp, -4.7_wp, &
        0.68_wp, -0.9_wp, -0.11_wp, 0.0_wp, -0.02_wp, 5.49_wp, 0.0_wp, 0.0_wp, &
        0.0_wp, 0.0_wp, -0.12_wp, 1.83_wp, -2.5_wp, 2.63_wp, 3.5_wp, -0.06_wp, &
        0.0_wp, 0.08_wp, 3.02_wp, -4.1_wp, 0.68_wp, 0.9_wp, -0.09_wp, 0.0_wp, &
        0.02_wp, 0.0_wp, 0.0_wp, 5.21_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
        -0.12_wp, -3.54_wp, 3.8_wp, 2.7_wp, 3.6_wp, -1.35_wp, 1.8_wp, 0.08_wp, &
        0.0_wp, 0.04_wp, -2.9_wp, 3.9_wp, 0.68_wp, 0.9_wp, 0.09_wp, 0.0_wp, &
        0.02_wp, 0.8_wp, -1.1_wp, -2.78_wp, -3.7_wp, -0.02_wp, 0.0_wp, -0.08_wp, &
        4.1_wp, 0.0_wp, -2.39_wp, 0.0_wp, 0.0_wp, -0.09_wp, 0.0_wp, 0.05_wp, &
        -1.59_wp, 2.1_wp, 2.27_wp, 3.0_wp, 0.05_wp, 0.0_wp, 0.07_wp, -2.63_wp, &
        3.5_wp, -0.48_wp, -0.6_wp, -2.94_wp, -3.2_wp, -2.94_wp, 3.2_wp, 2.27_wp, &
        -3.0_wp, -1.11_wp, -1.5_wp, -0.07_wp, 0.0_wp, -0.03_wp, -0.56_wp, -0.8_wp, &
        -2.35_wp, 3.1_wp, 0.0_wp, -0.6_wp, -3.42_wp, 1.9_wp, -0.12_wp, -0.1_wp, &
        2.63_wp, -2.9_wp, 2.51_wp, 2.8_wp, -0.64_wp, 0.7_wp, -0.48_wp, -0.6_wp, &
        2.19_wp, -2.9_wp, 0.24_wp, -0.3_wp, 2.15_wp, 2.9_wp, 2.15_wp, -2.9_wp, &
        0.52_wp, 0.7_wp, 2.07_wp, -2.8_wp, -3.1_wp, 0.0_wp, 1.79_wp, 0.0_wp, &
        0.0_wp, 0.07_wp, 0.0_wp, -0.04_wp, 0.88_wp, 0.0_wp, -3.46_wp, 2.11_wp, &
        2.8_wp, -0.36_wp, 0.5_wp, 3.54_wp, -0.2_wp, -3.5_wp, -1.39_wp, 1.5_wp, &
        -1.91_wp, -2.1_wp, -1.47_wp, 2.0_wp, 1.39_wp, 1.9_wp, 2.07_wp, -2.3_wp, &
        0.91_wp, 1.0_wp, 1.99_wp, -2.7_wp, 3.3_wp, 0.0_wp, 0.6_wp, -0.44_wp, &
        -0.7_wp, -1.95_wp, 2.6_wp, 2.15_wp, -2.4_wp, -0.6_wp, -0.7_wp, 3.3_wp, &
        0.84_wp, 0.0_wp, -3.1_wp, -3.1_wp, 0.0_wp, -0.72_wp, -0.32_wp, 0.4_wp, &
        -1.87_wp, -2.5_wp, 1.87_wp, -2.5_wp, 0.32_wp, 0.4_wp, -0.24_wp, 0.3_wp, &
        -1.87_wp, -2.5_wp, -0.24_wp, -0.3_wp, 1.87_wp, -2.5_wp, -2.7_wp, 0.0_wp, &
        1.55_wp, 2.03_wp, 2.2_wp, -2.98_wp, -1.99_wp, -2.2_wp, 0.12_wp, -0.1_wp, &
        -0.4_wp, 0.5_wp, 1.59_wp, 2.1_wp, 0.0_wp, 0.0_wp, -1.79_wp, 2.0_wp, &
        -1.03_wp, 1.4_wp, -1.15_wp, -1.6_wp, 0.32_wp, 0.5_wp, 1.39_wp, -1.9_wp, &
        2.35_wp, -1.27_wp, 1.7_wp, 0.6_wp, 0.8_wp, -0.32_wp, -0.4_wp, 1.35_wp, &
        -1.8_wp, 0.44_wp, 0.0_wp, 2.23_wp, -0.84_wp, 0.9_wp, -1.27_wp, -1.4_wp, &
        -1.47_wp, 1.6_wp, -0.28_wp, -0.3_wp, -0.28_wp, 0.4_wp, -1.27_wp, -1.7_wp, &
        0.28_wp, -0.4_wp, -1.43_wp, -1.5_wp, 0.0_wp, 0.0_wp, -1.27_wp, -1.7_wp, &
        2.11_wp, -0.32_wp, -0.4_wp, -1.23_wp, 1.6_wp, 1.19_wp, -1.3_wp, -0.72_wp, &
        -0.8_wp, 0.72_wp, -0.8_wp, -1.15_wp, -1.3_wp, -1.35_wp, -1.5_wp, -1.19_wp, &
        -1.6_wp, -0.12_wp, 0.2_wp, 1.79_wp, 0.0_wp, -0.88_wp, -0.28_wp, 0.4_wp, &
        1.11_wp, 1.5_wp, -1.83_wp, 0.0_wp, 0.56_wp, -0.12_wp, 0.1_wp, -1.27_wp, &
        -1.4_wp, 0.0_wp, 0.0_wp, 1.15_wp, 1.5_wp, -0.12_wp, 0.2_wp, 1.11_wp, &
        1.5_wp, 0.36_wp, -0.5_wp, -1.07_wp, -1.4_wp, -1.11_wp, 1.5_wp, 1.67_wp, &
        0.0_wp, 0.8_wp, -1.11_wp, 0.0_wp, 1.43_wp, 1.23_wp, -1.3_wp, -0.24_wp, &
        -1.19_wp, -1.3_wp, -0.24_wp, 0.2_wp, -0.44_wp, -0.9_wp, -0.95_wp, 1.1_wp, &
        1.07_wp, -1.4_wp, 1.15_wp, -1.3_wp, 1.03_wp, -1.1_wp, -0.56_wp, -0.6_wp, &
        -0.68_wp, 0.9_wp, -0.76_wp, -1.0_wp, -0.24_wp, -0.3_wp, 0.95_wp, -1.3_wp, &
        0.56_wp, 0.7_wp, 0.84_wp, -1.1_wp, -0.56_wp, 0.0_wp, -1.55_wp, 0.91_wp, &
        -1.3_wp, 0.28_wp, 0.3_wp, 0.16_wp, -0.2_wp, 0.95_wp, 1.3_wp, 0.4_wp, &
        -0.5_wp, -0.88_wp, -1.2_wp, 0.95_wp, -1.1_wp, -0.48_wp, -0.5_wp, 0.0_wp, &
        0.0_wp, -1.07_wp, 1.2_wp, 0.44_wp, -0.5_wp, 0.95_wp, 1.1_wp, 0.0_wp, &
        0.0_wp, 0.92_wp, -1.3_wp, 0.95_wp, 1.0_wp, -0.52_wp, 0.6_wp, 1.59_wp, &
        0.24_wp, -0.4_wp, 0.91_wp, 1.2_wp, 0.84_wp, -1.1_wp, -0.44_wp, -0.6_wp, &
        0.84_wp, 1.1_wp, -0.44_wp, 0.6_wp, -0.44_wp, 0.6_wp, -0.84_wp, -1.1_wp, &
        -0.8_wp, 0.0_wp, 1.35_wp, 0.76_wp, 0.2_wp, -0.91_wp, -1.0_wp, 0.2_wp, &
        -0.3_wp, -0.91_wp, -1.2_wp, -0.95_wp, 1.0_wp, -0.48_wp, -0.5_wp, 0.88_wp, &
        1.0_wp, 0.48_wp, -0.5_wp, -0.95_wp, -1.1_wp, 0.2_wp, -0.2_wp, -0.99_wp, &
        1.1_wp, -0.84_wp, 1.1_wp, -0.24_wp, -0.3_wp, 0.2_wp, -0.3_wp, 0.84_wp, &
        1.1_wp, -1.39_wp, 0.0_wp, -0.28_wp, -0.16_wp, 0.2_wp, 0.84_wp, 1.1_wp, &
        0.0_wp, 0.0_wp, 1.39_wp, 0.0_wp, 0.0_wp, -0.95_wp, 1.0_wp, 1.35_wp, &
        -0.99_wp, 0.0_wp, 0.88_wp, -0.52_wp, 0.0_wp, -1.19_wp, 0.2_wp, 0.2_wp, &
        0.76_wp, -1.0_wp, 0.0_wp, 0.0_wp, 0.76_wp, 1.0_wp, 0.0_wp, 0.0_wp, &
        0.76_wp, 1.0_wp, -0.76_wp, 1.0_wp, 0.0_wp, 0.0_wp, 1.23_wp, 0.76_wp, &
        0.8_wp, -0.32_wp, 0.4_wp, -0.72_wp, 0.8_wp, -0.4_wp, -0.4_wp, 0.0_wp, &
        0.0_wp, -0.8_wp, -0.9_wp, -0.68_wp, 0.9_wp, -0.16_wp, -0.2_wp, -0.16_wp, &
        -0.2_wp, 0.68_wp, -0.9_wp, -0.36_wp, 0.5_wp, -0.56_wp, -0.8_wp, 0.72_wp, &
        -0.9_wp, 0.44_wp, -0.6_wp, -0.48_wp, -0.7_wp, -0.16_wp, 0.0_wp, -1.11_wp, &
        0.32_wp, 0.0_wp, -1.07_wp, 0.6_wp, -0.8_wp, -0.28_wp, -0.4_wp, -0.64_wp, &
        0.0_wp, 0.91_wp, 1.11_wp, 0.64_wp, -0.9_wp, 0.76_wp, -0.8_wp, 0.0_wp, &
        0.0_wp, -0.76_wp, -0.8_wp, 1.03_wp, 0.0_wp, -0.36_wp, -0.64_wp, -0.7_wp, &
        0.36_wp, -0.4_wp, 1.07_wp, 0.36_wp, -0.5_wp, -0.52_wp, -0.7_wp, 0.6_wp, &
        0.0_wp, 0.88_wp, 0.95_wp, 0.0_wp, 0.48_wp, 0.16_wp, -0.2_wp, 0.6_wp, &
        0.8_wp, 0.16_wp, -0.2_wp, -0.6_wp, -0.8_wp, 0.0_wp, -1.0_wp, 0.12_wp, &
        0.2_wp, 0.16_wp, -0.2_wp, 0.68_wp, 0.7_wp, 0.59_wp, -0.8_wp, -0.99_wp, &
        -0.56_wp, -0.6_wp, 0.36_wp, -0.4_wp, -0.68_wp, -0.7_wp, -0.68_wp, -0.7_wp, &
        -0.36_wp, -0.5_wp, -0.44_wp, 0.6_wp, 0.64_wp, 0.7_wp, -0.12_wp, 0.1_wp, &
        -0.52_wp, 0.6_wp, 0.36_wp, 0.4_wp, 0.0_wp, 0.0_wp, 0.95_wp, -0.84_wp, &
        0.0_wp, 0.44_wp, 0.56_wp, 0.6_wp, 0.32_wp, -0.3_wp, 0.0_wp, 0.0_wp, &
        0.6_wp, 0.7_wp, 0.0_wp, 0.0_wp, 0.6_wp, 0.7_wp, -0.12_wp, -0.2_wp, &
        0.52_wp, -0.7_wp, 0.0_wp, 0.0_wp, 0.56_wp, 0.7_wp, -0.12_wp, 0.1_wp, &
        -0.52_wp, -0.7_wp, 0.0_wp, 0.0_wp, 0.88_wp, -0.76_wp, 0.0_wp, -0.44_wp, &
        0.0_wp, 0.0_wp, -0.52_wp, -0.7_wp, 0.52_wp, -0.7_wp, 0.36_wp, -0.4_wp, &
        -0.44_wp, -0.5_wp, 0.0_wp, 0.0_wp, 0.6_wp, 0.6_wp, 0.84_wp, 0.0_wp, &
        0.12_wp, -0.24_wp, 0.0_wp, 0.8_wp, -0.56_wp, 0.6_wp, -0.32_wp, -0.3_wp, &
        0.48_wp, -0.5_wp, 0.28_wp, -0.3_wp, -0.48_wp, -0.5_wp, 0.12_wp, 0.2_wp, &
        0.48_wp, -0.6_wp, 0.48_wp, 0.6_wp, -0.12_wp, 0.2_wp, 0.24_wp, 0.0_wp, &
        0.76_wp, -0.52_wp, -0.6_wp, -0.52_wp, 0.6_wp, 0.48_wp, -0.5_wp, -0.24_wp, &
        -0.3_wp, 0.12_wp, -0.1_wp, 0.48_wp, 0.6_wp, 0.52_wp, -0.2_wp, 0.36_wp, &
        0.4_wp, -0.44_wp, 0.5_wp, -0.24_wp, -0.3_wp, -0.48_wp, -0.6_wp, -0.44_wp, &
        -0.6_wp, -0.12_wp, 0.1_wp, 0.76_wp, 0.76_wp, 0.2_wp, -0.2_wp, 0.48_wp, &
        0.5_wp, 0.4_wp, -0.5_wp, -0.24_wp, -0.3_wp, 0.44_wp, -0.6_wp, 0.44_wp, &
        -0.6_wp, 0.36_wp, 0.0_wp, -0.64_wp, 0.72_wp, 0.0_wp, -0.12_wp, 0.0_wp, &
        -0.1_wp, -0.4_wp, -0.6_wp, -0.2_wp, -0.2_wp, -0.44_wp, 0.5_wp, -0.44_wp, &
        0.5_wp, 0.2_wp, 0.2_wp, -0.44_wp, -0.5_wp, 0.2_wp, -0.2_wp, -0.2_wp, &
        0.2_wp, -0.44_wp, -0.5_wp, 0.64_wp, 0.0_wp, 0.32_wp, -0.36_wp, 0.5_wp, &
        -0.2_wp, -0.3_wp, 0.12_wp, -0.1_wp, 0.48_wp, 0.5_wp, -0.12_wp, 0.3_wp, &
        -0.36_wp, -0.5_wp, 0.0_wp, 0.0_wp, 0.48_wp, 0.5_wp, -0.48_wp, 0.5_wp, &
        0.68_wp, 0.0_wp, -0.12_wp, 0.56_wp, -0.4_wp, 0.44_wp, -0.5_wp, -0.12_wp, &
        -0.1_wp, 0.24_wp, 0.3_wp, -0.4_wp, 0.4_wp, 0.64_wp, 0.0_wp, -0.24_wp, &
        0.64_wp, 0.0_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.44_wp, -0.5_wp, 0.44_wp, &
        0.5_wp, -0.12_wp, 0.2_wp, -0.36_wp, -0.5_wp, 0.12_wp, 0.0_wp, 0.64_wp, &
        -0.4_wp, 0.5_wp, 0.0_wp, 0.1_wp, 0.0_wp, 0.0_wp, -0.4_wp, 0.5_wp, &
        0.0_wp, 0.0_wp, -0.4_wp, -0.5_wp, 0.56_wp, 0.0_wp, 0.28_wp, 0.0_wp, &
        0.1_wp, 0.36_wp, 0.5_wp, 0.0_wp, -0.1_wp, 0.36_wp, -0.5_wp, 0.36_wp, &
        0.5_wp, 0.0_wp, -0.1_wp, 0.24_wp, -0.2_wp, -0.36_wp, -0.4_wp, 0.16_wp, &
        0.2_wp, 0.4_wp, -0.4_wp, 0.0_wp, 0.0_wp, -0.36_wp, -0.5_wp, -0.36_wp, &
        -0.5_wp, -0.32_wp, -0.5_wp, -0.12_wp, 0.1_wp, 0.2_wp, 0.2_wp, -0.36_wp, &
        0.4_wp, -0.6_wp, 0.6_wp, 0.28_wp, 0.0_wp, 0.52_wp, 0.12_wp, -0.1_wp, &
        0.4_wp, 0.4_wp, 0.0_wp, -0.5_wp, 0.2_wp, -0.2_wp, -0.32_wp, 0.4_wp, &
        0.16_wp, 0.2_wp, -0.16_wp, 0.2_wp, 0.32_wp, 0.4_wp, 0.56_wp, 0.0_wp, &
        -0.12_wp, 0.32_wp, -0.4_wp, -0.16_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.4_wp, &
        0.4_wp, -0.4_wp, -0.4_wp, -0.4_wp, 0.4_wp, -0.36_wp, 0.4_wp, 0.12_wp, &
        0.1_wp, 0.0_wp, 0.1_wp, 0.36_wp, 0.4_wp, 0.0_wp, -0.1_wp, 0.36_wp, &
        0.4_wp, -0.36_wp, 0.4_wp, 0.0_wp, 0.1_wp, 0.32_wp, 0.0_wp, 0.44_wp, &
        0.12_wp, 0.2_wp, 0.28_wp, -0.4_wp, 0.0_wp, 0.0_wp, 0.36_wp, 0.4_wp, &
        0.32_wp, -0.4_wp, -0.16_wp, 0.12_wp, 0.1_wp, 0.32_wp, -0.4_wp, 0.2_wp, &
        0.3_wp, -0.24_wp, 0.3_wp, 0.0_wp, 0.1_wp, 0.32_wp, 0.4_wp, 0.0_wp, &
        -0.1_wp, -0.32_wp, -0.4_wp, -0.32_wp, 0.4_wp, 0.0_wp, 0.1_wp, -0.52_wp, &
        -0.52_wp, 0.52_wp, 0.32_wp, -0.4_wp, 0.0_wp, 0.0_wp, 0.32_wp, 0.4_wp, &
        0.32_wp, -0.4_wp, 0.0_wp, 0.0_wp, -0.32_wp, -0.4_wp, -0.32_wp, 0.4_wp, &
        0.32_wp, 0.4_wp, 0.0_wp, 0.0_wp, 0.32_wp, 0.4_wp, 0.0_wp, 0.0_wp, &
        -0.32_wp, -0.4_wp, 0.0_wp, 0.0_wp, 0.32_wp, 0.4_wp, 0.16_wp, 0.2_wp, &
        0.32_wp, -0.3_wp, -0.16_wp, 0.0_wp, -0.48_wp, -0.2_wp, 0.2_wp, -0.28_wp, &
        -0.3_wp, 0.28_wp, -0.4_wp, 0.0_wp, 0.0_wp, 0.28_wp, -0.4_wp, 0.0_wp, &
        0.0_wp, 0.28_wp, -0.4_wp, 0.0_wp, 0.0_wp, -0.28_wp, -0.4_wp, 0.28_wp, &
        0.4_wp, -0.28_wp, -0.4_wp, -0.48_wp, -0.2_wp, 0.2_wp, 0.24_wp, 0.3_wp, &
        0.44_wp, 0.0_wp, 0.16_wp, 0.24_wp, 0.3_wp, 0.16_wp, -0.2_wp, 0.24_wp, &
        0.3_wp, -0.12_wp, 0.2_wp, 0.2_wp, 0.3_wp, -0.16_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, 0.44_wp, -0.32_wp, 0.3_wp, 0.24_wp, 0.0_wp, -0.36_wp, 0.36_wp, &
        0.0_wp, 0.24_wp, 0.12_wp, -0.2_wp, 0.2_wp, 0.3_wp, -0.12_wp, 0.0_wp, &
        -0.28_wp, 0.3_wp, -0.24_wp, 0.3_wp, 0.12_wp, 0.1_wp, -0.28_wp, -0.3_wp, &
        -0.28_wp, 0.3_wp, 0.0_wp, 0.0_wp, -0.28_wp, -0.3_wp, 0.0_wp, 0.0_wp, &
        -0.28_wp, -0.3_wp, 0.0_wp, 0.0_wp, 0.28_wp, 0.3_wp, 0.0_wp, 0.0_wp, &
        -0.28_wp, -0.3_wp, -0.28_wp, 0.3_wp, 0.0_wp, 0.0_wp, -0.28_wp, -0.3_wp, &
        0.0_wp, 0.0_wp, 0.28_wp, 0.3_wp, 0.0_wp, 0.0_wp, -0.28_wp, 0.3_wp, &
        0.28_wp, -0.3_wp, -0.28_wp, 0.3_wp, 0.4_wp, 0.4_wp, -0.24_wp, 0.3_wp, &
        0.0_wp, -0.1_wp, 0.16_wp, 0.0_wp, 0.36_wp, -0.2_wp, 0.3_wp, -0.12_wp, &
        -0.1_wp, -0.24_wp, -0.3_wp, 0.0_wp, 0.0_wp, -0.24_wp, 0.3_wp, -0.24_wp, &
        0.3_wp, 0.0_wp, 0.0_wp, -0.24_wp, 0.3_wp, -0.24_wp, 0.3_wp, 0.24_wp, &
        -0.3_wp, 0.0_wp, 0.0_wp, 0.24_wp, -0.3_wp, 0.0_wp, 0.0_wp, 0.24_wp, &
        0.3_wp, 0.24_wp, -0.3_wp, 0.24_wp, 0.3_wp, -0.24_wp, 0.3_wp, -0.24_wp, &
        0.3_wp, -0.2_wp, 0.2_wp, -0.16_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.32_wp, &
        0.2_wp, 0.0_wp, 0.1_wp, 0.2_wp, -0.3_wp, 0.2_wp, -0.2_wp, 0.12_wp, &
        0.2_wp, -0.16_wp, 0.2_wp, 0.16_wp, 0.2_wp, 0.2_wp, 0.3_wp, 0.2_wp, &
        0.3_wp, 0.0_wp, 0.0_wp, -0.2_wp, 0.3_wp, 0.0_wp, 0.0_wp, 0.2_wp, &
        0.3_wp, -0.2_wp, -0.3_wp, -0.2_wp, -0.3_wp, 0.2_wp, -0.3_wp, 0.0_wp, &
        0.0_wp, 0.2_wp, 0.3_wp, 0.0_wp, 0.0_wp, 0.2_wp, 0.3_wp, 0.0_wp, &
        0.0_wp, 0.2_wp, 0.3_wp, 0.0_wp, 0.0_wp, 0.2_wp, 0.3_wp, 0.0_wp, &
        0.0_wp, 0.2_wp, -0.3_wp, 0.0_wp, 0.0_wp, -0.2_wp, -0.3_wp, 0.0_wp, &
        0.0_wp, -0.2_wp, 0.3_wp, 0.0_wp, 0.0_wp, -0.2_wp, 0.3_wp, 0.0_wp, &
        0.0_wp, 0.36_wp, 0.0_wp, 0.0_wp, 0.36_wp, 0.12_wp, 0.1_wp, -0.24_wp, &
        0.2_wp, 0.12_wp, -0.2_wp, -0.16_wp, -0.2_wp, -0.13_wp, 0.1_wp, 0.22_wp, &
        0.21_wp, 0.2_wp, 0.0_wp, -0.28_wp, 0.32_wp, 0.0_wp, -0.12_wp, -0.2_wp, &
        -0.2_wp, 0.12_wp, -0.1_wp, 0.12_wp, 0.1_wp, -0.2_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, -0.32_wp, 0.32_wp, 0.0_wp, 0.0_wp, 0.32_wp, 0.32_wp, 0.0_wp, &
        0.0_wp, -0.24_wp, -0.2_wp, 0.24_wp, 0.2_wp, 0.2_wp, 0.0_wp, -0.24_wp, &
        0.0_wp, 0.0_wp, -0.24_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.24_wp, 0.2_wp, &
        -0.24_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.24_wp, 0.2_wp, 0.16_wp, -0.2_wp, &
        0.12_wp, 0.1_wp, 0.2_wp, 0.2_wp, 0.0_wp, -0.1_wp, -0.12_wp, 0.1_wp, &
        -0.16_wp, -0.2_wp, -0.12_wp, -0.1_wp, -0.16_wp, 0.2_wp, 0.2_wp, 0.2_wp, &
        0.0_wp, 0.0_wp, -0.2_wp, 0.2_wp, -0.2_wp, 0.2_wp, -0.2_wp, 0.2_wp, &
        -0.2_wp, 0.2_wp, 0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, 0.0_wp, 0.0_wp, &
        -0.2_wp, 0.2_wp, 0.2_wp, 0.0_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.2_wp, &
        0.2_wp, -0.2_wp, 0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, -0.2_wp, 0.0_wp, &
        0.0_wp, 0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp, 0.12_wp, -0.2_wp, -0.12_wp, &
        -0.1_wp, 0.28_wp, -0.28_wp, 0.16_wp, -0.2_wp, 0.0_wp, -0.1_wp, 0.0_wp, &
        0.1_wp, -0.16_wp, 0.2_wp, 0.0_wp, -0.1_wp, -0.16_wp, -0.2_wp, 0.0_wp, &
        -0.1_wp, 0.16_wp, -0.2_wp, 0.16_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.16_wp, &
        0.2_wp, -0.16_wp, 0.2_wp, 0.0_wp, 0.0_wp, 0.16_wp, 0.2_wp, 0.16_wp, &
        -0.2_wp, 0.16_wp, -0.2_wp, -0.16_wp, 0.2_wp, 0.16_wp, -0.2_wp, 0.0_wp, &
        0.0_wp, 0.16_wp, 0.2_wp, 0.0_wp, 0.0_wp, 0.16_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, -0.16_wp, -0.2_wp, 0.16_wp, -0.2_wp, -0.16_wp, -0.2_wp, 0.0_wp, &
        0.0_wp, -0.16_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.16_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, 0.16_wp, -0.2_wp, 0.16_wp, 0.2_wp, 0.16_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, -0.16_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.16_wp, -0.2_wp, 0.0_wp, &
        0.0_wp, 0.16_wp, 0.2_wp, 0.16_wp, 0.2_wp, 0.0_wp, 0.0_wp, 0.16_wp, &
        0.2_wp, 0.16_wp, -0.2_wp, 0.16_wp, 0.2_wp, 0.0_wp, 0.0_wp, -0.16_wp, &
        0.2_wp, 0.0_wp, 0.1_wp, 0.12_wp, -0.2_wp, 0.12_wp, -0.2_wp, 0.0_wp, &
        -0.1_wp, 0.0_wp, -0.1_wp, 0.12_wp, 0.2_wp, 0.0_wp, -0.1_wp, -0.12_wp, &
        0.2_wp, -0.15_wp, 0.2_wp, -0.24_wp, 0.24_wp, 0.0_wp, 0.0_wp, 0.24_wp, &
        0.24_wp, 0.12_wp, -0.2_wp, -0.12_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.12_wp, &
        0.2_wp, 0.12_wp, -0.2_wp, 0.12_wp, 0.2_wp, 0.12_wp, 0.2_wp, 0.12_wp, &
        0.2_wp, 0.12_wp, -0.2_wp, -0.12_wp, 0.2_wp, 0.0_wp, 0.0_wp, 0.12_wp, &
        0.2_wp, 0.12_wp, 0.0_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.2_wp, &
        0.12_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.2_wp, -0.12_wp, 0.2_wp, &
        -0.12_wp, 0.2_wp, 0.12_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.2_wp, &
        0.2_wp, 0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, 0.2_wp, 0.0_wp, &
        0.0_wp, -0.12_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.2_wp, -0.12_wp, &
        -0.2_wp, 0.0_wp, 0.0_wp, 0.12_wp, -0.2_wp, 0.12_wp, -0.2_wp, 0.12_wp, &
        0.2_wp, -0.12_wp, -0.2_wp, 0.0_wp, 0.0_wp, 0.12_wp, -0.2_wp, 0.12_wp, &
        -0.2_wp, 0.12_wp, 0.2_wp, 0.12_wp, 0.0_wp, 0.2_wp, -0.12_wp, -0.2_wp, &
        0.0_wp, 0.0_wp, 0.12_wp, 0.2_wp, -0.16_wp, 0.0_wp, 0.16_wp, -0.2_wp, &
        0.2_wp, 0.0_wp, 0.0_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.2_wp, 0.2_wp, &
        0.0_wp, 0.0_wp, 0.2_wp, 0.2_wp, -0.2_wp, 0.0_wp, 0.0_wp, -0.2_wp, &
        0.12_wp, 0.0_wp, -0.16_wp, 0.2_wp, 0.0_wp, 0.0_wp, 0.2_wp, 0.12_wp, &
        -0.1_wp, 0.0_wp, 0.1_wp, 0.16_wp, -0.16_wp, -0.16_wp, -0.16_wp, -0.16_wp, &
        -0.16_wp, 0.0_wp, 0.0_wp, -0.16_wp, 0.0_wp, 0.0_wp, -0.16_wp, -0.16_wp, &
        -0.16_wp, 0.0_wp, 0.0_wp, -0.16_wp, 0.0_wp, 0.0_wp, 0.16_wp, 0.0_wp, &
        0.0_wp, 0.16_wp, 0.0_wp, 0.0_wp, 0.16_wp, 0.16_wp, 0.0_wp, 0.0_wp, &
        -0.16_wp, 0.0_wp, 0.0_wp, -0.16_wp, -0.16_wp, 0.0_wp, 0.0_wp, 0.16_wp, &
        0.0_wp, 0.0_wp, -0.16_wp, -0.16_wp, 0.0_wp, 0.0_wp, -0.16_wp, -0.16_wp, &
        0.12_wp, 0.1_wp, 0.12_wp, -0.1_wp, 0.12_wp, 0.1_wp, 0.0_wp, 0.0_wp, &
        0.12_wp, 0.1_wp, -0.12_wp, 0.1_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.1_wp, &
        0.12_wp, -0.1_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.1_wp, 0.0_wp, 0.0_wp, &
        0.12_wp, 0.1_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, &
        -0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.12_wp, 0.12_wp, 0.12_wp, 0.12_wp, &
        0.0_wp, 0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.12_wp, 0.0_wp, &
        0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, -0.12_wp, -0.12_wp, 0.12_wp, &
        0.12_wp, -0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, -0.12_wp, 0.12_wp, &
        0.12_wp, -0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.12_wp, 0.0_wp, &
        0.0_wp, -0.12_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, &
        0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, &
        0.12_wp, -0.12_wp, -0.12_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.12_wp, &
        0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.12_wp, -0.12_wp, 0.0_wp, &
        0.0_wp, -0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.12_wp, 0.0_wp, &
        0.0_wp, -0.12_wp, -0.12_wp, -0.12_wp, -0.12_wp, 0.12_wp, 0.0_wp, 0.0_wp, &
        0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.12_wp, 0.0_wp, 0.0_wp, &
        0.12_wp, -0.12_wp, -0.12_wp, -0.12_wp, -0.12_wp, 0.12_wp, 0.12_wp, -0.12_wp, &
        -0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, 0.12_wp, &
        0.0_wp, 0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, -0.12_wp, -0.12_wp, 0.0_wp, &
        0.0_wp, -0.12_wp, -0.12_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.12_wp, &
        0.0_wp, 0.0_wp, 0.12_wp, 0.0_wp, 0.0_wp, 0.12_wp, 0.12_wp, 0.08_wp, &
        0.0_wp, 0.04_wp]

    !  Interval between fundamental date J2000.0 and given date (JC).
    t = ( ( date1-dj00 ) + date2 ) / djc

    !  Powers of T.
    w = 1.0_wp
    do jpt=0,maxpt
       pt(jpt) = w
       w = w*t
    end do

    !
    !  Luni-solar fundamental (Delaunay) arguments (IERS 2003)
    !

    !  Mean anomaly of the Moon.
    fa(1) = FAL03 ( t )

    !  Mean anomaly of the Sun.
    fa(2) = FALP03 ( t )

    !  Mean argument of the latitude of the Moon.
    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 )

    !  Planetary longitudes, Mercury through Neptune.
    fa(6)  = FAME03 ( t )
    fa(7)  = FAVE03 ( t )
    fa(8)  = FAE03 ( t )
    fa(9)  = FAMA03 ( t )
    fa(10) = FAJU03 ( t )
    fa(11) = FASA03 ( t )
    fa(12) = FAUR03 ( t )
    fa(13) = FANE03 ( t )

    !  General accumulated precession in longitude.
    fa(14) = FAPA03 ( t )

    !  --------------------------------------
    !  Polynomial part of precession-nutation
    !  --------------------------------------

    do jxy=0,1
       xypr(jxy) = 0.0_wp
       do j=maxpt,0,-1
          xypr(jxy) = xypr(jxy) + xyp(j,jxy)*pt(j)
       end do
    end do

    !  ----------------------------------
    !  Nutation periodic terms, planetary
    !  ----------------------------------

    !  Initialize totals in X and Y.
    do jxy=0,1
       xypl(jxy) = 0.0_wp
    end do

    !  Work backwards through the coefficients per frequency list.
    ialast = na
    do ifreq=nfpl,1,-1

       !  Obtain the argument functions.
       arg = 0.0_wp
       do i=1,14
          m = mfapl(i,ifreq)
          if ( m/=0 ) arg = arg + real(m,wp)*fa(i)
       end do
       sc(0) = sin(arg)
       sc(1) = cos(arg)

       !  Work backwards through the amplitudes at this frequency.
       ia = nc(ifreq+nfls)
       do i=ialast,ia,-1

          !  Coefficient number (0 = 1st).
          j = i-ia

          !  X or Y.
          jxy = jaxy(j)

          !  Sin or cos.
          jsc = jasc(j)

          !  Power of T.
          jpt = japt(j)

          !  Accumulate the component.
          xypl(jxy) = xypl(jxy) + a(i)*sc(jsc)*pt(jpt)
       end do
       ialast = ia-1
    end do

    !  -----------------------------------
    !  Nutation periodic terms, luni-solar
    !  -----------------------------------

    !  Initialize totals in X and Y.
    do jxy=0,1
       xyls(jxy) = 0.0_wp
    end do

    !  Continue working backwards through the number of coefficients list.
    do ifreq=nfls,1,-1

       !  Obtain the argument functions.
       arg = 0.0_wp
       do i=1,5
          m = mfals(i,ifreq)
          if ( m/=0 ) arg = arg + real(m,wp)*fa(i)
       end do
       sc(0) = sin(arg)
       sc(1) = cos(arg)

       !  Work backwards through the amplitudes at this frequency.
       ia = nc(ifreq)
       do i=ialast,ia,-1

          !  Coefficient number (0 = 1st).
          j = i-ia

          !  X or Y.
          jxy = jaxy(j)

          !  Sin or cos.
          jsc = jasc(j)

          !  Power of T.
          jpt = japt(j)

          !  Accumulate the component.
          xyls(jxy) = xyls(jxy) + a(i)*sc(jsc)*pt(jpt)
       end do
       ialast = ia-1
    end do

    !  -------
    !  Results
    !  -------

    !  CIP unit vector components.
    x = das2r * ( xypr(0) + ( xyls(0) + xypl(0) )/1.0e6_wp )
    y = das2r * ( xypr(1) + ( xyls(1) + xypl(1) )/1.0e6_wp )

    end subroutine XY06
!***********************************************************************

!***********************************************************************
!>
!  For a given TT date, compute the X,Y coordinates of the Celestial
!  Intermediate Pole and the CIO locator s, using the IAU 2000A
!  precession-nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The Celestial Intermediate Pole coordinates are the x,y components
!     of the unit vector in the Geocentric Celestial Reference System.
!
!  3. The CIO locator s (in radians) positions the Celestial
!     Intermediate Origin on the equator of the CIP.
!
!  4. A faster, but slightly less accurate result (about 1 mas for X,Y),
!     can be obtained by using instead the XYS00B routine.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine XYS00A ( date1, date2, x, y, 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(out) :: x !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: y !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: s !! the CIO locator s (Note 2)

    real(wp) :: rbpn(3,3)

    !  Form the bias-precession-nutation matrix, IAU 2000A.
    call PNM00A ( date1, date2, rbpn )

    !  Extract X,Y.
    call BPN2XY ( rbpn, x, y )

    !  Obtain s.
    s = S00 ( date1, date2, x, y )

    end subroutine XYS00A
!***********************************************************************

!***********************************************************************
!>
!  For a given TT date, compute the X,Y coordinates of the Celestial
!  Intermediate Pole and the CIO locator s, using the IAU 2000B
!  precession-nutation model.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The Celestial Intermediate Pole coordinates are the x,y components
!     of the unit vector in the Geocentric Celestial Reference System.
!
!  3. The CIO locator s (in radians) positions the Celestial
!     Intermediate Origin on the equator of the CIP.
!
!  4. The present routine is faster, but slightly less accurate (about
!     1 mas in X,Y), than the XYS00A routine.
!
!### Reference
!
!  * McCarthy, D. D., Petit, G. (eds.), IERS Conventions (2003),
!    IERS Technical Note No. 32, BKG (2004)
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine XYS00B ( date1, date2, x, y, 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(out) :: x !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: y !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: s !! the CIO locator s (Note 2)

    real(wp) :: rbpn(3,3)

    !  Form the bias-precession-nutation matrix, IAU 2000A.
    call PNM00B ( date1, date2, rbpn )

    !  Extract X,Y.
    call BPN2XY ( rbpn, x, y )

    !  Obtain s.
    s = S00 ( date1, date2, x, y )

    end subroutine XYS00B
!***********************************************************************

!***********************************************************************
!>
!  For a given TT date, compute the X,Y coordinates of the Celestial
!  Intermediate Pole and the CIO locator s, using the IAU 2006
!  precession and IAU 2000A nutation models.
!
!  Status:  support routine.
!
!### Notes
!
!  1. 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.
!
!  2. The Celestial Intermediate Pole coordinates are the x,y components
!     of the unit vector in the Geocentric Celestial Reference System.
!
!  3. The CIO locator s (in radians) positions the Celestial
!     Intermediate Origin on the equator of the CIP.
!
!  4. Series-based solutions for generating X and Y are also available:
!     see Capitaine & Wallace (2006) and XY06.
!
!### References
!
!  * Capitaine, N. & Wallace, P.T., 2006, Astron.Astrophys. 450, 855
!
!  * Wallace, P.T. & Capitaine, N., 2006, Astron.Astrophys. 459, 981
!
!### History
!  * IAU SOFA revision: 2013 May 14

    subroutine XYS06A ( date1, date2, x, y, 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(out) :: x !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: y !! Celestial Intermediate Pole (Note 2)
    real(wp),intent(out) :: s !! the CIO locator s (Note 2)

    real(wp) :: rbpn(3,3)

    !  Form the bias-precession-nutation matrix, IAU 2006/2000A.
    call PNM06A ( date1, date2, rbpn )

    !  Extract X,Y.
    call BPN2XY ( rbpn, x, y )

    !  Obtain s.
    s = S06 ( date1, date2, x, y )

    end subroutine XYS06A
!***********************************************************************

!***********************************************************************
!>
!  Zero a p-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2000 November 25

    subroutine ZP ( p )

    implicit none

    real(wp),dimension(3),intent(out) :: p !! p-vector

    integer :: i

    do i=1,3
       p(i) = 0.0_wp
    end do

    end subroutine ZP
!***********************************************************************

!***********************************************************************
!>
!  Zero a pv-vector.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2006 November 13

    subroutine ZPV ( pv )

    implicit none

    real(wp),dimension(3,2),intent(out) :: pv !! pv-vector

    integer :: i

    do i=1,2
       call ZP ( pv(1,i) )
    end do

    end subroutine ZPV
!***********************************************************************

!***********************************************************************
!>
!  Initialize an r-matrix to the null matrix.
!
!  Status:  vector/matrix support routine.
!
!### History
!  * IAU SOFA revision: 2012 April 3

    subroutine ZR ( r )

    implicit none

    real(wp),dimension(3,3),intent(out) :: r !! r-matrix

    r(1,1) = 0.0_wp
    r(1,2) = 0.0_wp
    r(1,3) = 0.0_wp
    r(2,1) = 0.0_wp
    r(2,2) = 0.0_wp
    r(2,3) = 0.0_wp
    r(3,1) = 0.0_wp
    r(3,2) = 0.0_wp
    r(3,3) = 0.0_wp

    end subroutine ZR
!***********************************************************************

!********************************************************************************
    end module astro_module
!********************************************************************************