i0.c 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263
  1. /* i0.c
  2. *
  3. * Modified Bessel function of order zero
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, i0();
  10. *
  11. * y = i0( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns modified Bessel function of order zero of the
  18. * argument.
  19. *
  20. * The function is defined as i0(x) = j0( ix ).
  21. *
  22. * The range is partitioned into the two intervals [0,8] and
  23. * (8, infinity). Chebyshev polynomial expansions are employed
  24. * in each interval.
  25. *
  26. *
  27. *
  28. * ACCURACY:
  29. *
  30. * Relative error:
  31. * arithmetic domain # trials peak rms
  32. * DEC 0,30 6000 8.2e-17 1.9e-17
  33. * IEEE 0,30 30000 5.8e-16 1.4e-16
  34. *
  35. */
  36. /* i0e.c
  37. *
  38. * Modified Bessel function of order zero,
  39. * exponentially scaled
  40. *
  41. *
  42. *
  43. * SYNOPSIS:
  44. *
  45. * double x, y, i0e();
  46. *
  47. * y = i0e( x );
  48. *
  49. *
  50. *
  51. * DESCRIPTION:
  52. *
  53. * Returns exponentially scaled modified Bessel function
  54. * of order zero of the argument.
  55. *
  56. * The function is defined as i0e(x) = exp(-|x|) j0( ix ).
  57. *
  58. *
  59. *
  60. * ACCURACY:
  61. *
  62. * Relative error:
  63. * arithmetic domain # trials peak rms
  64. * IEEE 0,30 30000 5.4e-16 1.2e-16
  65. * See i0().
  66. *
  67. */
  68. /* i0.c */
  69. /*
  70. Cephes Math Library Release 2.8: June, 2000
  71. Copyright 1984, 1987, 2000 by Stephen L. Moshier
  72. */
  73. #include "mconf.h"
  74. /* Chebyshev coefficients for exp(-x) I0(x)
  75. * in the interval [0,8].
  76. *
  77. * lim(x->0){ exp(-x) I0(x) } = 1.
  78. */
  79. #ifdef UNK
  80. static double A[] = {-4.41534164647933937950E-18, 3.33079451882223809783E-17,
  81. -2.43127984654795469359E-16, 1.71539128555513303061E-15,
  82. -1.16853328779934516808E-14, 7.67618549860493561688E-14,
  83. -4.85644678311192946090E-13, 2.95505266312963983461E-12,
  84. -1.72682629144155570723E-11, 9.67580903537323691224E-11,
  85. -5.18979560163526290666E-10, 2.65982372468238665035E-9,
  86. -1.30002500998624804212E-8, 6.04699502254191894932E-8,
  87. -2.67079385394061173391E-7, 1.11738753912010371815E-6,
  88. -4.41673835845875056359E-6, 1.64484480707288970893E-5,
  89. -5.75419501008210370398E-5, 1.88502885095841655729E-4,
  90. -5.76375574538582365885E-4, 1.63947561694133579842E-3,
  91. -4.32430999505057594430E-3, 1.05464603945949983183E-2,
  92. -2.37374148058994688156E-2, 4.93052842396707084878E-2,
  93. -9.49010970480476444210E-2, 1.71620901522208775349E-1,
  94. -3.04682672343198398683E-1, 6.76795274409476084995E-1};
  95. #endif
  96. #ifdef DEC
  97. static unsigned short A[] = {
  98. 0121642, 0162671, 0004646, 0103567, 0022431, 0115424, 0135755, 0026104,
  99. 0123214, 0023533, 0110365, 0156635, 0023767, 0033304, 0117662, 0172716,
  100. 0124522, 0100426, 0012277, 0157531, 0025254, 0155062, 0054461, 0030465,
  101. 0126010, 0131143, 0013560, 0153604, 0026517, 0170577, 0006336, 0114437,
  102. 0127227, 0162253, 0152243, 0052734, 0027724, 0142766, 0061641, 0160200,
  103. 0130416, 0123760, 0116564, 0125262, 0031066, 0144035, 0021246, 0054641,
  104. 0131537, 0053664, 0060131, 0102530, 0032201, 0155664, 0165153, 0020652,
  105. 0132617, 0061434, 0074423, 0176145, 0033225, 0174444, 0136147, 0122542,
  106. 0133624, 0031576, 0056453, 0020470, 0034211, 0175305, 0172321, 0041314,
  107. 0134561, 0054462, 0147040, 0165315, 0035105, 0124333, 0120203, 0162532,
  108. 0135427, 0013750, 0174257, 0055221, 0035726, 0161654, 0050220, 0100162,
  109. 0136215, 0131361, 0000325, 0041110, 0036454, 0145417, 0117357, 0017352,
  110. 0136702, 0072367, 0104415, 0133574, 0037111, 0172126, 0072505, 0014544,
  111. 0137302, 0055601, 0120550, 0033523, 0037457, 0136543, 0136544, 0043002,
  112. 0137633, 0177536, 0001276, 0066150, 0040055, 0041164, 0100655, 0010521};
  113. #endif
  114. #ifdef IBMPC
  115. static unsigned short A[] = {
  116. 0xd0ef, 0x2134, 0x5cb7, 0xbc54, 0xa589, 0x977d, 0x3362, 0x3c83, 0xbbb4,
  117. 0x721e, 0x84eb, 0xbcb1, 0x5eba, 0x93f6, 0xe6d8, 0x3cde, 0xfbeb, 0xc297,
  118. 0x5022, 0xbd0a, 0x2627, 0x4b26, 0x9b46, 0x3d35, 0x1af0, 0x62ee, 0x164c,
  119. 0xbd61, 0xd324, 0xe19b, 0xfe2f, 0x3d89, 0x6abc, 0x7a94, 0xfc95, 0xbdb2,
  120. 0x3c10, 0xcc74, 0x98be, 0x3dda, 0x9556, 0x13ae, 0xd4fe, 0xbe01, 0xcb34,
  121. 0xa454, 0xd903, 0x3e26, 0x30ab, 0x8c0b, 0xeaf6, 0xbe4b, 0x6435, 0x9d4d,
  122. 0x3b76, 0x3e70, 0x7f8d, 0x8f22, 0xec63, 0xbe91, 0xf4ac, 0x978c, 0xbf24,
  123. 0x3eb2, 0x6427, 0xcba5, 0x866f, 0xbed2, 0x2859, 0xbe9a, 0x3f58, 0x3ef1,
  124. 0x1d5a, 0x59c4, 0x2b26, 0xbf0e, 0x7cab, 0x7410, 0xb51b, 0x3f28, 0xeb52,
  125. 0x1f15, 0xe2fd, 0xbf42, 0x100e, 0x8a12, 0xdc75, 0x3f5a, 0xa849, 0x201a,
  126. 0xb65e, 0xbf71, 0xe3dd, 0xf3dd, 0x9961, 0x3f85, 0xb6f0, 0xf121, 0x4e9e,
  127. 0xbf98, 0xa32d, 0xcea8, 0x3e8a, 0x3fa9, 0x06ea, 0x342d, 0x4b70, 0xbfb8,
  128. 0x88c0, 0x77ac, 0xf7ac, 0x3fc5, 0xcd8d, 0xc057, 0x7feb, 0xbfd3, 0xa22a,
  129. 0x9035, 0xa84e, 0x3fe5,
  130. };
  131. #endif
  132. #ifdef MIEEE
  133. static unsigned short A[] = {
  134. 0xbc54, 0x5cb7, 0x2134, 0xd0ef, 0x3c83, 0x3362, 0x977d, 0xa589, 0xbcb1,
  135. 0x84eb, 0x721e, 0xbbb4, 0x3cde, 0xe6d8, 0x93f6, 0x5eba, 0xbd0a, 0x5022,
  136. 0xc297, 0xfbeb, 0x3d35, 0x9b46, 0x4b26, 0x2627, 0xbd61, 0x164c, 0x62ee,
  137. 0x1af0, 0x3d89, 0xfe2f, 0xe19b, 0xd324, 0xbdb2, 0xfc95, 0x7a94, 0x6abc,
  138. 0x3dda, 0x98be, 0xcc74, 0x3c10, 0xbe01, 0xd4fe, 0x13ae, 0x9556, 0x3e26,
  139. 0xd903, 0xa454, 0xcb34, 0xbe4b, 0xeaf6, 0x8c0b, 0x30ab, 0x3e70, 0x3b76,
  140. 0x9d4d, 0x6435, 0xbe91, 0xec63, 0x8f22, 0x7f8d, 0x3eb2, 0xbf24, 0x978c,
  141. 0xf4ac, 0xbed2, 0x866f, 0xcba5, 0x6427, 0x3ef1, 0x3f58, 0xbe9a, 0x2859,
  142. 0xbf0e, 0x2b26, 0x59c4, 0x1d5a, 0x3f28, 0xb51b, 0x7410, 0x7cab, 0xbf42,
  143. 0xe2fd, 0x1f15, 0xeb52, 0x3f5a, 0xdc75, 0x8a12, 0x100e, 0xbf71, 0xb65e,
  144. 0x201a, 0xa849, 0x3f85, 0x9961, 0xf3dd, 0xe3dd, 0xbf98, 0x4e9e, 0xf121,
  145. 0xb6f0, 0x3fa9, 0x3e8a, 0xcea8, 0xa32d, 0xbfb8, 0x4b70, 0x342d, 0x06ea,
  146. 0x3fc5, 0xf7ac, 0x77ac, 0x88c0, 0xbfd3, 0x7feb, 0xc057, 0xcd8d, 0x3fe5,
  147. 0xa84e, 0x9035, 0xa22a};
  148. #endif
  149. /* Chebyshev coefficients for exp(-x) sqrt(x) I0(x)
  150. * in the inverted interval [8,infinity].
  151. *
  152. * lim(x->inf){ exp(-x) sqrt(x) I0(x) } = 1/sqrt(2pi).
  153. */
  154. #ifdef UNK
  155. static double B[] = {-7.23318048787475395456E-18, -4.83050448594418207126E-18,
  156. 4.46562142029675999901E-17, 3.46122286769746109310E-17,
  157. -2.82762398051658348494E-16, -3.42548561967721913462E-16,
  158. 1.77256013305652638360E-15, 3.81168066935262242075E-15,
  159. -9.55484669882830764870E-15, -4.15056934728722208663E-14,
  160. 1.54008621752140982691E-14, 3.85277838274214270114E-13,
  161. 7.18012445138366623367E-13, -1.79417853150680611778E-12,
  162. -1.32158118404477131188E-11, -3.14991652796324136454E-11,
  163. 1.18891471078464383424E-11, 4.94060238822496958910E-10,
  164. 3.39623202570838634515E-9, 2.26666899049817806459E-8,
  165. 2.04891858946906374183E-7, 2.89137052083475648297E-6,
  166. 6.88975834691682398426E-5, 3.36911647825569408990E-3,
  167. 8.04490411014108831608E-1};
  168. #endif
  169. #ifdef DEC
  170. static unsigned short B[] = {
  171. 0122005, 0066672, 0123124, 0054311, 0121662, 0033323, 0030214, 0104602,
  172. 0022515, 0170300, 0113314, 0020413, 0022437, 0117350, 0035402, 0007146,
  173. 0123243, 0000135, 0057220, 0177435, 0123305, 0073476, 0144106, 0170702,
  174. 0023777, 0071755, 0017527, 0154373, 0024211, 0052214, 0102247, 0033270,
  175. 0124454, 0017763, 0171453, 0012322, 0125072, 0166316, 0075505, 0154616,
  176. 0024612, 0133770, 0065376, 0025045, 0025730, 0162143, 0056036, 0001632,
  177. 0026112, 0015077, 0150464, 0063542, 0126374, 0101030, 0014274, 0065457,
  178. 0127150, 0077271, 0125763, 0157617, 0127412, 0104350, 0040713, 0120445,
  179. 0027121, 0023765, 0057500, 0001165, 0030407, 0147146, 0003643, 0075644,
  180. 0031151, 0061445, 0044422, 0156065, 0031702, 0132224, 0003266, 0125551,
  181. 0032534, 0000076, 0147153, 0005555, 0033502, 0004536, 0004016, 0026055,
  182. 0034620, 0076433, 0142314, 0171215, 0036134, 0146145, 0013454, 0101104,
  183. 0040115, 0171425, 0062500, 0047133};
  184. #endif
  185. #ifdef IBMPC
  186. static unsigned short B[] = {
  187. 0x8b19, 0x54ca, 0xadb7, 0xbc60, 0x9130, 0x6611, 0x46da, 0xbc56, 0x8421,
  188. 0x12d9, 0xbe18, 0x3c89, 0x41cd, 0x0760, 0xf3dd, 0x3c83, 0x1fe4, 0xabd2,
  189. 0x600b, 0xbcb4, 0xde38, 0xd908, 0xaee7, 0xbcb8, 0xfb1f, 0xa3ea, 0xee7d,
  190. 0x3cdf, 0xe6d7, 0x9094, 0x2a91, 0x3cf1, 0x629a, 0x7e65, 0x83fe, 0xbd05,
  191. 0xbb32, 0xcf68, 0x5d99, 0xbd27, 0xc545, 0x0d5f, 0x56ff, 0x3d11, 0xc073,
  192. 0x6b83, 0x1c8c, 0x3d5b, 0x8cec, 0xfa26, 0x4347, 0x3d69, 0x8d66, 0x0317,
  193. 0x9043, 0xbd7f, 0x7bf2, 0x357e, 0x0fd7, 0xbdad, 0x7425, 0x0839, 0x511d,
  194. 0xbdc1, 0x004f, 0xabe8, 0x24fe, 0x3daa, 0x6f75, 0xc0f4, 0xf9cc, 0x3e00,
  195. 0x5b87, 0xa922, 0x2c64, 0x3e2d, 0xd56d, 0x80d6, 0x5692, 0x3e58, 0x616e,
  196. 0xd9cd, 0x8007, 0x3e8b, 0xc586, 0xc101, 0x412b, 0x3ec8, 0x9e52, 0x7899,
  197. 0x0fa3, 0x3f12, 0x9049, 0xa2e5, 0x998c, 0x3f6b, 0x09cb, 0xaca8, 0xbe62,
  198. 0x3fe9};
  199. #endif
  200. #ifdef MIEEE
  201. static unsigned short B[] = {
  202. 0xbc60, 0xadb7, 0x54ca, 0x8b19, 0xbc56, 0x46da, 0x6611, 0x9130, 0x3c89,
  203. 0xbe18, 0x12d9, 0x8421, 0x3c83, 0xf3dd, 0x0760, 0x41cd, 0xbcb4, 0x600b,
  204. 0xabd2, 0x1fe4, 0xbcb8, 0xaee7, 0xd908, 0xde38, 0x3cdf, 0xee7d, 0xa3ea,
  205. 0xfb1f, 0x3cf1, 0x2a91, 0x9094, 0xe6d7, 0xbd05, 0x83fe, 0x7e65, 0x629a,
  206. 0xbd27, 0x5d99, 0xcf68, 0xbb32, 0x3d11, 0x56ff, 0x0d5f, 0xc545, 0x3d5b,
  207. 0x1c8c, 0x6b83, 0xc073, 0x3d69, 0x4347, 0xfa26, 0x8cec, 0xbd7f, 0x9043,
  208. 0x0317, 0x8d66, 0xbdad, 0x0fd7, 0x357e, 0x7bf2, 0xbdc1, 0x511d, 0x0839,
  209. 0x7425, 0x3daa, 0x24fe, 0xabe8, 0x004f, 0x3e00, 0xf9cc, 0xc0f4, 0x6f75,
  210. 0x3e2d, 0x2c64, 0xa922, 0x5b87, 0x3e58, 0x5692, 0x80d6, 0xd56d, 0x3e8b,
  211. 0x8007, 0xd9cd, 0x616e, 0x3ec8, 0x412b, 0xc101, 0xc586, 0x3f12, 0x0fa3,
  212. 0x7899, 0x9e52, 0x3f6b, 0x998c, 0xa2e5, 0x9049, 0x3fe9, 0xbe62, 0xaca8,
  213. 0x09cb};
  214. #endif
  215. #ifdef ANSIPROT
  216. extern double chbevl(double, void *, int);
  217. extern double exp(double);
  218. extern double sqrt(double);
  219. #else
  220. double chbevl(), exp(), sqrt();
  221. #endif
  222. double i0(x) double x;
  223. {
  224. double y;
  225. if (x < 0)
  226. x = -x;
  227. if (x <= 8.0) {
  228. y = (x / 2.0) - 2.0;
  229. return (exp(x) * chbevl(y, A, 30));
  230. }
  231. return (exp(x) * chbevl(32.0 / x - 2.0, B, 25) / sqrt(x));
  232. }
  233. double i0e(x) double x;
  234. {
  235. double y;
  236. if (x < 0)
  237. x = -x;
  238. if (x <= 8.0) {
  239. y = (x / 2.0) - 2.0;
  240. return (chbevl(y, A, 30));
  241. }
  242. return (chbevl(32.0 / x - 2.0, B, 25) / sqrt(x));
  243. }