void
test_f (const gsl_min_fminimizer_type * T,
const char * description, gsl_function *f,
double lower_bound, double middle, double upper_bound,
double correct_minimum)
{
int status;
size_t iterations = 0;
double m, a, b;
double x_lower, x_upper;
gsl_min_fminimizer * s;
x_lower = lower_bound;
x_upper = upper_bound;
s = gsl_min_fminimizer_alloc (T) ;
gsl_min_fminimizer_set (s, f, middle, x_lower, x_upper) ;
do
{
iterations++ ;
status = gsl_min_fminimizer_iterate (s);
m = gsl_min_fminimizer_x_minimum(s);
a = gsl_min_fminimizer_x_lower(s);
b = gsl_min_fminimizer_x_upper(s);
#ifdef DEBUG
printf("%.12f %.18f %.12f %.18f %.12f %.18f status=%d\n",
a, GSL_FN_EVAL(f, a), m, GSL_FN_EVAL(f, m), b, GSL_FN_EVAL(f, b), status);
#endif
if (a > b)
gsl_test (GSL_FAILURE, "interval is invalid (%g,%g)", a, b);
if (m < a || m > b)
gsl_test (GSL_FAILURE, "m lies outside interval %g (%g,%g)", m, a, b);
if (status) break ;
status = gsl_min_test_interval (a, b, EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (status, "%s, %s (%g obs vs %g expected) ",
gsl_min_fminimizer_name(s), description,
gsl_min_fminimizer_x_minimum(s), correct_minimum);
/* check the validity of the returned result */
if (!WITHIN_TOL (m, correct_minimum, EPSREL, EPSABS))
{
gsl_test (GSL_FAILURE, "incorrect precision (%g obs vs %g expected)",
m, correct_minimum);
}
gsl_min_fminimizer_free (s);
}
const Real GreensFunction2DAbs::drawTime(const Real rnd) const
{
THROW_UNLESS(std::invalid_argument, 0.0<=rnd && rnd <= 1.0);
if(D == 0e0 || a == std::numeric_limits<Real>::infinity() || rnd == 1e0)
return std::numeric_limits<Real>::infinity();
if(a == r0 || rnd == 0e0)
return 0e0;
p_survival_params params = {this, rnd};
gsl_function F =
{
reinterpret_cast<double (*)(double, void*)>(&p_survival_F), ¶ms
};
// this is not so accurate because
// initial position is not the center of this system.
const Real t_guess(a * a * 0.25 / D);
Real value(GSL_FN_EVAL(&F, t_guess));
Real low(t_guess);
Real high(t_guess);
// to determine high and low border
if(value < 0.0)
{
do
{
high *= 1e1;
value = GSL_FN_EVAL(&F, high);
if(fabs(high) > t_guess * 1e6)
throw std::invalid_argument("could not adjust higher border");
}
while(value <= 0e0);
}
else
{
Real value_prev = value;
do
{
low *= 1e-1;
value = GSL_FN_EVAL(&F, low);
if(fabs(low) <= t_guess * 1e-6 || fabs(value - value_prev) < CUTOFF)
throw std::invalid_argument("could not adjust lower border");
value_prev = value;
}
while(value >= 0e0);
}
//find the root
const gsl_root_fsolver_type* solverType(gsl_root_fsolver_brent);
gsl_root_fsolver* solver(gsl_root_fsolver_alloc(solverType));
const Real t(findRoot(F, solver, low, high, 1e-18, 1e-12,
"GreensFunction2DAbs::drawTime"));
gsl_root_fsolver_free(solver);
return t;
}
static double
i_transform (double t, void *params)
{
gsl_function *f = (gsl_function *) params;
double x = (1 - t) / t;
double y = GSL_FN_EVAL (f, x) + GSL_FN_EVAL (f, -x);
return (y / t) / t;
}
int
gsl_diff_forward (const gsl_function * f,
double x, double *result, double *abserr)
{
/* Construct a divided difference table with a fairly large step
size to get a very rough estimate of f''. Use this to estimate
the step size which will minimize the error in calculating f'. */
int i, k;
double h = GSL_SQRT_DBL_EPSILON;
double a[3], d[3], a2;
/* Algorithm based on description on pg. 204 of Conte and de Boor
(CdB) - coefficients of Newton form of polynomial of degree 2. */
for (i = 0; i < 3; i++)
{
a[i] = x + i * h;
d[i] = GSL_FN_EVAL (f, a[i]);
}
for (k = 1; k < 4; k++)
{
for (i = 0; i < 3 - k; i++)
{
d[i] = (d[i + 1] - d[i]) / (a[i + k] - a[i]);
}
}
/* Adapt procedure described on pg. 282 of CdB to find best value of
step size. */
a2 = fabs (d[0] + d[1] + d[2]);
if (a2 < 100.0 * GSL_SQRT_DBL_EPSILON)
{
a2 = 100.0 * GSL_SQRT_DBL_EPSILON;
}
h = sqrt (GSL_SQRT_DBL_EPSILON / (2.0 * a2));
if (h > 100.0 * GSL_SQRT_DBL_EPSILON)
{
h = 100.0 * GSL_SQRT_DBL_EPSILON;
}
*result = (GSL_FN_EVAL (f, x + h) - GSL_FN_EVAL (f, x)) / h;
*abserr = fabs (10.0 * a2 * h);
return GSL_SUCCESS;
}
int UnidimensionalRootFinder(gsl_function *F,
double lower_bound,
double upper_bound,
double abs_error,
double rel_error,
int max_iterations,
double *return_result)
{
const gsl_root_fsolver_type * T = gsl_root_fsolver_bisection;
gsl_root_fsolver * s = gsl_root_fsolver_alloc(T);
// Test if the limits straddle the root,
// if they don't, we will return -1.
if (GSL_SIGN(GSL_FN_EVAL(F, lower_bound)) == GSL_SIGN(GSL_FN_EVAL(F, upper_bound)))
return -1;
gsl_root_fsolver_set(s, F, lower_bound, upper_bound);
int i = 0;
double x_lower;
double x_upper;
do{
i++;
int status = gsl_root_fsolver_iterate(s);
if (status != GSL_SUCCESS){
printf("ERROR: No solution to the gap equation was found!\n");
exit(EXIT_FAILURE);
}
x_lower = gsl_root_fsolver_x_lower(s);
x_upper = gsl_root_fsolver_x_upper(s);
} while(GSL_CONTINUE == gsl_root_test_interval(x_lower,
x_upper,
abs_error,
rel_error)
&& i <= max_iterations);
double result = gsl_root_fsolver_root(s);
void gsl_root_fsolver_free(gsl_root_fsolver * S);
*return_result = result;
return 0;
}
int gsl_cheb_init(gsl_cheb_series * cs, const gsl_function *func,
const double a, const double b)
{
size_t k, j;
if(a >= b) {
GSL_ERROR_VAL("null function interval [a,b]", GSL_EDOM, 0);
}
cs->a = a;
cs->b = b;
/* cs->err = 0.0; */
{
double bma = 0.5 * (cs->b - cs->a);
double bpa = 0.5 * (cs->b + cs->a);
double fac = 2.0/(cs->order +1.0);
for(k = 0; k<=cs->order; k++) {
double y = cos(M_PI * (k+0.5)/(cs->order+1));
cs->f[k] = GSL_FN_EVAL(func, (y*bma + bpa));
}
for(j = 0; j<=cs->order; j++) {
double sum = 0.0;
for(k = 0; k<=cs->order; k++)
sum += cs->f[k]*cos(M_PI * j*(k+0.5)/(cs->order+1));
cs->c[j] = fac * sum;
}
}
return GSL_SUCCESS;
}
static double
fn_cauchy (double x, void *params)
{
struct fn_cauchy_params *p = (struct fn_cauchy_params *) params;
gsl_function *f = p->function;
double c = p->singularity;
return GSL_FN_EVAL (f, x) / (x - c);
}
void
test (diff_fn * diff, gsl_function * f, gsl_function * df, double x,
const char * desc)
{
double result, abserr;
double expected = GSL_FN_EVAL (df, x);
(*diff) (f, x, &result, &abserr);
gsl_test_abs (result, expected, abserr, desc);
gsl_test (fabs(result-expected) > abserr, "%s, valid error estimate", desc);
}
static double
fn_cos (double x, void *params)
{
struct fn_fourier_params *p = (struct fn_fourier_params *) params;
gsl_function *f = p->function;
double w = p->omega;
double wx = w * x;
double coswx = cos(wx) ;
return GSL_FN_EVAL (f, x) * coswx ;
}
static double
il_transform (double t, void *params)
{
struct il_params *p = (struct il_params *) params;
double b = p->b;
gsl_function * f = p->f;
double x = b - (1 - t) / t;
double y = GSL_FN_EVAL (f, x);
return (y / t) / t;
}
static double
iu_transform (double t, void *params)
{
struct iu_params *p = (struct iu_params *) params;
double a = p->a;
gsl_function * f = p->f;
double x = a + (1 - t) / t;
double y = GSL_FN_EVAL (f, x);
return (y / t) / t;
}
void
test_dim (const size_t n, const double a, const double b,
gsl_function * F, gsl_function * DF, gsl_function *IF)
{
double tol = 100.0 * GSL_DBL_EPSILON;
double x;
gsl_cheb_series * cs = gsl_cheb_alloc(n);
gsl_cheb_series * csd = gsl_cheb_alloc(n);
gsl_cheb_series * csi = gsl_cheb_alloc(n);
gsl_cheb_init(cs, F, a, b);
for(x=a; x<b; x += (b-a)/100.0) {
double r = gsl_cheb_eval(cs, x);
gsl_test_abs(r, GSL_FN_EVAL(F, x), tol, "gsl_cheb_eval, F(%.3g)", x);
}
/* Test derivative */
gsl_cheb_calc_deriv(csd, cs);
for(x=a; x<b; x += (b-a)/100.0) {
double r = gsl_cheb_eval(csd, x);
gsl_test_abs(r, GSL_FN_EVAL(DF, x), tol, "gsl_cheb_eval, deriv F(%.3g)", x);
}
/* Test integral */
gsl_cheb_calc_integ(csi, cs);
for(x=a; x<b; x += (b-a)/100.0) {
double r = gsl_cheb_eval(csi, x);
gsl_test_abs(r, GSL_FN_EVAL(IF, x), tol, "gsl_cheb_eval, integ F(%.3g)", x);
}
gsl_cheb_free(csi);
gsl_cheb_free(csd);
gsl_cheb_free(cs);
}
static void
central_deriv (const gsl_function * f, double x, double h,
double *result, double *abserr_round, double *abserr_trunc)
{
/* Compute the derivative using the 5-point rule (x-h, x-h/2, x,
x+h/2, x+h). Note that the central point is not used.
Compute the error using the difference between the 5-point and
the 3-point rule (x-h,x,x+h). Again the central point is not
used. */
double fm1 = GSL_FN_EVAL (f, x - h);
double fp1 = GSL_FN_EVAL (f, x + h);
double fmh = GSL_FN_EVAL (f, x - h / 2);
double fph = GSL_FN_EVAL (f, x + h / 2);
double r3 = 0.5 * (fp1 - fm1);
double r5 = (4.0 / 3.0) * (fph - fmh) - (1.0 / 3.0) * r3;
double e3 = (fabs (fp1) + fabs (fm1)) * GSL_DBL_EPSILON;
double e5 = 2.0 * (fabs (fph) + fabs (fmh)) * GSL_DBL_EPSILON + e3;
/* The next term is due to finite precision in x+h = O (eps * x) */
double dy = GSL_MAX (fabs (r3 / h), fabs (r5 / h)) *(fabs (x) / h) * GSL_DBL_EPSILON;
/* The truncation error in the r5 approximation itself is O(h^4).
However, for safety, we estimate the error from r5-r3, which is
O(h^2). By scaling h we will minimise this estimated error, not
the actual truncation error in r5. */
*result = r5 / h;
*abserr_trunc = fabs ((r5 - r3) / h); /* Estimated truncation error O(h^2) */
*abserr_round = fabs (e5 / h) + dy; /* Rounding error (cancellations) */
}
static void
forward_deriv (const gsl_function * f, double x, double h,
double *result, double *abserr_round, double *abserr_trunc)
{
/* Compute the derivative using the 4-point rule (x+h/4, x+h/2,
x+3h/4, x+h).
Compute the error using the difference between the 4-point and
the 2-point rule (x+h/2,x+h). */
double f1 = GSL_FN_EVAL (f, x + h / 4.0);
double f2 = GSL_FN_EVAL (f, x + h / 2.0);
double f3 = GSL_FN_EVAL (f, x + (3.0 / 4.0) * h);
double f4 = GSL_FN_EVAL (f, x + h);
double r2 = 2.0*(f4 - f2);
double r4 = (22.0 / 3.0) * (f4 - f3) - (62.0 / 3.0) * (f3 - f2) +
(52.0 / 3.0) * (f2 - f1);
/* Estimate the rounding error for r4 */
double e4 = 2 * 20.67 * (fabs (f4) + fabs (f3) + fabs (f2) + fabs (f1)) * GSL_DBL_EPSILON;
/* The next term is due to finite precision in x+h = O (eps * x) */
double dy = GSL_MAX (fabs (r2 / h), fabs (r4 / h)) * fabs (x / h) * GSL_DBL_EPSILON;
/* The truncation error in the r4 approximation itself is O(h^3).
However, for safety, we estimate the error from r4-r2, which is
O(h). By scaling h we will minimise this estimated error, not
the actual truncation error in r4. */
*result = r4 / h;
*abserr_trunc = fabs ((r4 - r2) / h); /* Estimated truncation error O(h) */
*abserr_round = fabs (e4 / h) + dy;
}
static double
fn_qaws_R (double x, void *params)
{
struct fn_qaws_params *p = (struct fn_qaws_params *) params;
gsl_function *f = p->function;
gsl_integration_qaws_table *t = p->table;
double factor = 1.0;
if (t->beta != 0.0)
factor *= pow(p->b - x, t->beta);
if (t->nu == 1)
factor *= log(p->b - x);
return factor * GSL_FN_EVAL (f, x);
}
void
test (deriv_fn * deriv, gsl_function * f, gsl_function * df, double x,
const char * desc)
{
double result, abserr;
double expected = GSL_FN_EVAL (df, x);
(*deriv) (f, x, 1e-4, &result, &abserr);
gsl_test_abs (result, expected, GSL_MIN(1e-4,fabs(expected)) + GSL_DBL_EPSILON, desc);
if (abserr < fabs(result-expected))
{
gsl_test_factor (abserr, fabs(result-expected), 2, "%s error estimate", desc);
}
else if (result == expected || expected == 0.0)
{
gsl_test_abs (abserr, 0.0, 1e-6, "%s abserr", desc);
}
else
{
double d = fabs(result - expected);
gsl_test_abs (abserr, fabs(result-expected), 1e6*d, "%s abserr", desc);
}
}
Real GreensFunction3DRadInf::drawR(Real rnd, Real t) const
{
const Real sigma(this->getSigma());
const Real D(this->getD());
if (!(rnd < 1.0 && rnd >= 0.0))
{
throw std::invalid_argument((boost::format("rnd < 1.0 && rnd >= 0.0 : rnd=%.16g") % rnd).str());
}
if (!(r0 >= sigma))
{
throw std::invalid_argument((boost::format("r0 >= sigma : r0=%.16g, sigma=%.16g") % r0 % sigma).str());
}
if (!(t >= 0.0))
{
throw std::invalid_argument((boost::format("t >= 0.0 : t=%.16g") % t).str());
}
if(t == 0.0)
{
return r0;
}
const Real psurv(p_survival(t));
p_int_r_params params = { this, t, rnd * psurv };
gsl_function F =
{
reinterpret_cast<double (*)(double, void*)>(&p_int_r_F),
¶ms
};
// adjust low and high starting from r0.
// this is necessary to avoid root finding in the long tails where
// numerics can be unstable.
Real low(r0);
Real high(r0);
const Real sqrt6Dt(sqrt(6.0 * D * t));
if(GSL_FN_EVAL(&F, r0) < 0.0)
{
// low = r0
unsigned int H(3);
for (;;)
{
high = r0 + H * sqrt6Dt;
const Real value(GSL_FN_EVAL(&F, high));
if(value > 0.0)
{
break;
}
++H;
if(H > 20)
{
throw std::runtime_error("drawR: H > 20 while adjusting upper bound of r");
}
}
}
else
{
// high = r0
unsigned int H(3);
for (;;)
{
low = r0 - H * sqrt6Dt;
if(low < sigma)
{
if(GSL_FN_EVAL(&F, sigma) > 0.0)
{
log_.info("drawR: p_int_r(sigma) > 0.0. "
"returning sigma.");
return sigma;
}
low = sigma;
break;
}
const Real value(GSL_FN_EVAL(&F, low));
if(value < 0.0)
{
break;
}
++H;
}
}
// root finding by iteration.
const gsl_root_fsolver_type* solverType(gsl_root_fsolver_brent);
gsl_root_fsolver* solver(gsl_root_fsolver_alloc(solverType));
gsl_root_fsolver_set(solver, &F, low, high);
const unsigned int maxIter(100);
unsigned int i(0);
for (;;)
{
gsl_root_fsolver_iterate(solver);
low = gsl_root_fsolver_x_lower(solver);
high = gsl_root_fsolver_x_upper(solver);
const int status(gsl_root_test_interval(low, high, 1e-15,
this->TOLERANCE));
if(status == GSL_CONTINUE)
{
if(i >= maxIter)
{
gsl_root_fsolver_free(solver);
throw std::runtime_error("drawR: failed to converge");
}
}
else
{
break;
}
++i;
}
const Real r(gsl_root_fsolver_root(solver));
gsl_root_fsolver_free(solver);
return r;
}
int
gsl_integration_cquad (const gsl_function * f, double a, double b,
double epsabs, double epsrel,
gsl_integration_cquad_workspace * ws,
double *result, double *abserr, size_t * nevals)
{
/* Some constants that we will need. */
static const int n[4] = { 4, 8, 16, 32 };
static const int skip[4] = { 8, 4, 2, 1 };
static const int idx[4] = { 0, 5, 14, 31 };
static const double w = M_SQRT2 / 2;
static const int ndiv_max = 20;
/* Actual variables (as opposed to constants above). */
double m, h, temp;
double igral, err, igral_final, err_final, err_excess;
int nivals, neval = 0;
int i, j, d, split, t;
int nnans, nans[32];
gsl_integration_cquad_ival *iv, *ivl, *ivr;
double nc, ncdiff;
/* Check the input arguments. */
if (f == NULL)
GSL_ERROR ("function pointer shouldn't be NULL", GSL_EINVAL);
if (result == NULL)
GSL_ERROR ("result pointer shouldn't be NULL", GSL_EINVAL);
if (ws == NULL)
GSL_ERROR ("workspace pointer shouldn't be NULL", GSL_EINVAL);
/* Check for unreasonable accuracy demands */
if (epsabs < 0.0 || epsrel < 0.0)
GSL_ERROR ("tolerances may not be negative", GSL_EBADTOL);
if (epsabs <= 0 && epsrel < GSL_DBL_EPSILON)
GSL_ERROR ("unreasonable accuracy requirement", GSL_EBADTOL);
/* Create the first interval. */
iv = &(ws->ivals[0]);
m = (a + b) / 2;
h = (b - a) / 2;
nnans = 0;
for (i = 0; i <= n[3]; i++)
{
iv->fx[i] = GSL_FN_EVAL (f, m + xi[i] * h);
neval++;
if (!finite (iv->fx[i]))
{
nans[nnans++] = i;
iv->fx[i] = 0.0;
}
}
Vinvfx (iv->fx, &(iv->c[idx[0]]), 0);
Vinvfx (iv->fx, &(iv->c[idx[3]]), 3);
Vinvfx (iv->fx, &(iv->c[idx[2]]), 2);
for (i = 0; i < nnans; i++)
iv->fx[nans[i]] = GSL_NAN;
iv->a = a;
iv->b = b;
iv->depth = 3;
iv->rdepth = 1;
iv->ndiv = 0;
iv->igral = 2 * h * iv->c[idx[3]] * w;
nc = 0.0;
for (i = n[2] + 1; i <= n[3]; i++)
{
temp = iv->c[idx[3] + i];
nc += temp * temp;
}
ncdiff = nc;
for (i = 0; i <= n[2]; i++)
{
temp = iv->c[idx[2] + i] - iv->c[idx[3] + i];
ncdiff += temp * temp;
nc += iv->c[idx[3] + i] * iv->c[idx[3] + i];
}
ncdiff = sqrt (ncdiff);
nc = sqrt (nc);
iv->err = ncdiff * 2 * h;
if (ncdiff / nc > 0.1 && iv->err < 2 * h * nc)
iv->err = 2 * h * nc;
/* Initialize the heaps. */
for (i = 0; i < ws->size; i++)
ws->heap[i] = i;
/* Initialize some global values. */
igral = iv->igral;
err = iv->err;
nivals = 1;
igral_final = 0.0;
err_final = 0.0;
err_excess = 0.0;
/* Main loop. */
while (nivals > 0 && err > 0.0 &&
!(err <= fabs (igral) * epsrel || err <= epsabs)
&& !(err_final > fabs (igral) * epsrel
&& err - err_final < fabs (igral) * epsrel)
&& !(err_final > epsabs && err - err_final < epsabs))
{
/* Put our finger on the interval with the largest error. */
iv = &(ws->ivals[ws->heap[0]]);
m = (iv->a + iv->b) / 2;
h = (iv->b - iv->a) / 2;
/* printf
("cquad: processing ival %i (of %i) with [%e,%e] int=%e, err=%e, depth=%i\n",
ws->heap[0], nivals, iv->a, iv->b, iv->igral, iv->err, iv->depth);
*/
/* Should we try to increase the degree? */
if (iv->depth < 3)
{
/* Keep tabs on some variables. */
d = ++iv->depth;
/* Get the new (missing) function values */
for (i = skip[d]; i <= 32; i += 2 * skip[d])
{
iv->fx[i] = GSL_FN_EVAL (f, m + xi[i] * h);
neval++;
}
nnans = 0;
for (i = 0; i <= 32; i += skip[d])
{
if (!finite (iv->fx[i]))
{
nans[nnans++] = i;
iv->fx[i] = 0.0;
}
}
/* Compute the new coefficients. */
Vinvfx (iv->fx, &(iv->c[idx[d]]), d);
/* Downdate any NaNs. */
if (nnans > 0)
{
downdate (&(iv->c[idx[d]]), n[d], d, nans, nnans);
for (i = 0; i < nnans; i++)
iv->fx[nans[i]] = GSL_NAN;
}
/* Compute the error estimate. */
nc = 0.0;
for (i = n[d - 1] + 1; i <= n[d]; i++)
{
temp = iv->c[idx[d] + i];
nc += temp * temp;
}
ncdiff = nc;
for (i = 0; i <= n[d - 1]; i++)
{
temp = iv->c[idx[d - 1] + i] - iv->c[idx[d] + i];
ncdiff += temp * temp;
nc += iv->c[idx[d] + i] * iv->c[idx[d] + i];
}
ncdiff = sqrt (ncdiff);
nc = sqrt (nc);
iv->err = ncdiff * 2 * h;
/* Compute the local integral. */
iv->igral = 2 * h * w * iv->c[idx[d]];
/* Split the interval prematurely? */
split = (nc > 0 && ncdiff / nc > 0.1);
}
/* Maximum degree reached, just split. */
else
{
split = 1;
}
/* Should we drop this interval? */
if ((m + h * xi[0]) >= (m + h * xi[1])
|| (m + h * xi[31]) >= (m + h * xi[32])
|| iv->err < fabs (iv->igral) * GSL_DBL_EPSILON * 10)
{
/* printf
("cquad: dumping ival %i (of %i) with [%e,%e] int=%e, err=%e, depth=%i\n",
ws->heap[0], nivals, iv->a, iv->b, iv->igral, iv->err,
iv->depth);
*/
/* Keep this interval's contribution */
err_final += iv->err;
igral_final += iv->igral;
/* Swap with the last element on the heap */
t = ws->heap[nivals - 1];
ws->heap[nivals - 1] = ws->heap[0];
ws->heap[0] = t;
nivals--;
/* Fix up the heap */
i = 0;
while (2 * i + 1 < nivals)
{
/* Get the kids */
j = 2 * i + 1;
/* If the j+1st entry exists and is larger than the jth,
use it instead. */
if (j + 1 < nivals
&& ws->ivals[ws->heap[j + 1]].err >=
ws->ivals[ws->heap[j]].err)
j++;
/* Do we need to move the ith entry up? */
if (ws->ivals[ws->heap[j]].err <= ws->ivals[ws->heap[i]].err)
break;
else
{
t = ws->heap[j];
ws->heap[j] = ws->heap[i];
ws->heap[i] = t;
i = j;
}
}
}
/* Do we need to split this interval? */
else if (split)
{
/* Some values we will need often... */
d = iv->depth;
/* Generate the interval on the left */
ivl = &(ws->ivals[ws->heap[nivals++]]);
ivl->a = iv->a;
ivl->b = m;
ivl->depth = 0;
ivl->rdepth = iv->rdepth + 1;
ivl->fx[0] = iv->fx[0];
ivl->fx[32] = iv->fx[16];
for (i = skip[0]; i < 32; i += skip[0])
{
ivl->fx[i] =
GSL_FN_EVAL (f, (ivl->a + ivl->b) / 2 + xi[i] * h / 2);
neval++;
}
nnans = 0;
for (i = 0; i <= 32; i += skip[0])
{
if (!finite (ivl->fx[i]))
{
nans[nnans++] = i;
ivl->fx[i] = 0.0;
}
}
Vinvfx (ivl->fx, ivl->c, 0);
if (nnans > 0)
{
downdate (ivl->c, n[0], 0, nans, nnans);
for (i = 0; i < nnans; i++)
ivl->fx[nans[i]] = GSL_NAN;
}
for (i = 0; i <= n[d]; i++)
{
ivl->c[idx[d] + i] = 0.0;
for (j = i; j <= n[d]; j++)
ivl->c[idx[d] + i] += Tleft[i * 33 + j] * iv->c[idx[d] + j];
}
ncdiff = 0.0;
for (i = 0; i <= n[0]; i++)
{
temp = ivl->c[i] - ivl->c[idx[d] + i];
ncdiff += temp * temp;
}
for (i = n[0] + 1; i <= n[d]; i++)
{
temp = ivl->c[idx[d] + i];
ncdiff += temp * temp;
}
ncdiff = sqrt (ncdiff);
ivl->err = ncdiff * h;
/* Check for divergence. */
ivl->ndiv = iv->ndiv + (fabs (iv->c[0]) > 0
&& ivl->c[0] / iv->c[0] > 2);
if (ivl->ndiv > ndiv_max && 2 * ivl->ndiv > ivl->rdepth)
{
/* need copysign(INFINITY, igral) */
*result = (igral >= 0) ? GSL_POSINF : GSL_NEGINF;
if (nevals != NULL)
*nevals = neval;
return GSL_EDIVERGE;
}
/* Compute the local integral. */
ivl->igral = h * w * ivl->c[0];
/* Generate the interval on the right */
ivr = &(ws->ivals[ws->heap[nivals++]]);
ivr->a = m;
ivr->b = iv->b;
ivr->depth = 0;
ivr->rdepth = iv->rdepth + 1;
ivr->fx[0] = iv->fx[16];
ivr->fx[32] = iv->fx[32];
for (i = skip[0]; i < 32; i += skip[0])
{
ivr->fx[i] =
GSL_FN_EVAL (f, (ivr->a + ivr->b) / 2 + xi[i] * h / 2);
neval++;
}
nnans = 0;
for (i = 0; i <= 32; i += skip[0])
{
if (!finite (ivr->fx[i]))
{
nans[nnans++] = i;
ivr->fx[i] = 0.0;
}
}
Vinvfx (ivr->fx, ivr->c, 0);
if (nnans > 0)
{
downdate (ivr->c, n[0], 0, nans, nnans);
for (i = 0; i < nnans; i++)
ivr->fx[nans[i]] = GSL_NAN;
}
for (i = 0; i <= n[d]; i++)
{
ivr->c[idx[d] + i] = 0.0;
for (j = i; j <= n[d]; j++)
ivr->c[idx[d] + i] += Tright[i * 33 + j] * iv->c[idx[d] + j];
}
ncdiff = 0.0;
for (i = 0; i <= n[0]; i++)
{
temp = ivr->c[i] - ivr->c[idx[d] + i];
ncdiff += temp * temp;
}
for (i = n[0] + 1; i <= n[d]; i++)
{
temp = ivr->c[idx[d] + i];
ncdiff += temp * temp;
}
ncdiff = sqrt (ncdiff);
ivr->err = ncdiff * h;
/* Check for divergence. */
ivr->ndiv = iv->ndiv + (fabs (iv->c[0]) > 0
&& ivr->c[0] / iv->c[0] > 2);
if (ivr->ndiv > ndiv_max && 2 * ivr->ndiv > ivr->rdepth)
{
/* need copysign(INFINITY, igral) */
*result = (igral >= 0) ? GSL_POSINF : GSL_NEGINF;
if (nevals != NULL)
*nevals = neval;
return GSL_EDIVERGE;
}
/* Compute the local integral. */
ivr->igral = h * w * ivr->c[0];
/* Fix-up the heap: we now have one interval on top
that we don't need any more and two new, unsorted
ones at the bottom. */
/* Flip the last interval to the top of the heap and
sift down. */
t = ws->heap[nivals - 1];
ws->heap[nivals - 1] = ws->heap[0];
ws->heap[0] = t;
nivals--;
/* Sift this interval back down the heap. */
i = 0;
while (2 * i + 1 < nivals - 1)
{
j = 2 * i + 1;
if (j + 1 < nivals - 1
&& ws->ivals[ws->heap[j + 1]].err >=
ws->ivals[ws->heap[j]].err)
j++;
if (ws->ivals[ws->heap[j]].err <= ws->ivals[ws->heap[i]].err)
break;
else
{
t = ws->heap[j];
ws->heap[j] = ws->heap[i];
ws->heap[i] = t;
i = j;
}
}
/* Now grab the last interval and sift it up the heap. */
i = nivals - 1;
while (i > 0)
{
j = (i - 1) / 2;
if (ws->ivals[ws->heap[j]].err < ws->ivals[ws->heap[i]].err)
{
t = ws->heap[j];
ws->heap[j] = ws->heap[i];
ws->heap[i] = t;
i = j;
}
else
break;
}
}
/* Otherwise, just fix-up the heap. */
else
{
i = 0;
while (2 * i + 1 < nivals)
{
j = 2 * i + 1;
if (j + 1 < nivals
&& ws->ivals[ws->heap[j + 1]].err >=
ws->ivals[ws->heap[j]].err)
j++;
if (ws->ivals[ws->heap[j]].err <= ws->ivals[ws->heap[i]].err)
break;
else
{
t = ws->heap[j];
ws->heap[j] = ws->heap[i];
ws->heap[i] = t;
i = j;
}
}
}
/* If the heap is about to overflow, remove the last two
intervals. */
while (nivals > ws->size - 2)
{
iv = &(ws->ivals[ws->heap[nivals - 1]]);
/* printf
("cquad: dumping ival %i (of %i) with [%e,%e] int=%e, err=%e, depth=%i\n",
ws->heap[0], nivals, iv->a, iv->b, iv->igral, iv->err,
iv->depth);
*/
err_final += iv->err;
igral_final += iv->igral;
nivals--;
}
/* Collect the value of the integral and error. */
igral = igral_final;
err = err_final;
for (i = 0; i < nivals; i++)
{
igral += ws->ivals[ws->heap[i]].igral;
err += ws->ivals[ws->heap[i]].err;
}
}
/* Dump the contents of the heap. */
/* for (i = 0; i < nivals; i++)
{
iv = &(ws->ivals[ws->heap[i]]);
printf
("cquad: ival %i (%i) with [%e,%e], int=%e, err=%e, depth=%i, rdepth=%i\n",
i, ws->heap[i], iv->a, iv->b, iv->igral, iv->err, iv->depth,
iv->rdepth);
}
*/
/* Clean up and present the results. */
*result = igral;
if (abserr != NULL)
*abserr = err;
if (nevals != NULL)
*nevals = neval;
/* All is well that ends well. */
return GSL_SUCCESS;
}
bool three_body_system::find_characteristic_root(double &tar, vector<double> &new_orthonormal, vector<double> &h, int N){
// find the Nth root of the characteristic function specified by new_orthonormal and h
gsl_set_error_handler_off();
int status;
int iter = 0, max_iter = 100;
const gsl_root_fsolver_type *T;
gsl_root_fsolver *s;
double r = 0;
gsl_function F;
F.function = &helper_function;
characteristic_root_helper * params = new characteristic_root_helper(this, &new_orthonormal, &h);
F.params = params;
T = gsl_root_fsolver_brent;
s = gsl_root_fsolver_alloc (T);
double x_lo = 0.0;
double x_hi = evals[N] - 0.00001;
if (N > 0) x_lo = evals[N-1]*1.000000001;
else{
x_lo = x_hi - 1.0;
while (true){
double temp = GSL_FN_EVAL(&F, x_lo);
//cout << x_lo << " " << temp << endl;
if (temp < 0.0) break;
x_lo -= 1.0;
if (x_lo < x_hi - 10.0) break;
}
//if (evals[0] < 0.0) x_lo = evals[0] * 1.5;
//else x_lo = min(0.0, evals[0] - 250.0);
}
status = gsl_root_fsolver_set (s, &F, x_lo, x_hi);
//cout << x_lo << " " << x_hi << endl;
//cout << GSL_FN_EVAL(&F, x_lo) << " " << GSL_FN_EVAL(&F, x_hi) << endl;
if (status != GSL_SUCCESS){
//cout << "Root solver failure?" << endl;
return false;
}
do
{
iter++;
status = gsl_root_fsolver_iterate (s);
r = gsl_root_fsolver_root (s);
x_lo = gsl_root_fsolver_x_lower (s);
x_hi = gsl_root_fsolver_x_upper (s);
status = gsl_root_test_interval (x_lo, x_hi,
0, 1E-8);
}
while (status == GSL_CONTINUE && iter < max_iter);
gsl_root_fsolver_free (s);
tar = r;
return true;
}
int
gsl_integration_qng (const gsl_function *f,
double a, double b,
double epsabs, double epsrel,
double * result, double * abserr, size_t * neval)
{
double fv1[5], fv2[5], fv3[5], fv4[5];
double savfun[21]; /* array of function values which have been computed */
double res10, res21, res43, res87; /* 10, 21, 43 and 87 point results */
double result_kronrod, err ;
double resabs; /* approximation to the integral of abs(f) */
double resasc; /* approximation to the integral of abs(f-i/(b-a)) */
const double half_length = 0.5 * (b - a);
const double abs_half_length = fabs (half_length);
const double center = 0.5 * (b + a);
const double f_center = GSL_FN_EVAL(f, center);
int k ;
if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || epsrel < 0.5e-28))
{
* result = 0;
* abserr = 0;
* neval = 0;
GSL_ERROR ("tolerance cannot be acheived with given epsabs and epsrel",
GSL_EBADTOL);
};
/* Compute the integral using the 10- and 21-point formula. */
res10 = 0;
res21 = w21b[5] * f_center;
resabs = w21b[5] * fabs (f_center);
for (k = 0; k < 5; k++)
{
const double abscissa = half_length * x1[k];
const double fval1 = GSL_FN_EVAL(f, center + abscissa);
const double fval2 = GSL_FN_EVAL(f, center - abscissa);
const double fval = fval1 + fval2;
res10 += w10[k] * fval;
res21 += w21a[k] * fval;
resabs += w21a[k] * (fabs (fval1) + fabs (fval2));
savfun[k] = fval;
fv1[k] = fval1;
fv2[k] = fval2;
}
for (k = 0; k < 5; k++)
{
const double abscissa = half_length * x2[k];
const double fval1 = GSL_FN_EVAL(f, center + abscissa);
const double fval2 = GSL_FN_EVAL(f, center - abscissa);
const double fval = fval1 + fval2;
res21 += w21b[k] * fval;
resabs += w21b[k] * (fabs (fval1) + fabs (fval2));
savfun[k + 5] = fval;
fv3[k] = fval1;
fv4[k] = fval2;
}
resabs *= abs_half_length ;
{
const double mean = 0.5 * res21;
resasc = w21b[5] * fabs (f_center - mean);
for (k = 0; k < 5; k++)
{
resasc +=
(w21a[k] * (fabs (fv1[k] - mean) + fabs (fv2[k] - mean))
+ w21b[k] * (fabs (fv3[k] - mean) + fabs (fv4[k] - mean)));
}
resasc *= abs_half_length ;
}
result_kronrod = res21 * half_length;
err = rescale_error ((res21 - res10) * half_length, resabs, resasc) ;
/* test for convergence. */
if (err < epsabs || err < epsrel * fabs (result_kronrod))
{
* result = result_kronrod ;
* abserr = err ;
* neval = 21;
return GSL_SUCCESS;
}
/* compute the integral using the 43-point formula. */
res43 = w43b[11] * f_center;
for (k = 0; k < 10; k++)
{
res43 += savfun[k] * w43a[k];
}
for (k = 0; k < 11; k++)
{
const double abscissa = half_length * x3[k];
const double fval = (GSL_FN_EVAL(f, center + abscissa)
+ GSL_FN_EVAL(f, center - abscissa));
res43 += fval * w43b[k];
savfun[k + 10] = fval;
}
/* test for convergence */
result_kronrod = res43 * half_length;
err = rescale_error ((res43 - res21) * half_length, resabs, resasc);
if (err < epsabs || err < epsrel * fabs (result_kronrod))
{
* result = result_kronrod ;
* abserr = err ;
* neval = 43;
return GSL_SUCCESS;
}
/* compute the integral using the 87-point formula. */
res87 = w87b[22] * f_center;
for (k = 0; k < 21; k++)
{
res87 += savfun[k] * w87a[k];
}
for (k = 0; k < 22; k++)
{
const double abscissa = half_length * x4[k];
res87 += w87b[k] * (GSL_FN_EVAL(f, center + abscissa)
+ GSL_FN_EVAL(f, center - abscissa));
}
/* test for convergence */
result_kronrod = res87 * half_length ;
err = rescale_error ((res87 - res43) * half_length, resabs, resasc);
if (err < epsabs || err < epsrel * fabs (result_kronrod))
{
* result = result_kronrod ;
* abserr = err ;
* neval = 87;
return GSL_SUCCESS;
}
/* failed to converge */
* result = result_kronrod ;
* abserr = err ;
* neval = 87;
GSL_ERROR("failed to reach tolerance with highest-order rule", GSL_ETOL) ;
}
// Draws the first passage time from the survival probability,
// using an assistance function drawT_f that casts the math. function
// into the form needed by the GSL root solver.
Real
GreensFunction1DRadAbs::drawTime (Real rnd) const
{
THROW_UNLESS( std::invalid_argument, 0.0 <= rnd && rnd < 1.0 );
const Real sigma(this->getsigma());
const Real a(this->geta());
const Real L(this->geta()-this->getsigma());
const Real r0(this->getr0());
const Real k(this->getk());
const Real D(this->getD());
const Real v(this->getv());
const Real h((this->getk()+this->getv()/2.0)/this->getD());
if ( D == 0.0 || L == INFINITY )
{
return INFINITY;
}
if ( rnd <= EPSILON || L < 0.0 || fabs(a-r0) < EPSILON*L )
{
return 0.0;
}
const Real v2D(v/2.0/D);
const Real exp_av2D(exp(a*v2D));
const Real exp_sigmav2D(exp(sigma*v2D));
// exponent of the prefactor present in case of v<>0; has to be split because it has a t-dep. and t-indep. part
const Real vexpo_t(-v*v/4.0/D);
const Real vexpo_pref(-v*r0/2.0/D);
// the structure to store the numbers to calculate the numbers for 1-S
struct drawT_params parameters;
// some temporary variables
double root_n = 0;
double root_n2, root_n_r0_s, root_n_L, h_root_n;
double Xn, exponent, prefactor;
// produce the coefficients and the terms in the exponent and put them
// in the params structure. This is not very efficient at this point,
// coefficients should be calculated on demand->TODO
for (int n=0; n<MAX_TERMS; n++)
{
root_n = this->root_n(n+1); // get the n-th root of tan(root*a)=root/-h (Note: root numbering starts at n=1)
root_n2 = root_n * root_n;
root_n_r0_s = root_n * (r0-sigma);
root_n_L = root_n * L;
h_root_n = h / root_n;
if(v==0) Xn = (h*sin(root_n_r0_s) + root_n*cos(root_n_r0_s)) / (L*(root_n2+h*h)+h)
* ( h_root_n + sin(root_n_L) - h_root_n*cos(root_n_L) );
else Xn = (h*sin(root_n_r0_s) + root_n*cos(root_n_r0_s)) / (L*(root_n2+h*h)+h)
* (exp_sigmav2D*h*k/D - exp_av2D*(root_n2+h*h)*cos(root_n_L)) / (h_root_n * (root_n2 + v2D*v2D));
exponent = -D*root_n2 + vexpo_t;
// store the coefficients in the structure
parameters.Xn[n] = Xn;
// also store the values for the exponent
parameters.exponent[n] = exponent;
}
// the prefactor of the sum is also different in case of drift<>0 :
if(v==0) prefactor = 2.0;
else prefactor = 2.0*exp(vexpo_pref);
parameters.prefactor = prefactor;
// store the random number for the probability
parameters.rnd = rnd;
// store the number of terms used
parameters.terms = MAX_TERMS;
parameters.tscale = this->t_scale;
// Define the function for the rootfinder
gsl_function F;
F.function = &GreensFunction1DRadAbs::drawT_f;
F.params = ¶meters;
// Find a good interval to determine the first passage time in
// get the distance to absorbing boundary (disregard rad BC)
const Real dist(fabs(a-r0));
//const Real dist( std::min(r0, a-r0)); // for test purposes
// construct a guess: MSD = sqrt (2*d*D*t)
Real t_guess( dist * dist / ( 2.0*D ) );
// A different guess has to be made in case of nonzero drift to account for the displacement due to it
// TODO: This does not work properly in this case yet, but we don't know why...
// When drifting towards the closest boundary
//if( (r0 >= a/2.0 && v > 0.0) || (r0 <= a/2.0 && v < 0.0) ) t_guess = sqrt(D*D/(v*v*v*v)+dist*dist/(v*v)) - D/(v*v);
// When drifting away from the closest boundary
//if( ( r0 < a/2.0 && v > 0.0) || ( r0 > a/2.0 && v < 0.0) ) t_guess = D/(v*v) - sqrt(D*D/(v*v*v*v)-dist*dist/(v*v));
Real value( GSL_FN_EVAL( &F, t_guess ) );
Real low( t_guess );
Real high( t_guess );
// scale the interval around the guess such that the function straddles
if( value < 0.0 )
{
// if the guess was too low
do
{
// keep increasing the upper boundary until the
// function straddles
high *= 10;
value = GSL_FN_EVAL( &F, high );
if( fabs( high ) >= t_guess * 1e6 )
{
std::cerr << "GF1DRad: Couldn't adjust high. F("
<< high << ") = " << value << std::endl;
throw std::exception();
}
}
while ( value <= 0.0 );
}
else
{
// if the guess was too high
// initialize with 2 so the test below survives the first
// iteration
Real value_prev( 2 );
do
{
if( fabs( low ) <= t_guess * 1e-6 ||
fabs(value-value_prev) < EPSILON*1.0 )
{
std::cerr << "GF1DRad: Couldn't adjust low. F(" << low << ") = "
<< value << " t_guess: " << t_guess << " diff: "
<< (value - value_prev) << " value: " << value
<< " value_prev: " << value_prev << " rnd: "
<< rnd << std::endl;
return low;
}
value_prev = value;
// keep decreasing the lower boundary until the function straddles
low *= 0.1;
// get the accompanying value
value = GSL_FN_EVAL( &F, low );
}
while ( value >= 0.0 );
}
// find the intersection on the y-axis between the random number and
// the function
// define a new solver type brent
const gsl_root_fsolver_type* solverType( gsl_root_fsolver_brent );
// make a new solver instance
// TODO: incl typecast?
gsl_root_fsolver* solver( gsl_root_fsolver_alloc( solverType ) );
const Real t( findRoot( F, solver, low, high, t_scale*EPSILON, EPSILON,
"GreensFunction1DRadAbs::drawTime" ) );
// return the drawn time
return t;
}
void
gsl_integration_qk (const int n,
const double xgk[], const double wg[], const double wgk[],
double fv1[], double fv2[],
const gsl_function * f, double a, double b,
double *result, double *abserr,
double *resabs, double *resasc)
{
const double center = 0.5 * (a + b);
const double half_length = 0.5 * (b - a);
const double abs_half_length = fabs (half_length);
const double f_center = GSL_FN_EVAL (f, center);
double result_gauss = 0;
double result_kronrod = f_center * wgk[n - 1];
double result_abs = fabs (result_kronrod);
double result_asc = 0;
double mean = 0, err = 0;
int j;
if (n % 2 == 0)
{
result_gauss = f_center * wg[n / 2 - 1];
}
for (j = 0; j < (n - 1) / 2; j++)
{
const int jtw = j * 2 + 1; /* j=1,2,3 jtw=2,4,6 */
const double abscissa = half_length * xgk[jtw];
const double fval1 = GSL_FN_EVAL (f, center - abscissa);
const double fval2 = GSL_FN_EVAL (f, center + abscissa);
const double fsum = fval1 + fval2;
fv1[jtw] = fval1;
fv2[jtw] = fval2;
result_gauss += wg[j] * fsum;
result_kronrod += wgk[jtw] * fsum;
result_abs += wgk[jtw] * (fabs (fval1) + fabs (fval2));
}
for (j = 0; j < n / 2; j++)
{
int jtwm1 = j * 2;
const double abscissa = half_length * xgk[jtwm1];
const double fval1 = GSL_FN_EVAL (f, center - abscissa);
const double fval2 = GSL_FN_EVAL (f, center + abscissa);
fv1[jtwm1] = fval1;
fv2[jtwm1] = fval2;
result_kronrod += wgk[jtwm1] * (fval1 + fval2);
result_abs += wgk[jtwm1] * (fabs (fval1) + fabs (fval2));
};
mean = result_kronrod * 0.5;
result_asc = wgk[n - 1] * fabs (f_center - mean);
for (j = 0; j < n - 1; j++)
{
result_asc += wgk[j] * (fabs (fv1[j] - mean) + fabs (fv2[j] - mean));
}
/* scale by the width of the integration region */
err = (result_kronrod - result_gauss) * half_length;
result_kronrod *= half_length;
result_abs *= abs_half_length;
result_asc *= abs_half_length;
*result = result_kronrod;
*resabs = result_abs;
*resasc = result_asc;
*abserr = rescale_error (err, result_abs, result_asc);
}
// Draws the first passage time from the propensity function.
// Uses the help routine drawT_f and structure drawT_params for some technical
// reasons related to the way to input a function and parameters required by
// the GSL library.
Real
GreensFunction1DAbsAbs::drawTime (Real rnd) const
{
THROW_UNLESS( std::invalid_argument, 0.0 <= rnd && rnd < 1.0 );
const Real a(this->geta());
const Real sigma(this->getsigma());
const Real L(this->geta() - this->getsigma());
const Real r0(this->getr0());
const Real D(this->getD());
const Real v(this->getv());
if (D == 0.0 )
{
return INFINITY;
}
else if ( L < 0.0 || fabs(a-r0) < EPSILON*L || fabs(r0-sigma) > (1.0 - EPSILON)*L )
{
// if the domain had zero size
return 0.0;
}
const Real expo(-D/(L*L));
const Real r0s_L((r0-sigma)/L);
// some abbreviations for terms appearing in the sums with drift<>0
const Real sigmav2D(sigma*v/2.0/D);
const Real av2D(a*v/2.0/D);
const Real Lv2D(L*v/2.0/D);
// exponent of the prefactor present in case of v<>0; has to be split because it has a t-dep. and t-indep. part
const Real vexpo_t(-v*v/4.0/D);
const Real vexpo_pref(-v*r0/2.0/D);
// the structure to store the numbers to calculate the numbers for 1-S
struct drawT_params parameters;
Real Xn, exponent, prefactor;
Real nPI;
// Construct the coefficients and the terms in the exponent and put them
// into the params structure
int n = 0;
// a simpler sum has to be computed for the case w/o drift, so distinguish here
if(v==0)
{
do
{
nPI = ((Real)(n+1))*M_PI; // why n+1 : this loop starts at n=0 (1st index of the arrays), while the sum starts at n=1 !
Xn = sin(nPI*r0s_L) * (1.0 - cos(nPI)) / nPI;
exponent = nPI*nPI*expo;
// store the coefficients in the structure
parameters.Xn[n] = Xn;
// also store the values for the exponent
parameters.exponent[n]=exponent;
n++;
}
// TODO: Modify this later to include a cutoff when changes are small
while (n<MAX_TERMS);
}
else // case with drift<>0
{
do
{
nPI = ((Real)(n+1))*M_PI; // why n+1 : this loop starts at n=0 (1st index of the arrays), while the sum starts at n=1 !
Xn = (exp(sigmav2D) - cos(nPI)*exp(av2D)) * nPI/(Lv2D*Lv2D+nPI*nPI) * sin(nPI*r0s_L);
exponent = nPI*nPI*expo + vexpo_t;
// store the coefficients in the structure
parameters.Xn[n] = Xn;
// also store the values for the exponent
parameters.exponent[n]=exponent;
n++;
}
// TODO: Modify this later to include a cutoff when changes are small
while (n<MAX_TERMS);
}
// the prefactor of the sum is also different in case of drift<>0 :
if(v==0) prefactor = 2.0*exp(vexpo_pref);
else prefactor = 2.0;
parameters.prefactor = prefactor;
parameters.rnd = rnd;
parameters.terms = MAX_TERMS;
parameters.tscale = this->t_scale;
gsl_function F;
F.function = &drawT_f;
F.params = ¶meters;
// Find a good interval to determine the first passage time in
const Real dist( std::min(r0-sigma, a-r0) );
// construct a guess: MSD = sqrt (2*d*D*t)
Real t_guess( dist * dist / ( 2.0 * D ) );
// A different guess has to be made in case of nonzero drift to account for the displacement due to it
// When drifting towards the closest boundary...
if( ( r0-sigma >= L/2.0 && v > 0.0 ) || ( r0-sigma <= L/2.0 && v < 0.0 ) ) t_guess = sqrt(D*D/(v*v*v*v)+dist*dist/(v*v)) - D/(v*v);
// When drifting away from the closest boundary...
if( ( r0-sigma < L/2.0 && v > 0.0 ) || ( r0-sigma > L/2.0 && v < 0.0 ) ) t_guess = D/(v*v) - sqrt(D*D/(v*v*v*v)-dist*dist/(v*v));
Real value( GSL_FN_EVAL( &F, t_guess ) );
Real low( t_guess );
Real high( t_guess );
if( value < 0.0 )
{
// scale the interval around the guess such that the function
// straddles if the guess was too low
do
{
// keep increasing the upper boundary until the
// function straddles
high *= 10.0;
value = GSL_FN_EVAL( &F, high );
if( fabs( high ) >= t_guess * 1e6 )
{
std::cerr << "Couldn't adjust high. F(" << high << ") = "
<< value << std::endl;
throw std::exception();
}
}
while ( value <= 0.0 );
}
else
{
// if the guess was too high initialize with 2 so the test
// below survives the first iteration
Real value_prev( 2.0 );
do
{
if( fabs( low ) <= t_guess * 1.0e-6 ||
fabs(value-value_prev) < EPSILON*this->t_scale )
{
std::cerr << "Couldn't adjust low. F(" << low << ") = "
<< value << " t_guess: " << t_guess << " diff: "
<< (value - value_prev) << " value: " << value
<< " value_prev: " << value_prev << " t_scale: "
<< this->t_scale << std::endl;
return low;
}
value_prev = value;
// keep decreasing the lower boundary until the
// function straddles
low *= 0.1;
// get the accompanying value
value = GSL_FN_EVAL( &F, low );
}
while ( value >= 0.0 );
}
// find the intersection on the y-axis between the random number and
// the function
// define a new solver type brent
const gsl_root_fsolver_type* solverType( gsl_root_fsolver_brent );
// make a new solver instance
// TODO: incl typecast?
gsl_root_fsolver* solver( gsl_root_fsolver_alloc( solverType ) );
const Real t( findRoot( F, solver, low, high, EPSILON*t_scale, EPSILON,
"GreensFunction1DAbsAbs::drawTime" ) );
// return the drawn time
return t;
}
void
gsl_integration_qcheb (gsl_function * f, double a, double b, double *cheb12, double *cheb24)
{
size_t i;
double fval[25], v[12];
/* These are the values of cos(pi*k/24) for k=1..11 needed for the
Chebyshev expansion of f(x) */
const double x[11] = { 0.9914448613738104,
0.9659258262890683,
0.9238795325112868,
0.8660254037844386,
0.7933533402912352,
0.7071067811865475,
0.6087614290087206,
0.5000000000000000,
0.3826834323650898,
0.2588190451025208,
0.1305261922200516 };
const double center = 0.5 * (b + a);
const double half_length = 0.5 * (b - a);
fval[0] = 0.5 * GSL_FN_EVAL (f, center + half_length);
fval[12] = GSL_FN_EVAL (f, center);
fval[24] = 0.5 * GSL_FN_EVAL (f, center - half_length);
for (i = 1; i < 12; i++)
{
const size_t j = 24 - i;
const double u = half_length * x[i-1];
fval[i] = GSL_FN_EVAL(f, center + u);
fval[j] = GSL_FN_EVAL(f, center - u);
}
for (i = 0; i < 12; i++)
{
const size_t j = 24 - i;
v[i] = fval[i] - fval[j];
fval[i] = fval[i] + fval[j];
}
{
const double alam1 = v[0] - v[8];
const double alam2 = x[5] * (v[2] - v[6] - v[10]);
cheb12[3] = alam1 + alam2;
cheb12[9] = alam1 - alam2;
}
{
const double alam1 = v[1] - v[7] - v[9];
const double alam2 = v[3] - v[5] - v[11];
{
const double alam = x[2] * alam1 + x[8] * alam2;
cheb24[3] = cheb12[3] + alam;
cheb24[21] = cheb12[3] - alam;
}
{
const double alam = x[8] * alam1 - x[2] * alam2;
cheb24[9] = cheb12[9] + alam;
cheb24[15] = cheb12[9] - alam;
}
}
{
const double part1 = x[3] * v[4];
const double part2 = x[7] * v[8];
const double part3 = x[5] * v[6];
{
const double alam1 = v[0] + part1 + part2;
const double alam2 = x[1] * v[2] + part3 + x[9] * v[10];
cheb12[1] = alam1 + alam2;
cheb12[11] = alam1 - alam2;
}
{
const double alam1 = v[0] - part1 + part2;
const double alam2 = x[9] * v[2] - part3 + x[1] * v[10];
cheb12[5] = alam1 + alam2;
cheb12[7] = alam1 - alam2;
}
}
{
const double alam = (x[0] * v[1] + x[2] * v[3] + x[4] * v[5]
+ x[6] * v[7] + x[8] * v[9] + x[10] * v[11]);
cheb24[1] = cheb12[1] + alam;
cheb24[23] = cheb12[1] - alam;
}
{
const double alam = (x[10] * v[1] - x[8] * v[3] + x[6] * v[5]
- x[4] * v[7] + x[2] * v[9] - x[0] * v[11]);
cheb24[11] = cheb12[11] + alam;
cheb24[13] = cheb12[11] - alam;
}
{
const double alam = (x[4] * v[1] - x[8] * v[3] - x[0] * v[5]
- x[10] * v[7] + x[2] * v[9] + x[6] * v[11]);
cheb24[5] = cheb12[5] + alam;
cheb24[19] = cheb12[5] - alam;
}
{
const double alam = (x[6] * v[1] - x[2] * v[3] - x[10] * v[5]
+ x[0] * v[7] - x[8] * v[9] - x[4] * v[11]);
cheb24[7] = cheb12[7] + alam;
cheb24[17] = cheb12[7] - alam;
}
for (i = 0; i < 6; i++)
{
const size_t j = 12 - i;
v[i] = fval[i] - fval[j];
fval[i] = fval[i] + fval[j];
}
{
const double alam1 = v[0] + x[7] * v[4];
const double alam2 = x[3] * v[2];
cheb12[2] = alam1 + alam2;
cheb12[10] = alam1 - alam2;
}
cheb12[6] = v[0] - v[4];
{
const double alam = x[1] * v[1] + x[5] * v[3] + x[9] * v[5];
cheb24[2] = cheb12[2] + alam;
cheb24[22] = cheb12[2] - alam;
}
{
const double alam = x[5] * (v[1] - v[3] - v[5]);
cheb24[6] = cheb12[6] + alam;
cheb24[18] = cheb12[6] - alam;
}
{
const double alam = x[9] * v[1] - x[5] * v[3] + x[1] * v[5];
cheb24[10] = cheb12[10] + alam;
cheb24[14] = cheb12[10] - alam;
}
for (i = 0; i < 3; i++)
{
const size_t j = 6 - i;
v[i] = fval[i] - fval[j];
fval[i] = fval[i] + fval[j];
}
cheb12[4] = v[0] + x[7] * v[2];
cheb12[8] = fval[0] - x[7] * fval[2];
{
const double alam = x[3] * v[1];
cheb24[4] = cheb12[4] + alam;
cheb24[20] = cheb12[4] - alam;
}
{
const double alam = x[7] * fval[1] - fval[3];
cheb24[8] = cheb12[8] + alam;
cheb24[16] = cheb12[8] - alam;
}
cheb12[0] = fval[0] + fval[2];
{
const double alam = fval[1] + fval[3];
cheb24[0] = cheb12[0] + alam;
cheb24[24] = cheb12[0] - alam;
}
cheb12[12] = v[0] - v[2];
cheb24[12] = cheb12[12];
for (i = 1; i < 12; i++)
{
cheb12[i] *= 1.0 / 6.0;
}
cheb12[0] *= 1.0 / 12.0;
cheb12[12] *= 1.0 / 12.0;
for (i = 1; i < 24; i++)
{
cheb24[i] *= 1.0 / 12.0;
}
cheb24[0] *= 1.0 / 24.0;
cheb24[24] *= 1.0 / 24.0;
}
const Real
GreensFunction2DAbsSym::drawTime( const Real rnd ) const
{
THROW_UNLESS( std::invalid_argument, rnd < 1.0 && rnd >= 0.0 );
const Real a( geta() );
if( getD() == 0.0 || a == std::numeric_limits<Real>::infinity() )
{
return std::numeric_limits<Real>::infinity();
}
if( a == 0.0 )
{
return 0.0;
}
p_survival_params params = { this, rnd };
gsl_function F =
{
reinterpret_cast<double (*)(double, void*)>( &p_survival_F ), ¶ms
};
//for (Real t=0.0001; t<=1; t+=0.0001)
//{ std::cout << t << " " << GSL_FN_EVAL( &F, t) << std::endl;
//}
// Find a good interval to determine the first passage time in
const Real t_guess( a * a / ( 4. * D ) ); // construct a guess: msd = sqrt (2*d*D*t)
Real value( GSL_FN_EVAL( &F, t_guess ) );
Real low( t_guess );
Real high( t_guess );
// scale the interval around the guess such that the function straddles
if( value < 0.0 ) // if the guess was too low
{
do
{ high *= 10; // keep increasing the upper boundary until the function straddles
value = GSL_FN_EVAL( &F, high );
if( fabs( high ) >= t_guess * 1e6 )
{
// log_.warn("Couldn't adjust high. F(%.16g) = %.16g", high, value);
throw std::exception();
}
}
while ( value <= 0.0 );
}
else // if the guess was too high
{
Real value_prev( value );
do
{ low *= .1; // keep decreasing the lower boundary until the function straddles
value = GSL_FN_EVAL( &F, low ); // get the accompanying value
if( fabs( low ) <= t_guess * 1e-6 || fabs( value - value_prev ) < CUTOFF )
{
// log_.warn("Couldn't adjust high. F(%.16g) = %.16g", low, value);
return low;
}
value_prev = value;
}
while ( value >= 0.0 );
}
// find the root
const gsl_root_fsolver_type* solverType( gsl_root_fsolver_brent ); // a new solver type brent
gsl_root_fsolver* solver( gsl_root_fsolver_alloc( solverType ) ); // make a new solver instance
const Real t( findRoot( F, solver, low, high, 1e-18, 1e-12,
"GreensFunction2DAbsSym::drawTime" ) );
gsl_root_fsolver_free( solver );
return t;
}
Real GreensFunction3DAbsSym::drawTime(Real rnd) const
{
const Real D(getD());
if (rnd >= 1.0 || rnd < 0.0)
{
throw std::invalid_argument((boost::format("0.0 <= %.16g < 1.0") % rnd).str());
}
const Real a(geta());
if (D == 0.0 || a == INFINITY)
{
return INFINITY;
}
if (a == 0.0)
{
return 0.0;
}
p_survival_params params = { this, rnd };
gsl_function F =
{
reinterpret_cast<double (*)(double, void*)>( &p_survival_F ),
¶ms
};
const Real t_guess(a * a / (6. * D));
Real low(t_guess);
Real high(t_guess);
const Real value(GSL_FN_EVAL(&F, t_guess));
if (value < 0.0)
{
high *= 10;
for (;;)
{
const Real high_value(GSL_FN_EVAL(&F, high));
if (high_value >= 0.0)
{
break;
}
if (fabs(high) >= t_guess * 1e6)
{
throw std::runtime_error(
(boost::format("couldn't adjust high. F(%.16g) = %.16g; %s") %
high % GSL_FN_EVAL(&F, high) %
boost::lexical_cast<std::string>(*this)).str());
}
high *= 10;
}
}
else
{
Real low_value_prev(value);
low *= .1;
for (;;)
{
const Real low_value(GSL_FN_EVAL(&F, low));
if (low_value <= 0.0)
{
break;
}
if (fabs(low) <= t_guess * 1e-6 ||
fabs(low_value - low_value_prev) < CUTOFF)
{
log_.info("couldn't adjust high. F(%.16g) = %.16g; %s",
low, GSL_FN_EVAL(&F, low),
boost::lexical_cast<std::string>(*this).c_str());
log_.info("returning low (%.16g)", low);
return low;
}
low_value_prev = low_value;
low *= .1;
}
}
const gsl_root_fsolver_type* solverType(gsl_root_fsolver_brent);
gsl_root_fsolver* solver(gsl_root_fsolver_alloc(solverType));
const Real t(findRoot(F, solver, low, high, 1e-18, 1e-12,
"GreensFunction3DAbsSym::drawTime"));
gsl_root_fsolver_free(solver);
return t;
}
Real GreensFunction3DSym::drawR(Real rnd, Real t) const
{
// input parameter range checks.
if ( !(rnd <= 1.0 && rnd >= 0.0 ) )
{
throw std::invalid_argument( ( boost::format( "GreensFunction3DSym: rnd <= 1.0 && rnd >= 0.0 : rnd=%.16g" ) % rnd ).str() );
}
if ( !(t >= 0.0 ) )
{
throw std::invalid_argument( ( boost::format( "GreensFunction3DSym: t >= 0.0 : t=%.16g" ) % t ).str() );
}
// t == 0 or D == 0 means no move.
if( t == 0.0 || getD() == 0.0 )
{
return 0.0;
}
ip_r_params params = { this, t, rnd };
gsl_function F =
{
reinterpret_cast<double (*)(double, void*)>( &ip_r_F ),
¶ms
};
Real max_r( 4.0 * sqrt( 6.0 * getD() * t ) );
while( GSL_FN_EVAL( &F, max_r ) < 0.0 )
{
max_r *= 10;
}
const gsl_root_fsolver_type* solverType( gsl_root_fsolver_brent );
gsl_root_fsolver* solver( gsl_root_fsolver_alloc( solverType ) );
gsl_root_fsolver_set( solver, &F, 0.0, max_r );
const unsigned int maxIter( 100 );
unsigned int i( 0 );
while( true )
{
gsl_root_fsolver_iterate( solver );
const Real low( gsl_root_fsolver_x_lower( solver ) );
const Real high( gsl_root_fsolver_x_upper( solver ) );
const int status( gsl_root_test_interval( low, high, 1e-15,
this->TOLERANCE ) );
if( status == GSL_CONTINUE )
{
if( i >= maxIter )
{
gsl_root_fsolver_free( solver );
throw std::runtime_error("GreensFunction3DSym: drawR: failed to converge");
}
}
else
{
break;
}
++i;
}
//printf("%d\n", i );
const Real r( gsl_root_fsolver_root( solver ) );
gsl_root_fsolver_free( solver );
return r;
}
int
test (const char * name, gsl_function * f, double x[], int N, char *fmt)
{
int i;
double res, err, sum = 0, sumerr = 0;
printf ("void test_auto_%s (void);\n\n", name);
printf ("void\ntest_auto_%s (void)\n{\n", name);
/* gsl_set_error_handler_off(); */
w = gsl_integration_workspace_alloc (1000);
for (i = 0; i < N; i++)
{
res = 0;
err = 0;
if (x[0] < -1000)
{
if (x[i] < 0)
{
res = integrate_lower (f, x[i]);
}
else
{
res = 1 - integrate_upper (f, x[i]);
}
sum = res;
}
else
{
if (i == 0)
sum += 0;
else
sum += integrate(f, x[i-1], x[i]);
}
if (res < 0)
continue;
printf (fmt, "_P", x[i], sum);
if (inverse && (sum != 0 && sum != 1) && (x[i] == 0 || sum * 1e-4 < GSL_FN_EVAL(f,x[i]) * fabs(x[i])))
printf (fmt, "_Pinv", sum, x[i]);
}
printf("\n");
sum=0;
sumerr=0;
for (i = N-1; i >= 0; i--)
{
res = 0;
err = 0;
if (x[N-1] > 1000)
{
if (x[i] > 0)
{
res = integrate_upper (f, x[i]);
}
else
{
res = 1-integrate_lower (f, x[i]);
}
sum = res;
}
else
{
if (i == N-1)
sum += 0;
else
sum += integrate(f, x[i], x[i+1]);
}
printf (fmt, "_Q", x[i], sum);
if (inverse && (sum != 0 && sum != 1) && (x[i] == 0 || sum * 1e-4 < GSL_FN_EVAL(f,x[i]) * fabs(x[i])))
printf (fmt, "_Qinv", sum, x[i]);
}
printf ("}\n\n");
gsl_integration_workspace_free (w);
}
// Draws the first passage time from the propendity function
const Real FirstPassageGreensFunction1DRad::drawTime (const Real rnd) const
{
const Real L(this->getL());
const Real k(this->getk());
const Real D(this->getD());
const Real r0(this->getr0());
THROW_UNLESS( std::invalid_argument, 0.0 <= rnd && rnd < 1.0 );
if ( D == 0.0 || L == INFINITY )
{
return INFINITY;
}
if ( rnd <= EPSILON || L < 0.0 || fabs(r0 - L) < EPSILON*L )
{
return 0.0;
}
const Real h(k/D);
// the structure to store the numbers to calculate the numbers for 1-S
struct drawT_params parameters;
double An = 0;
double tmp0, tmp1, tmp2, tmp3;
double Xn, exponent;
// produce the coefficients and the terms in the exponent and put them
// in the params structure. This is not very efficient at this point,
// coefficients should be calculated on demand->TODO
for (int n=0; n<MAX_TERMEN; n++)
{
An = a_n (n+1); // get the n-th root of tan(alfa*L)=alfa/-k
tmp0 = An * An; // An^2
tmp1 = An * r0; // An * z'
tmp2 = An * L; // An * L
tmp3 = h / An; // h / An
Xn = (An*cos(tmp1) + h*sin(tmp1)) *
(sin(tmp2)-tmp3*cos(tmp2)+tmp3) / (L*(tmp0+h*h)+h);
exponent = -D*tmp0;
// store the coefficients in the structure
parameters.Xn[n] = Xn;
// also store the values for the exponent
parameters.exponent[n]=exponent;
}
// store the random number for the probability
parameters.rnd = rnd;
// store the number of terms used
parameters.terms = MAX_TERMEN;
parameters.tscale = this->t_scale;
// Define the function for the rootfinder
gsl_function F;
F.function = &FirstPassageGreensFunction1DRad::drawT_f;
F.params = ¶meters;
// Find a good interval to determine the first passage time in
// get the distance to absorbing boundary (disregard rad BC)
const Real dist(L-r0);
// construct a guess: msd = sqrt (2*d*D*t)
const Real t_guess( dist * dist / ( 2. * D ) );
Real value( GSL_FN_EVAL( &F, t_guess ) );
Real low( t_guess );
Real high( t_guess );
// scale the interval around the guess such that the function straddles
if( value < 0.0 )
{
// if the guess was too low
do
{
// keep increasing the upper boundary until the
// function straddles
high *= 10;
value = GSL_FN_EVAL( &F, high );
if( fabs( high ) >= t_guess * 1e6 )
{
std::cerr << "GF1DRad: Couldn't adjust high. F("
<< high << ") = " << value << std::endl;
throw std::exception();
}
}
while ( value <= 0.0 );
}
else
{
// if the guess was too high
// initialize with 2 so the test below survives the first
// iteration
Real value_prev( 2 );
do
{
if( fabs( low ) <= t_guess * 1e-6 ||
fabs(value-value_prev) < EPSILON*1.0 )
{
std::cerr << "GF1DRad: Couldn't adjust low. F(" << low << ") = "
<< value << " t_guess: " << t_guess << " diff: "
<< (value - value_prev) << " value: " << value
<< " value_prev: " << value_prev << " rnd: "
<< rnd << std::endl;
return low;
}
value_prev = value;
// keep decreasing the lower boundary until the function straddles
low *= .1;
// get the accompanying value
value = GSL_FN_EVAL( &F, low );
}
while ( value >= 0.0 );
}
// find the intersection on the y-axis between the random number and
// the function
// define a new solver type brent
const gsl_root_fsolver_type* solverType( gsl_root_fsolver_brent );
// make a new solver instance
// incl typecast?
gsl_root_fsolver* solver( gsl_root_fsolver_alloc( solverType ) );
const Real t( findRoot( F, solver, low, high, t_scale*EPSILON, EPSILON,
"FirstPassageGreensFunction1DRad::drawTime" ) );
// return the drawn time
return t;
}
