struve.c 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282
  1. /* struve.c
  2. *
  3. * Struve function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double v, x, y, struve();
  10. *
  11. * y = struve( v, x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Computes the Struve function Hv(x) of order v, argument x.
  18. * Negative x is rejected unless v is an integer.
  19. *
  20. * This module also contains the hypergeometric functions 1F2
  21. * and 3F0 and a routine for the Bessel function Yv(x) with
  22. * noninteger v.
  23. *
  24. *
  25. *
  26. * ACCURACY:
  27. *
  28. * Not accurately characterized, but spot checked against tables.
  29. *
  30. */
  31. /*
  32. Cephes Math Library Release 2.81: June, 2000
  33. Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
  34. */
  35. #include "mconf.h"
  36. #define DEBUG 0
  37. #ifdef ANSIPROT
  38. extern double gamma(double);
  39. extern double pow(double, double);
  40. extern double sqrt(double);
  41. extern double yn(int, double);
  42. extern double jv(double, double);
  43. extern double fabs(double);
  44. extern double floor(double);
  45. extern double sin(double);
  46. extern double cos(double);
  47. double yv(double, double);
  48. double onef2(double, double, double, double, double *);
  49. double threef0(double, double, double, double, double *);
  50. #else
  51. double gamma(), pow(), sqrt(), yn(), yv(), jv(), fabs(), floor();
  52. double sin(), cos();
  53. double onef2(), threef0();
  54. #endif
  55. static double stop = 1.37e-17;
  56. extern double MACHEP;
  57. double onef2(a, b, c, x, err) double a, b, c, x;
  58. double *err;
  59. {
  60. double n, a0, sum, t;
  61. double an, bn, cn, max, z;
  62. an = a;
  63. bn = b;
  64. cn = c;
  65. a0 = 1.0;
  66. sum = 1.0;
  67. n = 1.0;
  68. t = 1.0;
  69. max = 0.0;
  70. do {
  71. if (an == 0)
  72. goto done;
  73. if (bn == 0)
  74. goto error;
  75. if (cn == 0)
  76. goto error;
  77. if ((a0 > 1.0e34) || (n > 200))
  78. goto error;
  79. a0 *= (an * x) / (bn * cn * n);
  80. sum += a0;
  81. an += 1.0;
  82. bn += 1.0;
  83. cn += 1.0;
  84. n += 1.0;
  85. z = fabs(a0);
  86. if (z > max)
  87. max = z;
  88. if (sum != 0)
  89. t = fabs(a0 / sum);
  90. else
  91. t = z;
  92. } while (t > stop);
  93. done:
  94. *err = fabs(MACHEP * max / sum);
  95. #if DEBUG
  96. printf(" onef2 cancellation error %.5E\n", *err);
  97. #endif
  98. goto xit;
  99. error:
  100. #if DEBUG
  101. printf("onef2 does not converge\n");
  102. #endif
  103. *err = 1.0e38;
  104. xit:
  105. #if DEBUG
  106. printf("onef2( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
  107. #endif
  108. return (sum);
  109. }
  110. double threef0(a, b, c, x, err) double a, b, c, x;
  111. double *err;
  112. {
  113. double n, a0, sum, t, conv, conv1;
  114. double an, bn, cn, max, z;
  115. an = a;
  116. bn = b;
  117. cn = c;
  118. a0 = 1.0;
  119. sum = 1.0;
  120. n = 1.0;
  121. t = 1.0;
  122. max = 0.0;
  123. conv = 1.0e38;
  124. conv1 = conv;
  125. do {
  126. if (an == 0.0)
  127. goto done;
  128. if (bn == 0.0)
  129. goto done;
  130. if (cn == 0.0)
  131. goto done;
  132. if ((a0 > 1.0e34) || (n > 200))
  133. goto error;
  134. a0 *= (an * bn * cn * x) / n;
  135. an += 1.0;
  136. bn += 1.0;
  137. cn += 1.0;
  138. n += 1.0;
  139. z = fabs(a0);
  140. if (z > max)
  141. max = z;
  142. if (z >= conv) {
  143. if ((z < max) && (z > conv1))
  144. goto done;
  145. }
  146. conv1 = conv;
  147. conv = z;
  148. sum += a0;
  149. if (sum != 0)
  150. t = fabs(a0 / sum);
  151. else
  152. t = z;
  153. } while (t > stop);
  154. done:
  155. t = fabs(MACHEP * max / sum);
  156. #if DEBUG
  157. printf(" threef0 cancellation error %.5E\n", t);
  158. #endif
  159. max = fabs(conv / sum);
  160. if (max > t)
  161. t = max;
  162. #if DEBUG
  163. printf(" threef0 convergence %.5E\n", max);
  164. #endif
  165. goto xit;
  166. error:
  167. #if DEBUG
  168. printf("threef0 does not converge\n");
  169. #endif
  170. t = 1.0e38;
  171. xit:
  172. #if DEBUG
  173. printf("threef0( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
  174. #endif
  175. *err = t;
  176. return (sum);
  177. }
  178. extern double PI;
  179. double struve(v, x) double v, x;
  180. {
  181. double y, ya, f, g, h, t;
  182. double onef2err, threef0err;
  183. f = floor(v);
  184. if ((v < 0) && (v - f == 0.5)) {
  185. y = jv(-v, x);
  186. f = 1.0 - f;
  187. g = 2.0 * floor(f / 2.0);
  188. if (g != f)
  189. y = -y;
  190. return (y);
  191. }
  192. t = 0.25 * x * x;
  193. f = fabs(x);
  194. g = 1.5 * fabs(v);
  195. if ((f > 30.0) && (f > g)) {
  196. onef2err = 1.0e38;
  197. y = 0.0;
  198. } else {
  199. y = onef2(1.0, 1.5, 1.5 + v, -t, &onef2err);
  200. }
  201. if ((f < 18.0) || (x < 0.0)) {
  202. threef0err = 1.0e38;
  203. ya = 0.0;
  204. } else {
  205. ya = threef0(1.0, 0.5, 0.5 - v, -1.0 / t, &threef0err);
  206. }
  207. f = sqrt(PI);
  208. h = pow(0.5 * x, v - 1.0);
  209. if (onef2err <= threef0err) {
  210. g = gamma(v + 1.5);
  211. y = y * h * t / (0.5 * f * g);
  212. return (y);
  213. } else {
  214. g = gamma(v + 0.5);
  215. ya = ya * h / (f * g);
  216. ya = ya + yv(v, x);
  217. return (ya);
  218. }
  219. }
  220. /* Bessel function of noninteger order
  221. */
  222. double yv(v, x) double v, x;
  223. {
  224. double y, t;
  225. int n;
  226. y = floor(v);
  227. if (y == v) {
  228. n = v;
  229. y = yn(n, x);
  230. return (y);
  231. }
  232. t = PI * v;
  233. y = (cos(t) * jv(v, x) - jv(-v, x)) / sin(t);
  234. return (y);
  235. }
  236. /* Crossover points between ascending series and asymptotic series
  237. * for Struve function
  238. *
  239. * v x
  240. *
  241. * 0 19.2
  242. * 1 18.95
  243. * 2 19.15
  244. * 3 19.3
  245. * 5 19.7
  246. * 10 21.35
  247. * 20 26.35
  248. * 30 32.31
  249. * 40 40.0
  250. */