{-|
Module: Data.Astro.Effects.Nutation
Description: Calculation effects of nutation
Copyright: Alexander Ignatyev, 2016

Calculation effects of nutation.
-}

module Data.Astro.Effects.Nutation
(
  nutationLongitude
  , nutationObliquity
)

where

import qualified Data.Astro.Utils as U
import Data.Astro.Types (DecimalDegrees(..), toRadians, fromDMS)
import Data.Astro.Time.JulianDate (JulianDate, numberOfCenturies)
import Data.Astro.Time.Epoch (j1900)


-- | Calculates the nutation on the ecliptic longitude at the given JulianDate

nutationLongitude :: JulianDate -> DecimalDegrees
nutationLongitude :: JulianDate -> DecimalDegrees
nutationLongitude JulianDate
jd =
  let t :: TimeBaseType
t = JulianDate -> JulianDate -> TimeBaseType
numberOfCenturies JulianDate
j1900 JulianDate
jd
      l :: TimeBaseType
l = TimeBaseType -> TimeBaseType
sunMeanLongutude TimeBaseType
t
      omega :: TimeBaseType
omega = TimeBaseType -> TimeBaseType
moonNode TimeBaseType
t
      dPsi :: TimeBaseType
dPsi = -TimeBaseType
17.2TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*(TimeBaseType -> TimeBaseType
forall a. Floating a => a -> a
sin TimeBaseType
omega) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
1.3TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*(TimeBaseType -> TimeBaseType
forall a. Floating a => a -> a
sin (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType
2TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
l)
  in Int -> Int -> TimeBaseType -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
0 Int
0 TimeBaseType
dPsi


-- | Calculates the nutation on the obliquity of the ecliptic at the given JulianDate

nutationObliquity :: JulianDate -> DecimalDegrees
nutationObliquity :: JulianDate -> DecimalDegrees
nutationObliquity JulianDate
jd =
  let t :: TimeBaseType
t = JulianDate -> JulianDate -> TimeBaseType
numberOfCenturies JulianDate
j1900 JulianDate
jd
      l :: TimeBaseType
l = TimeBaseType -> TimeBaseType
sunMeanLongutude TimeBaseType
t
      omega :: TimeBaseType
omega = TimeBaseType -> TimeBaseType
moonNode TimeBaseType
t
      dEps :: TimeBaseType
dEps = TimeBaseType
9.2TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*(TimeBaseType -> TimeBaseType
forall a. Floating a => a -> a
cos TimeBaseType
omega) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
0.5TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*(TimeBaseType -> TimeBaseType
forall a. Floating a => a -> a
cos (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType
2TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
l)
  in Int -> Int -> TimeBaseType -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
0 Int
0 TimeBaseType
dEps


-- | It takes a number of centuries and returns the Sun's mean longitude in radians

sunMeanLongutude :: Double -> Double
sunMeanLongutude :: TimeBaseType -> TimeBaseType
sunMeanLongutude TimeBaseType
t =
  let a :: TimeBaseType
a = TimeBaseType
100.002136 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
* TimeBaseType
t
  in TimeBaseType -> TimeBaseType
forall a. Floating a => a -> a
U.toRadians (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a -> a
U.reduceToZeroRange TimeBaseType
360 (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType
279.6967 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
360 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
* (TimeBaseType
a TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType -> TimeBaseType
int TimeBaseType
a)


-- | It takes a number of centuries and returns the Moon's node in radians

moonNode :: Double -> Double
moonNode :: TimeBaseType -> TimeBaseType
moonNode TimeBaseType
t =
  let b :: TimeBaseType
b = TimeBaseType
5.372617 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
* TimeBaseType
t
  in TimeBaseType -> TimeBaseType
forall a. Floating a => a -> a
U.toRadians (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a -> a
U.reduceToZeroRange TimeBaseType
360 (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType
259.1833 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
360TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*(TimeBaseType
b TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType -> TimeBaseType
int TimeBaseType
b)


-- | 'round' function that returns Double

int :: Double -> Double
int :: TimeBaseType -> TimeBaseType
int = Integer -> TimeBaseType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> TimeBaseType)
-> (TimeBaseType -> Integer) -> TimeBaseType -> TimeBaseType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeBaseType -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round