/**
* returns the modified spherical Bessel function of the second kind needed
* for bound states.
\param l = order of the function (orbital angular momentum)
\param rho = independent variable (rho = k * r)
*/
double sphericalB::k(int l, double rho)
{
switch (l)
{
case 0:
return k0(rho);
case 1:
return k1(rho);
case 2:
return k2(rho);
case 3:
return k3(rho);
case 4:
return k4(rho);
case 5:
return k5(rho);
case 6:
return k6(rho);
case 7:
return k7(rho);
default:
cout << "no l>6 programed in sphericalB" << endl;
return 0.;
}
}
void bi::DOPRI5IntegratorHost<B,S,T1>::update(const T1 t1, const T1 t2,
State<B,ON_HOST>& s) {
/* pre-condition */
BI_ASSERT(t1 < t2);
typedef host_vector_reference<real> vector_reference_type;
typedef Pa<ON_HOST,B,host,host,host,host> PX;
typedef DOPRI5VisitorHost<B,S,S,real,PX,real> Visitor;
static const int N = block_size<S>::value;
const int P = s.size();
#pragma omp parallel
{
real buf[10*N]; // use of dynamic array faster than heap allocation
vector_reference_type x0(buf, N);
vector_reference_type x1(buf + N, N);
vector_reference_type x2(buf + 2*N, N);
vector_reference_type x3(buf + 3*N, N);
vector_reference_type x4(buf + 4*N, N);
vector_reference_type x5(buf + 5*N, N);
vector_reference_type x6(buf + 6*N, N);
vector_reference_type err(buf + 7*N, N);
vector_reference_type k1(buf + 8*N, N);
vector_reference_type k7(buf + 9*N, N);
real t, h, e, e2, logfacold, logfac11, fac;
int n, id, p;
bool k1in;
PX pax;
#pragma omp for
for (p = 0; p < P; ++p) {
t = t1;
h = h_h0;
logfacold = bi::log(BI_REAL(1.0e-4));
k1in = false;
n = 0;
host_load<B,S>(s, p, x0);
/* integrate */
while (t < t2 && n < h_nsteps) {
if (BI_REAL(0.1)*bi::abs(h) <= bi::abs(t)*h_uround) {
// step size too small
}
if (t + BI_REAL(1.01)*h - t2 > BI_REAL(0.0)) {
h = t2 - t;
if (h <= BI_REAL(0.0)) {
t = t2;
break;
}
}
/* stages */
Visitor::stage1(t, h, s, p, pax, x0.buf(), x1.buf(), x2.buf(), x3.buf(), x4.buf(), x5.buf(), x6.buf(), k1.buf(), err.buf(), k1in);
k1in = true; // can reuse from previous iteration in future
host_store<B,S>(s, p, x1);
Visitor::stage2(t, h, s, p, pax, x0.buf(), x2.buf(), x3.buf(), x4.buf(), x5.buf(), x6.buf(), err.buf());
host_store<B,S>(s, p, x2);
Visitor::stage3(t, h, s, p, pax, x0.buf(), x3.buf(), x4.buf(), x5.buf(), x6.buf(), err.buf());
host_store<B,S>(s, p, x3);
Visitor::stage4(t, h, s, p, pax, x0.buf(), x4.buf(), x5.buf(), x6.buf(), err.buf());
host_store<B,S>(s, p, x4);
Visitor::stage5(t, h, s, p, pax, x0.buf(), x5.buf(), x6.buf(), err.buf());
host_store<B,S>(s, p, x5);
Visitor::stage6(t, h, s, p, pax, x0.buf(), x6.buf(), err.buf());
/* compute error */
Visitor::stageErr(t, h, s, p, pax, x0.buf(), x6.buf(), k7.buf(), err.buf());
e2 = 0.0;
for (id = 0; id < N; ++id) {
e = err(id)*h/(h_atoler + h_rtoler*bi::max(bi::abs(x0(id)), bi::abs(x6(id))));
e2 += e*e;
}
e2 /= N;
/* accept/reject */
if (e2 <= BI_REAL(1.0)) {
/* accept */
t += h;
x0.swap(x6);
k1.swap(k7);
}
host_store<B,S>(s, p, x0);
/* compute next step size */
if (t < t2) {
logfac11 = h_expo*bi::log(e2);
if (e2 > BI_REAL(1.0)) {
/* step was rejected */
h *= bi::max(h_facl, bi::exp(h_logsafe - logfac11));
} else {
/* step was accepted */
fac = bi::exp(h_beta*logfacold + h_logsafe - logfac11); // Lund-stabilization
fac = bi::min(h_facr, bi::max(h_facl, fac)); // bound
h *= fac;
logfacold = BI_REAL(0.5)*bi::log(bi::max(e2, BI_REAL(1.0e-8)));
}
}
++n;
}
}
}
}
