static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok,
booleantype *jcurPtr, realtype gamma, void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, czdn, czup, diag, zdn, zup, q4coef, delz, verdco, hordco;
realtype **(*P)[MZ], **(*Jbd)[MZ];
long int *(*pivot)[MZ];
int ier, jx, jz;
realtype *ydata, **a, **j;
UserData data;
realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0;
/* Make local copies of pointers in P_data, and of pointer to y's data */
data = (UserData) P_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
ydata = NV_DATA_S(y);
/* Load problem coefficients and parameters */
Q1 = data->p[0];
Q2 = data->p[1];
C3 = data->p[2];
A3 = data->p[3];
A4 = data->p[4];
KH = data->p[5];
VEL = data->p[6];
KV0 = data->p[7];
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
dencopy(Jbd[jx][jz], P[jx][jz], NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
delz = data->dz;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jz=0; jz < MZ; jz++) {
zdn = ZMIN + (jz - RCONST(0.5))*delz;
zup = zdn + delz;
czdn = verdco*EXP(RCONST(0.2)*zdn);
czup = verdco*EXP(RCONST(0.2)*zup);
diag = -(czdn + czup + RCONST(2.0)*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(ydata,1,jx,jz);
c2 = IJKth(ydata,2,jx,jz);
j = Jbd[jx][jz];
a = P[jx][jz];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
denscale(-gamma, P[jx][jz], NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jz=0; jz < MZ; jz++) {
denaddI(P[jx][jz], NUM_SPECIES);
ier = gefa(P[jx][jz], NUM_SPECIES, pivot[jx][jz]);
if (ier != 0) return(1);
}
}
return(0);
}
/* Preconditioner setup routine. Generate and preprocess P. */
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MYSUB], **(*Jbd)[MYSUB];
long int nvmxsub, *(*pivot)[MYSUB], ier, offset;
int lx, ly, jx, jy, isubx, isuby;
realtype *udata, **a, **j;
PreconData predata;
UserData data;
/* Make local copies of pointers in P_data, pointer to u's data,
and PE index pair */
predata = (PreconData) P_data;
data = (UserData) (predata->f_data);
P = predata->P;
Jbd = predata->Jbd;
pivot = predata->pivot;
udata = NV_DATA_P(u);
isubx = data->isubx; isuby = data->isuby;
nvmxsub = data->nvmxsub;
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
dencopy(Jbd[lx][ly], P[lx][ly], NVARS, NVARS);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (ly = 0; ly < MYSUB; ly++) {
jy = ly + isuby*MYSUB;
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*EXP(RCONST(0.2)*ydn);
cyup = verdco*EXP(RCONST(0.2)*yup);
diag = -(cydn + cyup + RCONST(2.0)*hordco);
for (lx = 0; lx < MXSUB; lx++) {
jx = lx + isubx*MXSUB;
offset = lx*NVARS + ly*nvmxsub;
c1 = udata[offset];
c2 = udata[offset+1];
j = Jbd[lx][ly];
a = P[lx][ly];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NVARS, NVARS);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
denscale(-gamma, P[lx][ly], NVARS, NVARS);
/* Add identity matrix and do LU decompositions on blocks in place */
for (lx = 0; lx < MXSUB; lx++) {
for (ly = 0; ly < MYSUB; ly++) {
denaddI(P[lx][ly], NVARS);
ier = denGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]);
if (ier != 0) return(1);
}
}
return(0);
}
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr, realtype gamma,
void *P_data, N_Vector vtemp1, N_Vector vtemp2,
N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MY], **(*Jbd)[MY];
long int *(*pivot)[MY], ier;
int jx, jy;
realtype *udata, **a, **j;
UserData data;
/* Make local copies of pointers in P_data, and of pointer to u's data */
data = (UserData) P_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
udata = NV_DATA_S(u);
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
dencopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jy=0; jy < MY; jy++) {
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*exp(RCONST(0.2)*ydn);
cyup = verdco*exp(RCONST(0.2)*yup);
diag = -(cydn + cyup + TWO*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
j = Jbd[jx][jy];
a = P[jx][jy];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denscale(-gamma, P[jx][jy], NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jy=0; jy < MY; jy++) {
denaddI(P[jx][jy], NUM_SPECIES);
ier = gefa(P[jx][jy], NUM_SPECIES, pivot[jx][jy]);
if (ier != 0) return(1);
}
}
return(0);
}
void DenseCopy(DenseMat A, DenseMat B)
{
dencopy(A->data, B->data, A->size);
}
