123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282 |
- /* struve.c
- *
- * Struve function
- *
- *
- *
- * SYNOPSIS:
- *
- * double v, x, y, struve();
- *
- * y = struve( v, x );
- *
- *
- *
- * DESCRIPTION:
- *
- * Computes the Struve function Hv(x) of order v, argument x.
- * Negative x is rejected unless v is an integer.
- *
- * This module also contains the hypergeometric functions 1F2
- * and 3F0 and a routine for the Bessel function Yv(x) with
- * noninteger v.
- *
- *
- *
- * ACCURACY:
- *
- * Not accurately characterized, but spot checked against tables.
- *
- */
- /*
- Cephes Math Library Release 2.81: June, 2000
- Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
- */
- #include "mconf.h"
- #define DEBUG 0
- #ifdef ANSIPROT
- extern double gamma(double);
- extern double pow(double, double);
- extern double sqrt(double);
- extern double yn(int, double);
- extern double jv(double, double);
- extern double fabs(double);
- extern double floor(double);
- extern double sin(double);
- extern double cos(double);
- double yv(double, double);
- double onef2(double, double, double, double, double *);
- double threef0(double, double, double, double, double *);
- #else
- double gamma(), pow(), sqrt(), yn(), yv(), jv(), fabs(), floor();
- double sin(), cos();
- double onef2(), threef0();
- #endif
- static double stop = 1.37e-17;
- extern double MACHEP;
- double onef2(a, b, c, x, err) double a, b, c, x;
- double *err;
- {
- double n, a0, sum, t;
- double an, bn, cn, max, z;
- an = a;
- bn = b;
- cn = c;
- a0 = 1.0;
- sum = 1.0;
- n = 1.0;
- t = 1.0;
- max = 0.0;
- do {
- if (an == 0)
- goto done;
- if (bn == 0)
- goto error;
- if (cn == 0)
- goto error;
- if ((a0 > 1.0e34) || (n > 200))
- goto error;
- a0 *= (an * x) / (bn * cn * n);
- sum += a0;
- an += 1.0;
- bn += 1.0;
- cn += 1.0;
- n += 1.0;
- z = fabs(a0);
- if (z > max)
- max = z;
- if (sum != 0)
- t = fabs(a0 / sum);
- else
- t = z;
- } while (t > stop);
- done:
- *err = fabs(MACHEP * max / sum);
- #if DEBUG
- printf(" onef2 cancellation error %.5E\n", *err);
- #endif
- goto xit;
- error:
- #if DEBUG
- printf("onef2 does not converge\n");
- #endif
- *err = 1.0e38;
- xit:
- #if DEBUG
- printf("onef2( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
- #endif
- return (sum);
- }
- double threef0(a, b, c, x, err) double a, b, c, x;
- double *err;
- {
- double n, a0, sum, t, conv, conv1;
- double an, bn, cn, max, z;
- an = a;
- bn = b;
- cn = c;
- a0 = 1.0;
- sum = 1.0;
- n = 1.0;
- t = 1.0;
- max = 0.0;
- conv = 1.0e38;
- conv1 = conv;
- do {
- if (an == 0.0)
- goto done;
- if (bn == 0.0)
- goto done;
- if (cn == 0.0)
- goto done;
- if ((a0 > 1.0e34) || (n > 200))
- goto error;
- a0 *= (an * bn * cn * x) / n;
- an += 1.0;
- bn += 1.0;
- cn += 1.0;
- n += 1.0;
- z = fabs(a0);
- if (z > max)
- max = z;
- if (z >= conv) {
- if ((z < max) && (z > conv1))
- goto done;
- }
- conv1 = conv;
- conv = z;
- sum += a0;
- if (sum != 0)
- t = fabs(a0 / sum);
- else
- t = z;
- } while (t > stop);
- done:
- t = fabs(MACHEP * max / sum);
- #if DEBUG
- printf(" threef0 cancellation error %.5E\n", t);
- #endif
- max = fabs(conv / sum);
- if (max > t)
- t = max;
- #if DEBUG
- printf(" threef0 convergence %.5E\n", max);
- #endif
- goto xit;
- error:
- #if DEBUG
- printf("threef0 does not converge\n");
- #endif
- t = 1.0e38;
- xit:
- #if DEBUG
- printf("threef0( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
- #endif
- *err = t;
- return (sum);
- }
- extern double PI;
- double struve(v, x) double v, x;
- {
- double y, ya, f, g, h, t;
- double onef2err, threef0err;
- f = floor(v);
- if ((v < 0) && (v - f == 0.5)) {
- y = jv(-v, x);
- f = 1.0 - f;
- g = 2.0 * floor(f / 2.0);
- if (g != f)
- y = -y;
- return (y);
- }
- t = 0.25 * x * x;
- f = fabs(x);
- g = 1.5 * fabs(v);
- if ((f > 30.0) && (f > g)) {
- onef2err = 1.0e38;
- y = 0.0;
- } else {
- y = onef2(1.0, 1.5, 1.5 + v, -t, &onef2err);
- }
- if ((f < 18.0) || (x < 0.0)) {
- threef0err = 1.0e38;
- ya = 0.0;
- } else {
- ya = threef0(1.0, 0.5, 0.5 - v, -1.0 / t, &threef0err);
- }
- f = sqrt(PI);
- h = pow(0.5 * x, v - 1.0);
- if (onef2err <= threef0err) {
- g = gamma(v + 1.5);
- y = y * h * t / (0.5 * f * g);
- return (y);
- } else {
- g = gamma(v + 0.5);
- ya = ya * h / (f * g);
- ya = ya + yv(v, x);
- return (ya);
- }
- }
- /* Bessel function of noninteger order
- */
- double yv(v, x) double v, x;
- {
- double y, t;
- int n;
- y = floor(v);
- if (y == v) {
- n = v;
- y = yn(n, x);
- return (y);
- }
- t = PI * v;
- y = (cos(t) * jv(v, x) - jv(-v, x)) / sin(t);
- return (y);
- }
- /* Crossover points between ascending series and asymptotic series
- * for Struve function
- *
- * v x
- *
- * 0 19.2
- * 1 18.95
- * 2 19.15
- * 3 19.3
- * 5 19.7
- * 10 21.35
- * 20 26.35
- * 30 32.31
- * 40 40.0
- */
|