static int Precondbd(N_Vector cc, N_Vector cscale,
N_Vector fval, N_Vector fscale,
void *P_data,
N_Vector vtemp1, N_Vector vtemp2)
{
realtype r, r0, uround, sqruround, xx, yy, delx, dely, csave, fac;
realtype *cxy, *scxy, **Pxy, *ratesxy, *Pxycol, perturb_rates[NUM_SPECIES];
long int i, j, jx, jy, ret;
UserData data;
data = (UserData)P_data;
delx = data->dx;
dely = data->dy;
uround = data->uround;
sqruround = data->sqruround;
fac = N_VWL2Norm(fval, fscale);
r0 = THOUSAND * uround * fac * NEQ;
if(r0 == ZERO) r0 = ONE;
/* Loop over spatial points; get size NUM_SPECIES Jacobian block at each */
for (jy = 0; jy < MYSUB; jy++) {
yy = dely*(jy + data->isuby * MYSUB);
for (jx = 0; jx < MXSUB; jx++) {
xx = delx*(jx + data->isubx * MXSUB);
Pxy = (data->P)[jx][jy];
cxy = IJ_Vptr(cc,jx,jy);
scxy= IJ_Vptr(cscale,jx,jy);
ratesxy = IJ_Vptr((data->rates),jx,jy);
/* Compute difference quotients of interaction rate fn. */
for (j = 0; j < NUM_SPECIES; j++) {
csave = cxy[j]; /* Save the j,jx,jy element of cc */
r = MAX(sqruround*ABS(csave), r0/scxy[j]);
cxy[j] += r; /* Perturb the j,jx,jy element of cc */
fac = ONE/r;
WebRate(xx, yy, cxy, perturb_rates, data);
/* Restore j,jx,jy element of cc */
cxy[j] = csave;
/* Load the j-th column of difference quotients */
Pxycol = Pxy[j];
for (i = 0; i < NUM_SPECIES; i++)
Pxycol[i] = (perturb_rates[i] - ratesxy[i]) * fac;
} /* end of j loop */
/* Do LU decomposition of size NUM_SPECIES preconditioner block */
ret = denGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (data->pivot)[jx][jy]);
if (ret != 0) return(1);
} /* end of jx loop */
} /* end of jy loop */
return(0);
}
static int func(N_Vector cc, N_Vector fval, void *user_data)
{
realtype xx, yy, delx, dely, *cxy, *rxy, *fxy, dcyli, dcyui, dcxli, dcxri;
long int jx, jy, is, idyu, idyl, idxr, idxl;
UserData data;
data = (UserData)user_data;
delx = data->dx;
dely = data->dy;
/* Loop over all mesh points, evaluating rate array at each point*/
for (jy = 0; jy < MY; jy++) {
yy = dely*jy;
/* Set lower/upper index shifts, special at boundaries. */
idyl = (jy != 0 ) ? NSMX : -NSMX;
idyu = (jy != MY-1) ? NSMX : -NSMX;
for (jx = 0; jx < MX; jx++) {
xx = delx*jx;
/* Set left/right index shifts, special at boundaries. */
idxl = (jx != 0 ) ? NUM_SPECIES : -NUM_SPECIES;
idxr = (jx != MX-1) ? NUM_SPECIES : -NUM_SPECIES;
cxy = IJ_Vptr(cc,jx,jy);
rxy = IJ_Vptr(data->rates,jx,jy);
fxy = IJ_Vptr(fval,jx,jy);
/* Get species interaction rate array at (xx,yy) */
WebRate(xx, yy, cxy, rxy, user_data);
for(is = 0; is < NUM_SPECIES; is++) {
/* Differencing in x direction */
dcyli = *(cxy+is) - *(cxy - idyl + is) ;
dcyui = *(cxy + idyu + is) - *(cxy+is);
/* Differencing in y direction */
dcxli = *(cxy+is) - *(cxy - idxl + is);
dcxri = *(cxy + idxr +is) - *(cxy+is);
/* Compute the total rate value at (xx,yy) */
fxy[is] = (coy)[is] * (dcyui - dcyli) +
(cox)[is] * (dcxri - dcxli) + rxy[is];
} /* end of is loop */
} /* end of jx loop */
} /* end of jy loop */
return(0);
}
static int func_local(long int Nlocal, N_Vector cc, N_Vector fval, void *user_data)
{
realtype xx, yy, *cxy, *rxy, *fxy, dcydi, dcyui, dcxli, dcxri;
realtype *cext, dely, delx, *cdata;
int i, jx, jy, is, ly;
int isubx, isuby, nsmxsub, nsmxsub2;
int shifty, offsetc, offsetce, offsetcl, offsetcr, offsetcd, offsetcu;
UserData data;
data = (UserData)user_data;
cdata = NV_DATA_P(cc);
/* Get subgrid indices, data sizes, extended work array cext */
isubx = data->isubx; isuby = data->isuby;
nsmxsub = data->nsmxsub; nsmxsub2 = data->nsmxsub2;
cext = data->cext;
/* Copy local segment of cc vector into the working extended array cext */
offsetc = 0;
offsetce = nsmxsub2 + NUM_SPECIES;
for (ly = 0; ly < MYSUB; ly++) {
for (i = 0; i < nsmxsub; i++) cext[offsetce+i] = cdata[offsetc+i];
offsetc = offsetc + nsmxsub;
offsetce = offsetce + nsmxsub2;
}
/* To facilitate homogeneous Neumann boundary conditions, when this is a
boundary PE, copy data from the first interior mesh line of cc to cext */
/* If isuby = 0, copy x-line 2 of cc to cext */
if (isuby == 0) {
for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i];
}
/* If isuby = NPEY-1, copy x-line MYSUB-1 of cc to cext */
if (isuby == NPEY-1) {
offsetc = (MYSUB-2)*nsmxsub;
offsetce = (MYSUB+1)*nsmxsub2 + NUM_SPECIES;
for (i = 0; i < nsmxsub; i++) cext[offsetce+i] = cdata[offsetc+i];
}
/* If isubx = 0, copy y-line 2 of cc to cext */
if (isubx == 0) {
for (ly = 0; ly < MYSUB; ly++) {
offsetc = ly*nsmxsub + NUM_SPECIES;
offsetce = (ly+1)*nsmxsub2;
for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = cdata[offsetc+i];
}
}
/* If isubx = NPEX-1, copy y-line MXSUB-1 of cc to cext */
if (isubx == NPEX-1) {
for (ly = 0; ly < MYSUB; ly++) {
offsetc = (ly+1)*nsmxsub - 2*NUM_SPECIES;
offsetce = (ly+2)*nsmxsub2 - NUM_SPECIES;
for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = cdata[offsetc+i];
}
}
/* Loop over all mesh points, evaluating rate arra at each point */
delx = data->dx;
dely = data->dy;
shifty = (MXSUB+2)*NUM_SPECIES;
for (jy = 0; jy < MYSUB; jy++) {
yy = dely*(jy + isuby * MYSUB);
for (jx = 0; jx < MXSUB; jx++) {
xx = delx * (jx + isubx * MXSUB);
cxy = IJ_Vptr(cc,jx,jy);
rxy = IJ_Vptr(data->rates,jx,jy);
fxy = IJ_Vptr(fval,jx,jy);
WebRate(xx, yy, cxy, rxy, user_data);
offsetc = (jx+1)*NUM_SPECIES + (jy+1)*NSMXSUB2;
offsetcd = offsetc - shifty;
offsetcu = offsetc + shifty;
offsetcl = offsetc - NUM_SPECIES;
offsetcr = offsetc + NUM_SPECIES;
for (is = 0; is < NUM_SPECIES; is++) {
/* differencing in x */
dcydi = cext[offsetc+is] - cext[offsetcd+is];
dcyui = cext[offsetcu+is] - cext[offsetc+is];
/* differencing in y */
dcxli = cext[offsetc+is] - cext[offsetcl+is];
dcxri = cext[offsetcr+is] - cext[offsetc+is];
/* compute the value at xx , yy */
fxy[is] = (coy)[is] * (dcyui - dcydi) +
(cox)[is] * (dcxri - dcxli) + rxy[is];
} /* end of is loop */
} /* end of jx loop */
} /* end of jy loop */
return(0);
}
