int gsl_sf_hyperg_2F1_conj_renorm_e(const double aR, const double aI, const double c, const double x, gsl_sf_result * result ) { const double rintc = floor(c + 0.5); const double rinta = floor(aR + 0.5); const int a_neg_integer = ( aR < 0.0 && fabs(aR-rinta) < locEPS && aI == 0.0); const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS ); if(c_neg_integer) { if(a_neg_integer && aR > c+0.1) { /* 2F1 terminates early */ result->val = 0.0; result->err = 0.0; return GSL_SUCCESS; } else { /* 2F1 does not terminate early enough, so something survives */ /* [Abramowitz+Stegun, 15.1.2] */ gsl_sf_result g1, g2; gsl_sf_result g3; gsl_sf_result a1, a2; int stat = 0; stat += gsl_sf_lngamma_complex_e(aR-c+1, aI, &g1, &a1); stat += gsl_sf_lngamma_complex_e(aR, aI, &g2, &a2); stat += gsl_sf_lngamma_e(-c+2.0, &g3); if(stat != 0) { DOMAIN_ERROR(result); } else { gsl_sf_result F; int stat_F = gsl_sf_hyperg_2F1_conj_e(aR-c+1, aI, -c+2, x, &F); double ln_pre_val = 2.0*(g1.val - g2.val) - g3.val; double ln_pre_err = 2.0 * (g1.err + g2.err) + g3.err; int stat_e = gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err, F.val, F.err, result); return GSL_ERROR_SELECT_2(stat_e, stat_F); } } } else { /* generic c */ gsl_sf_result F; gsl_sf_result lng; double sgn; int stat_g = gsl_sf_lngamma_sgn_e(c, &lng, &sgn); int stat_F = gsl_sf_hyperg_2F1_conj_e(aR, aI, c, x, &F); int stat_e = gsl_sf_exp_mult_err_e(-lng.val, lng.err, sgn*F.val, F.err, result); return GSL_ERROR_SELECT_3(stat_e, stat_F, stat_g); } }
double CoulombPhaseShift(double z, double e, int kappa) { double phase, r, y, ke, a, b1, b2; gsl_sf_result dummy, arg; a = FINE_STRUCTURE_CONST2 * e; ke = sqrt(2.0*e*(1.0 + 0.5*a)); a += 1.0; y = a*z/ke; r = kappa; b1 = y/(fabs(r)*a); r = sqrt(r*r - FINE_STRUCTURE_CONST2*z*z); b2 = y/r; if (kappa < 0) { phase = 0.5*(atan(b1) - atan(b2)); } else { phase = -0.5*(atan(b1) + atan(b2) + M_PI); } gsl_sf_lngamma_complex_e(r, y, &dummy, &arg); phase = arg.val + M_PI; phase += (1.0 - r)*0.5*M_PI; return phase; }
scalar sasfit_peak_PearsonIVArea(scalar x, sasfit_param * param) { scalar z,u; scalar bckgr, a0, area, center, width, shape1, shape2; scalar a1,a2,a3,a4; scalar a_temp, l_temp, m_temp, nu_temp; gsl_sf_result lnr, carg; SASFIT_ASSERT_PTR( param ); sasfit_get_param(param, 6, &area, ¢er, &width, &shape1, &shape2, &bckgr); // a0 = area; a1 = center; a2 = width; a_temp = width; a3 = shape1; m_temp = shape1; a4 = shape2; nu_temp= shape2; SASFIT_CHECK_COND1((width <= 0), param, "width(%lg) <= 0",width); SASFIT_CHECK_COND1((shape1 <= 0.5), param, "shape1(%lg) <= 1/2",shape1); u = a4/(2.*a3); l_temp = center+a2*u; z = (x-l_temp)/a_temp; gsl_sf_lngamma_complex_e (m_temp, 0.5*nu_temp, &lnr, &carg); a0 = area*pow(exp(lnr.val-gsl_sf_lngamma(m_temp)),2.0)/(a_temp*gsl_sf_beta(m_temp-0.5,0.5)); return bckgr+a0*pow(1.0+z*z,-m_temp)*exp(-nu_temp*atan(z)); }
/* Logarithm of normalization factor, Log[N(ell,lambda)]. * N(ell,lambda) = Product[ lambda^2 + n^2, {n,0,ell} ] * = |Gamma(ell + 1 + I lambda)|^2 lambda sinh(Pi lambda) / Pi * Assumes ell >= 0. */ static int legendre_H3d_lnnorm(const int ell, const double lambda, double * result) { double abs_lam = fabs(lambda); if(abs_lam == 0.0) { *result = 0.0; GSL_ERROR ("error", GSL_EDOM); } else if(lambda > (ell + 1.0)/GSL_ROOT3_DBL_EPSILON) { /* There is a cancellation between the sinh(Pi lambda) * term and the log(gamma(ell + 1 + i lambda) in the * result below, so we show some care and save some digits. * Note that the above guarantees that lambda is large, * since ell >= 0. We use Stirling and a simple expansion * of sinh. */ double rat = (ell+1.0)/lambda; double ln_lam2ell2 = 2.0*log(lambda) + log(1.0 + rat*rat); double lg_corrected = -2.0*(ell+1.0) + M_LNPI + (ell+0.5)*ln_lam2ell2 + 1.0/(288.0*lambda*lambda); double angle_terms = lambda * 2.0 * rat * (1.0 - rat*rat/3.0); *result = log(abs_lam) + lg_corrected + angle_terms - M_LNPI; return GSL_SUCCESS; } else { gsl_sf_result lg_r; gsl_sf_result lg_theta; gsl_sf_result ln_sinh; gsl_sf_lngamma_complex_e(ell+1.0, lambda, &lg_r, &lg_theta); gsl_sf_lnsinh_e(M_PI * abs_lam, &ln_sinh); *result = log(abs_lam) + ln_sinh.val + 2.0*lg_r.val - M_LNPI; return GSL_SUCCESS; } }
/* the full definition of C_L(eta) for any valid L and eta * [Abramowitz and Stegun 14.1.7] * This depends on the complex gamma function. For large * arguments the phase of the complex gamma function is not * very accurately determined. However the modulus is, and that * is all that we need to calculate C_L. * * This is not valid for L <= -3/2 or L = -1. */ static int CLeta(double L, double eta, gsl_sf_result * result) { gsl_sf_result ln1; /* log of numerator Gamma function */ gsl_sf_result ln2; /* log of denominator Gamma function */ double sgn = 1.0; double arg_val, arg_err; if(fabs(eta/(L+1.0)) < GSL_DBL_EPSILON) { gsl_sf_lngamma_e(L+1.0, &ln1); } else { gsl_sf_result p1; /* phase of numerator Gamma -- not used */ gsl_sf_lngamma_complex_e(L+1.0, eta, &ln1, &p1); /* should be ok */ } gsl_sf_lngamma_e(2.0*(L+1.0), &ln2); if(L < -1.0) sgn = -sgn; arg_val = L*M_LN2 - 0.5*eta*M_PI + ln1.val - ln2.val; arg_err = ln1.err + ln2.err; arg_err += GSL_DBL_EPSILON * (fabs(L*M_LN2) + fabs(0.5*eta*M_PI)); return gsl_sf_exp_err_e(arg_val, arg_err, result); }
static VALUE rb_gsl_sf_lngamma_complex_e(int argc, VALUE *argv, VALUE obj) { gsl_sf_result *lnr, *arg; gsl_complex *z; double re, im; VALUE vlnr, varg; int status; switch (argc) { case 1: CHECK_COMPLEX(argv[0]); Data_Get_Struct(argv[0], gsl_complex, z); re = GSL_REAL(*z); im = GSL_IMAG(*z); break; case 2: Need_Float(argv[0]); Need_Float(argv[1]); re = NUM2DBL(argv[0]); im = NUM2DBL(argv[1]); default: rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc); } vlnr = Data_Make_Struct(cgsl_sf_result, gsl_sf_result, 0, free, lnr); varg = Data_Make_Struct(cgsl_sf_result, gsl_sf_result, 0, free, arg); status = gsl_sf_lngamma_complex_e(re, im, lnr, arg); return rb_ary_new3(3, vlnr, varg, INT2FIX(status)); }
/* * Gets the Coulomb phase sigma_l = arg(gamma(l + 1 + i*eta)) */ double GetCoulombPhase(int l, double eta) { gsl_sf_result absval, argval; if (gsl_sf_lngamma_complex_e(1.0+l, eta, &absval, &argval) == GSL_ELOSS) { cout << "Overflow error in gsl_sf_lngamma_complex_e, l=" << l << ", eta=" << eta << endl; } return argval.val; }
CAMLprim value ml_gsl_sf_lngamma_complex_e(value zr, value zi) { gsl_sf_result lnr, arg; gsl_sf_lngamma_complex_e(Double_val(zr), Double_val(zi),&lnr, &arg); return val_of_result_pair (&lnr, &arg); }