void densRad(double *x, int *n, double *xpts, int *nxpts,
double *h, double *result)
{
int i, j;
double d, ksum, cons;
cons = 2 * M_PI * bessel_i(*h, 0, 2);
for(i=0; i < *nxpts; i++) {
ksum = 0;
for(j=0; j < *n; j++) {
d = xpts[i] - x[j];
ksum += pow(exp(cos(d) - 1), *h);
}
result[i] = ksum / *n / cons;
}
}
/*
* Bessel series
* http://dlmf.nist.gov/11.4.19
*/
double struve_bessel_series(double v, double z, int is_h, double *err)
{
int n, sgn;
double term, cterm, sum, maxterm;
if (is_h && v < 0) {
/* Works less reliably in this region */
*err = NPY_INFINITY;
return NPY_NAN;
}
sum = 0;
maxterm = 0;
cterm = sqrt(z / (2*M_PI));
for (n = 0; n < MAXITER; ++n) {
if (is_h) {
term = cterm * bessel_j(n + v + 0.5, z) / (n + 0.5);
cterm *= z/2 / (n + 1);
}
else {
term = cterm * bessel_i(n + v + 0.5, z) / (n + 0.5);
cterm *= -z/2 / (n + 1);
}
sum += term;
if (fabs(term) > maxterm) {
maxterm = fabs(term);
}
if (fabs(term) < SUM_EPS * fabs(sum) || term == 0 || !npy_isfinite(sum)) {
break;
}
}
*err = fabs(term) + fabs(maxterm) * 1e-16;
/* Account for potential underflow of the Bessel functions */
*err += 1e-300 * fabs(cterm);
return sum;
}
/*
* Large-z expansion for Struve H and L
* http://dlmf.nist.gov/11.6.1
*/
double struve_asymp_large_z(double v, double z, int is_h, double *err)
{
int n, sgn, maxiter;
double term, sum, maxterm;
double m;
if (is_h) {
sgn = -1;
}
else {
sgn = 1;
}
/* Asymptotic expansion divergenge point */
m = z/2;
if (m <= 0) {
maxiter = 0;
}
else if (m > MAXITER) {
maxiter = MAXITER;
}
else {
maxiter = (int)m;
}
if (maxiter == 0) {
*err = NPY_INFINITY;
return NPY_NAN;
}
if (z < v) {
/* Exclude regions where our error estimation fails */
*err = NPY_INFINITY;
return NPY_NAN;
}
/* Evaluate sum */
term = -sgn / sqrt(M_PI) * exp(-lgam(v + 0.5) + (v - 1) * log(z/2)) * gammasgn(v + 0.5);
sum = term;
maxterm = 0;
for (n = 0; n < maxiter; ++n) {
term *= sgn * (1 + 2*n) * (1 + 2*n - 2*v) / (z*z);
sum += term;
if (fabs(term) > maxterm) {
maxterm = fabs(term);
}
if (fabs(term) < SUM_EPS * fabs(sum) || term == 0 || !npy_isfinite(sum)) {
break;
}
}
if (is_h) {
sum += bessel_y(v, z);
}
else {
sum += bessel_i(v, z);
}
/*
* This error estimate is strictly speaking valid only for
* n > v - 0.5, but numerical results indicate that it works
* reasonably.
*/
*err = fabs(term) + fabs(maxterm) * 1e-16;
return sum;
}
static double struve_hl(double v, double z, int is_h)
{
double value[4], err[4], tmp;
int n;
if (z < 0) {
n = v;
if (v == n) {
tmp = (n % 2 == 0) ? -1 : 1;
return tmp * struve_hl(v, -z, is_h);
}
else {
return NPY_NAN;
}
}
else if (z == 0) {
if (v < -1) {
return gammasgn(v + 1.5) * NPY_INFINITY;
}
else if (v == -1) {
return 2 / sqrt(M_PI) / Gamma(0.5);
}
else {
return 0;
}
}
n = -v - 0.5;
if (n == -v - 0.5 && n > 0) {
if (is_h) {
return (n % 2 == 0 ? 1 : -1) * bessel_j(n + 0.5, z);
}
else {
return bessel_i(n + 0.5, z);
}
}
/* Try the asymptotic expansion */
if (z >= 0.7*v + 12) {
value[0] = struve_asymp_large_z(v, z, is_h, &err[0]);
if (err[0] < GOOD_EPS * fabs(value[0])) {
return value[0];
}
}
else {
err[0] = NPY_INFINITY;
}
/* Try power series */
value[1] = struve_power_series(v, z, is_h, &err[1]);
if (err[1] < GOOD_EPS * fabs(value[1])) {
return value[1];
}
/* Try bessel series */
if (fabs(z) < fabs(v) + 20) {
value[2] = struve_bessel_series(v, z, is_h, &err[2]);
if (err[2] < GOOD_EPS * fabs(value[2])) {
return value[2];
}
}
else {
err[2] = NPY_INFINITY;
}
/* Return the best of the three, if it is acceptable */
n = 0;
if (err[1] < err[n]) n = 1;
if (err[2] < err[n]) n = 2;
if (err[n] < ACCEPTABLE_EPS * fabs(value[n]) || err[n] < ACCEPTABLE_ATOL) {
return value[n];
}
/* Maybe it really is an overflow? */
tmp = -lgam(v + 1.5) + (v + 1)*log(z/2);
if (!is_h) {
tmp = fabs(tmp);
}
if (tmp > 700) {
sf_error("struve", SF_ERROR_OVERFLOW, "overflow in series");
return NPY_INFINITY * gammasgn(v + 1.5);
}
/* Failure */
sf_error("struve", SF_ERROR_NO_RESULT, "total loss of precision");
return NPY_NAN;
}
void mgs(mgs_result* result, dbl_array* vect, dbl_array* sigma)
{
int i, j, k, is_zerocrossing, **zerocrossing;
double deriv_tot, s_times_two, e_pow_mstt, sum, **smoothed, bessel, *deriv;
int oldStatus = enableWarnings(-1);
smoothed = result->smoothed->values;
deriv = result->deriv->values;
zerocrossing = result->zerocrossing->values;
for(i = 0, deriv_tot = 0.0; i < result->deriv->length; i++)
{
deriv[i] = vect->values[i+1] - vect->values[i];
deriv_tot += deriv[i];
}
for(i = 0; i < sigma->length; i++)
{
s_times_two = 2.0 * sigma->values[i];
e_pow_mstt = exp(-s_times_two);
for(k = 0; k < result->deriv->length; k++)
{
for(j = 0, sum = 0.0; j < result->deriv->length; j++)
{
if(b && b_returned)
{
if(b_returned->values[i][abs(k-j)])
{
bessel = b->values[i][abs(k-j)];
b_returned->values[i][abs(k-j)]++;
}
else
{
bessel = bessel_i(s_times_two, (double)(k-j), 1.0);
b->values[i][abs(k-j)] = bessel;
b_returned->values[i][abs(k-j)]++;
}
}
else
{
bessel = bessel_i(s_times_two, (double)(k-j), 1.0);
}
sum += deriv[j] * e_pow_mstt * bessel;
}
smoothed[i][k] = sum / deriv_tot;
}
for(j = 0, k = 0; j < result->smoothed->cols; j++)
{
is_zerocrossing = 0;
is_zerocrossing += (int)(j == 0 && smoothed[i][j] > smoothed[i][j+1]);
is_zerocrossing += (int)(j == result->smoothed->cols - 1 && smoothed[i][j-1] < smoothed[i][j]);
is_zerocrossing += (int)(j > 0 && j < result->smoothed->cols - 1 && smoothed[i][j-1] < smoothed[i][j] && smoothed[i][j] > smoothed[i][j+1]);
if(is_zerocrossing)
zerocrossing[i][k++] = j + 1;
}
if (k == 0)
// fix for linear functions (no maxima in slope):
// all positions are considered as maxima
{
for(j = 0; j < result->zerocrossing->cols; j++)
{
zerocrossing[i][j] = j + 1;
}
}
}
enableWarnings(oldStatus);
}
static void init_L2L_Yukawa(FmmvHandle *FMMV, int level)
{
int pL = FMMV->pL;
_FLOAT_ **Tz_L2L = FMMV->Tz_L2L;
#if (FMM_PRECISION==0)
double II[4*FMM_P_MAX+4];
#else
_FLOAT_ II[4*FMM_P_MAX+4];
#endif
_FLOAT_ RR[2*FMM_P_MAX+3];
int m,n,nn,k, ii;
_FLOAT_ r, h, hh;
r = ldexp(0.4330127018922193233818615/FMMV->scale, -level); /* sqrt(3)/4 */
#if 0
RR[0] = 1.0;
RR[1] = 1.0/(r*FMMV->beta);
bessel_i(r*FMMV->beta, II, 2*pL+2, 4*pL+4);
for (k=2;k<=pL;k++) {
RR[k] = RR[k-1]*RR[1];
}
for (m=0; m<=pL; m++) {
ii=0;
for (nn=m; nn<=pL; nn++) {
for (n=m; n<=pL; n++) {
h = 0.0;
for (k=m; k<=(n<nn?n:nn); k++) {
hh = ldexp( (F[2*k]*II[nn+n-k]*RR[k]) /
(F[k+m]*F[k-m]*F[nn-k]*F[n-k]*F[k]),
-k + level*(n-nn) -nn );
h += hh;
}
Tz_L2L[m][ii] = ((n+nn)%2?-1:1)*((_FLOAT_) (2*nn+1))
* sqrt(F[nn-m]*F[n+m]*F[nn+m]*F[n-m])*h
* YUKSCALE_INV[nn]*YUKSCALE[n];
ii++;
}
}
}
#endif
#if (FMM_PRECISION==0)
bessel_i_scaled_double(r*FMMV->beta, II, 2*pL+2, 4*pL+4);
#else
bessel_i_scaled(r*FMMV->beta, II, 2*pL+2, 4*pL+4);
#endif
RR[0] = 1.0;
RR[1] = r*FMMV->beta;
for (k=2;k<=2*pL+1;k++) {
RR[k] = RR[k-1]*RR[1];
}
for (m=0; m<=pL; m++) {
ii=0;
for (nn=m; nn<=pL; nn++) {
for (n=m; n<=pL; n++) {
h = 0.0;
for (k=m; k<=(n<nn?n:nn); k++) {
hh = ldexp( (F[2*k]*II[nn+n-k]*RR[nn+n-2*k+1]) /
(F[k+m]*F[k-m]*F[nn-k]*F[n-k]*F[k]),
-k + level*(n-nn) -nn );
h += hh;
}
Tz_L2L[m][ii] = ((n+nn)%2?-1:1)*((_FLOAT_) (2*nn+1))
* sqrt(F[nn-m]*F[n+m]*F[nn+m]*F[n-m])*h
* YUKSCALE_INV[nn]*YUKSCALE[n];
ii++;
}
}
}
}