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);
}
