/* 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;
}
}
/* Calculate series for small eta*lambda.
* Assumes eta > 0, lambda != 0.
*
* This is just the defining hypergeometric for the Legendre function.
*
* P^{mu}_{-1/2 + I lam}(z) = 1/Gamma(l+3/2) ((z+1)/(z-1)^(mu/2)
* 2F1(1/2 - I lam, 1/2 + I lam; l+3/2; (1-z)/2)
* We use
* z = cosh(eta)
* (z-1)/2 = sinh^2(eta/2)
*
* And recall
* H3d = sqrt(Pi Norm /(2 lam^2 sinh(eta))) P^{-l-1/2}_{-1/2 + I lam}(cosh(eta))
*/
static
int
legendre_H3d_series(const int ell, const double lambda, const double eta,
gsl_sf_result * result)
{
const int nmax = 5000;
const double shheta = sinh(0.5*eta);
const double ln_zp1 = M_LN2 + log(1.0 + shheta*shheta);
const double ln_zm1 = M_LN2 + 2.0*log(shheta);
const double zeta = -shheta*shheta;
gsl_sf_result lg_lp32;
double term = 1.0;
double sum = 1.0;
double sum_err = 0.0;
gsl_sf_result lnsheta;
double lnN;
double lnpre_val, lnpre_err, lnprepow;
int stat_e;
int n;
gsl_sf_lngamma_e(ell + 3.0/2.0, &lg_lp32);
gsl_sf_lnsinh_e(eta, &lnsheta);
legendre_H3d_lnnorm(ell, lambda, &lnN);
lnprepow = 0.5*(ell + 0.5) * (ln_zm1 - ln_zp1);
lnpre_val = lnprepow + 0.5*(lnN + M_LNPI - M_LN2 - lnsheta.val) - lg_lp32.val - log(fabs(lambda));
lnpre_err = lnsheta.err + lg_lp32.err + GSL_DBL_EPSILON * fabs(lnpre_val);
lnpre_err += 2.0*GSL_DBL_EPSILON * (fabs(lnN) + M_LNPI + M_LN2);
lnpre_err += 2.0*GSL_DBL_EPSILON * (0.5*(ell + 0.5) * (fabs(ln_zm1) + fabs(ln_zp1)));
for(n=1; n<nmax; n++) {
double aR = n - 0.5;
term *= (aR*aR + lambda*lambda)*zeta/(ell + n + 0.5)/n;
sum += term;
sum_err += 2.0*GSL_DBL_EPSILON*fabs(term);
if(fabs(term/sum) < 2.0 * GSL_DBL_EPSILON) break;
}
stat_e = gsl_sf_exp_mult_err_e(lnpre_val, lnpre_err, sum, fabs(term)+sum_err, result);
return GSL_ERROR_SELECT_2(stat_e, (n==nmax ? GSL_EMAXITER : GSL_SUCCESS));
}
double gsl_sf_lnsinh(const double x)
{
EVAL_RESULT(gsl_sf_lnsinh_e(x, &result));
}
int
gsl_sf_legendre_H3d_e(const int ell, const double lambda, const double eta,
gsl_sf_result * result)
{
const double abs_lam = fabs(lambda);
const double lsq = abs_lam*abs_lam;
const double xi = abs_lam * eta;
const double cosh_eta = cosh(eta);
/* CHECK_POINTER(result) */
if(eta < 0.0) {
DOMAIN_ERROR(result);
}
else if(eta > GSL_LOG_DBL_MAX) {
/* cosh(eta) is too big. */
OVERFLOW_ERROR(result);
}
else if(ell == 0) {
return gsl_sf_legendre_H3d_0_e(lambda, eta, result);
}
else if(ell == 1) {
return gsl_sf_legendre_H3d_1_e(lambda, eta, result);
}
else if(eta == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(xi < 1.0) {
return legendre_H3d_series(ell, lambda, eta, result);
}
else if((ell*ell+lsq)/sqrt(1.0+lsq)/(cosh_eta*cosh_eta) < 5.0*GSL_ROOT3_DBL_EPSILON) {
/* Large argument.
*/
gsl_sf_result P;
double lm;
int stat_P = gsl_sf_conicalP_large_x_e(-ell-0.5, lambda, cosh_eta, &P, &lm);
if(P.val == 0.0) {
result->val = 0.0;
result->err = 0.0;
return stat_P;
}
else {
double lnN;
gsl_sf_result lnsh;
double ln_abslam;
double lnpre_val, lnpre_err;
int stat_e;
gsl_sf_lnsinh_e(eta, &lnsh);
legendre_H3d_lnnorm(ell, lambda, &lnN);
ln_abslam = log(abs_lam);
lnpre_val = 0.5*(M_LNPI + lnN - M_LN2 - lnsh.val) - ln_abslam;
lnpre_err = lnsh.err;
lnpre_err += 2.0 * GSL_DBL_EPSILON * (0.5*(M_LNPI + M_LN2 + fabs(lnN)) + fabs(ln_abslam));
lnpre_err += 2.0 * GSL_DBL_EPSILON * fabs(lnpre_val);
stat_e = gsl_sf_exp_mult_err_e(lnpre_val + lm, lnpre_err, P.val, P.err, result);
return GSL_ERROR_SELECT_2(stat_e, stat_P);
}
}
else if(abs_lam > 1000.0*ell*ell) {
/* Large degree.
*/
gsl_sf_result P;
double lm;
int stat_P = gsl_sf_conicalP_xgt1_neg_mu_largetau_e(ell+0.5,
lambda,
cosh_eta, eta,
&P, &lm);
if(P.val == 0.0) {
result->val = 0.0;
result->err = 0.0;
return stat_P;
}
else {
double lnN;
gsl_sf_result lnsh;
double ln_abslam;
double lnpre_val, lnpre_err;
int stat_e;
gsl_sf_lnsinh_e(eta, &lnsh);
legendre_H3d_lnnorm(ell, lambda, &lnN);
ln_abslam = log(abs_lam);
lnpre_val = 0.5*(M_LNPI + lnN - M_LN2 - lnsh.val) - ln_abslam;
lnpre_err = lnsh.err;
lnpre_err += GSL_DBL_EPSILON * (0.5*(M_LNPI + M_LN2 + fabs(lnN)) + fabs(ln_abslam));
lnpre_err += 2.0 * GSL_DBL_EPSILON * fabs(lnpre_val);
stat_e = gsl_sf_exp_mult_err_e(lnpre_val + lm, lnpre_err, P.val, P.err, result);
return GSL_ERROR_SELECT_2(stat_e, stat_P);
}
}
else {
/* Backward recurrence.
*/
const double coth_eta = 1.0/tanh(eta);
const double coth_err_mult = fabs(eta) + 1.0;
gsl_sf_result rH;
int stat_CF1 = legendre_H3d_CF1_ser(ell, lambda, coth_eta, &rH);
double Hlm1;
double Hl = GSL_SQRT_DBL_MIN;
double Hlp1 = rH.val * Hl;
int lp;
for(lp=ell; lp>0; lp--) {
double root_term_0 = sqrt(lambda*lambda + (double)lp*lp);
double root_term_1 = sqrt(lambda*lambda + (lp+1.0)*(lp+1.0));
Hlm1 = ((2.0*lp + 1.0)*coth_eta*Hl - root_term_1 * Hlp1)/root_term_0;
Hlp1 = Hl;
Hl = Hlm1;
}
if(fabs(Hl) > fabs(Hlp1)) {
gsl_sf_result H0;
int stat_H0 = gsl_sf_legendre_H3d_0_e(lambda, eta, &H0);
result->val = GSL_SQRT_DBL_MIN/Hl * H0.val;
result->err = GSL_SQRT_DBL_MIN/fabs(Hl) * H0.err;
result->err += fabs(rH.err/rH.val) * (ell+1.0) * coth_err_mult * fabs(result->val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_H0, stat_CF1);
}
else {
gsl_sf_result H1;
int stat_H1 = gsl_sf_legendre_H3d_1_e(lambda, eta, &H1);
result->val = GSL_SQRT_DBL_MIN/Hlp1 * H1.val;
result->err = GSL_SQRT_DBL_MIN/fabs(Hlp1) * H1.err;
result->err += fabs(rH.err/rH.val) * (ell+1.0) * coth_err_mult * fabs(result->val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_H1, stat_CF1);
}
}
}
