123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231 |
- /* kn.c
- *
- * Modified Bessel function, third kind, integer order
- *
- *
- *
- * SYNOPSIS:
- *
- * double x, y, kn();
- * int n;
- *
- * y = kn( n, x );
- *
- *
- *
- * DESCRIPTION:
- *
- * Returns modified Bessel function of the third kind
- * of order n of the argument.
- *
- * The range is partitioned into the two intervals [0,9.55] and
- * (9.55, infinity). An ascending power series is used in the
- * low range, and an asymptotic expansion in the high range.
- *
- *
- *
- * ACCURACY:
- *
- * Relative error:
- * arithmetic domain # trials peak rms
- * DEC 0,30 3000 1.3e-9 5.8e-11
- * IEEE 0,30 90000 1.8e-8 3.0e-10
- *
- * Error is high only near the crossover point x = 9.55
- * between the two expansions used.
- */
- /*
- Cephes Math Library Release 2.8: June, 2000
- Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
- */
- /*
- Algorithm for Kn.
- n-1
- -n - (n-k-1)! 2 k
- K (x) = 0.5 (x/2) > -------- (-x /4)
- n - k!
- k=0
- inf. 2 k
- n n - (x /4)
- + (-1) 0.5(x/2) > {p(k+1) + p(n+k+1) - 2log(x/2)} ---------
- - k! (n+k)!
- k=0
- where p(m) is the psi function: p(1) = -EUL and
- m-1
- -
- p(m) = -EUL + > 1/k
- -
- k=1
- For large x,
- 2 2 2
- u-1 (u-1 )(u-3 )
- K (z) = sqrt(pi/2z) exp(-z) { 1 + ------- + ------------ + ...}
- v 1 2
- 1! (8z) 2! (8z)
- asymptotically, where
- 2
- u = 4 v .
- */
- #include "mconf.h"
- #define EUL 5.772156649015328606065e-1
- #define MAXFAC 31
- #ifdef ANSIPROT
- extern double fabs(double);
- extern double exp(double);
- extern double log(double);
- extern double sqrt(double);
- #else
- double fabs(), exp(), log(), sqrt();
- #endif
- extern double MACHEP, MAXNUM, MAXLOG, PI;
- double kn(nn, x) int nn;
- double x;
- {
- double k, kf, nk1f, nkf, zn, t, s, z0, z;
- double ans, fn, pn, pk, zmn, tlg, tox;
- int i, n;
- if (nn < 0)
- n = -nn;
- else
- n = nn;
- if (n > MAXFAC) {
- overf:
- mtherr("kn", OVERFLOW);
- return (MAXNUM);
- }
- if (x <= 0.0) {
- if (x < 0.0)
- mtherr("kn", DOMAIN);
- else
- mtherr("kn", SING);
- return (MAXNUM);
- }
- if (x > 9.55)
- goto asymp;
- ans = 0.0;
- z0 = 0.25 * x * x;
- fn = 1.0;
- pn = 0.0;
- zmn = 1.0;
- tox = 2.0 / x;
- if (n > 0) {
- /* compute factorial of n and psi(n) */
- pn = -EUL;
- k = 1.0;
- for (i = 1; i < n; i++) {
- pn += 1.0 / k;
- k += 1.0;
- fn *= k;
- }
- zmn = tox;
- if (n == 1) {
- ans = 1.0 / x;
- } else {
- nk1f = fn / n;
- kf = 1.0;
- s = nk1f;
- z = -z0;
- zn = 1.0;
- for (i = 1; i < n; i++) {
- nk1f = nk1f / (n - i);
- kf = kf * i;
- zn *= z;
- t = nk1f * zn / kf;
- s += t;
- if ((MAXNUM - fabs(t)) < fabs(s))
- goto overf;
- if ((tox > 1.0) && ((MAXNUM / tox) < zmn))
- goto overf;
- zmn *= tox;
- }
- s *= 0.5;
- t = fabs(s);
- if ((zmn > 1.0) && ((MAXNUM / zmn) < t))
- goto overf;
- if ((t > 1.0) && ((MAXNUM / t) < zmn))
- goto overf;
- ans = s * zmn;
- }
- }
- tlg = 2.0 * log(0.5 * x);
- pk = -EUL;
- if (n == 0) {
- pn = pk;
- t = 1.0;
- } else {
- pn = pn + 1.0 / n;
- t = 1.0 / fn;
- }
- s = (pk + pn - tlg) * t;
- k = 1.0;
- do {
- t *= z0 / (k * (k + n));
- pk += 1.0 / k;
- pn += 1.0 / (k + n);
- s += (pk + pn - tlg) * t;
- k += 1.0;
- } while (fabs(t / s) > MACHEP);
- s = 0.5 * s / zmn;
- if (n & 1)
- s = -s;
- ans += s;
- return (ans);
- /* Asymptotic expansion for Kn(x) */
- /* Converges to 1.4e-17 for x > 18.4 */
- asymp:
- if (x > MAXLOG) {
- mtherr("kn", UNDERFLOW);
- return (0.0);
- }
- k = n;
- pn = 4.0 * k * k;
- pk = 1.0;
- z0 = 8.0 * x;
- fn = 1.0;
- t = 1.0;
- s = t;
- nkf = MAXNUM;
- i = 0;
- do {
- z = pn - pk * pk;
- t = t * z / (fn * z0);
- nk1f = fabs(t);
- if ((i >= n) && (nk1f > nkf)) {
- goto adone;
- }
- nkf = nk1f;
- s += t;
- fn += 1.0;
- pk += 2.0;
- i += 1;
- } while (fabs(t / s) > MACHEP);
- adone:
- ans = exp(-x) * sqrt(PI / (2.0 * x)) * s;
- return (ans);
- }
|