d9b1mp.cpp 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265
  1. /* d9b1mp.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. static integer const c__3 = 3;
  7. static integer const c__37 = 37;
  8. static integer const c__39 = 39;
  9. static integer const c__40 = 40;
  10. static integer const c__44 = 44;
  11. static integer const c__4 = 4;
  12. static integer const c__1 = 1;
  13. static integer const c__2 = 2;
  14. /* Initialized data */
  15. static double const bm1cs[37] = { .1069845452618063014969985308538,
  16. .003274915039715964900729055143445,
  17. -2.987783266831698592030445777938e-5,
  18. 8.331237177991974531393222669023e-7,
  19. -4.112665690302007304896381725498e-8,
  20. 2.855344228789215220719757663161e-9,
  21. -2.485408305415623878060026596055e-10,
  22. 2.543393338072582442742484397174e-11,
  23. -2.941045772822967523489750827909e-12,
  24. 3.743392025493903309265056153626e-13,
  25. -5.149118293821167218720548243527e-14,
  26. 7.552535949865143908034040764199e-15,
  27. -1.169409706828846444166290622464e-15,
  28. 1.89656244943479157172182460506e-16,
  29. -3.201955368693286420664775316394e-17,
  30. 5.599548399316204114484169905493e-18,
  31. -1.010215894730432443119390444544e-18,
  32. 1.873844985727562983302042719573e-19,
  33. -3.563537470328580219274301439999e-20,
  34. 6.931283819971238330422763519999e-21,
  35. -1.376059453406500152251408930133e-21,
  36. 2.783430784107080220599779327999e-22,
  37. -5.727595364320561689348669439999e-23,
  38. 1.197361445918892672535756799999e-23,
  39. -2.539928509891871976641440426666e-24,
  40. 5.461378289657295973069619199999e-25,
  41. -1.189211341773320288986289493333e-25,
  42. 2.620150977340081594957824e-26,
  43. -5.836810774255685901920938666666e-27,
  44. 1.313743500080595773423615999999e-27,
  45. -2.985814622510380355332778666666e-28,
  46. 6.848390471334604937625599999999e-29,
  47. -1.58440156822247672119296e-29,
  48. 3.695641006570938054301013333333e-30,
  49. -8.687115921144668243012266666666e-31,
  50. 2.057080846158763462929066666666e-31,
  51. -4.905225761116225518523733333333e-32 };
  52. static double const bt12cs[39] = { .73823860128742974662620839792764,
  53. -.0033361113174483906384470147681189,
  54. 6.1463454888046964698514899420186e-5,
  55. -2.4024585161602374264977635469568e-6,
  56. 1.4663555577509746153210591997204e-7,
  57. -1.1841917305589180567005147504983e-8,
  58. 1.1574198963919197052125466303055e-9,
  59. -1.3001161129439187449366007794571e-10,
  60. 1.6245391141361731937742166273667e-11,
  61. -2.2089636821403188752155441770128e-12,
  62. 3.2180304258553177090474358653778e-13,
  63. -4.9653147932768480785552021135381e-14,
  64. 8.0438900432847825985558882639317e-15,
  65. -1.3589121310161291384694712682282e-15,
  66. 2.3810504397147214869676529605973e-16,
  67. -4.3081466363849106724471241420799e-17,
  68. 8.02025440327710024349935125504e-18,
  69. -1.5316310642462311864230027468799e-18,
  70. 2.9928606352715568924073040554666e-19,
  71. -5.9709964658085443393815636650666e-20,
  72. 1.2140289669415185024160852650666e-20,
  73. -2.5115114696612948901006977706666e-21,
  74. 5.2790567170328744850738380799999e-22,
  75. -1.1260509227550498324361161386666e-22,
  76. 2.43482773595763266596634624e-23,
  77. -5.3317261236931800130038442666666e-24,
  78. 1.1813615059707121039205990399999e-24,
  79. -2.6465368283353523514856789333333e-25,
  80. 5.9903394041361503945577813333333e-26,
  81. -1.3690854630829503109136383999999e-26,
  82. 3.1576790154380228326413653333333e-27,
  83. -7.3457915082084356491400533333333e-28,
  84. 1.722808148072274793070592e-28,-4.07169079612865079410688e-29,
  85. 9.6934745136779622700373333333333e-30,
  86. -2.3237636337765716765354666666666e-30,
  87. 5.6074510673522029406890666666666e-31,
  88. -1.3616465391539005860522666666666e-31,
  89. 3.3263109233894654388906666666666e-32 };
  90. static double const bm12cs[40] = { .09807979156233050027272093546937,
  91. .001150961189504685306175483484602,
  92. -4.312482164338205409889358097732e-6,
  93. 5.951839610088816307813029801832e-8,
  94. -1.704844019826909857400701586478e-9,
  95. 7.798265413611109508658173827401e-11,
  96. -4.958986126766415809491754951865e-12,
  97. 4.038432416421141516838202265144e-13,
  98. -3.993046163725175445765483846645e-14,
  99. 4.619886183118966494313342432775e-15,
  100. -6.089208019095383301345472619333e-16,
  101. 8.960930916433876482157048041249e-17,
  102. -1.449629423942023122916518918925e-17,
  103. 2.546463158537776056165149648068e-18,
  104. -4.80947287464783644425926371862e-19,
  105. 9.687684668292599049087275839124e-20,
  106. -2.067213372277966023245038117551e-20,
  107. 4.64665155915038473180276780959e-21,
  108. -1.094966128848334138241351328339e-21,
  109. 2.693892797288682860905707612785e-22,
  110. -6.894992910930374477818970026857e-23,
  111. 1.83026826275206290989066855474e-23,
  112. -5.025064246351916428156113553224e-24,
  113. 1.423545194454806039631693634194e-24,
  114. -4.152191203616450388068886769801e-25,
  115. 1.244609201503979325882330076547e-25,
  116. -3.827336370569304299431918661286e-26,
  117. 1.205591357815617535374723981835e-26,
  118. -3.884536246376488076431859361124e-27,
  119. 1.278689528720409721904895283461e-27,
  120. -4.295146689447946272061936915912e-28,
  121. 1.470689117829070886456802707983e-28,
  122. -5.128315665106073128180374017796e-29,
  123. 1.819509585471169385481437373286e-29,
  124. -6.563031314841980867618635050373e-30,
  125. 2.404898976919960653198914875834e-30,
  126. -8.945966744690612473234958242979e-31,
  127. 3.37608516065723102663714897824e-31,
  128. -1.291791454620656360913099916966e-31,
  129. 5.008634462958810520684951501254e-32 };
  130. static double const bth1cs[44] = { .74749957203587276055443483969695,
  131. -.0012400777144651711252545777541384,
  132. 9.9252442404424527376641497689592e-6,
  133. -2.0303690737159711052419375375608e-7,
  134. 7.5359617705690885712184017583629e-9,
  135. -4.1661612715343550107630023856228e-10,
  136. 3.0701618070834890481245102091216e-11,
  137. -2.8178499637605213992324008883924e-12,
  138. 3.0790696739040295476028146821647e-13,
  139. -3.8803300262803434112787347554781e-14,
  140. 5.5096039608630904934561726208562e-15,
  141. -8.6590060768383779940103398953994e-16,
  142. 1.4856049141536749003423689060683e-16,
  143. -2.7519529815904085805371212125009e-17,
  144. 5.4550796090481089625036223640923e-18,
  145. -1.1486534501983642749543631027177e-18,
  146. 2.5535213377973900223199052533522e-19,
  147. -5.9621490197413450395768287907849e-20,
  148. 1.4556622902372718620288302005833e-20,
  149. -3.7022185422450538201579776019593e-21,
  150. 9.7763074125345357664168434517924e-22,
  151. -2.6726821639668488468723775393052e-22,
  152. 7.5453300384983271794038190655764e-23,
  153. -2.1947899919802744897892383371647e-23,
  154. 6.5648394623955262178906999817493e-24,
  155. -2.0155604298370207570784076869519e-24,
  156. 6.341776855677614349214466718567e-25,
  157. -2.0419277885337895634813769955591e-25,
  158. 6.7191464220720567486658980018551e-26,
  159. -2.2569079110207573595709003687336e-26,
  160. 7.7297719892989706370926959871929e-27,
  161. -2.696744451229464091321142408092e-27,
  162. 9.5749344518502698072295521933627e-28,
  163. -3.4569168448890113000175680827627e-28,
  164. 1.2681234817398436504211986238374e-28,
  165. -4.7232536630722639860464993713445e-29,
  166. 1.7850008478186376177858619796417e-29,
  167. -6.8404361004510395406215223566746e-30,
  168. 2.6566028671720419358293422672212e-30,
  169. -1.045040252791445291771416148467e-30,
  170. 4.1618290825377144306861917197064e-31,
  171. -1.6771639203643714856501347882887e-31,
  172. 6.8361997776664389173535928028528e-32,
  173. -2.817224786123364116673957462281e-32 };
  174. static double const pi4 = .785398163397448309615660845819876;
  175. static float const eta = (float) d1mach_(3) * (float).1;
  176. static integer const nbm1 = initds_(bm1cs, &c__37, &eta);
  177. static integer const nbm12 = initds_(bm12cs, &c__40, &eta);
  178. static integer const nbt12 = initds_(bt12cs, &c__39, &eta);
  179. static integer const nbth1 = initds_(bth1cs, &c__44, &eta);
  180. static double const xmax = 1. / d1mach_(4);
  181. int d9b1mp_(double const *x, double *ampl, double *theta)
  182. {
  183. /* Local variables */
  184. double z__;
  185. /* ***BEGIN PROLOGUE D9B1MP */
  186. /* ***SUBSIDIARY */
  187. /* ***PURPOSE Evaluate the modulus and phase for the J1 and Y1 Bessel */
  188. /* functions. */
  189. /* ***LIBRARY SLATEC (FNLIB) */
  190. /* ***CATEGORY C10A1 */
  191. /* ***TYPE DOUBLE PRECISION (D9B1MP-D) */
  192. /* ***KEYWORDS BESSEL FUNCTION, FNLIB, MODULUS, PHASE, SPECIAL FUNCTIONS */
  193. /* ***AUTHOR Fullerton, W., (LANL) */
  194. /* ***DESCRIPTION */
  195. /* Evaluate the modulus and phase for the Bessel J1 and Y1 functions. */
  196. /* Series for BM1 on the interval 1.56250E-02 to 6.25000E-02 */
  197. /* with weighted error 4.91E-32 */
  198. /* log weighted error 31.31 */
  199. /* significant figures required 30.04 */
  200. /* decimal places required 32.09 */
  201. /* Series for BT12 on the interval 1.56250E-02 to 6.25000E-02 */
  202. /* with weighted error 3.33E-32 */
  203. /* log weighted error 31.48 */
  204. /* significant figures required 31.05 */
  205. /* decimal places required 32.27 */
  206. /* Series for BM12 on the interval 0. to 1.56250E-02 */
  207. /* with weighted error 5.01E-32 */
  208. /* log weighted error 31.30 */
  209. /* significant figures required 29.99 */
  210. /* decimal places required 32.10 */
  211. /* Series for BTH1 on the interval 0. to 1.56250E-02 */
  212. /* with weighted error 2.82E-32 */
  213. /* log weighted error 31.55 */
  214. /* significant figures required 31.12 */
  215. /* decimal places required 32.37 */
  216. /* ***SEE ALSO DBESJ1, DBESY1 */
  217. /* ***REFERENCES (NONE) */
  218. /* ***ROUTINES CALLED D1MACH, DCSEVL, INITDS, XERMSG */
  219. /* ***REVISION HISTORY (YYMMDD) */
  220. /* 770701 DATE WRITTEN */
  221. /* 890531 Changed all specific intrinsics to generic. (WRB) */
  222. /* 890531 REVISION DATE from Version 3.2 */
  223. /* 891214 Prologue converted to Version 4.0 format. (BAB) */
  224. /* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
  225. /* 900720 Routine changed from user-callable to subsidiary. (WRB) */
  226. /* 920618 Removed space from variable name and code restructured to */
  227. /* use IF-THEN-ELSE. (RWC, WRB) */
  228. /* ***END PROLOGUE D9B1MP */
  229. /* ***FIRST EXECUTABLE STATEMENT D9B1MP */
  230. if (*x < 4.) {
  231. xermsg_("SLATEC", "D9B1MP", "X must be .GE. 4", &c__1, &c__2, (ftnlen)
  232. 6, (ftnlen)6, (ftnlen)16);
  233. *ampl = 0.;
  234. *theta = 0.;
  235. } else if (*x <= 8.) {
  236. z__ = (128. / (*x * *x) - 5.) / 3.;
  237. *ampl = (dcsevl_(&z__, bm1cs, &nbm1) + .75) / sqrt(*x);
  238. *theta = *x - pi4 * 3. + dcsevl_(&z__, bt12cs, &nbt12) / *x;
  239. } else {
  240. if (*x > xmax) {
  241. xermsg_("SLATEC", "D9B1MP", "No precision because X is too big", &
  242. c__2, &c__2, (ftnlen)6, (ftnlen)6, (ftnlen)33);
  243. }
  244. z__ = 128. / (*x * *x) - 1.;
  245. *ampl = (dcsevl_(&z__, bm12cs, &nbm12) + .75) / sqrt(*x);
  246. *theta = *x - pi4 * 3. + dcsevl_(&z__, bth1cs, &nbth1) / *x;
  247. }
  248. return 0;
  249. } /* d9b1mp_ */