/* Routine to compute the Jacobian matrix from R(y), scaled by the factor c.
We add the result into Jac and do not erase what was already there */
static int ReactionJac(realtype c, N_Vector y, DlsMat Jac, UserData udata)
{
long int N = udata->N; /* set shortcuts */
long int i;
realtype u, v, w;
realtype ep = udata->ep;
realtype *Ydata = N_VGetArrayPointer(y); /* access solution array */
if (check_flag((void *)Ydata, "N_VGetArrayPointer", 0)) return 1;
/* iterate over nodes, filling in Jacobian of reaction terms */
for (i=1; i<N-1; i++) {
u = Ydata[IDX(i,0)]; /* set nodal value shortcuts */
v = Ydata[IDX(i,1)];
w = Ydata[IDX(i,2)];
/* all vars wrt u */
BAND_ELEM(Jac,IDX(i,0),IDX(i,0)) += c*(RCONST(2.0)*u*v-(w+RCONST(1.0)));
BAND_ELEM(Jac,IDX(i,1),IDX(i,0)) += c*(w - RCONST(2.0)*u*v);
BAND_ELEM(Jac,IDX(i,2),IDX(i,0)) += c*(-w);
/* all vars wrt v */
BAND_ELEM(Jac,IDX(i,0),IDX(i,1)) += c*(u*u);
BAND_ELEM(Jac,IDX(i,1),IDX(i,1)) += c*(-u*u);
/* all vars wrt w */
BAND_ELEM(Jac,IDX(i,0),IDX(i,2)) += c*(-u);
BAND_ELEM(Jac,IDX(i,1),IDX(i,2)) += c*(u);
BAND_ELEM(Jac,IDX(i,2),IDX(i,2)) += c*(-RCONST(1.0)/ep - u);
}
return 0; /* Return with success */
}
void sdBandMatrix::print(const std::string& name) const
{
std::cout << M->M << std::endl;
std::cout << M->ml << std::endl;
std::cout << M->mu << std::endl;
for (int i = 0; i < M->M; i++) {
for (int j = i - M->ml; j <= i + M->mu; j++) {
if (j < 0 || j >= M->M) {
continue;
}
std::cout << boost::format("%s[%i,%i] = %e") % name % i % j % BAND_ELEM(M,i,j) << std::endl;
}
}
std::cout.flush();
}
/* Routine to compute the stiffness matrix from (L*y), scaled by the factor c.
We add the result into Jac and do not erase what was already there */
static int LaplaceMatrix(realtype c, DlsMat Jac, UserData udata)
{
long int i; /* set shortcuts */
long int N = udata->N;
realtype dx = udata->dx;
/* iterate over intervals, filling in Jacobian of (L*y) */
for (i=1; i<N-1; i++) {
BAND_ELEM(Jac,IDX(i,0),IDX(i-1,0)) += c*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i-1,1)) += c*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i-1,2)) += c*udata->dw/dx/dx;
BAND_ELEM(Jac,IDX(i,0),IDX(i,0)) += -c*RCONST(2.0)*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i,1)) += -c*RCONST(2.0)*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i,2)) += -c*RCONST(2.0)*udata->dw/dx/dx;
BAND_ELEM(Jac,IDX(i,0),IDX(i+1,0)) += c*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i+1,1)) += c*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i+1,2)) += c*udata->dw/dx/dx;
}
return 0; /* Return with success */
}
CAMLprim value c_bandmatrix_set(value vmatrix, value vi, value vj, value v)
{
CAMLparam4(vmatrix, vi, vj, v);
DlsMat m = DLSMAT(vmatrix);
int i = Long_val(vi);
int j = Long_val(vj);
#if SUNDIALS_ML_SAFE == 1
if (i < 0 || i >= m->M) caml_invalid_argument("Bandmatrix.set: invalid i");
if (j < 0 || j >= m->N) caml_invalid_argument("Bandmatrix.set: invalid j");
#endif
BAND_ELEM(m, i, j) = Double_val(v);
CAMLreturn(caml_copy_double(v));
}
/* Routine to compute the stiffness matrix from (L*y), scaled by the factor c.
We add the result into Jac and do not erase what was already there */
static int LaplaceMatrix(realtype c, DlsMat Jac, UserData udata)
{
long int i; /* set shortcuts */
long int N = udata->N;
realtype dx = udata->dx;
/* iterate over intervals, filling in Jacobian entries */
#pragma omp parallel for default(shared) private(i) schedule(static) num_threads(udata->nthreads)
for (i=1; i<N-1; i++) {
/* Jacobian of (L*y) at this node */
BAND_ELEM(Jac,IDX(i,0),IDX(i-1,0)) += c*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i-1,1)) += c*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i-1,2)) += c*udata->dw/dx/dx;
BAND_ELEM(Jac,IDX(i,0),IDX(i,0)) += -c*RCONST(2.0)*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i,1)) += -c*RCONST(2.0)*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i,2)) += -c*RCONST(2.0)*udata->dw/dx/dx;
BAND_ELEM(Jac,IDX(i,0),IDX(i+1,0)) += c*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i+1,1)) += c*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i+1,2)) += c*udata->dw/dx/dx;
}
return 0;
}
/* Routine to compute the Jacobian matrix from R(y), scaled by the factor c.
We add the result into Jac and do not erase what was already there */
static int ReactionJac(realtype c, N_Vector y, DlsMat Jac, UserData udata)
{
long int N = udata->N; /* set shortcuts */
long int i;
realtype u, v, w;
realtype ep = udata->ep;
realtype *Ydata = N_VGetArrayPointer(y); /* access solution array */
if (check_flag((void *)Ydata, "N_VGetArrayPointer", 0)) return 1;
/* iterate over nodes, filling in Jacobian entries */
#pragma omp parallel for default(shared) private(i,u,v,w) schedule(static) num_threads(udata->nthreads)
for (i=1; i<N-1; i++) {
/* set nodal value shortcuts (shifted index due to start at first interior node) */
u = Ydata[IDX(i,0)];
v = Ydata[IDX(i,1)];
w = Ydata[IDX(i,2)];
/* all vars wrt u */
BAND_ELEM(Jac,IDX(i,0),IDX(i,0)) += c*(RCONST(2.0)*u*v-(w+RCONST(1.0)));
BAND_ELEM(Jac,IDX(i,1),IDX(i,0)) += c*(w - RCONST(2.0)*u*v);
BAND_ELEM(Jac,IDX(i,2),IDX(i,0)) += c*(-w);
/* all vars wrt v */
BAND_ELEM(Jac,IDX(i,0),IDX(i,1)) += c*(u*u);
BAND_ELEM(Jac,IDX(i,1),IDX(i,1)) += c*(-u*u);
/* all vars wrt w */
BAND_ELEM(Jac,IDX(i,0),IDX(i,2)) += c*(-u);
BAND_ELEM(Jac,IDX(i,1),IDX(i,2)) += c*(u);
BAND_ELEM(Jac,IDX(i,2),IDX(i,2)) += c*(-RCONST(1.0)/ep - u);
}
return 0;
}
