static void PrintHeader(realtype rtol, N_Vector avtol, N_Vector y)
{
realtype *atval, *yval;
atval = N_VGetArrayPointer_Serial(avtol);
yval = N_VGetArrayPointer_Serial(y);
printf("\nidaRoberts_sps: Robertson kinetics DAE serial example problem for IDA.\n");
printf(" Three equation chemical kinetics problem.\n\n");
printf("Linear solver: IDASUPERLUMT, with user-supplied Jacobian.\n");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("Tolerance parameters: rtol = %Lg atol = %Lg %Lg %Lg \n",
rtol, atval[0],atval[1],atval[2]);
printf("Initial conditions y0 = (%Lg %Lg %Lg)\n",
yval[0], yval[1], yval[2]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("Tolerance parameters: rtol = %g atol = %g %g %g \n",
rtol, atval[0],atval[1],atval[2]);
printf("Initial conditions y0 = (%g %g %g)\n",
yval[0], yval[1], yval[2]);
#else
printf("Tolerance parameters: rtol = %g atol = %g %g %g \n",
rtol, atval[0],atval[1],atval[2]);
printf("Initial conditions y0 = (%g %g %g)\n",
yval[0], yval[1], yval[2]);
#endif
printf("Constraints and id not used.\n\n");
printf("-----------------------------------------------------------------------\n");
printf(" t y1 y2 y3");
printf(" | nst k h\n");
printf("-----------------------------------------------------------------------\n");
}
static int func(N_Vector u, N_Vector f, void *user_data)
{
realtype *udata, *fdata;
realtype x1, l1, L1, x2, l2, L2;
realtype *lb, *ub;
UserData data;
data = (UserData)user_data;
lb = data->lb;
ub = data->ub;
udata = N_VGetArrayPointer_Serial(u);
fdata = N_VGetArrayPointer_Serial(f);
x1 = udata[0];
x2 = udata[1];
l1 = udata[2];
L1 = udata[3];
l2 = udata[4];
L2 = udata[5];
fdata[0] = PT5 * sin(x1*x2) - PT25 * x2 / PI - PT5 * x1;
fdata[1] = (ONE - PT25/PI)*(SUNRexp(TWO*x1)-E) + E*x2/PI - TWO*E*x1;
fdata[2] = l1 - x1 + lb[0];
fdata[3] = L1 - x1 + ub[0];
fdata[4] = l2 - x2 + lb[1];
fdata[5] = L2 - x2 + ub[1];
return(0);
}
int resHeat(realtype tt,
N_Vector uu, N_Vector up, N_Vector rr,
void *user_data)
{
long int i, j, offset, loc, mm;
realtype *uu_data, *up_data, *rr_data, coeff, dif1, dif2;
UserData data;
uu_data = N_VGetArrayPointer_Serial(uu);
up_data = N_VGetArrayPointer_Serial(up);
rr_data = N_VGetArrayPointer_Serial(rr);
data = (UserData) user_data;
coeff = data->coeff;
mm = data->mm;
/* Initialize rr to uu, to take care of boundary equations. */
N_VScale(ONE, uu, rr);
/* Loop over interior points; set res = up - (central difference). */
for (j = 1; j < MGRID-1; j++) {
offset = mm*j;
for (i = 1; i < mm-1; i++) {
loc = offset + i;
dif1 = uu_data[loc-1] + uu_data[loc+1] - TWO * uu_data[loc];
dif2 = uu_data[loc-mm] + uu_data[loc+mm] - TWO * uu_data[loc];
rr_data[loc]= up_data[loc] - coeff * ( dif1 + dif2 );
}
}
return(0);
}
int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector resval,
void *user_data)
{
long int mm, i, j, offset, loc;
realtype *uv, *upv, *resv, coeff;
UserData data;
uv = N_VGetArrayPointer_Serial(uu); upv = N_VGetArrayPointer_Serial(up); resv = N_VGetArrayPointer_Serial(resval);
data = (UserData)user_data;
mm = data->mm;
coeff = data->coeff;
/* Initialize resval to uu, to take care of boundary equations. */
N_VScale(ONE, uu, resval);
/* Loop over interior points; set res = up - (central difference). */
for (j = 1; j < mm-1; j++) {
offset = mm*j;
for (i = 1; i < mm-1; i++) {
loc = offset + i;
resv[loc] = upv[loc] - coeff *
(uv[loc-1] + uv[loc+1] + uv[loc-mm] + uv[loc+mm] - RCONST(4.0)*uv[loc]);
}
}
return(0);
}
int rhsFunction(double pVoi, N_Vector pStates, N_Vector pRates, void *pUserData)
{
// Compute the RHS function
CvodeSolverUserData *userData = static_cast<CvodeSolverUserData *>(pUserData);
userData->computeRates()(pVoi, userData->constants(),
N_VGetArrayPointer_Serial(pRates),
N_VGetArrayPointer_Serial(pStates),
userData->algebraic());
return 0;
}
int systemFunction(N_Vector pY, N_Vector pF, void *pUserData)
{
// Compute the system function
KinsolSolverUserData *userData = static_cast<KinsolSolverUserData *>(pUserData);
userData->computeSystem()(N_VGetArrayPointer_Serial(pY),
N_VGetArrayPointer_Serial(pF),
userData->userData());
// Everything went fine, so...
return 0;
}
/*
This routine computes the right-hand side of the ODE system and
returns it in cdot. The interaction rates are computed by calls to WebRates,
and these are saved in fsave for use in preconditioning.
*/
static int f(realtype t, N_Vector c, N_Vector cdot,void *user_data)
{
int i, ic, ici, idxl, idxu, jx, ns, mxns, iyoff, jy, idyu, idyl;
realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, dx, dy;
realtype *cdata, *cdotdata;
WebData wdata;
wdata = (WebData) user_data;
cdata = N_VGetArrayPointer_Serial(c);
cdotdata = N_VGetArrayPointer_Serial(cdot);
mxns = wdata->mxns;
ns = wdata->ns;
fsave = wdata->fsave;
cox = wdata->cox;
coy = wdata->coy;
mxns = wdata->mxns;
dx = wdata->dx;
dy = wdata->dy;
for (jy = 0; jy < MY; jy++) {
y = jy*dy;
iyoff = mxns*jy;
idyu = (jy == MY-1) ? -mxns : mxns;
idyl = (jy == 0) ? -mxns : mxns;
for (jx = 0; jx < MX; jx++) {
x = jx*dx;
ic = iyoff + ns*jx;
/* Get interaction rates at one point (x,y). */
WebRates(x, y, t, cdata+ic, fsave+ic, wdata);
idxu = (jx == MX-1) ? -ns : ns;
idxl = (jx == 0) ? -ns : ns;
for (i = 1; i <= ns; i++) {
ici = ic + i-1;
/* Do differencing in y. */
dcyli = cdata[ici] - cdata[ici-idyl];
dcyui = cdata[ici+idyu] - cdata[ici];
/* Do differencing in x. */
dcxli = cdata[ici] - cdata[ici-idxl];
dcxui = cdata[ici+idxu] - cdata[ici];
/* Collect terms and load cdot elements. */
cdotdata[ici] = coy[i-1]*(dcyui - dcyli) + cox[i-1]*(dcxui - dcxli) +
fsave[ici];
}
}
}
return(0);
}
static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up,
N_Vector id, N_Vector res)
{
realtype xfact, yfact, *udata, *updata, *iddata;
long int mm, mm1, i, j, offset, loc;
mm = data->mm;
mm1 = mm - 1;
udata = N_VGetArrayPointer_Serial(uu);
updata = N_VGetArrayPointer_Serial(up);
iddata = N_VGetArrayPointer_Serial(id);
/* Initialize id to 1's. */
N_VConst(ONE, id);
/* Initialize uu on all grid points. */
for (j = 0; j < mm; j++) {
yfact = data->dx * j;
offset = mm*j;
for (i = 0;i < mm; i++) {
xfact = data->dx * i;
loc = offset + i;
udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact);
}
}
/* Initialize up vector to 0. */
N_VConst(ZERO, up);
/* heatres sets res to negative of ODE RHS values at interior points. */
heatres(ZERO, uu, up, res, data);
/* Copy -res into up to get correct interior initial up values. */
N_VScale(-ONE, res, up);
/* Finally, set values of u, up, and id at boundary points. */
for (j = 0; j < mm; j++) {
offset = mm*j;
for (i = 0;i < mm; i++) {
loc = offset + i;
if (j == 0 || j == mm1 || i == 0 || i == mm1 ) {
udata[loc] = BVAL; updata[loc] = ZERO; iddata[loc] = ZERO; }
}
}
return(0);
}
int resrob(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data)
{
realtype *yval, *ypval, *rval;
yval = N_VGetArrayPointer_Serial(yy);
ypval = N_VGetArrayPointer_Serial(yp);
rval = N_VGetArrayPointer_Serial(rr);
rval[0] = RCONST(-0.04)*yval[0] + RCONST(1.0e4)*yval[1]*yval[2];
rval[1] = -rval[0] - RCONST(3.0e7)*yval[1]*yval[1] - ypval[1];
rval[0] -= ypval[0];
rval[2] = yval[0] + yval[1] + yval[2] - ONE;
return(0);
}
static void PrintAllSpecies(N_Vector c, int ns, int mxns, realtype t)
{
int i, jx ,jy;
realtype *cdata;
cdata = N_VGetArrayPointer_Serial(c);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("c values at t = %Lg:\n\n", t);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("c values at t = %g:\n\n", t);
#else
printf("c values at t = %g:\n\n", t);
#endif
for (i=1; i <= ns; i++) {
printf("Species %d\n", i);
for (jy=MY-1; jy >= 0; jy--) {
for (jx=0; jx < MX; jx++) {
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%-10.6Lg", cdata[(i-1) + jx*ns + jy*mxns]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%-10.6g", cdata[(i-1) + jx*ns + jy*mxns]);
#else
printf("%-10.6g", cdata[(i-1) + jx*ns + jy*mxns]);
#endif
}
printf("\n");
}
printf("\n");
}
}
/* This routine computes and loads the vector of initial values. */
static void CInit(N_Vector c, WebData wdata)
{
int jx, jy, ns, mxns, ioff, iyoff, i, ici;
realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata;
cdata = N_VGetArrayPointer_Serial(c);
ns = wdata->ns;
mxns = wdata->mxns;
dx = wdata->dx;
dy = wdata->dy;
x_factor = RCONST(4.0)/SUNSQR(AX);
y_factor = RCONST(4.0)/SUNSQR(AY);
for (jy = 0; jy < MY; jy++) {
y = jy*dy;
argy = SUNSQR(y_factor*y*(AY-y));
iyoff = mxns*jy;
for (jx = 0; jx < MX; jx++) {
x = jx*dx;
argx = SUNSQR(x_factor*x*(AX-x));
ioff = iyoff + ns*jx;
for (i = 1; i <= ns; i++) {
ici = ioff + i-1;
cdata[ici] = RCONST(10.0) + i*argx*argy;
}
}
}
}
static void PrintOutput(void *mem, realtype t, N_Vector y)
{
realtype *yval;
int retval, kused;
long int nst;
realtype hused;
yval = N_VGetArrayPointer_Serial(y);
retval = IDAGetLastOrder(mem, &kused);
check_flag(&retval, "IDAGetLastOrder", 1);
retval = IDAGetNumSteps(mem, &nst);
check_flag(&retval, "IDAGetNumSteps", 1);
retval = IDAGetLastStep(mem, &hused);
check_flag(&retval, "IDAGetLastStep", 1);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%10.4Le %12.4Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n",
t, yval[0], yval[1], yval[2], nst, kused, hused);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%10.4e %12.4e %12.4e %12.4e | %3ld %1d %12.4e\n",
t, yval[0], yval[1], yval[2], nst, kused, hused);
#else
printf("%10.4e %12.4e %12.4e %12.4e | %3ld %1d %12.4e\n",
t, yval[0], yval[1], yval[2], nst, kused, hused);
#endif
}
int PsetupHeat(realtype tt,
N_Vector uu, N_Vector up, N_Vector rr,
realtype c_j, void *prec_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
long int i, j, offset, loc, mm;
realtype *ppv, pelinv;
UserData data;
data = (UserData) prec_data;
ppv = N_VGetArrayPointer_Serial(data->pp);
mm = data->mm;
/* Initialize the entire vector to 1., then set the interior points to the
correct value for preconditioning. */
N_VConst(ONE,data->pp);
/* Compute the inverse of the preconditioner diagonal elements. */
pelinv = ONE/(c_j + FOUR*data->coeff);
for (j = 1; j < mm-1; j++) {
offset = mm * j;
for (i = 1; i < mm-1; i++) {
loc = offset + i;
ppv[loc] = pelinv;
}
}
return(0);
}
static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy)
{
int jx, jy;
realtype x, y, cx, cy;
realtype *udata;
/* Set pointer to data array in vector u. */
udata = N_VGetArrayPointer_Serial(u);
/* Load initial profiles of c1 and c2 into u vector */
for (jy = 0; jy < MY; jy++) {
y = YMIN + jy*dy;
cy = SUNSQR(RCONST(0.1)*(y - YMID));
cy = ONE - cy + RCONST(0.5)*SUNSQR(cy);
for (jx = 0; jx < MX; jx++) {
x = XMIN + jx*dx;
cx = SUNSQR(RCONST(0.1)*(x - XMID));
cx = ONE - cx + RCONST(0.5)*SUNSQR(cx);
IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy;
IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy;
}
}
}
static void PrintOutput(void *cvode_mem, realtype t, N_Vector u)
{
long int nst;
int qu, flag;
realtype hu, *udata;
udata = N_VGetArrayPointer_Serial(u);
flag = CVodeGetNumSteps(cvode_mem, &nst);
check_flag(&flag, "CVodeGetNumSteps", 1);
flag = CVodeGetLastOrder(cvode_mem, &qu);
check_flag(&flag, "CVodeGetLastOrder", 1);
flag = CVodeGetLastStep(cvode_mem, &hu);
check_flag(&flag, "CVodeGetLastStep", 1);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%8.3Le %2d %8.3Le %5ld\n", t, qu, hu, nst);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%8.3e %2d %8.3e %5ld\n", t, qu, hu, nst);
#else
printf("%8.3e %2d %8.3e %5ld\n", t, qu, hu, nst);
#endif
printf(" Solution ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le %12.4Le \n", udata[0], udata[1], udata[2]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4e %12.4e %12.4e \n", udata[0], udata[1], udata[2]);
#else
printf("%12.4e %12.4e %12.4e \n", udata[0], udata[1], udata[2]);
#endif
}
static int PSolve(realtype tn, N_Vector u, N_Vector fu,
N_Vector r, N_Vector z,
realtype gamma, realtype delta,
int lr, void *user_data, N_Vector vtemp)
{
realtype **(*P)[MY];
long int *(*pivot)[MY];
int jx, jy;
realtype *zdata, *v;
UserData data;
/* Extract the P and pivot arrays from user_data. */
data = (UserData) user_data;
P = data->P;
pivot = data->pivot;
zdata = N_VGetArrayPointer_Serial(z);
N_VScale(ONE, r, z);
/* Solve the block-diagonal system Px = r using LU factors stored
in P and pivot data in pivot, and return the solution in z. */
for (jx=0; jx < MX; jx++) {
for (jy=0; jy < MY; jy++) {
v = &(IJKth(zdata, 1, jx, jy));
denseGETRS(P[jx][jy], NUM_SPECIES, pivot[jx][jy], v);
}
}
return(0);
}
static void SetIC(N_Vector u, UserData data)
{
int i, j;
realtype x, y, dx, dy;
realtype *udata;
/* Extract needed constants from data */
dx = data->dx;
dy = data->dy;
/* Set pointer to data array in vector u. */
udata = N_VGetArrayPointer_Serial(u);
/* Load initial profile into u vector */
for (j=1; j <= MY; j++) {
y = j*dy;
for (i=1; i <= MX; i++) {
x = i*dx;
IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*SUNRexp(FIVE*x*y);
}
}
}
static int f(realtype t, N_Vector u,N_Vector udot, void *user_data)
{
realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff;
realtype *udata, *dudata;
int i, j;
UserData data;
udata = N_VGetArrayPointer_Serial(u);
dudata = N_VGetArrayPointer_Serial(udot);
/* Extract needed constants from data */
data = (UserData) user_data;
hordc = data->hdcoef;
horac = data->hacoef;
verdc = data->vdcoef;
/* Loop over all grid points. */
for (j=1; j <= MY; j++) {
for (i=1; i <= MX; i++) {
/* Extract u at x_i, y_j and four neighboring points */
uij = IJth(udata, i, j);
udn = (j == 1) ? ZERO : IJth(udata, i, j-1);
uup = (j == MY) ? ZERO : IJth(udata, i, j+1);
ult = (i == 1) ? ZERO : IJth(udata, i-1, j);
urt = (i == MX) ? ZERO : IJth(udata, i+1, j);
/* Set diffusion and advection terms and load into udot */
hdiff = hordc*(ult - TWO*uij + urt);
hadv = horac*(urt - ult);
vdiff = verdc*(uup - TWO*uij + udn);
IJth(dudata, i, j) = hdiff + hadv + vdiff;
}
}
return(0);
}
static int grob(realtype t, N_Vector yy, N_Vector yp, realtype *gout,
void *user_data)
{
realtype *yval, y1, y3;
yval = N_VGetArrayPointer_Serial(yy);
y1 = yval[0]; y3 = yval[2];
gout[0] = y1 - RCONST(0.0001);
gout[1] = y3 - RCONST(0.01);
return(0);
}
static void PrintOutputS(N_Vector *uS)
{
realtype *sdata;
sdata = N_VGetArrayPointer_Serial(uS[0]);
printf(" Sensitivity 1 ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]);
#else
printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]);
#endif
sdata = N_VGetArrayPointer_Serial(uS[1]);
printf(" Sensitivity 2 ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]);
#else
printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]);
#endif
sdata = N_VGetArrayPointer_Serial(uS[2]);
printf(" Sensitivity 3 ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]);
#else
printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]);
#endif
}
void CvodeSolver::solve(double &pVoi, const double &pVoiEnd) const
{
// Solve the model
CVode(mSolver, pVoiEnd, mStatesVector, &pVoi, CV_NORMAL);
// Compute the rates one more time to get up-to-date values for the rates
// Note: another way of doing this would be to copy the contents of the
// calculated rates in rhsFunction, but that's bound to be more time
// consuming since a call to CVode is likely to generate at least a
// few calls to rhsFunction, so that would be quite a few memory
// transfers while here we 'only' compute the rates one more time,
// so...
mComputeRates(pVoiEnd, mConstants, mRates,
N_VGetArrayPointer_Serial(mStatesVector), mAlgebraic);
}
/*
This routine applies two inverse preconditioner matrices
to the vector r, using the interaction-only block-diagonal Jacobian
with block-grouping, denoted Jr, and Gauss-Seidel applied to the
diffusion contribution to the Jacobian, denoted Jd.
It first calls GSIter for a Gauss-Seidel approximation to
((I - gamma*Jd)-inverse)*r, and stores the result in z.
Then it computes ((I - gamma*Jr)-inverse)*z, using LU factors of the
blocks in P, and pivot information in pivot, and returns the result in z.
*/
static int PSolve(realtype tn, N_Vector c, N_Vector fc,
N_Vector r, N_Vector z,
realtype gamma, realtype delta,
int lr, void *user_data, N_Vector vtemp)
{
realtype ***P;
long int **pivot;
int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx;
long int mp;
WebData wdata;
wdata = (WebData) user_data;
N_VScale(ONE, r, z);
/* call GSIter for Gauss-Seidel iterations */
GSIter(gamma, z, vtemp, wdata);
/* Do backsolves for inverse of block-diagonal preconditioner factor */
P = wdata->P;
pivot = wdata->pivot;
mx = wdata->mx;
my = wdata->my;
ngx = wdata->ngx;
mp = wdata->mp;
jigx = wdata->jigx;
jigy = wdata->jigy;
iv = 0;
for (jy = 0; jy < my; jy++) {
igy = jigy[jy];
for (jx = 0; jx < mx; jx++) {
igx = jigx[jx];
ig = igx + igy*ngx;
denseGETRS(P[ig], mp, pivot[ig], &(N_VGetArrayPointer_Serial(z)[iv]));
iv += mp;
}
}
return(0);
}
int jacrob(realtype tt, realtype cj,
N_Vector yy, N_Vector yp, N_Vector resvec,
SlsMat JacMat, void *user_data,
N_Vector tempv1, N_Vector tempv2, N_Vector tempv3)
{
realtype *yval;
int *colptrs = *JacMat->colptrs;
int *rowvals = *JacMat->rowvals;
yval = N_VGetArrayPointer_Serial(yy);
SparseSetMatToZero(JacMat);
colptrs[0] = 0;
colptrs[1] = 3;
colptrs[2] = 6;
colptrs[3] = 9;
JacMat->data[0] = RCONST(-0.04) - cj;
rowvals[0] = 0;
JacMat->data[1] = RCONST(0.04);
rowvals[1] = 1;
JacMat->data[2] = ONE;
rowvals[2] = 2;
JacMat->data[3] = RCONST(1.0e4)*yval[2];
rowvals[3] = 0;
JacMat->data[4] = (RCONST(-1.0e4)*yval[2]) - (RCONST(6.0e7)*yval[1]) - cj;
rowvals[4] = 1;
JacMat->data[5] = ONE;
rowvals[5] = 2;
JacMat->data[6] = RCONST(1.0e4)*yval[1];
rowvals[6] = 0;
JacMat->data[7] = RCONST(-1.0e4)*yval[1];
rowvals[7] = 1;
JacMat->data[8] = ONE;
rowvals[8] = 2;
return(0);
}
static int Jac(realtype t,
N_Vector y, N_Vector fy, SlsMat JacMat, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
realtype *yval;
int *colptrs = *JacMat->colptrs;
int *rowvals = *JacMat->rowvals;
yval = N_VGetArrayPointer_Serial(y);
SparseSetMatToZero(JacMat);
colptrs[0] = 0;
colptrs[1] = 3;
colptrs[2] = 6;
colptrs[3] = 9;
JacMat->data[0] = RCONST(-0.04);
rowvals[0] = 0;
JacMat->data[1] = RCONST(0.04);
rowvals[1] = 1;
JacMat->data[2] = ZERO;
rowvals[2] = 2;
JacMat->data[3] = RCONST(1.0e4)*yval[2];
rowvals[3] = 0;
JacMat->data[4] = (RCONST(-1.0e4)*yval[2]) - (RCONST(6.0e7)*yval[1]);
rowvals[4] = 1;
JacMat->data[5] = RCONST(6.0e7)*yval[1];
rowvals[5] = 2;
JacMat->data[6] = RCONST(1.0e4)*yval[1];
rowvals[6] = 0;
JacMat->data[7] = RCONST(-1.0e4)*yval[1];
rowvals[7] = 1;
JacMat->data[8] = ZERO;
rowvals[8] = 2;
return(0);
}
static void PrintOutput(void *cvode_mem, N_Vector u,realtype t)
{
long int nst;
int qu, flag;
realtype hu, *udata;
int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1;
udata = N_VGetArrayPointer_Serial(u);
flag = CVodeGetNumSteps(cvode_mem, &nst);
check_flag(&flag, "CVodeGetNumSteps", 1);
flag = CVodeGetLastOrder(cvode_mem, &qu);
check_flag(&flag, "CVodeGetLastOrder", 1);
flag = CVodeGetLastStep(cvode_mem, &hu);
check_flag(&flag, "CVodeGetLastStep", 1);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n",
t, nst, qu, hu);
printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n",
IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1));
printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n",
IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n",
t, nst, qu, hu);
printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n",
IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1));
printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n",
IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1));
#else
printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n",
t, nst, qu, hu);
printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n",
IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1));
printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n",
IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1));
#endif
}
static int Jac(realtype t,
N_Vector y, N_Vector fy, SlsMat JacMat, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
realtype *yval;
int* colptrs;
int* rowvals;
realtype* data;
UserData userdata;
realtype p1, p2, p3;
yval = N_VGetArrayPointer_Serial(y);
colptrs = (*JacMat->colptrs);
rowvals = (*JacMat->rowvals);
data = JacMat->data;
userdata = (UserData) user_data;
p1 = userdata->p[0]; p2 = userdata->p[1]; p3 = userdata->p[2];
SparseSetMatToZero(JacMat);
colptrs[0] = 0;
colptrs[1] = 3;
colptrs[2] = 6;
colptrs[3] = 9;
data[0] = -p1; rowvals[0] = 0;
data[1] = p1; rowvals[1] = 1;
data[2] = ZERO; rowvals[2] = 2;
data[3] = p2*yval[2]; rowvals[3] = 0;
data[4] = -p2*yval[2]-2*p3*yval[1]; rowvals[4] = 1;
data[5] = 2*yval[1]; rowvals[5] = 2;
data[6] = p2*yval[1]; rowvals[6] = 0;
data[7] = -p2*yval[1]; rowvals[7] = 1;
data[8] = ZERO; rowvals[8] = 2;
return(0);
}
static int jacDense(long int N,
N_Vector y, N_Vector f,
DlsMat J, void *user_data,
N_Vector tmp1, N_Vector tmp2)
{
realtype *yd;
yd = N_VGetArrayPointer_Serial(y);
/* row 0 */
DENSE_ELEM(J,0,0) = PT5 * cos(yd[0]*yd[1]) * yd[1] - PT5;
DENSE_ELEM(J,0,1) = PT5 * cos(yd[0]*yd[1]) * yd[0] - PT25/PI;
/* row 1 */
DENSE_ELEM(J,1,0) = TWO * (ONE - PT25/PI) * (SUNRexp(TWO*yd[0]) - E);
DENSE_ELEM(J,1,1) = E/PI;
/* row 2 */
DENSE_ELEM(J,2,0) = -ONE;
DENSE_ELEM(J,2,2) = ONE;
/* row 3 */
DENSE_ELEM(J,3,0) = -ONE;
DENSE_ELEM(J,3,3) = ONE;
/* row 4 */
DENSE_ELEM(J,4,1) = -ONE;
DENSE_ELEM(J,4,4) = ONE;
/* row 5 */
DENSE_ELEM(J,5,1) = -ONE;
DENSE_ELEM(J,5,5) = ONE;
return(0);
}
static void SetInitialGuess2(N_Vector u, UserData data)
{
realtype x1, x2;
realtype *udata;
realtype *lb, *ub;
udata = N_VGetArrayPointer_Serial(u);
lb = data->lb;
ub = data->ub;
/* There are two known solutions for this problem */
/* this init. guess should take us to (0.5; 3.1415926) */
x1 = PT5 * (lb[0] + ub[0]);
x2 = PT5 * (lb[1] + ub[1]);
udata[0] = x1;
udata[1] = x2;
udata[2] = x1 - lb[0];
udata[3] = x1 - ub[0];
udata[4] = x2 - lb[1];
udata[5] = x2 - ub[1];
}
static int f(realtype t, N_Vector u, N_Vector udot,void *user_data)
{
realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt;
realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2;
realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup;
realtype q4coef, dely, verdco, hordco, horaco;
realtype *udata, *dudata;
int idn, iup, ileft, iright, jx, jy;
UserData data;
data = (UserData) user_data;
udata = N_VGetArrayPointer_Serial(u);
dudata = N_VGetArrayPointer_Serial(udot);
/* Set diurnal rate coefficients. */
s = sin(data->om*t);
if (s > ZERO) {
q3 = SUNRexp(-A3/s);
data->q4 = SUNRexp(-A4/s);
} else {
q3 = ZERO;
data->q4 = ZERO;
}
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
horaco = data->haco;
/* Loop over all grid points. */
for (jy = 0; jy < MY; jy++) {
/* Set vertical diffusion coefficients at jy +- 1/2 */
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(RCONST(0.2)*yup);
idn = (jy == 0) ? 1 : -1;
iup = (jy == MY-1) ? -1 : 1;
for (jx = 0; jx < MX; jx++) {
/* Extract c1 and c2, and set kinetic rate terms. */
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
qq1 = Q1*c1*C3;
qq2 = Q2*c1*c2;
qq3 = q3*C3;
qq4 = q4coef*c2;
rkin1 = -qq1 - qq2 + TWO*qq3 + qq4;
rkin2 = qq1 - qq2 - qq4;
/* Set vertical diffusion terms. */
c1dn = IJKth(udata,1,jx,jy+idn);
c2dn = IJKth(udata,2,jx,jy+idn);
c1up = IJKth(udata,1,jx,jy+iup);
c2up = IJKth(udata,2,jx,jy+iup);
vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn);
vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn);
/* Set horizontal diffusion and advection terms. */
ileft = (jx == 0) ? 1 : -1;
iright =(jx == MX-1) ? -1 : 1;
c1lt = IJKth(udata,1,jx+ileft,jy);
c2lt = IJKth(udata,2,jx+ileft,jy);
c1rt = IJKth(udata,1,jx+iright,jy);
c2rt = IJKth(udata,2,jx+iright,jy);
hord1 = hordco*(c1rt - TWO*c1 + c1lt);
hord2 = hordco*(c2rt - TWO*c2 + c2lt);
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
/* Load all terms into udot. */
IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1;
IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2;
}
}
return(0);
}
static int jac(N_Vector y, N_Vector f,SUNMatrix J,
void *user_data, N_Vector tmp1, N_Vector tmp2)
{
int i;
realtype *yd;
realtype x1, x2, x3, x4, x5, x6, x7, x8;
yd = N_VGetArrayPointer_Serial(y);
x1 = yd[0];
x2 = yd[1];
x3 = yd[2];
x4 = yd[3];
x5 = yd[4];
x6 = yd[5];
x7 = yd[6];
x8 = yd[7];
/* Nonlinear equations */
/*
- 0.1238*x1 + x7 - 0.001637*x2
- 0.9338*x4 + 0.004731*x1*x3 - 0.3578*x2*x3 - 0.3571
*/
IJth(J,1,1) = - 0.1238 + 0.004731*x3;
IJth(J,1,2) = - 0.001637 - 0.3578*x3;
IJth(J,1,3) = 0.004731*x1 - 0.3578*x2;
IJth(J,1,4) = - 0.9338;
IJth(J,1,7) = 1.0;
/*
0.2638*x1 - x7 - 0.07745*x2
- 0.6734*x4 + 0.2238*x1*x3 + 0.7623*x2*x3 - 0.6022
*/
IJth(J,2,1) = 0.2638 + 0.2238*x3;
IJth(J,2,2) = - 0.07745 + 0.7623*x3;
IJth(J,2,3) = 0.2238*x1 + 0.7623*x2;
IJth(J,2,4) = - 0.6734;
IJth(J,2,7) = -1.0;
/*
0.3578*x1 + 0.004731*x2 + x6*x8
*/
IJth(J,3,1) = 0.3578;
IJth(J,3,2) = 0.004731;
IJth(J,3,6) = x8;
IJth(J,3,8) = x6;
/*
- 0.7623*x1 + 0.2238*x2 + 0.3461
*/
IJth(J,4,1) = - 0.7623;
IJth(J,4,2) = 0.2238;
/*
x1*x1 + x2*x2 - 1
*/
IJth(J,5,1) = 2.0*x1;
IJth(J,5,2) = 2.0*x2;
/*
x3*x3 + x4*x4 - 1
*/
IJth(J,6,3) = 2.0*x3;
IJth(J,6,4) = 2.0*x4;
/*
x5*x5 + x6*x6 - 1
*/
IJth(J,7,5) = 2.0*x5;
IJth(J,7,6) = 2.0*x6;
/*
x7*x7 + x8*x8 - 1
*/
IJth(J,8,7) = 2.0*x7;
IJth(J,8,8) = 2.0*x8;
/*
Lower bounds ( l_i = 1 + x_i >= 0)
l_i - 1.0 - x_i
*/
for(i=1;i<=8;i++) {
IJth(J,8+i,i) = -1.0;
IJth(J,8+i,8+i) = 1.0;
}
/*
Upper bounds ( u_i = 1 - x_i >= 0)
u_i - 1.0 + x_i
*/
for(i=1;i<=8;i++) {
IJth(J,16+i,i) = 1.0;
IJth(J,16+i,16+i) = 1.0;
}
return(0);
}
