dawsn.c 9.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392
  1. /* dawsn.c
  2. *
  3. * Dawson's Integral
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, dawsn();
  10. *
  11. * y = dawsn( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Approximates the integral
  18. *
  19. * x
  20. * -
  21. * 2 | | 2
  22. * dawsn(x) = exp( -x ) | exp( t ) dt
  23. * | |
  24. * -
  25. * 0
  26. *
  27. * Three different rational approximations are employed, for
  28. * the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up.
  29. *
  30. *
  31. * ACCURACY:
  32. *
  33. * Relative error:
  34. * arithmetic domain # trials peak rms
  35. * IEEE 0,10 10000 6.9e-16 1.0e-16
  36. * DEC 0,10 6000 7.4e-17 1.4e-17
  37. *
  38. *
  39. */
  40. /* dawsn.c */
  41. /*
  42. Cephes Math Library Release 2.8: June, 2000
  43. Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
  44. */
  45. #include <math.h>
  46. /* Dawson's integral, interval 0 to 3.25 */
  47. #ifdef UNK
  48. static double AN[10] = {
  49. 1.13681498971755972054E-11,
  50. 8.49262267667473811108E-10,
  51. 1.94434204175553054283E-8,
  52. 9.53151741254484363489E-7,
  53. 3.07828309874913200438E-6,
  54. 3.52513368520288738649E-4,
  55. -8.50149846724410912031E-4,
  56. 4.22618223005546594270E-2,
  57. -9.17480371773452345351E-2,
  58. 9.99999999999999994612E-1,
  59. };
  60. static double AD[11] = {
  61. 2.40372073066762605484E-11,
  62. 1.48864681368493396752E-9,
  63. 5.21265281010541664570E-8,
  64. 1.27258478273186970203E-6,
  65. 2.32490249820789513991E-5,
  66. 3.25524741826057911661E-4,
  67. 3.48805814657162590916E-3,
  68. 2.79448531198828973716E-2,
  69. 1.58874241960120565368E-1,
  70. 5.74918629489320327824E-1,
  71. 1.00000000000000000539E0,
  72. };
  73. #endif
  74. #ifdef DEC
  75. static unsigned short AN[40] = {
  76. 0027107,0176630,0075752,0107612,
  77. 0030551,0070604,0166707,0127727,
  78. 0031647,0002210,0117120,0056376,
  79. 0033177,0156026,0141275,0140627,
  80. 0033516,0112200,0037035,0165515,
  81. 0035270,0150613,0016423,0105634,
  82. 0135536,0156227,0023515,0044413,
  83. 0037055,0015273,0105147,0064025,
  84. 0137273,0163145,0014460,0166465,
  85. 0040200,0000000,0000000,0000000,
  86. };
  87. static unsigned short AD[44] = {
  88. 0027323,0067372,0115566,0131320,
  89. 0030714,0114432,0074206,0006637,
  90. 0032137,0160671,0044203,0026344,
  91. 0033252,0146656,0020247,0100231,
  92. 0034303,0003346,0123260,0022433,
  93. 0035252,0125460,0173041,0155415,
  94. 0036144,0113747,0125203,0124617,
  95. 0036744,0166232,0143671,0133670,
  96. 0037442,0127755,0162625,0000100,
  97. 0040023,0026736,0003604,0106265,
  98. 0040200,0000000,0000000,0000000,
  99. };
  100. #endif
  101. #ifdef IBMPC
  102. static unsigned short AN[40] = {
  103. 0x51f1,0x0f7d,0xffb3,0x3da8,
  104. 0xf5fb,0x9db8,0x2e30,0x3e0d,
  105. 0x0ba0,0x13ca,0xe091,0x3e54,
  106. 0xb833,0xd857,0xfb82,0x3eaf,
  107. 0xbd6a,0x07c3,0xd290,0x3ec9,
  108. 0x7174,0x63a2,0x1a31,0x3f37,
  109. 0xa921,0xe4e9,0xdb92,0xbf4b,
  110. 0xed03,0x714c,0xa357,0x3fa5,
  111. 0x1da7,0xa326,0x7ccc,0xbfb7,
  112. 0x0000,0x0000,0x0000,0x3ff0,
  113. };
  114. static unsigned short AD[44] = {
  115. 0xd65a,0x536e,0x6ddf,0x3dba,
  116. 0xc1b4,0x4f10,0x9323,0x3e19,
  117. 0x659c,0x2910,0xfc37,0x3e6b,
  118. 0xf013,0xc414,0x59b5,0x3eb5,
  119. 0x04a3,0xd4d6,0x60dc,0x3ef8,
  120. 0x3b62,0x1ec4,0x5566,0x3f35,
  121. 0x7532,0xf550,0x92fc,0x3f6c,
  122. 0x36f7,0x58f7,0x9d93,0x3f9c,
  123. 0xa008,0xbcb2,0x55fd,0x3fc4,
  124. 0x9197,0xc0f0,0x65bb,0x3fe2,
  125. 0x0000,0x0000,0x0000,0x3ff0,
  126. };
  127. #endif
  128. #ifdef MIEEE
  129. static unsigned short AN[40] = {
  130. 0x3da8,0xffb3,0x0f7d,0x51f1,
  131. 0x3e0d,0x2e30,0x9db8,0xf5fb,
  132. 0x3e54,0xe091,0x13ca,0x0ba0,
  133. 0x3eaf,0xfb82,0xd857,0xb833,
  134. 0x3ec9,0xd290,0x07c3,0xbd6a,
  135. 0x3f37,0x1a31,0x63a2,0x7174,
  136. 0xbf4b,0xdb92,0xe4e9,0xa921,
  137. 0x3fa5,0xa357,0x714c,0xed03,
  138. 0xbfb7,0x7ccc,0xa326,0x1da7,
  139. 0x3ff0,0x0000,0x0000,0x0000,
  140. };
  141. static unsigned short AD[44] = {
  142. 0x3dba,0x6ddf,0x536e,0xd65a,
  143. 0x3e19,0x9323,0x4f10,0xc1b4,
  144. 0x3e6b,0xfc37,0x2910,0x659c,
  145. 0x3eb5,0x59b5,0xc414,0xf013,
  146. 0x3ef8,0x60dc,0xd4d6,0x04a3,
  147. 0x3f35,0x5566,0x1ec4,0x3b62,
  148. 0x3f6c,0x92fc,0xf550,0x7532,
  149. 0x3f9c,0x9d93,0x58f7,0x36f7,
  150. 0x3fc4,0x55fd,0xbcb2,0xa008,
  151. 0x3fe2,0x65bb,0xc0f0,0x9197,
  152. 0x3ff0,0x0000,0x0000,0x0000,
  153. };
  154. #endif
  155. /* interval 3.25 to 6.25 */
  156. #ifdef UNK
  157. static double BN[11] = {
  158. 5.08955156417900903354E-1,
  159. -2.44754418142697847934E-1,
  160. 9.41512335303534411857E-2,
  161. -2.18711255142039025206E-2,
  162. 3.66207612329569181322E-3,
  163. -4.23209114460388756528E-4,
  164. 3.59641304793896631888E-5,
  165. -2.14640351719968974225E-6,
  166. 9.10010780076391431042E-8,
  167. -2.40274520828250956942E-9,
  168. 3.59233385440928410398E-11,
  169. };
  170. static double BD[10] = {
  171. /* 1.00000000000000000000E0,*/
  172. -6.31839869873368190192E-1,
  173. 2.36706788228248691528E-1,
  174. -5.31806367003223277662E-2,
  175. 8.48041718586295374409E-3,
  176. -9.47996768486665330168E-4,
  177. 7.81025592944552338085E-5,
  178. -4.55875153252442634831E-6,
  179. 1.89100358111421846170E-7,
  180. -4.91324691331920606875E-9,
  181. 7.18466403235734541950E-11,
  182. };
  183. #endif
  184. #ifdef DEC
  185. static unsigned short BN[44] = {
  186. 0040002,0045342,0113762,0004360,
  187. 0137572,0120346,0172745,0144046,
  188. 0037300,0151134,0123440,0117047,
  189. 0136663,0025423,0014755,0046026,
  190. 0036157,0177561,0027535,0046744,
  191. 0135335,0161052,0071243,0146535,
  192. 0034426,0154060,0164506,0135625,
  193. 0133420,0005356,0100017,0151334,
  194. 0032303,0066137,0024013,0046212,
  195. 0131045,0016612,0066270,0047574,
  196. 0027435,0177025,0060625,0116363,
  197. };
  198. static unsigned short BD[40] = {
  199. /*0040200,0000000,0000000,0000000,*/
  200. 0140041,0140101,0174552,0037073,
  201. 0037562,0061503,0124271,0160756,
  202. 0137131,0151760,0073210,0110534,
  203. 0036412,0170562,0117017,0155377,
  204. 0135570,0101374,0074056,0037276,
  205. 0034643,0145376,0001516,0060636,
  206. 0133630,0173540,0121344,0155231,
  207. 0032513,0005602,0134516,0007144,
  208. 0131250,0150540,0075747,0105341,
  209. 0027635,0177020,0012465,0125402,
  210. };
  211. #endif
  212. #ifdef IBMPC
  213. static unsigned short BN[44] = {
  214. 0x411e,0x52fe,0x495c,0x3fe0,
  215. 0xb905,0xdebc,0x541c,0xbfcf,
  216. 0x13c5,0x94e4,0x1a4b,0x3fb8,
  217. 0xa983,0x633d,0x6562,0xbf96,
  218. 0xa9bd,0x25eb,0xffee,0x3f6d,
  219. 0x79ac,0x4e54,0xbc45,0xbf3b,
  220. 0xd773,0x1d28,0xdb06,0x3f02,
  221. 0xfa5b,0xd001,0x015d,0xbec2,
  222. 0x6991,0xe501,0x6d8b,0x3e78,
  223. 0x09f0,0x4d97,0xa3b1,0xbe24,
  224. 0xb39e,0xac32,0xbfc2,0x3dc3,
  225. };
  226. static unsigned short BD[40] = {
  227. /*0x0000,0x0000,0x0000,0x3ff0,*/
  228. 0x47c7,0x3f2d,0x3808,0xbfe4,
  229. 0x3c3e,0x7517,0x4c68,0x3fce,
  230. 0x122b,0x0ed1,0x3a7e,0xbfab,
  231. 0xfb60,0x53c1,0x5e2e,0x3f81,
  232. 0xc7d8,0x8f05,0x105f,0xbf4f,
  233. 0xcc34,0xc069,0x795f,0x3f14,
  234. 0x9b53,0x145c,0x1eec,0xbed3,
  235. 0xc1cd,0x5729,0x6170,0x3e89,
  236. 0xf15c,0x0f7c,0x1a2c,0xbe35,
  237. 0xb560,0x02a6,0xbfc2,0x3dd3,
  238. };
  239. #endif
  240. #ifdef MIEEE
  241. static unsigned short BN[44] = {
  242. 0x3fe0,0x495c,0x52fe,0x411e,
  243. 0xbfcf,0x541c,0xdebc,0xb905,
  244. 0x3fb8,0x1a4b,0x94e4,0x13c5,
  245. 0xbf96,0x6562,0x633d,0xa983,
  246. 0x3f6d,0xffee,0x25eb,0xa9bd,
  247. 0xbf3b,0xbc45,0x4e54,0x79ac,
  248. 0x3f02,0xdb06,0x1d28,0xd773,
  249. 0xbec2,0x015d,0xd001,0xfa5b,
  250. 0x3e78,0x6d8b,0xe501,0x6991,
  251. 0xbe24,0xa3b1,0x4d97,0x09f0,
  252. 0x3dc3,0xbfc2,0xac32,0xb39e,
  253. };
  254. static unsigned short BD[40] = {
  255. /*0x3ff0,0x0000,0x0000,0x0000,*/
  256. 0xbfe4,0x3808,0x3f2d,0x47c7,
  257. 0x3fce,0x4c68,0x7517,0x3c3e,
  258. 0xbfab,0x3a7e,0x0ed1,0x122b,
  259. 0x3f81,0x5e2e,0x53c1,0xfb60,
  260. 0xbf4f,0x105f,0x8f05,0xc7d8,
  261. 0x3f14,0x795f,0xc069,0xcc34,
  262. 0xbed3,0x1eec,0x145c,0x9b53,
  263. 0x3e89,0x6170,0x5729,0xc1cd,
  264. 0xbe35,0x1a2c,0x0f7c,0xf15c,
  265. 0x3dd3,0xbfc2,0x02a6,0xb560,
  266. };
  267. #endif
  268. /* 6.25 to infinity */
  269. #ifdef UNK
  270. static double CN[5] = {
  271. -5.90592860534773254987E-1,
  272. 6.29235242724368800674E-1,
  273. -1.72858975380388136411E-1,
  274. 1.64837047825189632310E-2,
  275. -4.86827613020462700845E-4,
  276. };
  277. static double CD[5] = {
  278. /* 1.00000000000000000000E0,*/
  279. -2.69820057197544900361E0,
  280. 1.73270799045947845857E0,
  281. -3.93708582281939493482E-1,
  282. 3.44278924041233391079E-2,
  283. -9.73655226040941223894E-4,
  284. };
  285. #endif
  286. #ifdef DEC
  287. static unsigned short CN[20] = {
  288. 0140027,0030427,0176477,0074402,
  289. 0040041,0012617,0112375,0162657,
  290. 0137461,0000761,0074120,0135160,
  291. 0036607,0004325,0117246,0115525,
  292. 0135377,0036345,0064750,0047732,
  293. };
  294. static unsigned short CD[20] = {
  295. /*0040200,0000000,0000000,0000000,*/
  296. 0140454,0127521,0071653,0133415,
  297. 0040335,0144540,0016105,0045241,
  298. 0137711,0112053,0155034,0062237,
  299. 0037015,0002102,0177442,0074546,
  300. 0135577,0036345,0064750,0052152,
  301. };
  302. #endif
  303. #ifdef IBMPC
  304. static unsigned short CN[20] = {
  305. 0xef20,0xffa7,0xe622,0xbfe2,
  306. 0xbcb6,0xf29f,0x22b1,0x3fe4,
  307. 0x174e,0x2f0a,0x203e,0xbfc6,
  308. 0xd36b,0xb3d4,0xe11a,0x3f90,
  309. 0x09fb,0xad3d,0xe79c,0xbf3f,
  310. };
  311. static unsigned short CD[20] = {
  312. /*0x0000,0x0000,0x0000,0x3ff0,*/
  313. 0x76e2,0x2e75,0x95ea,0xc005,
  314. 0xa954,0x0388,0xb92c,0x3ffb,
  315. 0x8c94,0x7b43,0x3285,0xbfd9,
  316. 0x4f2d,0x5fe4,0xa088,0x3fa1,
  317. 0x0a8d,0xad3d,0xe79c,0xbf4f,
  318. };
  319. #endif
  320. #ifdef MIEEE
  321. static unsigned short CN[20] = {
  322. 0xbfe2,0xe622,0xffa7,0xef20,
  323. 0x3fe4,0x22b1,0xf29f,0xbcb6,
  324. 0xbfc6,0x203e,0x2f0a,0x174e,
  325. 0x3f90,0xe11a,0xb3d4,0xd36b,
  326. 0xbf3f,0xe79c,0xad3d,0x09fb,
  327. };
  328. static unsigned short CD[20] = {
  329. /*0x3ff0,0x0000,0x0000,0x0000,*/
  330. 0xc005,0x95ea,0x2e75,0x76e2,
  331. 0x3ffb,0xb92c,0x0388,0xa954,
  332. 0xbfd9,0x3285,0x7b43,0x8c94,
  333. 0x3fa1,0xa088,0x5fe4,0x4f2d,
  334. 0xbf4f,0xe79c,0xad3d,0x0a8d,
  335. };
  336. #endif
  337. #ifdef ANSIPROT
  338. extern double chbevl ( double, void *, int );
  339. extern double sqrt ( double );
  340. extern double fabs ( double );
  341. extern double polevl ( double, void *, int );
  342. extern double p1evl ( double, void *, int );
  343. #else
  344. double chbevl(), sqrt(), fabs(), polevl(), p1evl();
  345. #endif
  346. extern double PI, MACHEP;
  347. double dawsn( xx )
  348. double xx;
  349. {
  350. double x, y;
  351. int sign;
  352. sign = 1;
  353. if( xx < 0.0 )
  354. {
  355. sign = -1;
  356. xx = -xx;
  357. }
  358. if( xx < 3.25 )
  359. {
  360. x = xx*xx;
  361. y = xx * polevl( x, AN, 9 )/polevl( x, AD, 10 );
  362. return( sign * y );
  363. }
  364. x = 1.0/(xx*xx);
  365. if( xx < 6.25 )
  366. {
  367. y = 1.0/xx + x * polevl( x, BN, 10) / (p1evl( x, BD, 10) * xx);
  368. return( sign * 0.5 * y );
  369. }
  370. if( xx > 1.0e9 )
  371. return( (sign * 0.5)/xx );
  372. /* 6.25 to infinity */
  373. y = 1.0/xx + x * polevl( x, CN, 4) / (p1evl( x, CD, 5) * xx);
  374. return( sign * 0.5 * y );
  375. }