/* [Abramowitz+Stegun, 9.6.11]
* assumes n >= 1
*/
static
int
bessel_Kn_scaled_small_x(const int n, const double x, gsl_sf_result * result)
{
int k;
double y = 0.25 * x * x;
double ln_x_2 = log(0.5*x);
double ex = exp(x);
gsl_sf_result ln_nm1_fact;
double k_term;
double term1, sum1, ln_pre1;
double term2, sum2, pre2;
gsl_sf_lnfact_e((unsigned int)(n-1), &ln_nm1_fact);
ln_pre1 = -n*ln_x_2 + ln_nm1_fact.val;
if(ln_pre1 > GSL_LOG_DBL_MAX - 3.0) GSL_ERROR ("error", GSL_EOVRFLW);
sum1 = 1.0;
k_term = 1.0;
for(k=1; k<=n-1; k++) {
k_term *= -y/(k * (n-k));
sum1 += k_term;
}
term1 = 0.5 * exp(ln_pre1) * sum1;
pre2 = 0.5 * exp(n*ln_x_2);
if(pre2 > 0.0) {
const int KMAX = 20;
gsl_sf_result psi_n;
gsl_sf_result npk_fact;
double yk = 1.0;
double k_fact = 1.0;
double psi_kp1 = -M_EULER;
double psi_npkp1;
gsl_sf_psi_int_e(n, &psi_n);
gsl_sf_fact_e((unsigned int)n, &npk_fact);
psi_npkp1 = psi_n.val + 1.0/n;
sum2 = (psi_kp1 + psi_npkp1 - 2.0*ln_x_2)/npk_fact.val;
for(k=1; k<KMAX; k++) {
psi_kp1 += 1.0/k;
psi_npkp1 += 1.0/(n+k);
k_fact *= k;
npk_fact.val *= n+k;
yk *= y;
k_term = yk*(psi_kp1 + psi_npkp1 - 2.0*ln_x_2)/(k_fact*npk_fact.val);
sum2 += k_term;
}
term2 = ( GSL_IS_ODD(n) ? -1.0 : 1.0 ) * pre2 * sum2;
}
else {
term2 = 0.0;
}
result->val = ex * (term1 + term2);
result->err = ex * GSL_DBL_EPSILON * (fabs(ln_pre1)*fabs(term1) + fabs(term2));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
int gsl_sf_psi_n_e(const int n, const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(n == 0)
{
return gsl_sf_psi_e(x, result);
}
else if(n == 1)
{
return gsl_sf_psi_1_e(x, result);
}
else if(n < 0 || x <= 0.0) {
DOMAIN_ERROR(result);
}
else {
gsl_sf_result ln_nf;
gsl_sf_result hzeta;
int stat_hz = gsl_sf_hzeta_e(n+1.0, x, &hzeta);
int stat_nf = gsl_sf_lnfact_e((unsigned int) n, &ln_nf);
int stat_e = gsl_sf_exp_mult_err_e(ln_nf.val, ln_nf.err,
hzeta.val, hzeta.err,
result);
if(GSL_IS_EVEN(n)) result->val = -result->val;
return GSL_ERROR_SELECT_3(stat_e, stat_nf, stat_hz);
}
}
/* normalization for hydrogenic wave functions */
static
int
R_norm(const int n, const int l, const double Z, gsl_sf_result * result)
{
double A = 2.0*Z/n;
double pre = sqrt(A*A*A /(2.0*n));
gsl_sf_result ln_a, ln_b;
gsl_sf_result ex;
int stat_a = gsl_sf_lnfact_e(n+l, &ln_a);
int stat_b = gsl_sf_lnfact_e(n-l-1, &ln_b);
double diff_val = 0.5*(ln_b.val - ln_a.val);
double diff_err = 0.5*(ln_b.err + ln_a.err) + GSL_DBL_EPSILON * fabs(diff_val);
int stat_e = gsl_sf_exp_err_e(diff_val, diff_err, &ex);
result->val = pre * ex.val;
result->err = pre * ex.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_3(stat_e, stat_a, stat_b);
}
/// Log factorial.
double
lfactorial(unsigned int n)
{
gsl_sf_result result;
int stat = gsl_sf_lnfact_e(n, &result);
if (stat != GSL_SUCCESS)
{
std::ostringstream msg("Error in lfactorial:");
msg << " n=" << n;
throw std::runtime_error(msg.str());
}
else
return result.val;
}
/* generic polygamma; assumes n >= 0 and x > 0
*/
static int
psi_n_xg0(const int n, const double x, gsl_sf_result * result)
{
if(n == 0) {
return gsl_sf_psi_e(x, result);
}
else {
/* Abramowitz + Stegun 6.4.10 */
gsl_sf_result ln_nf;
gsl_sf_result hzeta;
int stat_hz = gsl_sf_hzeta_e(n+1.0, x, &hzeta);
int stat_nf = gsl_sf_lnfact_e((unsigned int) n, &ln_nf);
int stat_e = gsl_sf_exp_mult_err_e(ln_nf.val, ln_nf.err,
hzeta.val, hzeta.err,
result);
if(GSL_IS_EVEN(n)) result->val = -result->val;
return GSL_ERROR_SELECT_3(stat_e, stat_nf, stat_hz);
}
}
int
gsl_sf_exprel_n_e(const int N, const double x, gsl_sf_result * result)
{
if(N < 0) {
DOMAIN_ERROR(result);
}
else if(x == 0.0) {
result->val = 1.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(fabs(x) < GSL_ROOT3_DBL_EPSILON * N) {
result->val = 1.0 + x/(N+1) * (1.0 + x/(N+2));
result->err = 2.0 * GSL_DBL_EPSILON;
return GSL_SUCCESS;
}
else if(N == 0) {
return gsl_sf_exp_e(x, result);
}
else if(N == 1) {
return gsl_sf_exprel_e(x, result);
}
else if(N == 2) {
return gsl_sf_exprel_2_e(x, result);
}
else {
if(x > N && (-x + N*(1.0 + log(x/N)) < GSL_LOG_DBL_EPSILON)) {
/* x is much larger than n.
* Ignore polynomial part, so
* exprel_N(x) ~= e^x N!/x^N
*/
gsl_sf_result lnf_N;
double lnr_val;
double lnr_err;
double lnterm;
gsl_sf_lnfact_e(N, &lnf_N);
lnterm = N*log(x);
lnr_val = x + lnf_N.val - lnterm;
lnr_err = GSL_DBL_EPSILON * (fabs(x) + fabs(lnf_N.val) + fabs(lnterm));
lnr_err += lnf_N.err;
return gsl_sf_exp_err_e(lnr_val, lnr_err, result);
}
else if(x > N) {
/* Write the identity
* exprel_n(x) = e^x n! / x^n (1 - Gamma[n,x]/Gamma[n])
* then use the asymptotic expansion
* Gamma[n,x] ~ x^(n-1) e^(-x) (1 + (n-1)/x + (n-1)(n-2)/x^2 + ...)
*/
double ln_x = log(x);
gsl_sf_result lnf_N;
double lg_N;
double lnpre_val;
double lnpre_err;
gsl_sf_lnfact_e(N, &lnf_N); /* log(N!) */
lg_N = lnf_N.val - log(N); /* log(Gamma(N)) */
lnpre_val = x + lnf_N.val - N*ln_x;
lnpre_err = GSL_DBL_EPSILON * (fabs(x) + fabs(lnf_N.val) + fabs(N*ln_x));
lnpre_err += lnf_N.err;
if(lnpre_val < GSL_LOG_DBL_MAX - 5.0) {
int stat_eG;
gsl_sf_result bigG_ratio;
gsl_sf_result pre;
int stat_ex = gsl_sf_exp_err_e(lnpre_val, lnpre_err, &pre);
double ln_bigG_ratio_pre = -x + (N-1)*ln_x - lg_N;
double bigGsum = 1.0;
double term = 1.0;
int k;
for(k=1; k<N; k++) {
term *= (N-k)/x;
bigGsum += term;
}
stat_eG = gsl_sf_exp_mult_e(ln_bigG_ratio_pre, bigGsum, &bigG_ratio);
if(stat_eG == GSL_SUCCESS) {
result->val = pre.val * (1.0 - bigG_ratio.val);
result->err = pre.val * (2.0*GSL_DBL_EPSILON + bigG_ratio.err);
result->err += pre.err * fabs(1.0 - bigG_ratio.val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_ex;
}
else {
result->val = 0.0;
result->err = 0.0;
return stat_eG;
}
}
else {
OVERFLOW_ERROR(result);
}
}
else if(x > -10.0*N) {
return exprel_n_CF(N, x, result);
}
else {
/* x -> -Inf asymptotic:
* exprel_n(x) ~ e^x n!/x^n - n/x (1 + (n-1)/x + (n-1)(n-2)/x + ...)
* ~ - n/x (1 + (n-1)/x + (n-1)(n-2)/x + ...)
*/
double sum = 1.0;
double term = 1.0;
int k;
for(k=1; k<N; k++) {
term *= (N-k)/x;
sum += term;
}
result->val = -N/x * sum;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
}
