Back to home page

EIC code displayed by LXR
 
 

    

File indexing completed on 2025-07-11 08:15:26 

0001 //  Copyright (c) 2006 Xiaogang Zhang
0002 //  Copyright (c) 2006 John Maddock
0003 //  Use, modification and distribution are subject to the
0004 //  Boost Software License, Version 1.0. (See accompanying file
0005 //  LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
0006 //
0007 //  History:
0008 //  XZ wrote the original of this file as part of the Google
0009 //  Summer of Code 2006.  JM modified it to fit into the
0010 //  Boost.Math conceptual framework better, and to correctly
0011 //  handle the various corner cases.
0012 //
0013 
0014 #ifndef BOOST_MATH_ELLINT_3_HPP
0015 #define BOOST_MATH_ELLINT_3_HPP
0016 
0017 #ifdef _MSC_VER
0018 #pragma once
0019 #endif
0020 
0021 #include <boost/math/special_functions/math_fwd.hpp>
0022 #include <boost/math/special_functions/ellint_rf.hpp>
0023 #include <boost/math/special_functions/ellint_rj.hpp>
0024 #include <boost/math/special_functions/ellint_1.hpp>
0025 #include <boost/math/special_functions/ellint_2.hpp>
0026 #include <boost/math/special_functions/log1p.hpp>
0027 #include <boost/math/special_functions/atanh.hpp>
0028 #include <boost/math/constants/constants.hpp>
0029 #include <boost/math/policies/error_handling.hpp>
0030 #include <boost/math/tools/workaround.hpp>
0031 #include <boost/math/special_functions/round.hpp>
0032 
0033 // Elliptic integrals (complete and incomplete) of the third kind
0034 // Carlson, Numerische Mathematik, vol 33, 1 (1979)
0035 
0036 namespace boost { namespace math { 
0037    
0038 namespace detail{
0039 
0040 template <typename T, typename Policy>
0041 T ellint_pi_imp(T v, T k, T vc, const Policy& pol);
0042 
0043 // Elliptic integral (Legendre form) of the third kind
0044 template <typename T, typename Policy>
0045 T ellint_pi_imp(T v, T phi, T k, T vc, const Policy& pol)
0046 {
0047    // Note vc = 1-v presumably without cancellation error.
0048    BOOST_MATH_STD_USING
0049 
0050    static const char* function = "boost::math::ellint_3<%1%>(%1%,%1%,%1%)";
0051 
0052 
0053    T sphi = sin(fabs(phi));
0054    T result = 0;
0055 
0056    if (k * k * sphi * sphi > 1)
0057    {
0058       return policies::raise_domain_error<T>(function, "Got k = %1%, function requires |k| <= 1", k, pol);
0059    }
0060    // Special cases first:
0061    if(v == 0)
0062    {
0063       // A&S 17.7.18 & 19
0064       return (k == 0) ? phi : ellint_f_imp(phi, k, pol);
0065    }
0066    if((v > 0) && (1 / v < (sphi * sphi)))
0067    {
0068       // Complex result is a domain error:
0069       return policies::raise_domain_error<T>(function, "Got v = %1%, but result is complex for v > 1 / sin^2(phi)", v, pol);
0070    }
0071 
0072    if(v == 1)
0073    {
0074       if (k == 0)
0075          return tan(phi);
0076 
0077       // http://functions.wolfram.com/08.06.03.0008.01
0078       T m = k * k;
0079       result = sqrt(1 - m * sphi * sphi) * tan(phi) - ellint_e_imp(phi, k, pol);
0080       result /= 1 - m;
0081       result += ellint_f_imp(phi, k, pol);
0082       return result;
0083    }
0084    if(phi == constants::half_pi<T>())
0085    {
0086       // Have to filter this case out before the next
0087       // special case, otherwise we might get an infinity from
0088       // tan(phi).
0089       // Also note that since we can't represent PI/2 exactly
0090       // in a T, this is a bit of a guess as to the users true
0091       // intent...
0092       //
0093       return ellint_pi_imp(v, k, vc, pol);
0094    }
0095    if((phi > constants::half_pi<T>()) || (phi < 0))
0096    {
0097       // Carlson's algorithm works only for |phi| <= pi/2,
0098       // use the integrand's periodicity to normalize phi
0099       //
0100       // Xiaogang's original code used a cast to long long here
0101       // but that fails if T has more digits than a long long,
0102       // so rewritten to use fmod instead:
0103       //
0104       // See http://functions.wolfram.com/08.06.16.0002.01
0105       //
0106       if(fabs(phi) > 1 / tools::epsilon<T>())
0107       {
0108          // Invalid for v > 1, this case is caught above since v > 1 implies 1/v < sin^2(phi)
0109          BOOST_MATH_ASSERT(v <= 1);
0110          //  
0111          // Phi is so large that phi%pi is necessarily zero (or garbage),
0112          // just return the second part of the duplication formula:
0113          //
0114          result = 2 * fabs(phi) * ellint_pi_imp(v, k, vc, pol) / constants::pi<T>();
0115       }
0116       else
0117       {
0118          T rphi = boost::math::tools::fmod_workaround(T(fabs(phi)), T(constants::half_pi<T>()));
0119          T m = boost::math::round((fabs(phi) - rphi) / constants::half_pi<T>());
0120          int sign = 1;
0121          if((m != 0) && (k >= 1))
0122          {
0123             return policies::raise_domain_error<T>(function, "Got k=1 and phi=%1% but the result is complex in that domain", phi, pol);
0124          }
0125          if(boost::math::tools::fmod_workaround(m, T(2)) > T(0.5))
0126          {
0127             m += 1;
0128             sign = -1;
0129             rphi = constants::half_pi<T>() - rphi;
0130          }
0131          result = sign * ellint_pi_imp(v, rphi, k, vc, pol);
0132          if((m > 0) && (vc > 0))
0133             result += m * ellint_pi_imp(v, k, vc, pol);
0134       }
0135       return phi < 0 ? T(-result) : result;
0136    }
0137    if(k == 0)
0138    {
0139       // A&S 17.7.20:
0140       if(v < 1)
0141       {
0142          T vcr = sqrt(vc);
0143          return atan(vcr * tan(phi)) / vcr;
0144       }
0145       else
0146       {
0147          // v > 1:
0148          T vcr = sqrt(-vc);
0149          T arg = vcr * tan(phi);
0150          return (boost::math::log1p(arg, pol) - boost::math::log1p(-arg, pol)) / (2 * vcr);
0151       }
0152    }
0153    if((v < 0) && fabs(k) <= 1)
0154    {
0155       //
0156       // If we don't shift to 0 <= v <= 1 we get
0157       // cancellation errors later on.  Use
0158       // A&S 17.7.15/16 to shift to v > 0.
0159       //
0160       // Mathematica simplifies the expressions
0161       // given in A&S as follows (with thanks to
0162       // Rocco Romeo for figuring these out!):
0163       //
0164       // V = (k2 - n)/(1 - n)
0165       // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[Sqrt[(1 - V)*(1 - k2 / V)] / Sqrt[((1 - n)*(1 - k2 / n))]]]
0166       // Result: ((-1 + k2) n) / ((-1 + n) (-k2 + n))
0167       //
0168       // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[k2 / (Sqrt[-n*(k2 - n) / (1 - n)] * Sqrt[(1 - n)*(1 - k2 / n)])]]
0169       // Result : k2 / (k2 - n)
0170       //
0171       // Assuming[(k2 >= 0 && k2 <= 1) && n < 0, FullSimplify[Sqrt[1 / ((1 - n)*(1 - k2 / n))]]]
0172       // Result : Sqrt[n / ((k2 - n) (-1 + n))]
0173       //
0174       T k2 = k * k;
0175       T N = (k2 - v) / (1 - v);
0176       T Nm1 = (1 - k2) / (1 - v);
0177       T p2 = -v * N;
0178       T t;
0179       if (p2 <= tools::min_value<T>())
0180       {
0181          p2 = sqrt(-v) * sqrt(N);
0182       }
0183       else
0184          p2 = sqrt(p2);
0185       T delta = sqrt(1 - k2 * sphi * sphi);
0186       if(N > k2)
0187       {
0188          result = ellint_pi_imp(N, phi, k, Nm1, pol);
0189          result *= v / (v - 1);
0190          result *= (k2 - 1) / (v - k2);
0191       }
0192 
0193       if(k != 0)
0194       {
0195          t = ellint_f_imp(phi, k, pol);
0196          t *= k2 / (k2 - v);
0197          result += t;
0198       }
0199       t = v / ((k2 - v) * (v - 1));
0200       if(t > tools::min_value<T>())
0201       {
0202          result += atan((p2 / 2) * sin(2 * phi) / delta) * sqrt(t);
0203       }
0204       else
0205       {
0206          result += atan((p2 / 2) * sin(2 * phi) / delta) * sqrt(fabs(1 / (k2 - v))) * sqrt(fabs(v / (v - 1)));
0207       }
0208       return result;
0209    }
0210    if(k == 1)
0211    {
0212       // See http://functions.wolfram.com/08.06.03.0013.01
0213       result = sqrt(v) * atanh(sqrt(v) * sin(phi), pol) - log(1 / cos(phi) + tan(phi));
0214       result /= v - 1;
0215       return result;
0216    }
0217 #if 0  // disabled but retained for future reference: see below.
0218    if(v > 1)
0219    {
0220       //
0221       // If v > 1 we can use the identity in A&S 17.7.7/8
0222       // to shift to 0 <= v <= 1.  In contrast to previous
0223       // revisions of this header, this identity does now work
0224       // but appears not to produce better error rates in 
0225       // practice.  Archived here for future reference...
0226       //
0227       T k2 = k * k;
0228       T N = k2 / v;
0229       T Nm1 = (v - k2) / v;
0230       T p1 = sqrt((-vc) * (1 - k2 / v));
0231       T delta = sqrt(1 - k2 * sphi * sphi);
0232       //
0233       // These next two terms have a large amount of cancellation
0234       // so it's not clear if this relation is useable even if
0235       // the issues with phi > pi/2 can be fixed:
0236       //
0237       result = -ellint_pi_imp(N, phi, k, Nm1, pol);
0238       result += ellint_f_imp(phi, k, pol);
0239       //
0240       // This log term gives the complex result when
0241       //     n > 1/sin^2(phi)
0242       // However that case is dealt with as an error above, 
0243       // so we should always get a real result here:
0244       //
0245       result += log((delta + p1 * tan(phi)) / (delta - p1 * tan(phi))) / (2 * p1);
0246       return result;
0247    }
0248 #endif
0249    //
0250    // Carlson's algorithm works only for |phi| <= pi/2,
0251    // by the time we get here phi should already have been
0252    // normalised above.
0253    //
0254    BOOST_MATH_ASSERT(fabs(phi) < constants::half_pi<T>());
0255    BOOST_MATH_ASSERT(phi >= 0);
0256    T x, y, z, p, t;
0257    T cosp = cos(phi);
0258    x = cosp * cosp;
0259    t = sphi * sphi;
0260    y = 1 - k * k * t;
0261    z = 1;
0262    if(v * t < T(0.5))
0263       p = 1 - v * t;
0264    else
0265       p = x + vc * t;
0266    result = sphi * (ellint_rf_imp(x, y, z, pol) + v * t * ellint_rj_imp(x, y, z, p, pol) / 3);
0267 
0268    return result;
0269 }
0270 
0271 // Complete elliptic integral (Legendre form) of the third kind
0272 template <typename T, typename Policy>
0273 T ellint_pi_imp(T v, T k, T vc, const Policy& pol)
0274 {
0275     // Note arg vc = 1-v, possibly without cancellation errors
0276     BOOST_MATH_STD_USING
0277     using namespace boost::math::tools;
0278 
0279     static const char* function = "boost::math::ellint_pi<%1%>(%1%,%1%)";
0280 
0281     if (abs(k) >= 1)
0282     {
0283        return policies::raise_domain_error<T>(function, "Got k = %1%, function requires |k| <= 1", k, pol);
0284     }
0285     if(vc <= 0)
0286     {
0287        // Result is complex:
0288        return policies::raise_domain_error<T>(function, "Got v = %1%, function requires v < 1", v, pol);
0289     }
0290 
0291     if(v == 0)
0292     {
0293        return (k == 0) ? boost::math::constants::pi<T>() / 2 : boost::math::ellint_1(k, pol);
0294     }
0295 
0296     if(v < 0)
0297     {
0298        // Apply A&S 17.7.17:
0299        T k2 = k * k;
0300        T N = (k2 - v) / (1 - v);
0301        T Nm1 = (1 - k2) / (1 - v);
0302        T result = 0;
0303        result = boost::math::detail::ellint_pi_imp(N, k, Nm1, pol);
0304        // This next part is split in two to avoid spurious over/underflow:
0305        result *= -v / (1 - v);
0306        result *= (1 - k2) / (k2 - v);
0307        result += boost::math::ellint_1(k, pol) * k2 / (k2 - v);
0308        return result;
0309     }
0310 
0311     T x = 0;
0312     T y = 1 - k * k;
0313     T z = 1;
0314     T p = vc;
0315     T value = ellint_rf_imp(x, y, z, pol) + v * ellint_rj_imp(x, y, z, p, pol) / 3;
0316 
0317     return value;
0318 }
0319 
0320 template <class T1, class T2, class T3>
0321 inline typename tools::promote_args<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi, const std::false_type&)
0322 {
0323    return boost::math::ellint_3(k, v, phi, policies::policy<>());
0324 }
0325 
0326 template <class T1, class T2, class Policy>
0327 inline typename tools::promote_args<T1, T2>::type ellint_3(T1 k, T2 v, const Policy& pol, const std::true_type&)
0328 {
0329    typedef typename tools::promote_args<T1, T2>::type result_type;
0330    typedef typename policies::evaluation<result_type, Policy>::type value_type;
0331    return policies::checked_narrowing_cast<result_type, Policy>(
0332       detail::ellint_pi_imp(
0333          static_cast<value_type>(v), 
0334          static_cast<value_type>(k),
0335          static_cast<value_type>(1-v),
0336          pol), "boost::math::ellint_3<%1%>(%1%,%1%)");
0337 }
0338 
0339 } // namespace detail
0340 
0341 template <class T1, class T2, class T3, class Policy>
0342 inline typename tools::promote_args<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi, const Policy&)
0343 {
0344    typedef typename tools::promote_args<T1, T2, T3>::type result_type;
0345    typedef typename policies::evaluation<result_type, Policy>::type value_type;
0346    typedef typename policies::normalise<Policy, policies::promote_float<false>, policies::promote_double<false> >::type forwarding_policy;
0347    return policies::checked_narrowing_cast<result_type, Policy>(
0348       detail::ellint_pi_imp(
0349          static_cast<value_type>(v), 
0350          static_cast<value_type>(phi), 
0351          static_cast<value_type>(k),
0352          static_cast<value_type>(1-v),
0353          forwarding_policy()), "boost::math::ellint_3<%1%>(%1%,%1%,%1%)");
0354 }
0355 
0356 template <class T1, class T2, class T3>
0357 typename detail::ellint_3_result<T1, T2, T3>::type ellint_3(T1 k, T2 v, T3 phi)
0358 {
0359    typedef typename policies::is_policy<T3>::type tag_type;
0360    return detail::ellint_3(k, v, phi, tag_type());
0361 }
0362 
0363 template <class T1, class T2>
0364 inline typename tools::promote_args<T1, T2>::type ellint_3(T1 k, T2 v)
0365 {
0366    return ellint_3(k, v, policies::policy<>());
0367 }
0368 
0369 }} // namespaces
0370 
0371 #endif // BOOST_MATH_ELLINT_3_HPP
0372
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!