module Math.NevilleTheta
    ( theta_c, 
      theta_d,
      theta_n,
      theta_s,
      theta_c', 
      theta_d',
      theta_n',
      theta_s'
    ) where
import Data.Complex           ( Complex(..) )
import Math.EllipticIntegrals ( ellipticF )
import Math.JacobiTheta
    ( jtheta1, jtheta1Dash, jtheta2, jtheta3, jtheta4 )


i_ :: Complex Double
i_ :: Complex Double
i_ = Double
0.0 forall a. a -> a -> Complex a
:+ Double
1.0

tauFromM :: Complex Double -> Complex Double
tauFromM :: Complex Double -> Complex Double
tauFromM Complex Double
m = Complex Double
i_ forall a. Num a => a -> a -> a
* Complex Double -> Complex Double -> Complex Double
ellipticF (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Complex Double
2) (Complex Double
1 forall a. Num a => a -> a -> a
- Complex Double
m) forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
ellipticF (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Complex Double
2) Complex Double
m

nomeFromM :: Complex Double -> Complex Double
nomeFromM :: Complex Double -> Complex Double
nomeFromM Complex Double
m = forall a. Floating a => a -> a
exp (Complex Double
i_ forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* Complex Double -> Complex Double
tauFromM Complex Double
m)

-- | Neville theta-c function in terms of the nome.
theta_c :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ q, the nome
  -> Complex Double
theta_c :: Complex Double -> Complex Double -> Complex Double
theta_c Complex Double
z Complex Double
q = 
  Complex Double -> Complex Double -> Complex Double
jtheta2 Complex Double
z' Complex Double
q forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
jtheta2 Complex Double
0 Complex Double
q
  where
    j3 :: Complex Double
j3 = Complex Double -> Complex Double -> Complex Double
jtheta3 Complex Double
0 Complex Double
q
    z' :: Complex Double
z' = Complex Double
z forall a. Fractional a => a -> a -> a
/ (Complex Double
j3 forall a. Num a => a -> a -> a
* Complex Double
j3)

-- | Neville theta-d function in terms of the nome.
theta_d :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ q, the nome
  -> Complex Double
theta_d :: Complex Double -> Complex Double -> Complex Double
theta_d Complex Double
z Complex Double
q = 
  Complex Double -> Complex Double -> Complex Double
jtheta3 Complex Double
z' Complex Double
q forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
jtheta3 Complex Double
0 Complex Double
q
  where
    j3 :: Complex Double
j3 = Complex Double -> Complex Double -> Complex Double
jtheta3 Complex Double
0 Complex Double
q
    z' :: Complex Double
z' = Complex Double
z forall a. Fractional a => a -> a -> a
/ (Complex Double
j3 forall a. Num a => a -> a -> a
* Complex Double
j3)

-- | Neville theta-n function in terms of the nome.
theta_n :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ q, the nome
  -> Complex Double
theta_n :: Complex Double -> Complex Double -> Complex Double
theta_n Complex Double
z Complex Double
q = 
  Complex Double -> Complex Double -> Complex Double
jtheta4 Complex Double
z' Complex Double
q forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
jtheta4 Complex Double
0 Complex Double
q
  where
    j3 :: Complex Double
j3 = Complex Double -> Complex Double -> Complex Double
jtheta3 Complex Double
0 Complex Double
q
    z' :: Complex Double
z' = Complex Double
z forall a. Fractional a => a -> a -> a
/ (Complex Double
j3 forall a. Num a => a -> a -> a
* Complex Double
j3)

-- | Neville theta-d function in terms of the nome.
theta_s :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ q, the nome
  -> Complex Double
theta_s :: Complex Double -> Complex Double -> Complex Double
theta_s Complex Double
z Complex Double
q = 
  Complex Double
j3sq forall a. Num a => a -> a -> a
* Complex Double -> Complex Double -> Complex Double
jtheta1 Complex Double
z' Complex Double
q forall a. Fractional a => a -> a -> a
/ Complex Double -> Complex Double -> Complex Double
jtheta1Dash Complex Double
0 Complex Double
q
  where
    j3 :: Complex Double
j3 = Complex Double -> Complex Double -> Complex Double
jtheta3 Complex Double
0 Complex Double
q
    j3sq :: Complex Double
j3sq = Complex Double
j3 forall a. Num a => a -> a -> a
* Complex Double
j3
    z' :: Complex Double
z' = Complex Double
z forall a. Fractional a => a -> a -> a
/ Complex Double
j3sq

-- | Neville theta-c function in terms of the squared modulus.
theta_c' :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ m, the squared modulus
  -> Complex Double
theta_c' :: Complex Double -> Complex Double -> Complex Double
theta_c' Complex Double
z Complex Double
m = Complex Double -> Complex Double -> Complex Double
theta_c Complex Double
z (Complex Double -> Complex Double
nomeFromM Complex Double
m)

-- | Neville theta-d function in terms of the squared modulus.
theta_d' :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ m, the squared modulus
  -> Complex Double
theta_d' :: Complex Double -> Complex Double -> Complex Double
theta_d' Complex Double
z Complex Double
m = Complex Double -> Complex Double -> Complex Double
theta_d Complex Double
z (Complex Double -> Complex Double
nomeFromM Complex Double
m)

-- | Neville theta-n function in terms of the squared modulus.
theta_n' :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ m, the squared modulus
  -> Complex Double
theta_n' :: Complex Double -> Complex Double -> Complex Double
theta_n' Complex Double
z Complex Double
m = Complex Double -> Complex Double -> Complex Double
theta_n Complex Double
z (Complex Double -> Complex Double
nomeFromM Complex Double
m)

-- | Neville theta-s function in terms of the squared modulus.
theta_s' :: 
     Complex Double -- ^ z
  -> Complex Double -- ^ m, the squared modulus
  -> Complex Double
theta_s' :: Complex Double -> Complex Double -> Complex Double
theta_s' Complex Double
z Complex Double
m = Complex Double -> Complex Double -> Complex Double
theta_s Complex Double
z (Complex Double -> Complex Double
nomeFromM Complex Double
m)