pkg/sun/sun_nutate.F

27f9df093b Oliv*0001 #include "SUN_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: SUN_NUTATE
                0005
                0006 C     !INTERFACE: ======================================================
                0007       SUBROUTINE SUN_NUTATE(
                0008      I                       t, xls, gs, xlm, asc,
                0009      O                       dpsi, eps )
                0010
                0011 C     !DESCRIPTION:
                0012 C  This subroutine computes the nutation in longitude and the obliquity
                0013 C  of the ecliptic corrected for nutation.  It uses the model referenced
                0014 C  in The Astronomical Almanac for 1984, Section S (Supplement) and
                0015 C  documented in Exact closed-form geolocation algorithm for Earth
                0016 C  survey sensors, by F.S. Patt and W.W. Gregg, Int. Journal of
                0017 C  Remote Sensing, 1993.  These parameters are used to compute the
                0018 C  apparent time correction to the Greenwich Hour Angle and for the
                0019 C  calculation of the geocentric Sun vector.  The input ephemeris
                0020 C  parameters are computed using subroutine ephparms.  Terms are
                0021 C  included to 0.1 arcsecond.
                0022 C
                0023 C       Program written by:     Frederick S. Patt
                0024 C                               General Sciences Corporation
                0025 C                               October 21, 1992
                0026
                0027 C     !USES: ===========================================================
                0028       IMPLICIT NONE
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032
                0033 C     !INPUT PARAMETERS: ===============================================
                0034 C     t   :: Time in days since January 1, 2000 at 12 hours UT
                0035 C     xls :: Mean solar longitude (degrees)
                0036 C     gs  :: Mean solar anomaly   (degrees)
                0037 C     xlm :: Mean lunar longitude (degrees)
                0038 C     asc :: Ascending node of mean lunar orbit
                0039       _RL t, xls, gs, xlm, asc
                0040
                0041 C     !OUTPUT PARAMETERS: ==============================================
                0042 C     dPsi :: Nutation in longitude (degrees)
                0043 C     Eps  :: Obliquity of the Ecliptic (degrees)
                0044 C             (includes nutation in obliquity)
                0045       _RL dpsi, eps
                0046 CEOP
                0047
                0048 #ifdef ALLOW_SUN
                0049
                0050 C     !LOCAL VARIABLES: ================================================
                0051       _RL epsm, deps
                0052
                0053 C  Nutation in Longitude
                0054       dpsi = - 17.1996 _d 0*SIN(asc*deg2rad)
                0055      &       + 0.2062 _d 0*SIN(2.0 _d 0*asc*deg2rad)
                0056      &       - 1.3187 _d 0*SIN(2.0 _d 0*xls*deg2rad)
                0057      &       + 0.1426 _d 0*SIN(gs*deg2rad)
                0058      &       - 0.2274 _d 0*SIN(2.0 _d 0*xlm*deg2rad)
                0059
                0060 C  Mean Obliquity of the Ecliptic
                0061       epsm = 23.439291 _d 0 - 3.560 _d -7*t
                0062
                0063 C  Nutation in Obliquity
                0064       deps = 9.2025 _d 0*COS(asc*deg2rad) +
                0065      &       0.5736 _d 0*COS(2.0 _d 0*xls*deg2rad)
                0066
                0067 C  True Obliquity of the Ecliptic
                0068       eps = epsm + deps/3600.0 _d 0
                0069
                0070       dpsi = dpsi/3600.0 _d 0
                0071
                0072 #endif
                0073
                0074       RETURN
                0075       END