1 /* specfunc/hyperg_2F1.c
3 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2004 Gerard Jungman
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.
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.
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.
20 /* Author: G. Jungman */
23 #include <gsl/gsl_math.h>
24 #include <gsl/gsl_errno.h>
25 #include <gsl/gsl_sf_exp.h>
26 #include <gsl/gsl_sf_pow_int.h>
27 #include <gsl/gsl_sf_gamma.h>
28 #include <gsl/gsl_sf_psi.h>
29 #include <gsl/gsl_sf_hyperg.h>
33 #define locEPS (1000.0*GSL_DBL_EPSILON)
36 /* Assumes c != negative integer.
39 hyperg_2F1_series(const double a, const double b, const double c,
41 gsl_sf_result * result
52 if(fabs(c) < GSL_DBL_EPSILON) {
53 result->val = 0.0; /* FIXME: ?? */
55 GSL_ERROR ("error", GSL_EDOM);
60 result->val = sum_pos - sum_neg;
61 result->err = del_pos + del_neg;
62 result->err += 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
63 result->err += 2.0 * GSL_DBL_EPSILON * (2.0*sqrt(k)+1.0) * fabs(result->val);
64 GSL_ERROR ("error", GSL_EMAXITER);
66 del *= (a+k)*(b+k) * x / ((c+k) * (k+1.0)); /* Gauss series */
73 /* Exact termination (a or b was a negative integer).
85 } while(fabs((del_pos + del_neg)/(sum_pos-sum_neg)) > GSL_DBL_EPSILON);
87 result->val = sum_pos - sum_neg;
88 result->err = del_pos + del_neg;
89 result->err += 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
90 result->err += 2.0 * GSL_DBL_EPSILON * (2.0*sqrt(k) + 1.0) * fabs(result->val);
96 /* a = aR + i aI, b = aR - i aI */
99 hyperg_2F1_conj_series(const double aR, const double aI, const double c,
101 gsl_sf_result * result)
104 result->val = 0.0; /* FIXME: should be Inf */
106 GSL_ERROR ("error", GSL_EDOM);
109 double sum_pos = 1.0;
110 double sum_neg = 0.0;
111 double del_pos = 1.0;
112 double del_neg = 0.0;
116 del *= ((aR+k)*(aR+k) + aI*aI)/((k+1.0)*(c+k)) * x;
128 result->val = sum_pos - sum_neg;
129 result->err = del_pos + del_neg;
130 result->err += 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
131 result->err += 2.0 * GSL_DBL_EPSILON * (2.0*sqrt(k)+1.0) * fabs(result->val);
132 GSL_ERROR ("error", GSL_EMAXITER);
136 } while(fabs((del_pos + del_neg)/(sum_pos - sum_neg)) > GSL_DBL_EPSILON);
138 result->val = sum_pos - sum_neg;
139 result->err = del_pos + del_neg;
140 result->err += 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
141 result->err += 2.0 * GSL_DBL_EPSILON * (2.0*sqrt(k) + 1.0) * fabs(result->val);
148 /* Luke's rational approximation. The most accesible
149 * discussion is in [Kolbig, CPC 23, 51 (1981)].
150 * The convergence is supposedly guaranteed for x < 0.
151 * You have to read Luke's books to see this and other
152 * results. Unfortunately, the stability is not so
153 * clear to me, although it seems very efficient when
158 hyperg_2F1_luke(const double a, const double b, const double c,
160 gsl_sf_result * result)
163 const double RECUR_BIG = 1.0e+50;
164 const int nmax = 20000;
166 const double x = -xin;
167 const double x3 = x*x*x;
168 const double t0 = a*b/c;
169 const double t1 = (a+1.0)*(b+1.0)/(2.0*c);
170 const double t2 = (a+2.0)*(b+2.0)/(2.0*(c+1.0));
174 double Bnm3 = 1.0; /* B0 */
175 double Bnm2 = 1.0 + t1 * x; /* B1 */
176 double Bnm1 = 1.0 + t2 * x * (1.0 + t1/3.0 * x); /* B2 */
178 double Anm3 = 1.0; /* A0 */
179 double Anm2 = Bnm2 - t0 * x; /* A1 */
180 double Anm1 = Bnm1 - t0*(1.0 + t2*x)*x + t0 * t1 * (c/(c+1.0)) * x*x; /* A2 */
183 double npam1 = n + a - 1;
184 double npbm1 = n + b - 1;
185 double npcm1 = n + c - 1;
186 double npam2 = n + a - 2;
187 double npbm2 = n + b - 2;
188 double npcm2 = n + c - 2;
189 double tnm1 = 2*n - 1;
190 double tnm3 = 2*n - 3;
191 double tnm5 = 2*n - 5;
193 double F1 = (3.0*n2 + (a+b-6)*n + 2 - a*b - 2*(a+b)) / (2*tnm3*npcm1);
194 double F2 = -(3.0*n2 - (a+b+6)*n + 2 - a*b)*npam1*npbm1/(4*tnm1*tnm3*npcm2*npcm1);
195 double F3 = (npam2*npam1*npbm2*npbm1*(n-a-2)*(n-b-2)) / (8*tnm3*tnm3*tnm5*(n+c-3)*npcm2*npcm1);
196 double E = -npam1*npbm1*(n-c-1) / (2*tnm3*npcm2*npcm1);
198 double An = (1.0+F1*x)*Anm1 + (E + F2*x)*x*Anm2 + F3*x3*Anm3;
199 double Bn = (1.0+F1*x)*Bnm1 + (E + F2*x)*x*Bnm2 + F3*x3*Bnm3;
202 prec = fabs((F - r)/F);
205 if(prec < GSL_DBL_EPSILON || n > nmax) break;
207 if(fabs(An) > RECUR_BIG || fabs(Bn) > RECUR_BIG) {
217 else if(fabs(An) < 1.0/RECUR_BIG || fabs(Bn) < 1.0/RECUR_BIG) {
238 result->err = 2.0 * fabs(prec * F);
239 result->err += 2.0 * GSL_DBL_EPSILON * (n+1.0) * fabs(F);
241 /* FIXME: just a hack: there's a lot of shit going on here */
242 result->err *= 8.0 * (fabs(a) + fabs(b) + 1.0);
244 stat_iter = (n >= nmax ? GSL_EMAXITER : GSL_SUCCESS );
250 /* Luke's rational approximation for the
251 * case a = aR + i aI, b = aR - i aI.
255 hyperg_2F1_conj_luke(const double aR, const double aI, const double c,
257 gsl_sf_result * result)
260 const double RECUR_BIG = 1.0e+50;
261 const int nmax = 10000;
263 const double x = -xin;
264 const double x3 = x*x*x;
265 const double atimesb = aR*aR + aI*aI;
266 const double apb = 2.0*aR;
267 const double t0 = atimesb/c;
268 const double t1 = (atimesb + apb + 1.0)/(2.0*c);
269 const double t2 = (atimesb + 2.0*apb + 4.0)/(2.0*(c+1.0));
273 double Bnm3 = 1.0; /* B0 */
274 double Bnm2 = 1.0 + t1 * x; /* B1 */
275 double Bnm1 = 1.0 + t2 * x * (1.0 + t1/3.0 * x); /* B2 */
277 double Anm3 = 1.0; /* A0 */
278 double Anm2 = Bnm2 - t0 * x; /* A1 */
279 double Anm1 = Bnm1 - t0*(1.0 + t2*x)*x + t0 * t1 * (c/(c+1.0)) * x*x; /* A2 */
284 double npam1_npbm1 = atimesb + nm1*apb + nm1*nm1;
285 double npam2_npbm2 = atimesb + nm2*apb + nm2*nm2;
286 double npcm1 = nm1 + c;
287 double npcm2 = nm2 + c;
288 double tnm1 = 2*n - 1;
289 double tnm3 = 2*n - 3;
290 double tnm5 = 2*n - 5;
292 double F1 = (3.0*n2 + (apb-6)*n + 2 - atimesb - 2*apb) / (2*tnm3*npcm1);
293 double F2 = -(3.0*n2 - (apb+6)*n + 2 - atimesb)*npam1_npbm1/(4*tnm1*tnm3*npcm2*npcm1);
294 double F3 = (npam2_npbm2*npam1_npbm1*(nm2*nm2 - nm2*apb + atimesb)) / (8*tnm3*tnm3*tnm5*(n+c-3)*npcm2*npcm1);
295 double E = -npam1_npbm1*(n-c-1) / (2*tnm3*npcm2*npcm1);
297 double An = (1.0+F1*x)*Anm1 + (E + F2*x)*x*Anm2 + F3*x3*Anm3;
298 double Bn = (1.0+F1*x)*Bnm1 + (E + F2*x)*x*Bnm2 + F3*x3*Bnm3;
301 prec = fabs(F - r)/fabs(F);
304 if(prec < GSL_DBL_EPSILON || n > nmax) break;
306 if(fabs(An) > RECUR_BIG || fabs(Bn) > RECUR_BIG) {
316 else if(fabs(An) < 1.0/RECUR_BIG || fabs(Bn) < 1.0/RECUR_BIG) {
337 result->err = 2.0 * fabs(prec * F);
338 result->err += 2.0 * GSL_DBL_EPSILON * (n+1.0) * fabs(F);
340 /* FIXME: see above */
341 result->err *= 8.0 * (fabs(aR) + fabs(aI) + 1.0);
343 stat_iter = (n >= nmax ? GSL_EMAXITER : GSL_SUCCESS );
349 /* Do the reflection described in [Moshier, p. 334].
350 * Assumes a,b,c != neg integer.
354 hyperg_2F1_reflect(const double a, const double b, const double c,
355 const double x, gsl_sf_result * result)
357 const double d = c - a - b;
358 const int intd = floor(d+0.5);
359 const int d_integer = ( fabs(d - intd) < locEPS );
362 const double ln_omx = log(1.0 - x);
363 const double ad = fabs(d);
364 int stat_F2 = GSL_SUCCESS;
370 gsl_sf_result lng_ad2;
371 gsl_sf_result lng_bd2;
385 stat_ad2 = gsl_sf_lngamma_e(a+d2, &lng_ad2);
386 stat_bd2 = gsl_sf_lngamma_e(b+d2, &lng_bd2);
387 stat_c = gsl_sf_lngamma_e(c, &lng_c);
391 if(ad < GSL_DBL_EPSILON) {
397 gsl_sf_result lng_ad;
398 gsl_sf_result lng_ad1;
399 gsl_sf_result lng_bd1;
400 int stat_ad = gsl_sf_lngamma_e(ad, &lng_ad);
401 int stat_ad1 = gsl_sf_lngamma_e(a+d1, &lng_ad1);
402 int stat_bd1 = gsl_sf_lngamma_e(b+d1, &lng_bd1);
404 if(stat_ad1 == GSL_SUCCESS && stat_bd1 == GSL_SUCCESS && stat_ad == GSL_SUCCESS) {
405 /* Gamma functions in the denominator are ok.
406 * Proceed with evaluation.
411 double ln_pre1_val = lng_ad.val + lng_c.val + d2*ln_omx - lng_ad1.val - lng_bd1.val;
412 double ln_pre1_err = lng_ad.err + lng_c.err + lng_ad1.err + lng_bd1.err + GSL_DBL_EPSILON * fabs(ln_pre1_val);
417 for(i=1; i<ad; i++) {
419 term *= (a + d2 + j) * (b + d2 + j) / (1.0 + d2 + j) / i * (1.0-x);
423 stat_e = gsl_sf_exp_mult_err_e(ln_pre1_val, ln_pre1_err,
424 sum1, GSL_DBL_EPSILON*fabs(sum1),
426 if(stat_e == GSL_EOVRFLW) {
427 OVERFLOW_ERROR(result);
431 /* Gamma functions in the denominator were not ok.
432 * So the F1 term is zero.
437 } /* end F1 evaluation */
442 if(stat_ad2 == GSL_SUCCESS && stat_bd2 == GSL_SUCCESS) {
443 /* Gamma functions in the denominator are ok.
444 * Proceed with evaluation.
446 const int maxiter = 2000;
447 double psi_1 = -M_EULER;
448 gsl_sf_result psi_1pd;
449 gsl_sf_result psi_apd1;
450 gsl_sf_result psi_bpd1;
451 int stat_1pd = gsl_sf_psi_e(1.0 + ad, &psi_1pd);
452 int stat_apd1 = gsl_sf_psi_e(a + d1, &psi_apd1);
453 int stat_bpd1 = gsl_sf_psi_e(b + d1, &psi_bpd1);
454 int stat_dall = GSL_ERROR_SELECT_3(stat_1pd, stat_apd1, stat_bpd1);
456 double psi_val = psi_1 + psi_1pd.val - psi_apd1.val - psi_bpd1.val - ln_omx;
457 double psi_err = psi_1pd.err + psi_apd1.err + psi_bpd1.err + GSL_DBL_EPSILON*fabs(psi_val);
459 double sum2_val = psi_val;
460 double sum2_err = psi_err;
461 double ln_pre2_val = lng_c.val + d1*ln_omx - lng_ad2.val - lng_bd2.val;
462 double ln_pre2_err = lng_c.err + lng_ad2.err + lng_bd2.err + GSL_DBL_EPSILON * fabs(ln_pre2_val);
469 for(j=1; j<maxiter; j++) {
470 /* values for psi functions use recurrence; Abramowitz+Stegun 6.3.5 */
471 double term1 = 1.0/(double)j + 1.0/(ad+j);
472 double term2 = 1.0/(a+d1+j-1.0) + 1.0/(b+d1+j-1.0);
474 psi_val += term1 - term2;
475 psi_err += GSL_DBL_EPSILON * (fabs(term1) + fabs(term2));
476 fact *= (a+d1+j-1.0)*(b+d1+j-1.0)/((ad+j)*j) * (1.0-x);
477 delta = fact * psi_val;
479 sum2_err += fabs(fact * psi_err) + GSL_DBL_EPSILON*fabs(delta);
480 if(fabs(delta) < GSL_DBL_EPSILON * fabs(sum2_val)) break;
483 if(j == maxiter) stat_F2 = GSL_EMAXITER;
485 if(sum2_val == 0.0) {
490 stat_e = gsl_sf_exp_mult_err_e(ln_pre2_val, ln_pre2_err,
493 if(stat_e == GSL_EOVRFLW) {
496 GSL_ERROR ("error", GSL_EOVRFLW);
499 stat_F2 = GSL_ERROR_SELECT_2(stat_F2, stat_dall);
502 /* Gamma functions in the denominator not ok.
503 * So the F2 term is zero.
507 } /* end F2 evaluation */
509 sgn_2 = ( GSL_IS_ODD(intd) ? -1.0 : 1.0 );
510 result->val = F1.val + sgn_2 * F2.val;
511 result->err = F1.err + F2. err;
512 result->err += 2.0 * GSL_DBL_EPSILON * (fabs(F1.val) + fabs(F2.val));
513 result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
517 /* d not an integer */
519 gsl_sf_result pre1, pre2;
521 gsl_sf_result F1, F2;
522 int status_F1, status_F2;
524 /* These gamma functions appear in the denominator, so we
525 * catch their harmless domain errors and set the terms to zero.
527 gsl_sf_result ln_g1ca, ln_g1cb, ln_g2a, ln_g2b;
528 double sgn_g1ca, sgn_g1cb, sgn_g2a, sgn_g2b;
529 int stat_1ca = gsl_sf_lngamma_sgn_e(c-a, &ln_g1ca, &sgn_g1ca);
530 int stat_1cb = gsl_sf_lngamma_sgn_e(c-b, &ln_g1cb, &sgn_g1cb);
531 int stat_2a = gsl_sf_lngamma_sgn_e(a, &ln_g2a, &sgn_g2a);
532 int stat_2b = gsl_sf_lngamma_sgn_e(b, &ln_g2b, &sgn_g2b);
533 int ok1 = (stat_1ca == GSL_SUCCESS && stat_1cb == GSL_SUCCESS);
534 int ok2 = (stat_2a == GSL_SUCCESS && stat_2b == GSL_SUCCESS);
536 gsl_sf_result ln_gc, ln_gd, ln_gmd;
537 double sgn_gc, sgn_gd, sgn_gmd;
538 gsl_sf_lngamma_sgn_e( c, &ln_gc, &sgn_gc);
539 gsl_sf_lngamma_sgn_e( d, &ln_gd, &sgn_gd);
540 gsl_sf_lngamma_sgn_e(-d, &ln_gmd, &sgn_gmd);
542 sgn1 = sgn_gc * sgn_gd * sgn_g1ca * sgn_g1cb;
543 sgn2 = sgn_gc * sgn_gmd * sgn_g2a * sgn_g2b;
546 double ln_pre1_val = ln_gc.val + ln_gd.val - ln_g1ca.val - ln_g1cb.val;
547 double ln_pre2_val = ln_gc.val + ln_gmd.val - ln_g2a.val - ln_g2b.val + d*log(1.0-x);
548 double ln_pre1_err = ln_gc.err + ln_gd.err + ln_g1ca.err + ln_g1cb.err;
549 double ln_pre2_err = ln_gc.err + ln_gmd.err + ln_g2a.err + ln_g2b.err;
550 if(ln_pre1_val < GSL_LOG_DBL_MAX && ln_pre2_val < GSL_LOG_DBL_MAX) {
551 gsl_sf_exp_err_e(ln_pre1_val, ln_pre1_err, &pre1);
552 gsl_sf_exp_err_e(ln_pre2_val, ln_pre2_err, &pre2);
557 OVERFLOW_ERROR(result);
560 else if(ok1 && !ok2) {
561 double ln_pre1_val = ln_gc.val + ln_gd.val - ln_g1ca.val - ln_g1cb.val;
562 double ln_pre1_err = ln_gc.err + ln_gd.err + ln_g1ca.err + ln_g1cb.err;
563 if(ln_pre1_val < GSL_LOG_DBL_MAX) {
564 gsl_sf_exp_err_e(ln_pre1_val, ln_pre1_err, &pre1);
570 OVERFLOW_ERROR(result);
573 else if(!ok1 && ok2) {
574 double ln_pre2_val = ln_gc.val + ln_gmd.val - ln_g2a.val - ln_g2b.val + d*log(1.0-x);
575 double ln_pre2_err = ln_gc.err + ln_gmd.err + ln_g2a.err + ln_g2b.err;
576 if(ln_pre2_val < GSL_LOG_DBL_MAX) {
579 gsl_sf_exp_err_e(ln_pre2_val, ln_pre2_err, &pre2);
583 OVERFLOW_ERROR(result);
589 UNDERFLOW_ERROR(result);
592 status_F1 = hyperg_2F1_series( a, b, 1.0-d, 1.0-x, &F1);
593 status_F2 = hyperg_2F1_series(c-a, c-b, 1.0+d, 1.0-x, &F2);
595 result->val = pre1.val*F1.val + pre2.val*F2.val;
596 result->err = fabs(pre1.val*F1.err) + fabs(pre2.val*F2.err);
597 result->err += fabs(pre1.err*F1.val) + fabs(pre2.err*F2.val);
598 result->err += 2.0 * GSL_DBL_EPSILON * (fabs(pre1.val*F1.val) + fabs(pre2.val*F2.val));
599 result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
606 static int pow_omx(const double x, const double p, gsl_sf_result * result)
610 if(fabs(x) < GSL_ROOT5_DBL_EPSILON) {
611 ln_omx = -x*(1.0 + x*(1.0/2.0 + x*(1.0/3.0 + x/4.0 + x*x/5.0)));
616 ln_result = p * ln_omx;
617 return gsl_sf_exp_err_e(ln_result, GSL_DBL_EPSILON * fabs(ln_result), result);
621 /*-*-*-*-*-*-*-*-*-*-*-* Functions with Error Codes *-*-*-*-*-*-*-*-*-*-*-*/
624 gsl_sf_hyperg_2F1_e(double a, double b, const double c,
626 gsl_sf_result * result)
628 const double d = c - a - b;
629 const double rinta = floor(a + 0.5);
630 const double rintb = floor(b + 0.5);
631 const double rintc = floor(c + 0.5);
632 const int a_neg_integer = ( a < 0.0 && fabs(a - rinta) < locEPS );
633 const int b_neg_integer = ( b < 0.0 && fabs(b - rintb) < locEPS );
634 const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
639 /* Handle x == 1.0 RJM */
641 if (fabs (x - 1.0) < locEPS && (c - a - b) > 0 && c != 0 && !c_neg_integer) {
642 gsl_sf_result lngamc, lngamcab, lngamca, lngamcb;
643 double lngamc_sgn, lngamca_sgn, lngamcb_sgn;
645 int stat1 = gsl_sf_lngamma_sgn_e (c, &lngamc, &lngamc_sgn);
646 int stat2 = gsl_sf_lngamma_e (c - a - b, &lngamcab);
647 int stat3 = gsl_sf_lngamma_sgn_e (c - a, &lngamca, &lngamca_sgn);
648 int stat4 = gsl_sf_lngamma_sgn_e (c - b, &lngamcb, &lngamcb_sgn);
650 if (stat1 != GSL_SUCCESS || stat2 != GSL_SUCCESS
651 || stat3 != GSL_SUCCESS || stat4 != GSL_SUCCESS)
653 DOMAIN_ERROR (result);
657 gsl_sf_exp_err_e (lngamc.val + lngamcab.val - lngamca.val - lngamcb.val,
658 lngamc.err + lngamcab.err + lngamca.err + lngamcb.err,
661 result->val *= lngamc_sgn / (lngamca_sgn * lngamcb_sgn);
665 if(x < -1.0 || 1.0 <= x) {
666 DOMAIN_ERROR(result);
670 if(! (a_neg_integer && a > c + 0.1)) DOMAIN_ERROR(result);
671 if(! (b_neg_integer && b > c + 0.1)) DOMAIN_ERROR(result);
674 if(fabs(c-b) < locEPS || fabs(c-a) < locEPS) {
675 return pow_omx(x, d, result); /* (1-x)^(c-a-b) */
678 if(a >= 0.0 && b >= 0.0 && c >=0.0 && x >= 0.0 && x < 0.995) {
679 /* Series has all positive definite
680 * terms and x is not close to 1.
682 return hyperg_2F1_series(a, b, c, x, result);
685 if(fabs(a) < 10.0 && fabs(b) < 10.0) {
686 /* a and b are not too large, so we attempt
687 * variations on the series summation.
690 return hyperg_2F1_series(rinta, b, c, x, result);
693 return hyperg_2F1_series(a, rintb, c, x, result);
697 return hyperg_2F1_luke(a, b, c, x, result);
700 return hyperg_2F1_series(a, b, c, x, result);
704 return hyperg_2F1_series(a, b, c, x, result);
707 return hyperg_2F1_reflect(a, b, c, x, result);
712 /* Either a or b or both large.
713 * Introduce some new variables ap,bp so that bp is
714 * the larger in magnitude.
717 if(fabs(a) > fabs(b)) {
727 /* What the hell, maybe Luke will converge.
729 return hyperg_2F1_luke(a, b, c, x, result);
732 if(GSL_MAX_DBL(fabs(a),1.0)*fabs(bp)*fabs(x) < 2.0*fabs(c)) {
733 /* If c is large enough or x is small enough,
734 * we can attempt the series anyway.
736 return hyperg_2F1_series(a, b, c, x, result);
739 if(fabs(bp*bp*x*x) < 0.001*fabs(bp) && fabs(a) < 10.0) {
740 /* The famous but nearly worthless "large b" asymptotic.
742 int stat = gsl_sf_hyperg_1F1_e(a, c, bp*x, result);
743 result->err = 0.001 * fabs(result->val);
750 GSL_ERROR ("error", GSL_EUNIMPL);
756 gsl_sf_hyperg_2F1_conj_e(const double aR, const double aI, const double c,
758 gsl_sf_result * result)
760 const double ax = fabs(x);
761 const double rintc = floor(c + 0.5);
762 const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
767 if(ax >= 1.0 || c_neg_integer || c == 0.0) {
768 DOMAIN_ERROR(result);
771 if( (ax < 0.25 && fabs(aR) < 20.0 && fabs(aI) < 20.0)
772 || (c > 0.0 && x > 0.0)
774 return hyperg_2F1_conj_series(aR, aI, c, x, result);
776 else if(fabs(aR) < 10.0 && fabs(aI) < 10.0) {
778 return hyperg_2F1_conj_luke(aR, aI, c, x, result);
781 return hyperg_2F1_conj_series(aR, aI, c, x, result);
786 /* What the hell, maybe Luke will converge.
788 return hyperg_2F1_conj_luke(aR, aI, c, x, result);
794 GSL_ERROR ("error", GSL_EUNIMPL);
800 gsl_sf_hyperg_2F1_renorm_e(const double a, const double b, const double c,
802 gsl_sf_result * result
805 const double rinta = floor(a + 0.5);
806 const double rintb = floor(b + 0.5);
807 const double rintc = floor(c + 0.5);
808 const int a_neg_integer = ( a < 0.0 && fabs(a - rinta) < locEPS );
809 const int b_neg_integer = ( b < 0.0 && fabs(b - rintb) < locEPS );
810 const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
813 if((a_neg_integer && a > c+0.1) || (b_neg_integer && b > c+0.1)) {
814 /* 2F1 terminates early */
820 /* 2F1 does not terminate early enough, so something survives */
821 /* [Abramowitz+Stegun, 15.1.2] */
822 gsl_sf_result g1, g2, g3, g4, g5;
823 double s1, s2, s3, s4, s5;
825 stat += gsl_sf_lngamma_sgn_e(a-c+1, &g1, &s1);
826 stat += gsl_sf_lngamma_sgn_e(b-c+1, &g2, &s2);
827 stat += gsl_sf_lngamma_sgn_e(a, &g3, &s3);
828 stat += gsl_sf_lngamma_sgn_e(b, &g4, &s4);
829 stat += gsl_sf_lngamma_sgn_e(-c+2, &g5, &s5);
831 DOMAIN_ERROR(result);
835 int stat_F = gsl_sf_hyperg_2F1_e(a-c+1, b-c+1, -c+2, x, &F);
836 double ln_pre_val = g1.val + g2.val - g3.val - g4.val - g5.val;
837 double ln_pre_err = g1.err + g2.err + g3.err + g4.err + g5.err;
838 double sg = s1 * s2 * s3 * s4 * s5;
839 int stat_e = gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err,
842 return GSL_ERROR_SELECT_2(stat_e, stat_F);
851 int stat_g = gsl_sf_lngamma_sgn_e(c, &lng, &sgn);
852 int stat_F = gsl_sf_hyperg_2F1_e(a, b, c, x, &F);
853 int stat_e = gsl_sf_exp_mult_err_e(-lng.val, lng.err,
856 return GSL_ERROR_SELECT_3(stat_e, stat_F, stat_g);
862 gsl_sf_hyperg_2F1_conj_renorm_e(const double aR, const double aI, const double c,
864 gsl_sf_result * result
867 const double rintc = floor(c + 0.5);
868 const double rinta = floor(aR + 0.5);
869 const int a_neg_integer = ( aR < 0.0 && fabs(aR-rinta) < locEPS && aI == 0.0);
870 const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
873 if(a_neg_integer && aR > c+0.1) {
874 /* 2F1 terminates early */
880 /* 2F1 does not terminate early enough, so something survives */
881 /* [Abramowitz+Stegun, 15.1.2] */
882 gsl_sf_result g1, g2;
884 gsl_sf_result a1, a2;
886 stat += gsl_sf_lngamma_complex_e(aR-c+1, aI, &g1, &a1);
887 stat += gsl_sf_lngamma_complex_e(aR, aI, &g2, &a2);
888 stat += gsl_sf_lngamma_e(-c+2.0, &g3);
890 DOMAIN_ERROR(result);
894 int stat_F = gsl_sf_hyperg_2F1_conj_e(aR-c+1, aI, -c+2, x, &F);
895 double ln_pre_val = 2.0*(g1.val - g2.val) - g3.val;
896 double ln_pre_err = 2.0 * (g1.err + g2.err) + g3.err;
897 int stat_e = gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err,
900 return GSL_ERROR_SELECT_2(stat_e, stat_F);
909 int stat_g = gsl_sf_lngamma_sgn_e(c, &lng, &sgn);
910 int stat_F = gsl_sf_hyperg_2F1_conj_e(aR, aI, c, x, &F);
911 int stat_e = gsl_sf_exp_mult_err_e(-lng.val, lng.err,
914 return GSL_ERROR_SELECT_3(stat_e, stat_F, stat_g);
919 /*-*-*-*-*-*-*-*-*-* Functions w/ Natural Prototypes *-*-*-*-*-*-*-*-*-*-*/
923 double gsl_sf_hyperg_2F1(double a, double b, double c, double x)
925 EVAL_RESULT(gsl_sf_hyperg_2F1_e(a, b, c, x, &result));
928 double gsl_sf_hyperg_2F1_conj(double aR, double aI, double c, double x)
930 EVAL_RESULT(gsl_sf_hyperg_2F1_conj_e(aR, aI, c, x, &result));
933 double gsl_sf_hyperg_2F1_renorm(double a, double b, double c, double x)
935 EVAL_RESULT(gsl_sf_hyperg_2F1_renorm_e(a, b, c, x, &result));
938 double gsl_sf_hyperg_2F1_conj_renorm(double aR, double aI, double c, double x)
940 EVAL_RESULT(gsl_sf_hyperg_2F1_conj_renorm_e(aR, aI, c, x, &result));