struvef.c 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315
  1. /* struvef.c
  2. *
  3. * Struve function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float v, x, y, struvef();
  10. *
  11. * y = struvef( 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. * v varies from 0 to 10.
  29. * Absolute error (relative error when |Hv(x)| > 1):
  30. * arithmetic domain # trials peak rms
  31. * IEEE -10,10 100000 9.0e-5 4.0e-6
  32. *
  33. */
  34. /*
  35. Cephes Math Library Release 2.2: July, 1992
  36. Copyright 1984, 1987, 1989 by Stephen L. Moshier
  37. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  38. */
  39. #include <math.h>
  40. #define DEBUG 0
  41. extern float MACHEPF, MAXNUMF, PIF;
  42. #define fabsf(x) ( (x) < 0 ? -(x) : (x) )
  43. #ifdef ANSIC
  44. float gammaf(float), powf(float, float), sqrtf(float);
  45. float yvf(float, float);
  46. float floorf(float), ynf(int, float);
  47. float jvf(float, float);
  48. float sinf(float), cosf(float);
  49. #else
  50. float gammaf(), powf(), sqrtf(), yvf();
  51. float floorf(), ynf(), jvf(), sinf(), cosf();
  52. #endif
  53. float onef2f( float aa, float bb, float cc, float xx, float *err )
  54. {
  55. float a, b, c, x, n, a0, sum, t;
  56. float an, bn, cn, max, z;
  57. a = aa;
  58. b = bb;
  59. c = cc;
  60. x = xx;
  61. an = a;
  62. bn = b;
  63. cn = c;
  64. a0 = 1.0;
  65. sum = 1.0;
  66. n = 1.0;
  67. t = 1.0;
  68. max = 0.0;
  69. do
  70. {
  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 = fabsf( a0 );
  86. if( z > max )
  87. max = z;
  88. if( sum != 0 )
  89. t = fabsf( a0 / sum );
  90. else
  91. t = z;
  92. }
  93. while( t > MACHEPF );
  94. done:
  95. *err = fabsf( MACHEPF*max /sum );
  96. #if DEBUG
  97. printf(" onef2f cancellation error %.5E\n", *err );
  98. #endif
  99. goto xit;
  100. error:
  101. #if DEBUG
  102. printf("onef2f does not converge\n");
  103. #endif
  104. *err = MAXNUMF;
  105. xit:
  106. #if DEBUG
  107. printf("onef2( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
  108. #endif
  109. return(sum);
  110. }
  111. float threef0f( float aa, float bb, float cc, float xx, float *err )
  112. {
  113. float a, b, c, x, n, a0, sum, t, conv, conv1;
  114. float an, bn, cn, max, z;
  115. a = aa;
  116. b = bb;
  117. c = cc;
  118. x = xx;
  119. an = a;
  120. bn = b;
  121. cn = c;
  122. a0 = 1.0;
  123. sum = 1.0;
  124. n = 1.0;
  125. t = 1.0;
  126. max = 0.0;
  127. conv = 1.0e38;
  128. conv1 = conv;
  129. do
  130. {
  131. if( an == 0.0 )
  132. goto done;
  133. if( bn == 0.0 )
  134. goto done;
  135. if( cn == 0.0 )
  136. goto done;
  137. if( (a0 > 1.0e34) || (n > 200) )
  138. goto error;
  139. a0 *= (an * bn * cn * x) / n;
  140. an += 1.0;
  141. bn += 1.0;
  142. cn += 1.0;
  143. n += 1.0;
  144. z = fabsf( a0 );
  145. if( z > max )
  146. max = z;
  147. if( z >= conv )
  148. {
  149. if( (z < max) && (z > conv1) )
  150. goto done;
  151. }
  152. conv1 = conv;
  153. conv = z;
  154. sum += a0;
  155. if( sum != 0 )
  156. t = fabsf( a0 / sum );
  157. else
  158. t = z;
  159. }
  160. while( t > MACHEPF );
  161. done:
  162. t = fabsf( MACHEPF*max/sum );
  163. #if DEBUG
  164. printf(" threef0f cancellation error %.5E\n", t );
  165. #endif
  166. max = fabsf( conv/sum );
  167. if( max > t )
  168. t = max;
  169. #if DEBUG
  170. printf(" threef0f convergence %.5E\n", max );
  171. #endif
  172. goto xit;
  173. error:
  174. #if DEBUG
  175. printf("threef0f does not converge\n");
  176. #endif
  177. t = MAXNUMF;
  178. xit:
  179. #if DEBUG
  180. printf("threef0f( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
  181. #endif
  182. *err = t;
  183. return(sum);
  184. }
  185. float struvef( float vv, float xx )
  186. {
  187. float v, x, y, ya, f, g, h, t;
  188. float onef2err, threef0err;
  189. v = vv;
  190. x = xx;
  191. f = floorf(v);
  192. if( (v < 0) && ( v-f == 0.5 ) )
  193. {
  194. y = jvf( -v, x );
  195. f = 1.0 - f;
  196. g = 2.0 * floorf(0.5*f);
  197. if( g != f )
  198. y = -y;
  199. return(y);
  200. }
  201. t = 0.25*x*x;
  202. f = fabsf(x);
  203. g = 1.5 * fabsf(v);
  204. if( (f > 30.0) && (f > g) )
  205. {
  206. onef2err = MAXNUMF;
  207. y = 0.0;
  208. }
  209. else
  210. {
  211. y = onef2f( 1.0, 1.5, 1.5+v, -t, &onef2err );
  212. }
  213. if( (f < 18.0) || (x < 0.0) )
  214. {
  215. threef0err = MAXNUMF;
  216. ya = 0.0;
  217. }
  218. else
  219. {
  220. ya = threef0f( 1.0, 0.5, 0.5-v, -1.0/t, &threef0err );
  221. }
  222. f = sqrtf( PIF );
  223. h = powf( 0.5*x, v-1.0 );
  224. if( onef2err <= threef0err )
  225. {
  226. g = gammaf( v + 1.5 );
  227. y = y * h * t / ( 0.5 * f * g );
  228. return(y);
  229. }
  230. else
  231. {
  232. g = gammaf( v + 0.5 );
  233. ya = ya * h / ( f * g );
  234. ya = ya + yvf( v, x );
  235. return(ya);
  236. }
  237. }
  238. /* Bessel function of noninteger order
  239. */
  240. float yvf( float vv, float xx )
  241. {
  242. float v, x, y, t;
  243. int n;
  244. v = vv;
  245. x = xx;
  246. y = floorf( v );
  247. if( y == v )
  248. {
  249. n = v;
  250. y = ynf( n, x );
  251. return( y );
  252. }
  253. t = PIF * v;
  254. y = (cosf(t) * jvf( v, x ) - jvf( -v, x ))/sinf(t);
  255. return( y );
  256. }
  257. /* Crossover points between ascending series and asymptotic series
  258. * for Struve function
  259. *
  260. * v x
  261. *
  262. * 0 19.2
  263. * 1 18.95
  264. * 2 19.15
  265. * 3 19.3
  266. * 5 19.7
  267. * 10 21.35
  268. * 20 26.35
  269. * 30 32.31
  270. * 40 40.0
  271. */