gsl_specfunc__ellint.c 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628
  1. /* specfunc/ellint.c
  2. *
  3. * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
  4. *
  5. * This program is free software; you can redistribute it and/or modify
  6. * it under the terms of the GNU General Public License as published by
  7. * the Free Software Foundation; either version 3 of the License, or (at
  8. * your option) any later version.
  9. *
  10. * This program is distributed in the hope that it will be useful, but
  11. * WITHOUT ANY WARRANTY; without even the implied warranty of
  12. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13. * General Public License for more details.
  14. *
  15. * You should have received a copy of the GNU General Public License
  16. * along with this program; if not, write to the Free Software
  17. * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18. */
  19. /* Author: G. Jungman */
  20. #include "gsl__config.h"
  21. #include "gsl_math.h"
  22. #include "gsl_errno.h"
  23. #include "gsl_precision.h"
  24. #include "gsl_sf_ellint.h"
  25. #include "gsl_specfunc__error.h"
  26. /*-*-*-*-*-*-*-*-*-*-*-* Private Section *-*-*-*-*-*-*-*-*-*-*-*/
  27. inline
  28. static double locMAX3(double x, double y, double z)
  29. {
  30. double xy = GSL_MAX(x, y);
  31. return GSL_MAX(xy, z);
  32. }
  33. inline
  34. static double locMAX4(double x, double y, double z, double w)
  35. {
  36. double xy = GSL_MAX(x, y);
  37. double xyz = GSL_MAX(xy, z);
  38. return GSL_MAX(xyz, w);
  39. }
  40. /*-*-*-*-*-*-*-*-*-*-*-* Functions with Error Codes *-*-*-*-*-*-*-*-*-*-*-*/
  41. /* based on Carlson's algorithms:
  42. [B. C. Carlson Numer. Math. 33, 1 (1979)]
  43. see also:
  44. [B.C. Carlson, Special Functions of Applied Mathematics (1977)]
  45. */
  46. /* According to Carlson's algorithm, the errtol parameter
  47. typically effects the relative error in the following way:
  48. relative error < 16 errtol^6 / (1 - 2 errtol)
  49. errtol precision
  50. ------ ----------
  51. 0.001 1.0e-17
  52. 0.003 2.0e-14
  53. 0.01 2.0e-11
  54. 0.03 2.0e-8
  55. 0.1 2.0e-5
  56. */
  57. int
  58. gsl_sf_ellint_RC_e(double x, double y, gsl_mode_t mode, gsl_sf_result * result)
  59. {
  60. const double lolim = 5.0 * GSL_DBL_MIN;
  61. const double uplim = 0.2 * GSL_DBL_MAX;
  62. const gsl_prec_t goal = GSL_MODE_PREC(mode);
  63. const double errtol = ( goal == GSL_PREC_DOUBLE ? 0.001 : 0.03 );
  64. const double prec = gsl_prec_eps[goal];
  65. if(x < 0.0 || y < 0.0 || x + y < lolim) {
  66. DOMAIN_ERROR(result);
  67. }
  68. else if(GSL_MAX(x, y) < uplim) {
  69. const double c1 = 1.0 / 7.0;
  70. const double c2 = 9.0 / 22.0;
  71. double xn = x;
  72. double yn = y;
  73. double mu, sn, lamda, s;
  74. while(1) {
  75. mu = (xn + yn + yn) / 3.0;
  76. sn = (yn + mu) / mu - 2.0;
  77. if (fabs(sn) < errtol) break;
  78. lamda = 2.0 * sqrt(xn) * sqrt(yn) + yn;
  79. xn = (xn + lamda) * 0.25;
  80. yn = (yn + lamda) * 0.25;
  81. }
  82. s = sn * sn * (0.3 + sn * (c1 + sn * (0.375 + sn * c2)));
  83. result->val = (1.0 + s) / sqrt(mu);
  84. result->err = prec * fabs(result->val);
  85. return GSL_SUCCESS;
  86. }
  87. else {
  88. DOMAIN_ERROR(result);
  89. }
  90. }
  91. int
  92. gsl_sf_ellint_RD_e(double x, double y, double z, gsl_mode_t mode, gsl_sf_result * result)
  93. {
  94. const gsl_prec_t goal = GSL_MODE_PREC(mode);
  95. const double errtol = ( goal == GSL_PREC_DOUBLE ? 0.001 : 0.03 );
  96. const double prec = gsl_prec_eps[goal];
  97. const double lolim = 2.0/pow(GSL_DBL_MAX, 2.0/3.0);
  98. const double uplim = pow(0.1*errtol/GSL_DBL_MIN, 2.0/3.0);
  99. if(GSL_MIN(x,y) < 0.0 || GSL_MIN(x+y,z) < lolim) {
  100. DOMAIN_ERROR(result);
  101. }
  102. else if(locMAX3(x,y,z) < uplim) {
  103. const double c1 = 3.0 / 14.0;
  104. const double c2 = 1.0 / 6.0;
  105. const double c3 = 9.0 / 22.0;
  106. const double c4 = 3.0 / 26.0;
  107. double xn = x;
  108. double yn = y;
  109. double zn = z;
  110. double sigma = 0.0;
  111. double power4 = 1.0;
  112. double ea, eb, ec, ed, ef, s1, s2;
  113. double mu, xndev, yndev, zndev;
  114. while(1) {
  115. double xnroot, ynroot, znroot, lamda;
  116. double epslon;
  117. mu = (xn + yn + 3.0 * zn) * 0.2;
  118. xndev = (mu - xn) / mu;
  119. yndev = (mu - yn) / mu;
  120. zndev = (mu - zn) / mu;
  121. epslon = locMAX3(fabs(xndev), fabs(yndev), fabs(zndev));
  122. if (epslon < errtol) break;
  123. xnroot = sqrt(xn);
  124. ynroot = sqrt(yn);
  125. znroot = sqrt(zn);
  126. lamda = xnroot * (ynroot + znroot) + ynroot * znroot;
  127. sigma += power4 / (znroot * (zn + lamda));
  128. power4 *= 0.25;
  129. xn = (xn + lamda) * 0.25;
  130. yn = (yn + lamda) * 0.25;
  131. zn = (zn + lamda) * 0.25;
  132. }
  133. ea = xndev * yndev;
  134. eb = zndev * zndev;
  135. ec = ea - eb;
  136. ed = ea - 6.0 * eb;
  137. ef = ed + ec + ec;
  138. s1 = ed * (- c1 + 0.25 * c3 * ed - 1.5 * c4 * zndev * ef);
  139. s2 = zndev * (c2 * ef + zndev * (- c3 * ec + zndev * c4 * ea));
  140. result->val = 3.0 * sigma + power4 * (1.0 + s1 + s2) / (mu * sqrt(mu));
  141. result->err = prec * fabs(result->val);
  142. return GSL_SUCCESS;
  143. }
  144. else {
  145. DOMAIN_ERROR(result);
  146. }
  147. }
  148. int
  149. gsl_sf_ellint_RF_e(double x, double y, double z, gsl_mode_t mode, gsl_sf_result * result)
  150. {
  151. const double lolim = 5.0 * GSL_DBL_MIN;
  152. const double uplim = 0.2 * GSL_DBL_MAX;
  153. const gsl_prec_t goal = GSL_MODE_PREC(mode);
  154. const double errtol = ( goal == GSL_PREC_DOUBLE ? 0.001 : 0.03 );
  155. const double prec = gsl_prec_eps[goal];
  156. if(x < 0.0 || y < 0.0 || z < 0.0) {
  157. DOMAIN_ERROR(result);
  158. }
  159. else if(x+y < lolim || x+z < lolim || y+z < lolim) {
  160. DOMAIN_ERROR(result);
  161. }
  162. else if(locMAX3(x,y,z) < uplim) {
  163. const double c1 = 1.0 / 24.0;
  164. const double c2 = 3.0 / 44.0;
  165. const double c3 = 1.0 / 14.0;
  166. double xn = x;
  167. double yn = y;
  168. double zn = z;
  169. double mu, xndev, yndev, zndev, e2, e3, s;
  170. while(1) {
  171. double epslon, lamda;
  172. double xnroot, ynroot, znroot;
  173. mu = (xn + yn + zn) / 3.0;
  174. xndev = 2.0 - (mu + xn) / mu;
  175. yndev = 2.0 - (mu + yn) / mu;
  176. zndev = 2.0 - (mu + zn) / mu;
  177. epslon = locMAX3(fabs(xndev), fabs(yndev), fabs(zndev));
  178. if (epslon < errtol) break;
  179. xnroot = sqrt(xn);
  180. ynroot = sqrt(yn);
  181. znroot = sqrt(zn);
  182. lamda = xnroot * (ynroot + znroot) + ynroot * znroot;
  183. xn = (xn + lamda) * 0.25;
  184. yn = (yn + lamda) * 0.25;
  185. zn = (zn + lamda) * 0.25;
  186. }
  187. e2 = xndev * yndev - zndev * zndev;
  188. e3 = xndev * yndev * zndev;
  189. s = 1.0 + (c1 * e2 - 0.1 - c2 * e3) * e2 + c3 * e3;
  190. result->val = s / sqrt(mu);
  191. result->err = prec * fabs(result->val);
  192. return GSL_SUCCESS;
  193. }
  194. else {
  195. DOMAIN_ERROR(result);
  196. }
  197. }
  198. int
  199. gsl_sf_ellint_RJ_e(double x, double y, double z, double p, gsl_mode_t mode, gsl_sf_result * result)
  200. {
  201. const gsl_prec_t goal = GSL_MODE_PREC(mode);
  202. const double errtol = ( goal == GSL_PREC_DOUBLE ? 0.001 : 0.03 );
  203. const double prec = gsl_prec_eps[goal];
  204. const double lolim = pow(5.0 * GSL_DBL_MIN, 1.0/3.0);
  205. const double uplim = 0.3 * pow(0.2 * GSL_DBL_MAX, 1.0/3.0);
  206. if(x < 0.0 || y < 0.0 || z < 0.0) {
  207. DOMAIN_ERROR(result);
  208. }
  209. else if(x + y < lolim || x + z < lolim || y + z < lolim || p < lolim) {
  210. DOMAIN_ERROR(result);
  211. }
  212. else if(locMAX4(x,y,z,p) < uplim) {
  213. const double c1 = 3.0 / 14.0;
  214. const double c2 = 1.0 / 3.0;
  215. const double c3 = 3.0 / 22.0;
  216. const double c4 = 3.0 / 26.0;
  217. double xn = x;
  218. double yn = y;
  219. double zn = z;
  220. double pn = p;
  221. double sigma = 0.0;
  222. double power4 = 1.0;
  223. double mu, xndev, yndev, zndev, pndev;
  224. double ea, eb, ec, e2, e3, s1, s2, s3;
  225. while(1) {
  226. double xnroot, ynroot, znroot;
  227. double lamda, alfa, beta;
  228. double epslon;
  229. gsl_sf_result rcresult;
  230. int rcstatus;
  231. mu = (xn + yn + zn + pn + pn) * 0.2;
  232. xndev = (mu - xn) / mu;
  233. yndev = (mu - yn) / mu;
  234. zndev = (mu - zn) / mu;
  235. pndev = (mu - pn) / mu;
  236. epslon = locMAX4(fabs(xndev), fabs(yndev), fabs(zndev), fabs(pndev));
  237. if(epslon < errtol) break;
  238. xnroot = sqrt(xn);
  239. ynroot = sqrt(yn);
  240. znroot = sqrt(zn);
  241. lamda = xnroot * (ynroot + znroot) + ynroot * znroot;
  242. alfa = pn * (xnroot + ynroot + znroot) + xnroot * ynroot * znroot;
  243. alfa = alfa * alfa;
  244. beta = pn * (pn + lamda) * (pn + lamda);
  245. rcstatus = gsl_sf_ellint_RC_e(alfa, beta, mode, &rcresult);
  246. if(rcstatus != GSL_SUCCESS) {
  247. result->val = 0.0;
  248. result->err = 0.0;
  249. return rcstatus;
  250. }
  251. sigma += power4 * rcresult.val;
  252. power4 *= 0.25;
  253. xn = (xn + lamda) * 0.25;
  254. yn = (yn + lamda) * 0.25;
  255. zn = (zn + lamda) * 0.25;
  256. pn = (pn + lamda) * 0.25;
  257. }
  258. ea = xndev * (yndev + zndev) + yndev * zndev;
  259. eb = xndev * yndev * zndev;
  260. ec = pndev * pndev;
  261. e2 = ea - 3.0 * ec;
  262. e3 = eb + 2.0 * pndev * (ea - ec);
  263. s1 = 1.0 + e2 * (- c1 + 0.75 * c3 * e2 - 1.5 * c4 * e3);
  264. s2 = eb * (0.5 * c2 + pndev * (- c3 - c3 + pndev * c4));
  265. s3 = pndev * ea * (c2 - pndev * c3) - c2 * pndev * ec;
  266. result->val = 3.0 * sigma + power4 * (s1 + s2 + s3) / (mu * sqrt(mu));
  267. result->err = prec * fabs(result->val);
  268. return GSL_SUCCESS;
  269. }
  270. else {
  271. DOMAIN_ERROR(result);
  272. }
  273. }
  274. /* [Carlson, Numer. Math. 33 (1979) 1, (4.1)] */
  275. int
  276. gsl_sf_ellint_F_e(double phi, double k, gsl_mode_t mode, gsl_sf_result * result)
  277. {
  278. /* Angular reduction to -pi/2 < phi < pi/2 (we should really use an
  279. exact reduction but this will have to do for now) BJG */
  280. double nc = floor(phi/M_PI + 0.5);
  281. double phi_red = phi - nc * M_PI;
  282. phi = phi_red;
  283. {
  284. double sin_phi = sin(phi);
  285. double sin2_phi = sin_phi*sin_phi;
  286. double x = 1.0 - sin2_phi;
  287. double y = 1.0 - k*k*sin2_phi;
  288. gsl_sf_result rf;
  289. int status = gsl_sf_ellint_RF_e(x, y, 1.0, mode, &rf);
  290. result->val = sin_phi * rf.val;
  291. result->err = GSL_DBL_EPSILON * fabs(result->val) + fabs(sin_phi*rf.err);
  292. if (nc == 0) {
  293. return status;
  294. } else {
  295. gsl_sf_result rk; /* add extra terms from periodicity */
  296. const int rkstatus = gsl_sf_ellint_Kcomp_e(k, mode, &rk);
  297. result->val += 2*nc*rk.val;
  298. result->err += 2*fabs(nc)*rk.err;
  299. return GSL_ERROR_SELECT_2(status, rkstatus);
  300. }
  301. }
  302. }
  303. /* [Carlson, Numer. Math. 33 (1979) 1, (4.2)] */
  304. int
  305. gsl_sf_ellint_E_e(double phi, double k, gsl_mode_t mode, gsl_sf_result * result)
  306. {
  307. /* Angular reduction to -pi/2 < phi < pi/2 (we should really use an
  308. exact reduction but this will have to do for now) BJG */
  309. double nc = floor(phi/M_PI + 0.5);
  310. double phi_red = phi - nc * M_PI;
  311. phi = phi_red;
  312. {
  313. const double sin_phi = sin(phi);
  314. const double sin2_phi = sin_phi * sin_phi;
  315. const double x = 1.0 - sin2_phi;
  316. const double y = 1.0 - k*k*sin2_phi;
  317. if(x < GSL_DBL_EPSILON) {
  318. gsl_sf_result re;
  319. const int status = gsl_sf_ellint_Ecomp_e(k, mode, &re);
  320. /* could use A&S 17.4.14 to improve the value below */
  321. result->val = 2*nc*re.val + GSL_SIGN(sin_phi) * re.val;
  322. result->err = 2*fabs(nc)*re.err + re.err;
  323. return status;
  324. }
  325. else {
  326. gsl_sf_result rf, rd;
  327. const double sin3_phi = sin2_phi * sin_phi;
  328. const int rfstatus = gsl_sf_ellint_RF_e(x, y, 1.0, mode, &rf);
  329. const int rdstatus = gsl_sf_ellint_RD_e(x, y, 1.0, mode, &rd);
  330. result->val = sin_phi * rf.val - k*k/3.0 * sin3_phi * rd.val;
  331. result->err = GSL_DBL_EPSILON * fabs(sin_phi * rf.val);
  332. result->err += fabs(sin_phi*rf.err);
  333. result->err += k*k/3.0 * GSL_DBL_EPSILON * fabs(sin3_phi * rd.val);
  334. result->err += k*k/3.0 * fabs(sin3_phi*rd.err);
  335. if (nc == 0) {
  336. return GSL_ERROR_SELECT_2(rfstatus, rdstatus);
  337. } else {
  338. gsl_sf_result re; /* add extra terms from periodicity */
  339. const int restatus = gsl_sf_ellint_Ecomp_e(k, mode, &re);
  340. result->val += 2*nc*re.val;
  341. result->err += 2*fabs(nc)*re.err;
  342. return GSL_ERROR_SELECT_3(rfstatus, rdstatus, restatus);
  343. }
  344. }
  345. }
  346. }
  347. /* [Carlson, Numer. Math. 33 (1979) 1, (4.3)] */
  348. int
  349. gsl_sf_ellint_P_e(double phi, double k, double n, gsl_mode_t mode, gsl_sf_result * result)
  350. {
  351. /* Angular reduction to -pi/2 < phi < pi/2 (we should really use an
  352. exact reduction but this will have to do for now) BJG */
  353. double nc = floor(phi/M_PI + 0.5);
  354. double phi_red = phi - nc * M_PI;
  355. phi = phi_red;
  356. /* FIXME: need to handle the case of small x, as for E,F */
  357. {
  358. const double sin_phi = sin(phi);
  359. const double sin2_phi = sin_phi * sin_phi;
  360. const double sin3_phi = sin2_phi * sin_phi;
  361. const double x = 1.0 - sin2_phi;
  362. const double y = 1.0 - k*k*sin2_phi;
  363. gsl_sf_result rf;
  364. gsl_sf_result rj;
  365. const int rfstatus = gsl_sf_ellint_RF_e(x, y, 1.0, mode, &rf);
  366. const int rjstatus = gsl_sf_ellint_RJ_e(x, y, 1.0, 1.0 + n*sin2_phi, mode, &rj);
  367. result->val = sin_phi * rf.val - n/3.0*sin3_phi * rj.val;
  368. result->err = GSL_DBL_EPSILON * fabs(sin_phi * rf.val);
  369. result->err += fabs(sin_phi * rf.err);
  370. result->err += n/3.0 * GSL_DBL_EPSILON * fabs(sin3_phi*rj.val);
  371. result->err += n/3.0 * fabs(sin3_phi*rj.err);
  372. if (nc == 0) {
  373. return GSL_ERROR_SELECT_2(rfstatus, rjstatus);
  374. } else {
  375. gsl_sf_result rp; /* add extra terms from periodicity */
  376. const int rpstatus = gsl_sf_ellint_Pcomp_e(k, n, mode, &rp);
  377. result->val += 2*nc*rp.val;
  378. result->err += 2*fabs(nc)*rp.err;
  379. return GSL_ERROR_SELECT_3(rfstatus, rjstatus, rpstatus);
  380. }
  381. }
  382. }
  383. /* [Carlson, Numer. Math. 33 (1979) 1, (4.4)] */
  384. int
  385. gsl_sf_ellint_D_e(double phi, double k, double n, gsl_mode_t mode, gsl_sf_result * result)
  386. {
  387. /* Angular reduction to -pi/2 < phi < pi/2 (we should really use an
  388. exact reduction but this will have to do for now) BJG */
  389. double nc = floor(phi/M_PI + 0.5);
  390. double phi_red = phi - nc * M_PI;
  391. phi = phi_red;
  392. /* FIXME: need to handle the case of small x, as for E,F */
  393. {
  394. const double sin_phi = sin(phi);
  395. const double sin2_phi = sin_phi * sin_phi;
  396. const double sin3_phi = sin2_phi * sin_phi;
  397. const double x = 1.0 - sin2_phi;
  398. const double y = 1.0 - k*k*sin2_phi;
  399. gsl_sf_result rd;
  400. const int status = gsl_sf_ellint_RD_e(x, y, 1.0, mode, &rd);
  401. result->val = sin3_phi/3.0 * rd.val;
  402. result->err = GSL_DBL_EPSILON * fabs(result->val) + fabs(sin3_phi/3.0 * rd.err);
  403. if (nc == 0) {
  404. return status;
  405. } else {
  406. gsl_sf_result rd; /* add extra terms from periodicity */
  407. const int rdstatus = gsl_sf_ellint_Dcomp_e(k, mode, &rd);
  408. result->val += 2*nc*rd.val;
  409. result->err += 2*fabs(nc)*rd.err;
  410. return GSL_ERROR_SELECT_2(status, rdstatus);
  411. }
  412. }
  413. }
  414. int
  415. gsl_sf_ellint_Dcomp_e(double k, gsl_mode_t mode, gsl_sf_result * result)
  416. {
  417. if(k*k >= 1.0) {
  418. DOMAIN_ERROR(result);
  419. } else {
  420. const double y = 1.0 - k*k; /* FIXME: still need to handle k~=~1 */
  421. gsl_sf_result rd;
  422. const int status = gsl_sf_ellint_RD_e(0.0, y, 1.0, mode, &rd);
  423. result->val = (1.0/3.0) * rd.val;
  424. result->err = GSL_DBL_EPSILON * fabs(result->val) + fabs(1.0/3.0 * rd.err);
  425. return status;
  426. }
  427. }
  428. /* [Carlson, Numer. Math. 33 (1979) 1, (4.5)] */
  429. int
  430. gsl_sf_ellint_Kcomp_e(double k, gsl_mode_t mode, gsl_sf_result * result)
  431. {
  432. if(k*k >= 1.0) {
  433. DOMAIN_ERROR(result);
  434. }
  435. else if(k*k >= 1.0 - GSL_SQRT_DBL_EPSILON) {
  436. /* [Abramowitz+Stegun, 17.3.33] */
  437. const double y = 1.0 - k*k;
  438. const double a[] = { 1.38629436112, 0.09666344259, 0.03590092383 };
  439. const double b[] = { 0.5, 0.12498593597, 0.06880248576 };
  440. const double ta = a[0] + y*(a[1] + y*a[2]);
  441. const double tb = -log(y) * (b[0] * y*(b[1] + y*b[2]));
  442. result->val = ta + tb;
  443. result->err = 2.0 * GSL_DBL_EPSILON * result->val;
  444. return GSL_SUCCESS;
  445. }
  446. else {
  447. /* This was previously computed as,
  448. return gsl_sf_ellint_RF_e(0.0, 1.0 - k*k, 1.0, mode, result);
  449. but this underestimated the total error for small k, since the
  450. argument y=1-k^2 is not exact (there is an absolute error of
  451. GSL_DBL_EPSILON near y=0 due to cancellation in the subtraction).
  452. Taking the singular behavior of -log(y) above gives an error
  453. of 0.5*epsilon/y near y=0. (BJG) */
  454. double y = 1.0 - k*k;
  455. int status = gsl_sf_ellint_RF_e(0.0, y, 1.0, mode, result);
  456. result->err += 0.5 * GSL_DBL_EPSILON / y;
  457. return status ;
  458. }
  459. }
  460. /* [Carlson, Numer. Math. 33 (1979) 1, (4.6)] */
  461. int
  462. gsl_sf_ellint_Ecomp_e(double k, gsl_mode_t mode, gsl_sf_result * result)
  463. {
  464. if(k*k >= 1.0) {
  465. DOMAIN_ERROR(result);
  466. }
  467. else if(k*k >= 1.0 - GSL_SQRT_DBL_EPSILON) {
  468. /* [Abramowitz+Stegun, 17.3.36] */
  469. const double y = 1.0 - k*k;
  470. const double a[] = { 0.44325141463, 0.06260601220, 0.04757383546 };
  471. const double b[] = { 0.24998368310, 0.09200180037, 0.04069697526 };
  472. const double ta = 1.0 + y*(a[0] + y*(a[1] + a[2]*y));
  473. const double tb = -y*log(y) * (b[0] + y*(b[1] + b[2]*y));
  474. result->val = ta + tb;
  475. result->err = 2.0 * GSL_DBL_EPSILON * result->val;
  476. return GSL_SUCCESS;
  477. }
  478. else {
  479. gsl_sf_result rf;
  480. gsl_sf_result rd;
  481. const double y = 1.0 - k*k;
  482. const int rfstatus = gsl_sf_ellint_RF_e(0.0, y, 1.0, mode, &rf);
  483. const int rdstatus = gsl_sf_ellint_RD_e(0.0, y, 1.0, mode, &rd);
  484. result->val = rf.val - k*k/3.0 * rd.val;
  485. result->err = rf.err + k*k/3.0 * rd.err;
  486. return GSL_ERROR_SELECT_2(rfstatus, rdstatus);
  487. }
  488. }
  489. /* [Carlson, Numer. Math. 33 (1979) 1, (4.3) phi=pi/2] */
  490. int
  491. gsl_sf_ellint_Pcomp_e(double k, double n, gsl_mode_t mode, gsl_sf_result * result)
  492. {
  493. if(k*k >= 1.0) {
  494. DOMAIN_ERROR(result);
  495. }
  496. /* FIXME: need to handle k ~=~ 1 cancellations */
  497. else {
  498. gsl_sf_result rf;
  499. gsl_sf_result rj;
  500. const double y = 1.0 - k*k;
  501. const int rfstatus = gsl_sf_ellint_RF_e(0.0, y, 1.0, mode, &rf);
  502. const int rjstatus = gsl_sf_ellint_RJ_e(0.0, y, 1.0, 1.0 + n, mode, &rj);
  503. result->val = rf.val - (n/3.0) * rj.val;
  504. result->err = rf.err + fabs(n/3.0) * rj.err;
  505. return GSL_ERROR_SELECT_2(rfstatus, rjstatus);
  506. }
  507. }
  508. /*-*-*-*-*-*-*-*-*-* Functions w/ Natural Prototypes *-*-*-*-*-*-*-*-*-*-*/
  509. #include "gsl_specfunc__eval.h"
  510. double gsl_sf_ellint_Kcomp(double k, gsl_mode_t mode)
  511. {
  512. EVAL_RESULT(gsl_sf_ellint_Kcomp_e(k, mode, &result));
  513. }
  514. double gsl_sf_ellint_Ecomp(double k, gsl_mode_t mode)
  515. {
  516. EVAL_RESULT(gsl_sf_ellint_Ecomp_e(k, mode, &result));
  517. }
  518. double gsl_sf_ellint_Pcomp(double k, double n, gsl_mode_t mode)
  519. {
  520. EVAL_RESULT(gsl_sf_ellint_Pcomp_e(k, n, mode, &result));
  521. }
  522. double gsl_sf_ellint_Dcomp(double k, gsl_mode_t mode)
  523. {
  524. EVAL_RESULT(gsl_sf_ellint_Dcomp_e(k, mode, &result));
  525. }
  526. double gsl_sf_ellint_F(double phi, double k, gsl_mode_t mode)
  527. {
  528. EVAL_RESULT(gsl_sf_ellint_F_e(phi, k, mode, &result));
  529. }
  530. double gsl_sf_ellint_E(double phi, double k, gsl_mode_t mode)
  531. {
  532. EVAL_RESULT(gsl_sf_ellint_E_e(phi, k, mode, &result));
  533. }
  534. double gsl_sf_ellint_P(double phi, double k, double n, gsl_mode_t mode)
  535. {
  536. EVAL_RESULT(gsl_sf_ellint_P_e(phi, k, n, mode, &result));
  537. }
  538. double gsl_sf_ellint_D(double phi, double k, double n, gsl_mode_t mode)
  539. {
  540. EVAL_RESULT(gsl_sf_ellint_D_e(phi, k, n, mode, &result));
  541. }
  542. double gsl_sf_ellint_RC(double x, double y, gsl_mode_t mode)
  543. {
  544. EVAL_RESULT(gsl_sf_ellint_RC_e(x, y, mode, &result));
  545. }
  546. double gsl_sf_ellint_RD(double x, double y, double z, gsl_mode_t mode)
  547. {
  548. EVAL_RESULT(gsl_sf_ellint_RD_e(x, y, z, mode, &result));
  549. }
  550. double gsl_sf_ellint_RF(double x, double y, double z, gsl_mode_t mode)
  551. {
  552. EVAL_RESULT(gsl_sf_ellint_RF_e(x, y, z, mode, &result));
  553. }
  554. double gsl_sf_ellint_RJ(double x, double y, double z, double p, gsl_mode_t mode)
  555. {
  556. EVAL_RESULT(gsl_sf_ellint_RJ_e(x, y, z, p, mode, &result));
  557. }