dbesj0.cpp 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. /* dbesj0.f -- translated by f2c (version 20100827).
  2. This file no longer depends on f2c.
  3. */
  4. #include "slatec-internal.hpp"
  5. /* Table of constant values */
  6. integer const c__3 = 3;
  7. integer const c__19 = 19;
  8. /* Initialized data */
  9. double const bj0cs[19] = { .10025416196893913701073127264074,
  10. -.66522300776440513177678757831124,
  11. .2489837034982813137046046872668,
  12. -.033252723170035769653884341503854,
  13. .0023114179304694015462904924117729,
  14. -9.9112774199508092339048519336549e-5,
  15. 2.8916708643998808884733903747078e-6,
  16. -6.1210858663032635057818407481516e-8,
  17. 9.8386507938567841324768748636415e-10,
  18. -1.2423551597301765145515897006836e-11,
  19. 1.2654336302559045797915827210363e-13,
  20. -1.0619456495287244546914817512959e-15,
  21. 7.4706210758024567437098915584e-18,
  22. -4.4697032274412780547627007999999e-20,
  23. 2.3024281584337436200523093333333e-22,
  24. -1.0319144794166698148522666666666e-24,
  25. 4.06081782748733227008e-27,
  26. -1.4143836005240913919999999999999e-29,
  27. 4.391090549669888e-32 };
  28. float const r__1 = (float) d1mach_(3) * (float).1;
  29. integer const ntj0 = initds_(bj0cs, &c__19, &r__1);
  30. double const xsml = sqrt(d1mach_(3) * 8.);
  31. double dbesj0_(double const *x)
  32. {
  33. /* System generated locals */
  34. double ret_val, d__1;
  35. /* Local variables */
  36. double y;
  37. double ampl;
  38. double theta;
  39. /* ***BEGIN PROLOGUE DBESJ0 */
  40. /* ***PURPOSE Compute the Bessel function of the first kind of order */
  41. /* zero. */
  42. /* ***LIBRARY SLATEC (FNLIB) */
  43. /* ***CATEGORY C10A1 */
  44. /* ***TYPE DOUBLE PRECISION (BESJ0-S, DBESJ0-D) */
  45. /* ***KEYWORDS BESSEL FUNCTION, FIRST KIND, FNLIB, ORDER ZERO, */
  46. /* SPECIAL FUNCTIONS */
  47. /* ***AUTHOR Fullerton, W., (LANL) */
  48. /* ***DESCRIPTION */
  49. /* DBESJ0(X) calculates the double precision Bessel function of */
  50. /* the first kind of order zero for double precision argument X. */
  51. /* Series for BJ0 on the interval 0. to 1.60000E+01 */
  52. /* with weighted error 4.39E-32 */
  53. /* log weighted error 31.36 */
  54. /* significant figures required 31.21 */
  55. /* decimal places required 32.00 */
  56. /* ***REFERENCES (NONE) */
  57. /* ***ROUTINES CALLED D1MACH, D9B0MP, DCSEVL, INITDS */
  58. /* ***REVISION HISTORY (YYMMDD) */
  59. /* 770701 DATE WRITTEN */
  60. /* 890531 Changed all specific intrinsics to generic. (WRB) */
  61. /* 890531 REVISION DATE from Version 3.2 */
  62. /* 891214 Prologue converted to Version 4.0 format. (BAB) */
  63. /* ***END PROLOGUE DBESJ0 */
  64. /* ***FIRST EXECUTABLE STATEMENT DBESJ0 */
  65. y = abs(*x);
  66. if (y > 4.) {
  67. goto L20;
  68. }
  69. ret_val = 1.;
  70. if (y > xsml) {
  71. d__1 = y * .125 * y - 1.;
  72. ret_val = dcsevl_(&d__1, bj0cs, &ntj0);
  73. }
  74. return ret_val;
  75. L20:
  76. d9b0mp_(&y, &ampl, &theta);
  77. ret_val = ampl * cos(theta);
  78. return ret_val;
  79. } /* dbesj0_ */