elliel.c 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  1. /* elliel.c
  2. *
  3. * Incomplete elliptic integral of the second kind
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * long double phi, m, y, elliel();
  10. *
  11. * y = elliel( phi, m );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Approximates the integral
  18. *
  19. *
  20. * phi
  21. * -
  22. * | |
  23. * | 2
  24. * E(phi_\m) = | sqrt( 1 - m sin t ) dt
  25. * |
  26. * | |
  27. * -
  28. * 0
  29. *
  30. * of amplitude phi and modulus m, using the arithmetic -
  31. * geometric mean algorithm.
  32. *
  33. *
  34. *
  35. * ACCURACY:
  36. *
  37. * Tested at random arguments with phi in [-10, 10] and m in
  38. * [0, 1].
  39. * Relative error:
  40. * arithmetic domain # trials peak rms
  41. * IEEE -10,10 50000 2.7e-18 2.3e-19
  42. *
  43. *
  44. */
  45. /*
  46. Cephes Math Library Release 2.3: November, 1995
  47. Copyright 1984, 1987, 1993, 1995 by Stephen L. Moshier
  48. */
  49. /* Incomplete elliptic integral of second kind */
  50. #include <math.h>
  51. #ifdef ANSIPROT
  52. extern long double sqrtl ( long double );
  53. extern long double fabsl ( long double );
  54. extern long double logl ( long double );
  55. extern long double sinl ( long double );
  56. extern long double tanl ( long double );
  57. extern long double atanl ( long double );
  58. extern long double floorl ( long double );
  59. extern long double ellpel ( long double );
  60. extern long double ellpkl ( long double );
  61. long double elliel ( long double, long double );
  62. #else
  63. long double sqrtl(), fabsl(), logl(), sinl(), tanl(), atanl(), floorl();
  64. long double ellpel(), ellpkl(), elliel();
  65. #endif
  66. extern long double PIL, PIO2L, MACHEPL;
  67. long double elliel( phi, m )
  68. long double phi, m;
  69. {
  70. long double a, b, c, e, temp, lphi, t, E;
  71. int d, mod, npio2, sign;
  72. if( m == 0.0L )
  73. return( phi );
  74. lphi = phi;
  75. npio2 = floorl( lphi/PIO2L );
  76. if( npio2 & 1 )
  77. npio2 += 1;
  78. lphi = lphi - npio2 * PIO2L;
  79. if( lphi < 0.0L )
  80. {
  81. lphi = -lphi;
  82. sign = -1;
  83. }
  84. else
  85. {
  86. sign = 1;
  87. }
  88. a = 1.0L - m;
  89. E = ellpel( a );
  90. if( a == 0.0L )
  91. {
  92. temp = sinl( lphi );
  93. goto done;
  94. }
  95. t = tanl( lphi );
  96. b = sqrtl(a);
  97. if( fabsl(t) > 10.0L )
  98. {
  99. /* Transform the amplitude */
  100. e = 1.0L/(b*t);
  101. /* ... but avoid multiple recursions. */
  102. if( fabsl(e) < 10.0L )
  103. {
  104. e = atanl(e);
  105. temp = E + m * sinl( lphi ) * sinl( e ) - elliel( e, m );
  106. goto done;
  107. }
  108. }
  109. c = sqrtl(m);
  110. a = 1.0L;
  111. d = 1;
  112. e = 0.0L;
  113. mod = 0;
  114. while( fabsl(c/a) > MACHEPL )
  115. {
  116. temp = b/a;
  117. lphi = lphi + atanl(t*temp) + mod * PIL;
  118. mod = (lphi + PIO2L)/PIL;
  119. t = t * ( 1.0L + temp )/( 1.0L - temp * t * t );
  120. c = 0.5L*( a - b );
  121. temp = sqrtl( a * b );
  122. a = 0.5L*( a + b );
  123. b = temp;
  124. d += d;
  125. e += c * sinl(lphi);
  126. }
  127. temp = E / ellpkl( 1.0L - m );
  128. temp *= (atanl(t) + mod * PIL)/(d * a);
  129. temp += e;
  130. done:
  131. if( sign < 0 )
  132. temp = -temp;
  133. temp += npio2 * E;
  134. return( temp );
  135. }