ellik.c 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137
  1. /* ellik.c
  2. *
  3. * Incomplete elliptic integral of the first kind
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double phi, m, y, ellik();
  10. *
  11. * y = ellik( phi, m );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Approximates the integral
  18. *
  19. *
  20. *
  21. * phi
  22. * -
  23. * | |
  24. * | dt
  25. * F(phi_\m) = | ------------------
  26. * | 2
  27. * | | sqrt( 1 - m sin t )
  28. * -
  29. * 0
  30. *
  31. * of amplitude phi and modulus m, using the arithmetic -
  32. * geometric mean algorithm.
  33. *
  34. *
  35. *
  36. *
  37. * ACCURACY:
  38. *
  39. * Tested at random points with m in [0, 1] and phi as indicated.
  40. *
  41. * Relative error:
  42. * arithmetic domain # trials peak rms
  43. * IEEE -10,10 200000 7.4e-16 1.0e-16
  44. *
  45. *
  46. */
  47. /*
  48. Cephes Math Library Release 2.8: June, 2000
  49. Copyright 1984, 1987, 2000 by Stephen L. Moshier
  50. */
  51. /* Incomplete elliptic integral of first kind */
  52. #include "mconf.h"
  53. #ifdef ANSIPROT
  54. extern double sqrt(double);
  55. extern double fabs(double);
  56. extern double log(double);
  57. extern double tan(double);
  58. extern double atan(double);
  59. extern double floor(double);
  60. extern double ellpk(double);
  61. double ellik(double, double);
  62. #else
  63. double sqrt(), fabs(), log(), tan(), atan(), floor(), ellpk();
  64. double ellik();
  65. #endif
  66. extern double PI, PIO2, MACHEP, MAXNUM;
  67. double ellik(phi, m) double phi, m;
  68. {
  69. double a, b, c, e, temp, t, K;
  70. int d, mod, sign, npio2;
  71. if (m == 0.0)
  72. return (phi);
  73. a = 1.0 - m;
  74. if (a == 0.0) {
  75. if (fabs(phi) >= PIO2) {
  76. mtherr("ellik", SING);
  77. return (MAXNUM);
  78. }
  79. return (log(tan((PIO2 + phi) / 2.0)));
  80. }
  81. npio2 = floor(phi / PIO2);
  82. if (npio2 & 1)
  83. npio2 += 1;
  84. if (npio2) {
  85. K = ellpk(a);
  86. phi = phi - npio2 * PIO2;
  87. } else
  88. K = 0.0;
  89. if (phi < 0.0) {
  90. phi = -phi;
  91. sign = -1;
  92. } else
  93. sign = 0;
  94. b = sqrt(a);
  95. t = tan(phi);
  96. if (fabs(t) > 10.0) {
  97. /* Transform the amplitude */
  98. e = 1.0 / (b * t);
  99. /* ... but avoid multiple recursions. */
  100. if (fabs(e) < 10.0) {
  101. e = atan(e);
  102. if (npio2 == 0)
  103. K = ellpk(a);
  104. temp = K - ellik(e, m);
  105. goto done;
  106. }
  107. }
  108. a = 1.0;
  109. c = sqrt(m);
  110. d = 1;
  111. mod = 0;
  112. while (fabs(c / a) > MACHEP) {
  113. temp = b / a;
  114. phi = phi + atan(t * temp) + mod * PI;
  115. mod = (phi + PIO2) / PI;
  116. t = t * (1.0 + temp) / (1.0 - temp * t * t);
  117. c = (a - b) / 2.0;
  118. temp = sqrt(a * b);
  119. a = (a + b) / 2.0;
  120. b = temp;
  121. d += d;
  122. }
  123. temp = (atan(t) + mod * PI) / (d * a);
  124. done:
  125. if (sign < 0)
  126. temp = -temp;
  127. temp += npio2 * K;
  128. return (temp);
  129. }