expn.c 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  1. /* expn.c
  2. *
  3. * Exponential integral En
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * int n;
  10. * double x, y, expn();
  11. *
  12. * y = expn( n, x );
  13. *
  14. *
  15. *
  16. * DESCRIPTION:
  17. *
  18. * Evaluates the exponential integral
  19. *
  20. * inf.
  21. * -
  22. * | | -xt
  23. * | e
  24. * E (x) = | ---- dt.
  25. * n | n
  26. * | | t
  27. * -
  28. * 1
  29. *
  30. *
  31. * Both n and x must be nonnegative.
  32. *
  33. * The routine employs either a power series, a continued
  34. * fraction, or an asymptotic formula depending on the
  35. * relative values of n and x.
  36. *
  37. * ACCURACY:
  38. *
  39. * Relative error:
  40. * arithmetic domain # trials peak rms
  41. * DEC 0, 30 5000 2.0e-16 4.6e-17
  42. * IEEE 0, 30 10000 1.7e-15 3.6e-16
  43. *
  44. */
  45. /* expn.c */
  46. /* Cephes Math Library Release 2.8: June, 2000
  47. Copyright 1985, 2000 by Stephen L. Moshier */
  48. #include "mconf.h"
  49. #ifdef ANSIPROT
  50. extern double pow(double, double);
  51. extern double gamma(double);
  52. extern double log(double);
  53. extern double exp(double);
  54. extern double fabs(double);
  55. #else
  56. double pow(), gamma(), log(), exp(), fabs();
  57. #endif
  58. #define EUL 0.57721566490153286060
  59. #define BIG 1.44115188075855872E+17
  60. extern double MAXNUM, MACHEP, MAXLOG;
  61. double expn(n, x) int n;
  62. double x;
  63. {
  64. double ans, r, t, yk, xk;
  65. double pk, pkm1, pkm2, qk, qkm1, qkm2;
  66. double psi, z;
  67. int i, k;
  68. static double big = BIG;
  69. if (n < 0)
  70. goto domerr;
  71. if (x < 0) {
  72. domerr:
  73. mtherr("expn", DOMAIN);
  74. return (MAXNUM);
  75. }
  76. if (x > MAXLOG)
  77. return (0.0);
  78. if (x == 0.0) {
  79. if (n < 2) {
  80. mtherr("expn", SING);
  81. return (MAXNUM);
  82. } else
  83. return (1.0 / (n - 1.0));
  84. }
  85. if (n == 0)
  86. return (exp(-x) / x);
  87. /* expn.c */
  88. /* Expansion for large n */
  89. if (n > 5000) {
  90. xk = x + n;
  91. yk = 1.0 / (xk * xk);
  92. t = n;
  93. ans = yk * t * (6.0 * x * x - 8.0 * t * x + t * t);
  94. ans = yk * (ans + t * (t - 2.0 * x));
  95. ans = yk * (ans + t);
  96. ans = (ans + 1.0) * exp(-x) / xk;
  97. goto done;
  98. }
  99. if (x > 1.0)
  100. goto cfrac;
  101. /* expn.c */
  102. /* Power series expansion */
  103. psi = -EUL - log(x);
  104. for (i = 1; i < n; i++)
  105. psi = psi + 1.0 / i;
  106. z = -x;
  107. xk = 0.0;
  108. yk = 1.0;
  109. pk = 1.0 - n;
  110. if (n == 1)
  111. ans = 0.0;
  112. else
  113. ans = 1.0 / pk;
  114. do {
  115. xk += 1.0;
  116. yk *= z / xk;
  117. pk += 1.0;
  118. if (pk != 0.0) {
  119. ans += yk / pk;
  120. }
  121. if (ans != 0.0)
  122. t = fabs(yk / ans);
  123. else
  124. t = 1.0;
  125. } while (t > MACHEP);
  126. k = xk;
  127. t = n;
  128. r = n - 1;
  129. ans = (pow(z, r) * psi / gamma(t)) - ans;
  130. goto done;
  131. /* expn.c */
  132. /* continued fraction */
  133. cfrac:
  134. k = 1;
  135. pkm2 = 1.0;
  136. qkm2 = x;
  137. pkm1 = 1.0;
  138. qkm1 = x + n;
  139. ans = pkm1 / qkm1;
  140. do {
  141. k += 1;
  142. if (k & 1) {
  143. yk = 1.0;
  144. xk = n + (k - 1) / 2;
  145. } else {
  146. yk = x;
  147. xk = k / 2;
  148. }
  149. pk = pkm1 * yk + pkm2 * xk;
  150. qk = qkm1 * yk + qkm2 * xk;
  151. if (qk != 0) {
  152. r = pk / qk;
  153. t = fabs((ans - r) / r);
  154. ans = r;
  155. } else
  156. t = 1.0;
  157. pkm2 = pkm1;
  158. pkm1 = pk;
  159. qkm2 = qkm1;
  160. qkm1 = qk;
  161. if (fabs(pk) > big) {
  162. pkm2 /= big;
  163. pkm1 /= big;
  164. qkm2 /= big;
  165. qkm1 /= big;
  166. }
  167. } while (t > MACHEP);
  168. ans *= exp(-x);
  169. done:
  170. return (ans);
  171. }