k1f.c 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174
  1. /* k1f.c
  2. *
  3. * Modified Bessel function, third kind, order one
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float x, y, k1f();
  10. *
  11. * y = k1f( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Computes the modified Bessel function of the third kind
  18. * of order one of the argument.
  19. *
  20. * The range is partitioned into the two intervals [0,2] and
  21. * (2, infinity). Chebyshev polynomial expansions are employed
  22. * in each interval.
  23. *
  24. *
  25. *
  26. * ACCURACY:
  27. *
  28. * Relative error:
  29. * arithmetic domain # trials peak rms
  30. * IEEE 0, 30 30000 4.6e-7 7.6e-8
  31. *
  32. * ERROR MESSAGES:
  33. *
  34. * message condition value returned
  35. * k1 domain x <= 0 MAXNUM
  36. *
  37. */
  38. /* k1ef.c
  39. *
  40. * Modified Bessel function, third kind, order one,
  41. * exponentially scaled
  42. *
  43. *
  44. *
  45. * SYNOPSIS:
  46. *
  47. * float x, y, k1ef();
  48. *
  49. * y = k1ef( x );
  50. *
  51. *
  52. *
  53. * DESCRIPTION:
  54. *
  55. * Returns exponentially scaled modified Bessel function
  56. * of the third kind of order one of the argument:
  57. *
  58. * k1e(x) = exp(x) * k1(x).
  59. *
  60. *
  61. *
  62. * ACCURACY:
  63. *
  64. * Relative error:
  65. * arithmetic domain # trials peak rms
  66. * IEEE 0, 30 30000 4.9e-7 6.7e-8
  67. * See k1().
  68. *
  69. */
  70. /*
  71. Cephes Math Library Release 2.2: June, 1992
  72. Copyright 1984, 1987, 1992 by Stephen L. Moshier
  73. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  74. */
  75. #include <math.h>
  76. /* Chebyshev coefficients for x(K1(x) - log(x/2) I1(x))
  77. * in the interval [0,2].
  78. *
  79. * lim(x->0){ x(K1(x) - log(x/2) I1(x)) } = 1.
  80. */
  81. #define MINNUMF 6.0e-39
  82. static float A[] =
  83. {
  84. -2.21338763073472585583E-8f,
  85. -2.43340614156596823496E-6f,
  86. -1.73028895751305206302E-4f,
  87. -6.97572385963986435018E-3f,
  88. -1.22611180822657148235E-1f,
  89. -3.53155960776544875667E-1f,
  90. 1.52530022733894777053E0f
  91. };
  92. /* Chebyshev coefficients for exp(x) sqrt(x) K1(x)
  93. * in the interval [2,infinity].
  94. *
  95. * lim(x->inf){ exp(x) sqrt(x) K1(x) } = sqrt(pi/2).
  96. */
  97. static float B[] =
  98. {
  99. 2.01504975519703286596E-9f,
  100. -1.03457624656780970260E-8f,
  101. 5.74108412545004946722E-8f,
  102. -3.50196060308781257119E-7f,
  103. 2.40648494783721712015E-6f,
  104. -1.93619797416608296024E-5f,
  105. 1.95215518471351631108E-4f,
  106. -2.85781685962277938680E-3f,
  107. 1.03923736576817238437E-1f,
  108. 2.72062619048444266945E0f
  109. };
  110. extern float MAXNUMF;
  111. #ifdef ANSIC
  112. float chbevlf(float, float *, int);
  113. float expf(float), i1f(float), logf(float), sqrtf(float);
  114. #else
  115. float chbevlf(), expf(), i1f(), logf(), sqrtf();
  116. #endif
  117. float k1f(float xx)
  118. {
  119. float x, y;
  120. x = xx;
  121. if( x <= MINNUMF )
  122. {
  123. mtherr( "k1f", DOMAIN );
  124. return( MAXNUMF );
  125. }
  126. if( x <= 2.0f )
  127. {
  128. y = x * x - 2.0f;
  129. y = logf( 0.5f * x ) * i1f(x) + chbevlf( y, A, 7 ) / x;
  130. return( y );
  131. }
  132. return( expf(-x) * chbevlf( 8.0f/x - 2.0f, B, 10 ) / sqrtf(x) );
  133. }
  134. float k1ef( float xx )
  135. {
  136. float x, y;
  137. x = xx;
  138. if( x <= 0.0f )
  139. {
  140. mtherr( "k1ef", DOMAIN );
  141. return( MAXNUMF );
  142. }
  143. if( x <= 2.0f )
  144. {
  145. y = x * x - 2.0f;
  146. y = logf( 0.5f * x ) * i1f(x) + chbevlf( y, A, 7 ) / x;
  147. return( y * expf(x) );
  148. }
  149. return( chbevlf( 8.0f/x - 2.0f, B, 10 ) / sqrtf(x) );
  150. }