j1f.c 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211
  1. /* j1f.c
  2. *
  3. * Bessel function of order one
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float x, y, j1f();
  10. *
  11. * y = j1f( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns Bessel function of order one of the argument.
  18. *
  19. * The domain is divided into the intervals [0, 2] and
  20. * (2, infinity). In the first interval a polynomial approximation
  21. * 2
  22. * (w - r ) x P(w)
  23. * 1
  24. * 2
  25. * is used, where w = x and r is the first zero of the function.
  26. *
  27. * In the second interval, the modulus and phase are approximated
  28. * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x)
  29. * and Phase(x) = x + 1/x R(1/x^2) - 3pi/4. The function is
  30. *
  31. * j0(x) = Modulus(x) cos( Phase(x) ).
  32. *
  33. *
  34. *
  35. * ACCURACY:
  36. *
  37. * Absolute error:
  38. * arithmetic domain # trials peak rms
  39. * IEEE 0, 2 100000 1.2e-7 2.5e-8
  40. * IEEE 2, 32 100000 2.0e-7 5.3e-8
  41. *
  42. *
  43. */
  44. /* y1.c
  45. *
  46. * Bessel function of second kind of order one
  47. *
  48. *
  49. *
  50. * SYNOPSIS:
  51. *
  52. * double x, y, y1();
  53. *
  54. * y = y1( x );
  55. *
  56. *
  57. *
  58. * DESCRIPTION:
  59. *
  60. * Returns Bessel function of the second kind of order one
  61. * of the argument.
  62. *
  63. * The domain is divided into the intervals [0, 2] and
  64. * (2, infinity). In the first interval a rational approximation
  65. * R(x) is employed to compute
  66. *
  67. * 2
  68. * y0(x) = (w - r ) x R(x^2) + 2/pi (ln(x) j1(x) - 1/x) .
  69. * 1
  70. *
  71. * Thus a call to j1() is required.
  72. *
  73. * In the second interval, the modulus and phase are approximated
  74. * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x)
  75. * and Phase(x) = x + 1/x S(1/x^2) - 3pi/4. Then the function is
  76. *
  77. * y0(x) = Modulus(x) sin( Phase(x) ).
  78. *
  79. *
  80. *
  81. *
  82. * ACCURACY:
  83. *
  84. * Absolute error:
  85. * arithmetic domain # trials peak rms
  86. * IEEE 0, 2 100000 2.2e-7 4.6e-8
  87. * IEEE 2, 32 100000 1.9e-7 5.3e-8
  88. *
  89. * (error criterion relative when |y1| > 1).
  90. *
  91. */
  92. /*
  93. Cephes Math Library Release 2.2: June, 1992
  94. Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier
  95. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  96. */
  97. #include <math.h>
  98. static float JP[5] = {
  99. -4.878788132172128E-009f,
  100. 6.009061827883699E-007f,
  101. -4.541343896997497E-005f,
  102. 1.937383947804541E-003f,
  103. -3.405537384615824E-002f
  104. };
  105. static float YP[5] = {
  106. 8.061978323326852E-009f,
  107. -9.496460629917016E-007f,
  108. 6.719543806674249E-005f,
  109. -2.641785726447862E-003f,
  110. 4.202369946500099E-002f
  111. };
  112. static float MO1[8] = {
  113. 6.913942741265801E-002f,
  114. -2.284801500053359E-001f,
  115. 3.138238455499697E-001f,
  116. -2.102302420403875E-001f,
  117. 5.435364690523026E-003f,
  118. 1.493389585089498E-001f,
  119. 4.976029650847191E-006f,
  120. 7.978845453073848E-001f
  121. };
  122. static float PH1[8] = {
  123. -4.497014141919556E+001f,
  124. 5.073465654089319E+001f,
  125. -2.485774108720340E+001f,
  126. 7.222973196770240E+000f,
  127. -1.544842782180211E+000f,
  128. 3.503787691653334E-001f,
  129. -1.637986776941202E-001f,
  130. 3.749989509080821E-001f
  131. };
  132. static float YO1 = 4.66539330185668857532f;
  133. static float Z1 = 1.46819706421238932572E1f;
  134. static float THPIO4F = 2.35619449019234492885f; /* 3*pi/4 */
  135. static float TWOOPI = 0.636619772367581343075535f; /* 2/pi */
  136. extern float PIO4;
  137. float polevlf(float, float *, int);
  138. float logf(float), sinf(float), cosf(float), sqrtf(float);
  139. float j1f( float xx )
  140. {
  141. float x, w, z, p, q, xn;
  142. x = xx;
  143. if( x < 0 )
  144. x = -xx;
  145. if( x <= 2.0f )
  146. {
  147. z = x * x;
  148. p = (z-Z1) * x * polevlf( z, JP, 4 );
  149. return( p );
  150. }
  151. q = 1.0f/x;
  152. w = sqrtf(q);
  153. p = w * polevlf( q, MO1, 7);
  154. w = q*q;
  155. xn = q * polevlf( w, PH1, 7) - THPIO4F;
  156. p = p * cosf(xn + x);
  157. return(p);
  158. }
  159. extern float MAXNUMF;
  160. float y1f( float xx )
  161. {
  162. float x, w, z, p, q, xn;
  163. x = xx;
  164. if( x <= 2.0f )
  165. {
  166. if( x <= 0.0f )
  167. {
  168. mtherr( "y1f", DOMAIN );
  169. return( -MAXNUMF );
  170. }
  171. z = x * x;
  172. w = (z - YO1) * x * polevlf( z, YP, 4 );
  173. w += TWOOPI * ( j1f(x) * logf(x) - 1.0f/x );
  174. return( w );
  175. }
  176. q = 1.0f/x;
  177. w = sqrtf(q);
  178. p = w * polevlf( q, MO1, 7);
  179. w = q*q;
  180. xn = q * polevlf( w, PH1, 7) - THPIO4F;
  181. p = p * sinf(xn + x);
  182. return(p);
  183. }