ellie.c 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. /* ellie.c
  2. *
  3. * Incomplete elliptic integral of the second kind
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double phi, m, y, ellie();
  10. *
  11. * y = ellie( 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. * DEC 0,2 2000 1.9e-16 3.4e-17
  42. * IEEE -10,10 150000 3.3e-15 1.4e-16
  43. *
  44. *
  45. */
  46. /*
  47. Cephes Math Library Release 2.8: June, 2000
  48. Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier
  49. */
  50. /* Incomplete elliptic integral of second kind */
  51. #include <math.h>
  52. extern double PI, PIO2, MACHEP;
  53. #ifdef ANSIPROT
  54. extern double sqrt ( double );
  55. extern double fabs ( double );
  56. extern double log ( double );
  57. extern double sin ( double x );
  58. extern double tan ( double x );
  59. extern double atan ( double );
  60. extern double floor ( double );
  61. extern double ellpe ( double );
  62. extern double ellpk ( double );
  63. double ellie ( double, double );
  64. #else
  65. double sqrt(), fabs(), log(), sin(), tan(), atan(), floor();
  66. double ellpe(), ellpk(), ellie();
  67. #endif
  68. double ellie( phi, m )
  69. double phi, m;
  70. {
  71. double a, b, c, e, temp;
  72. double lphi, t, E;
  73. int d, mod, npio2, sign;
  74. if( m == 0.0 )
  75. return( phi );
  76. lphi = phi;
  77. npio2 = floor( lphi/PIO2 );
  78. if( npio2 & 1 )
  79. npio2 += 1;
  80. lphi = lphi - npio2 * PIO2;
  81. if( lphi < 0.0 )
  82. {
  83. lphi = -lphi;
  84. sign = -1;
  85. }
  86. else
  87. {
  88. sign = 1;
  89. }
  90. a = 1.0 - m;
  91. E = ellpe( a );
  92. if( a == 0.0 )
  93. {
  94. temp = sin( lphi );
  95. goto done;
  96. }
  97. t = tan( lphi );
  98. b = sqrt(a);
  99. /* Thanks to Brian Fitzgerald <fitzgb@mml0.meche.rpi.edu>
  100. for pointing out an instability near odd multiples of pi/2. */
  101. if( fabs(t) > 10.0 )
  102. {
  103. /* Transform the amplitude */
  104. e = 1.0/(b*t);
  105. /* ... but avoid multiple recursions. */
  106. if( fabs(e) < 10.0 )
  107. {
  108. e = atan(e);
  109. temp = E + m * sin( lphi ) * sin( e ) - ellie( e, m );
  110. goto done;
  111. }
  112. }
  113. c = sqrt(m);
  114. a = 1.0;
  115. d = 1;
  116. e = 0.0;
  117. mod = 0;
  118. while( fabs(c/a) > MACHEP )
  119. {
  120. temp = b/a;
  121. lphi = lphi + atan(t*temp) + mod * PI;
  122. mod = (lphi + PIO2)/PI;
  123. t = t * ( 1.0 + temp )/( 1.0 - temp * t * t );
  124. c = ( a - b )/2.0;
  125. temp = sqrt( a * b );
  126. a = ( a + b )/2.0;
  127. b = temp;
  128. d += d;
  129. e += c * sin(lphi);
  130. }
  131. temp = E / ellpk( 1.0 - m );
  132. temp *= (atan(t) + mod * PI)/(d * a);
  133. temp += e;
  134. done:
  135. if( sign < 0 )
  136. temp = -temp;
  137. temp += npio2 * E;
  138. return( temp );
  139. }