/// Confluent hypergeometric functions.
double
conf_hyperg(double a, double c, double x)
{
gsl_sf_result result;
int stat = gsl_sf_hyperg_1F1_e(a, c, x, &result);
if (stat != GSL_SUCCESS)
{
std::ostringstream msg("Error in conf_hyperg:");
msg << " a=" << a << " c=" << c << " x=" << x;
throw std::runtime_error(msg.str());
}
else
return result.val;
}
/**
* form factor of a mass fractal consisting of spheres with a radius R, a
* fractal dimesnion of D, a cut-off length of xi and a scattering length
* density eta
*/
scalar sasfit_sq_MassFractalGaussianCutOff(scalar q, sasfit_param * param)
{
scalar P16, r0, xi, D;
int status;
gsl_sf_result pFq_1F1;
SASFIT_ASSERT_PTR( param );
sasfit_get_param(param, 3, &r0, &xi, &D);
gsl_set_error_handler_off();
SASFIT_CHECK_COND1((q < 0.0), param, "q(%lg) < 0",q);
SASFIT_CHECK_COND1((r0 <= 0.0), param, "r0(%lg) <= 0",r0);
SASFIT_CHECK_COND2((xi < r0), param, "xi(%lg) < r0(%lg)",xi,r0);
SASFIT_CHECK_COND1((D <= 1.0), param, "D(%lg) <= 1",D);
if ((xi == 0) || (r0 == 0))
{
return 1.0;
}
P16 = gsl_sf_gamma(D/2.)*D/2.;
P16 = P16*pow(xi/r0,D);
status = gsl_sf_hyperg_1F1_e(D/2.,1.5,-0.25*pow(q*xi,2.),&pFq_1F1);
if (status && (q*xi >= 10))
{
pFq_1F1.val = (sqrt(M_PI)*(pow(2.,D)/(pow(q,D)*pow(pow(xi,2),D/2.)*gsl_sf_gamma(1.5 - D/2.)) +
(pow(4,1.5 - D/2.)*pow(q,-3 + D)*pow(-pow(xi,2),-1.5 + D/2.))/
(exp((pow(q,2)*pow(xi,2))/4.)*gsl_sf_gamma(D/2.))))/2. ;
// gsl_sf_gamma(1.5)/gsl_sf_gamma(1.5-D/2.0)*pow(0.25*pow(q*xi,2.),D/2.);
}
else if (status && (q*xi < 10))
{
sasfit_param_set_err(param, DBGINFO("%s,q=%lf"), gsl_strerror(status), q);
return SASFIT_RETURNVAL_ON_ERROR;
} else {
return 1.0+P16*pFq_1F1.val;
}
return P16;
}
int
gsl_sf_hyperg_2F1_e(double a, double b, const double c,
const double x,
gsl_sf_result * result)
{
const double d = c - a - b;
const double rinta = floor(a + 0.5);
const double rintb = floor(b + 0.5);
const double rintc = floor(c + 0.5);
const int a_neg_integer = ( a < 0.0 && fabs(a - rinta) < locEPS );
const int b_neg_integer = ( b < 0.0 && fabs(b - rintb) < locEPS );
const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
result->val = 0.0;
result->err = 0.0;
/* Handle x == 1.0 RJM */
if (fabs (x - 1.0) < locEPS && (c - a - b) > 0 && c != 0 && !c_neg_integer) {
gsl_sf_result lngamc, lngamcab, lngamca, lngamcb;
double lngamc_sgn, lngamca_sgn, lngamcb_sgn;
int status;
int stat1 = gsl_sf_lngamma_sgn_e (c, &lngamc, &lngamc_sgn);
int stat2 = gsl_sf_lngamma_e (c - a - b, &lngamcab);
int stat3 = gsl_sf_lngamma_sgn_e (c - a, &lngamca, &lngamca_sgn);
int stat4 = gsl_sf_lngamma_sgn_e (c - b, &lngamcb, &lngamcb_sgn);
if (stat1 != GSL_SUCCESS || stat2 != GSL_SUCCESS
|| stat3 != GSL_SUCCESS || stat4 != GSL_SUCCESS)
{
DOMAIN_ERROR (result);
}
status =
gsl_sf_exp_err_e (lngamc.val + lngamcab.val - lngamca.val - lngamcb.val,
lngamc.err + lngamcab.err + lngamca.err + lngamcb.err,
result);
result->val *= lngamc_sgn / (lngamca_sgn * lngamcb_sgn);
return status;
}
if(x < -1.0 || 1.0 <= x) {
DOMAIN_ERROR(result);
}
if(c_neg_integer) {
/* If c is a negative integer, then either a or b must be a
negative integer of smaller magnitude than c to ensure
cancellation of the series. */
if(! (a_neg_integer && a > c + 0.1) && ! (b_neg_integer && b > c + 0.1)) {
DOMAIN_ERROR(result);
}
}
if(fabs(c-b) < locEPS || fabs(c-a) < locEPS) {
return pow_omx(x, d, result); /* (1-x)^(c-a-b) */
}
if(a >= 0.0 && b >= 0.0 && c >=0.0 && x >= 0.0 && x < 0.995) {
/* Series has all positive definite
* terms and x is not close to 1.
*/
return hyperg_2F1_series(a, b, c, x, result);
}
if(fabs(a) < 10.0 && fabs(b) < 10.0) {
/* a and b are not too large, so we attempt
* variations on the series summation.
*/
if(a_neg_integer) {
return hyperg_2F1_series(rinta, b, c, x, result);
}
if(b_neg_integer) {
return hyperg_2F1_series(a, rintb, c, x, result);
}
if(x < -0.25) {
return hyperg_2F1_luke(a, b, c, x, result);
}
else if(x < 0.5) {
return hyperg_2F1_series(a, b, c, x, result);
}
else {
if(fabs(c) > 10.0) {
return hyperg_2F1_series(a, b, c, x, result);
}
else {
return hyperg_2F1_reflect(a, b, c, x, result);
}
}
}
else {
/* Either a or b or both large.
* Introduce some new variables ap,bp so that bp is
* the larger in magnitude.
*/
double ap, bp;
if(fabs(a) > fabs(b)) {
bp = a;
ap = b;
}
else {
bp = b;
ap = a;
}
if(x < 0.0) {
/* What the hell, maybe Luke will converge.
*/
return hyperg_2F1_luke(a, b, c, x, result);
}
if(GSL_MAX_DBL(fabs(a),1.0)*fabs(bp)*fabs(x) < 2.0*fabs(c)) {
/* If c is large enough or x is small enough,
* we can attempt the series anyway.
*/
return hyperg_2F1_series(a, b, c, x, result);
}
if(fabs(bp*bp*x*x) < 0.001*fabs(bp) && fabs(a) < 10.0) {
/* The famous but nearly worthless "large b" asymptotic.
*/
int stat = gsl_sf_hyperg_1F1_e(a, c, bp*x, result);
result->err = 0.001 * fabs(result->val);
return stat;
}
/* We give up. */
result->val = 0.0;
result->err = 0.0;
GSL_ERROR ("error", GSL_EUNIMPL);
}
}
