static void SetSource(ProblemData d)
{
int *l_m, *m_start;
realtype *xmin, *xmax, *dx;
realtype x[DIM], g, *pdata;
int i[DIM];
l_m = d->l_m;
m_start = d->m_start;
xmin = d->xmin;
xmax = d->xmax;
dx = d->dx;
pdata = NV_DATA_P(d->p);
for(i[0]=0; i[0]<l_m[0]; i[0]++) {
x[0] = xmin[0] + (m_start[0]+i[0]) * dx[0];
for(i[1]=0; i[1]<l_m[1]; i[1]++) {
x[1] = xmin[1] + (m_start[1]+i[1]) * dx[1];
#ifdef USE3D
for(i[2]=0; i[2]<l_m[2]; i[2]++) {
x[2] = xmin[2] + (m_start[2]+i[2]) * dx[2];
g = G1_AMPL
* SUNRexp( -SUNSQR(G1_X-x[0])/SUNSQR(G1_SIGMA) )
* SUNRexp( -SUNSQR(G1_Y-x[1])/SUNSQR(G1_SIGMA) )
* SUNRexp( -SUNSQR(G1_Z-x[2])/SUNSQR(G1_SIGMA) );
g += G2_AMPL
* SUNRexp( -SUNSQR(G2_X-x[0])/SUNSQR(G2_SIGMA) )
* SUNRexp( -SUNSQR(G2_Y-x[1])/SUNSQR(G2_SIGMA) )
* SUNRexp( -SUNSQR(G2_Z-x[2])/SUNSQR(G2_SIGMA) );
if( g < G_MIN ) g = ZERO;
IJth(pdata, i) = g;
}
#else
g = G1_AMPL
* SUNRexp( -SUNSQR(G1_X-x[0])/SUNSQR(G1_SIGMA) )
* SUNRexp( -SUNSQR(G1_Y-x[1])/SUNSQR(G1_SIGMA) );
g += G2_AMPL
* SUNRexp( -SUNSQR(G2_X-x[0])/SUNSQR(G2_SIGMA) )
* SUNRexp( -SUNSQR(G2_Y-x[1])/SUNSQR(G2_SIGMA) );
if( g < G_MIN ) g = ZERO;
IJth(pdata, i) = g;
#endif
}
}
}
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);
}
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 void SetIC(N_Vector u, realtype dx)
{
int i;
realtype x;
realtype *udata;
/* Set pointer to data array and get local length of u. */
udata = NV_DATA_S(u);
/* Load initial profile into u vector */
for (i=0; i<NEQ; i++) {
x = (i+1)*dx;
udata[i] = x*(XMAX - x)*SUNRexp(RCONST(2.0)*x);
}
}
static void SetIC(N_Vector u, realtype dx, sunindextype my_length, sunindextype my_base)
{
int i;
sunindextype iglobal;
realtype x;
realtype *udata;
/* Set pointer to data array and get local length of u */
udata = N_VGetArrayPointer_Parallel(u);
my_length = N_VGetLocalLength_Parallel(u);
/* Load initial profile into u vector */
for (i=1; i<=my_length; i++) {
iglobal = my_base + i;
x = iglobal*dx;
udata[i-1] = x*(XMAX - x)*SUNRexp(TWO*x);
}
}
static void SetIC(HYPRE_IJVector Uij, realtype dx, long int my_length,
long int my_base)
{
int i;
HYPRE_Int *iglobal;
realtype x;
realtype *udata;
/* Set pointer to data array and get local length of u. */
udata = (realtype*) malloc(my_length*sizeof(realtype));
iglobal = (HYPRE_Int*) malloc(my_length*sizeof(HYPRE_Int));
/* Load initial profile into u vector */
for (i = 0; i < my_length; i++) {
iglobal[i] = my_base + i;
x = (iglobal[i] + 1)*dx;
udata[i] = x*(XMAX - x)*SUNRexp(RCONST(2.0)*x);
}
HYPRE_IJVectorSetValues(Uij, my_length, iglobal, udata);
free(iglobal);
free(udata);
}
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 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 Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr, realtype gamma,
void *user_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 user_data, and of pointer to u's data */
data = (UserData) user_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
udata = N_VGetArrayPointer_Serial(u);
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denseCopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES, 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*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(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;
denseCopy(j, a, NUM_SPECIES, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denseScale(-gamma, P[jx][jy], NUM_SPECIES, 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++) {
denseAddIdentity(P[jx][jy], NUM_SPECIES);
ier = denseGETRF(P[jx][jy], NUM_SPECIES, NUM_SPECIES, pivot[jx][jy]);
if (ier != 0) return(1);
}
}
return(0);
}
static int jtv(N_Vector v, N_Vector Jv, realtype t,
N_Vector u, N_Vector fu,
void *user_data, N_Vector tmp)
{
realtype c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt, c1rt, c2rt;
realtype v1, v2, v1dn, v2dn, v1up, v2up, v1lt, v2lt, v1rt, v2rt;
realtype Jv1, Jv2;
realtype cydn, cyup;
realtype s, ydn, yup;
realtype q4coef, dely, verdco, hordco, horaco;
int jx, jy, idn, iup, ileft, iright;
realtype *udata, *vdata, *Jvdata;
UserData data;
data = (UserData) user_data;
udata = N_VGetArrayPointer_Serial(u);
vdata = N_VGetArrayPointer_Serial(v);
Jvdata = N_VGetArrayPointer_Serial(Jv);
/* Set diurnal rate coefficients. */
s = sin(data->om*t);
if (s > ZERO) {
data->q4 = SUNRexp(-A4/s);
} else {
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++) {
Jv1 = ZERO;
Jv2 = ZERO;
/* Extract c1 and c2 at the current location and at neighbors */
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
v1 = IJKth(vdata,1,jx,jy);
v2 = IJKth(vdata,2,jx,jy);
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);
v1dn = IJKth(vdata,1,jx,jy+idn);
v2dn = IJKth(vdata,2,jx,jy+idn);
v1up = IJKth(vdata,1,jx,jy+iup);
v2up = IJKth(vdata,2,jx,jy+iup);
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);
v1lt = IJKth(vdata,1,jx+ileft,jy);
v2lt = IJKth(vdata,2,jx+ileft,jy);
v1rt = IJKth(vdata,1,jx+iright,jy);
v2rt = IJKth(vdata,2,jx+iright,jy);
/* Set kinetic rate terms. */
/*
rkin1 = -Q1*C3 * c1 - Q2 * c1*c2 + q4coef * c2 + TWO*C3*q3;
rkin2 = Q1*C3 * c1 - Q2 * c1*c2 - q4coef * c2;
*/
Jv1 += -(Q1*C3 + Q2*c2) * v1 + (q4coef - Q2*c1) * v2;
Jv2 += (Q1*C3 - Q2*c2) * v1 - (q4coef + Q2*c1) * v2;
/* Set vertical diffusion terms. */
/*
vertd1 = -(cyup+cydn) * c1 + cyup * c1up + cydn * c1dn;
vertd2 = -(cyup+cydn) * c2 + cyup * c2up + cydn * c2dn;
*/
Jv1 += -(cyup+cydn) * v1 + cyup * v1up + cydn * v1dn;
Jv2 += -(cyup+cydn) * v2 + cyup * v2up + cydn * v2dn;
/* Set horizontal diffusion and advection terms. */
/*
hord1 = hordco*(c1rt - TWO*c1 + c1lt);
hord2 = hordco*(c2rt - TWO*c2 + c2lt);
*/
Jv1 += hordco*(v1rt - TWO*v1 + v1lt);
Jv2 += hordco*(v2rt - TWO*v2 + v2lt);
/*
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
*/
Jv1 += horaco*(v1rt - v1lt);
Jv2 += horaco*(v2rt - v2lt);
/* Load two components of J*v */
/*
IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1;
IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2;
*/
IJKth(Jvdata, 1, jx, jy) = Jv1;
IJKth(Jvdata, 2, jx, jy) = Jv2;
}
}
return(0);
}
static int jac(N_Vector y, N_Vector f,
SlsMat J, void *user_data,
N_Vector tmp1, N_Vector tmp2)
{
realtype *yd;
int *rowptrs;
int *colvals;
realtype *data;
yd = N_VGetArrayPointer_Serial(y);
rowptrs = (*J->rowptrs);
colvals = (*J->colvals);
data = J->data;
SparseSetMatToZero(J);
rowptrs[0] = 0;
rowptrs[1] = 2;
rowptrs[2] = 4;
rowptrs[3] = 6;
rowptrs[4] = 8;
rowptrs[5] = 10;
rowptrs[6] = 12;
/* row 0 */
data[0] = PT5 * cos(yd[0]*yd[1]) * yd[1] - PT5;
colvals[0] = 0;
data[1] = PT5 * cos(yd[0]*yd[1]) * yd[0] - PT25/PI;
colvals[1] = 1;
/* row 1 */
data[2] = TWO * (ONE - PT25/PI) * (SUNRexp(TWO*yd[0]) - E);
colvals[2] = 0;
data[3] = E/PI;
colvals[3] = 1;
/* row 2 */
data[4] = -ONE;
colvals[4] = 0;
data[5] = ONE;
colvals[5] = 2;
/* row 3 */
data[6] = -ONE;
colvals[6] = 0;
data[7] = ONE;
colvals[7] = 3;
/* row 4 */
data[8] = -ONE;
colvals[8] = 1;
data[9] = ONE;
colvals[9] = 4;
/* row 5 */
data[10] = -ONE;
colvals[10] = 1;
data[11] = ONE;
colvals[11] = 5;
return(0);
}
static int flocal(long int Nlocal, realtype t, N_Vector u,
N_Vector udot, void *user_data)
{
realtype *uext;
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;
int i, lx, ly, jx, jy;
int isubx, isuby;
long int nvmxsub, nvmxsub2, offsetu, offsetue;
UserData data;
realtype *uarray, *duarray;
uarray = N_VGetArrayPointer_Parallel(u);
duarray = N_VGetArrayPointer_Parallel(udot);
/* Get subgrid indices, array sizes, extended work array uext */
data = (UserData) user_data;
isubx = data->isubx; isuby = data->isuby;
nvmxsub = data->nvmxsub; nvmxsub2 = data->nvmxsub2;
uext = data->uext;
/* Copy local segment of u vector into the working extended array uext */
offsetu = 0;
offsetue = nvmxsub2 + NVARS;
for (ly = 0; ly < MYSUB; ly++) {
for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = uarray[offsetu+i];
offsetu = offsetu + nvmxsub;
offsetue = offsetue + nvmxsub2;
}
/* To facilitate homogeneous Neumann boundary conditions, when this is
a boundary PE, copy data from the first interior mesh line of u to uext */
/* If isuby = 0, copy x-line 2 of u to uext */
if (isuby == 0) {
for (i = 0; i < nvmxsub; i++) uext[NVARS+i] = uarray[nvmxsub+i];
}
/* If isuby = NPEY-1, copy x-line MYSUB-1 of u to uext */
if (isuby == NPEY-1) {
offsetu = (MYSUB-2)*nvmxsub;
offsetue = (MYSUB+1)*nvmxsub2 + NVARS;
for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = uarray[offsetu+i];
}
/* If isubx = 0, copy y-line 2 of u to uext */
if (isubx == 0) {
for (ly = 0; ly < MYSUB; ly++) {
offsetu = ly*nvmxsub + NVARS;
offsetue = (ly+1)*nvmxsub2;
for (i = 0; i < NVARS; i++) uext[offsetue+i] = uarray[offsetu+i];
}
}
/* If isubx = NPEX-1, copy y-line MXSUB-1 of u to uext */
if (isubx == NPEX-1) {
for (ly = 0; ly < MYSUB; ly++) {
offsetu = (ly+1)*nvmxsub - 2*NVARS;
offsetue = (ly+2)*nvmxsub2 - NVARS;
for (i = 0; i < NVARS; i++) uext[offsetue+i] = uarray[offsetu+i];
}
}
/* Make local copies of problem variables, for efficiency */
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
horaco = data->haco;
/* Set diurnal rate coefficients as functions of t, and save q4 in
data block for use by preconditioner evaluation routine */
s = sin((data->om)*t);
if (s > ZERO) {
q3 = SUNRexp(-A3/s);
q4coef = SUNRexp(-A4/s);
} else {
q3 = ZERO;
q4coef = ZERO;
}
data->q4 = q4coef;
/* Loop over all grid points in local subgrid */
for (ly = 0; ly < MYSUB; ly++) {
jy = ly + isuby*MYSUB;
/* 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);
for (lx = 0; lx < MXSUB; lx++) {
jx = lx + isubx*MXSUB;
/* Extract c1 and c2, and set kinetic rate terms */
offsetue = (lx+1)*NVARS + (ly+1)*nvmxsub2;
c1 = uext[offsetue];
c2 = uext[offsetue+1];
qq1 = Q1*c1*C3;
qq2 = Q2*c1*c2;
qq3 = q3*C3;
qq4 = q4coef*c2;
rkin1 = -qq1 - qq2 + 2.0*qq3 + qq4;
rkin2 = qq1 - qq2 - qq4;
/* Set vertical diffusion terms */
c1dn = uext[offsetue-nvmxsub2];
c2dn = uext[offsetue-nvmxsub2+1];
c1up = uext[offsetue+nvmxsub2];
c2up = uext[offsetue+nvmxsub2+1];
vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn);
vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn);
/* Set horizontal diffusion and advection terms */
c1lt = uext[offsetue-2];
c2lt = uext[offsetue-1];
c1rt = uext[offsetue+2];
c2rt = uext[offsetue+3];
hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt);
hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt);
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
/* Load all terms into duarray */
offsetu = lx*NVARS + ly*nvmxsub;
duarray[offsetu] = vertd1 + hord1 + horad1 + rkin1;
duarray[offsetu+1] = vertd2 + hord2 + horad2 + rkin2;
}
}
return(0);
}
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *user_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];
int nvmxsub, ier, offset;
long int *(*pivot)[MYSUB];
int lx, ly, jy, isuby;
realtype *udata, **a, **j;
HYPRE_ParVector uhyp;
UserData data;
/* Make local copies of pointers in user_data, pointer to u's data,
and PE index pair */
data = (UserData) user_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
isuby = data->isuby;
nvmxsub = data->nvmxsub;
uhyp = N_VGetVector_ParHyp(u);
udata = hypre_VectorData(hypre_ParVectorLocalVector(uhyp));
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
denseCopy(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
c*omputed 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*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(RCONST(0.2)*yup);
diag = -(cydn + cyup + RCONST(2.0)*hordco);
for (lx = 0; lx < MXSUB; lx++) {
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;
denseCopy(j, a, NVARS, NVARS);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
denseScale(-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++) {
denseAddIdentity(P[lx][ly], NVARS);
ier = denseGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]);
if (ier != 0) return(1);
}
}
return(0);
}
