kn.c 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231
  1. /* kn.c
  2. *
  3. * Modified Bessel function, third kind, integer order
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, kn();
  10. * int n;
  11. *
  12. * y = kn( n, x );
  13. *
  14. *
  15. *
  16. * DESCRIPTION:
  17. *
  18. * Returns modified Bessel function of the third kind
  19. * of order n of the argument.
  20. *
  21. * The range is partitioned into the two intervals [0,9.55] and
  22. * (9.55, infinity). An ascending power series is used in the
  23. * low range, and an asymptotic expansion in the high range.
  24. *
  25. *
  26. *
  27. * ACCURACY:
  28. *
  29. * Relative error:
  30. * arithmetic domain # trials peak rms
  31. * DEC 0,30 3000 1.3e-9 5.8e-11
  32. * IEEE 0,30 90000 1.8e-8 3.0e-10
  33. *
  34. * Error is high only near the crossover point x = 9.55
  35. * between the two expansions used.
  36. */
  37. /*
  38. Cephes Math Library Release 2.8: June, 2000
  39. Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
  40. */
  41. /*
  42. Algorithm for Kn.
  43. n-1
  44. -n - (n-k-1)! 2 k
  45. K (x) = 0.5 (x/2) > -------- (-x /4)
  46. n - k!
  47. k=0
  48. inf. 2 k
  49. n n - (x /4)
  50. + (-1) 0.5(x/2) > {p(k+1) + p(n+k+1) - 2log(x/2)} ---------
  51. - k! (n+k)!
  52. k=0
  53. where p(m) is the psi function: p(1) = -EUL and
  54. m-1
  55. -
  56. p(m) = -EUL + > 1/k
  57. -
  58. k=1
  59. For large x,
  60. 2 2 2
  61. u-1 (u-1 )(u-3 )
  62. K (z) = sqrt(pi/2z) exp(-z) { 1 + ------- + ------------ + ...}
  63. v 1 2
  64. 1! (8z) 2! (8z)
  65. asymptotically, where
  66. 2
  67. u = 4 v .
  68. */
  69. #include "mconf.h"
  70. #define EUL 5.772156649015328606065e-1
  71. #define MAXFAC 31
  72. #ifdef ANSIPROT
  73. extern double fabs(double);
  74. extern double exp(double);
  75. extern double log(double);
  76. extern double sqrt(double);
  77. #else
  78. double fabs(), exp(), log(), sqrt();
  79. #endif
  80. extern double MACHEP, MAXNUM, MAXLOG, PI;
  81. double kn(nn, x) int nn;
  82. double x;
  83. {
  84. double k, kf, nk1f, nkf, zn, t, s, z0, z;
  85. double ans, fn, pn, pk, zmn, tlg, tox;
  86. int i, n;
  87. if (nn < 0)
  88. n = -nn;
  89. else
  90. n = nn;
  91. if (n > MAXFAC) {
  92. overf:
  93. mtherr("kn", OVERFLOW);
  94. return (MAXNUM);
  95. }
  96. if (x <= 0.0) {
  97. if (x < 0.0)
  98. mtherr("kn", DOMAIN);
  99. else
  100. mtherr("kn", SING);
  101. return (MAXNUM);
  102. }
  103. if (x > 9.55)
  104. goto asymp;
  105. ans = 0.0;
  106. z0 = 0.25 * x * x;
  107. fn = 1.0;
  108. pn = 0.0;
  109. zmn = 1.0;
  110. tox = 2.0 / x;
  111. if (n > 0) {
  112. /* compute factorial of n and psi(n) */
  113. pn = -EUL;
  114. k = 1.0;
  115. for (i = 1; i < n; i++) {
  116. pn += 1.0 / k;
  117. k += 1.0;
  118. fn *= k;
  119. }
  120. zmn = tox;
  121. if (n == 1) {
  122. ans = 1.0 / x;
  123. } else {
  124. nk1f = fn / n;
  125. kf = 1.0;
  126. s = nk1f;
  127. z = -z0;
  128. zn = 1.0;
  129. for (i = 1; i < n; i++) {
  130. nk1f = nk1f / (n - i);
  131. kf = kf * i;
  132. zn *= z;
  133. t = nk1f * zn / kf;
  134. s += t;
  135. if ((MAXNUM - fabs(t)) < fabs(s))
  136. goto overf;
  137. if ((tox > 1.0) && ((MAXNUM / tox) < zmn))
  138. goto overf;
  139. zmn *= tox;
  140. }
  141. s *= 0.5;
  142. t = fabs(s);
  143. if ((zmn > 1.0) && ((MAXNUM / zmn) < t))
  144. goto overf;
  145. if ((t > 1.0) && ((MAXNUM / t) < zmn))
  146. goto overf;
  147. ans = s * zmn;
  148. }
  149. }
  150. tlg = 2.0 * log(0.5 * x);
  151. pk = -EUL;
  152. if (n == 0) {
  153. pn = pk;
  154. t = 1.0;
  155. } else {
  156. pn = pn + 1.0 / n;
  157. t = 1.0 / fn;
  158. }
  159. s = (pk + pn - tlg) * t;
  160. k = 1.0;
  161. do {
  162. t *= z0 / (k * (k + n));
  163. pk += 1.0 / k;
  164. pn += 1.0 / (k + n);
  165. s += (pk + pn - tlg) * t;
  166. k += 1.0;
  167. } while (fabs(t / s) > MACHEP);
  168. s = 0.5 * s / zmn;
  169. if (n & 1)
  170. s = -s;
  171. ans += s;
  172. return (ans);
  173. /* Asymptotic expansion for Kn(x) */
  174. /* Converges to 1.4e-17 for x > 18.4 */
  175. asymp:
  176. if (x > MAXLOG) {
  177. mtherr("kn", UNDERFLOW);
  178. return (0.0);
  179. }
  180. k = n;
  181. pn = 4.0 * k * k;
  182. pk = 1.0;
  183. z0 = 8.0 * x;
  184. fn = 1.0;
  185. t = 1.0;
  186. s = t;
  187. nkf = MAXNUM;
  188. i = 0;
  189. do {
  190. z = pn - pk * pk;
  191. t = t * z / (fn * z0);
  192. nk1f = fabs(t);
  193. if ((i >= n) && (nk1f > nkf)) {
  194. goto adone;
  195. }
  196. nkf = nk1f;
  197. s += t;
  198. fn += 1.0;
  199. pk += 2.0;
  200. i += 1;
  201. } while (fabs(t / s) > MACHEP);
  202. adone:
  203. ans = exp(-x) * sqrt(PI / (2.0 * x)) * s;
  204. return (ans);
  205. }