static int reslocal(long int Nlocal, realtype tt,
N_Vector cc, N_Vector cp, N_Vector rr,
void *res_data)
{
realtype *cdata, *ratesxy, *cpxy, *resxy,
xx, yy, dcyli, dcyui, dcxli, dcxui;
long int ix, jy, is, i, locc, ylocce, locce;
UserData webdata;
webdata = (UserData) res_data;
/* Get data pointers, subgrid data, array sizes, work array cext. */
cdata = NV_DATA_P(cc);
/* Copy local segment of cc vector into the working extended array cext. */
locc = 0;
locce = nsmxsub2 + NUM_SPECIES;
for (jy = 0; jy < mysub; jy++) {
for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i];
locc = locc + nsmxsub;
locce = locce + 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 jysub = 0, copy x-line 2 of cc to cext. */
if (jysub == 0)
{ for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; }
/* If jysub = npey-1, copy x-line mysub-1 of cc to cext. */
if (jysub == npey-1) {
locc = (mysub-2)*nsmxsub;
locce = (mysub+1)*nsmxsub2 + NUM_SPECIES;
for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i];
}
/* If ixsub = 0, copy y-line 2 of cc to cext. */
if (ixsub == 0) {
for (jy = 0; jy < mysub; jy++) {
locc = jy*nsmxsub + NUM_SPECIES;
locce = (jy+1)*nsmxsub2;
for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i];
}
}
/* If ixsub = npex-1, copy y-line mxsub-1 of cc to cext. */
if (ixsub == npex-1) {
for (jy = 0; jy < mysub; jy++) {
locc = (jy+1)*nsmxsub - 2*NUM_SPECIES;
locce = (jy+2)*nsmxsub2 - NUM_SPECIES;
for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i];
}
}
/* Loop over all grid points, setting local array rates to right-hand sides.
Then set rr values appropriately for prey/predator components of F. */
for (jy = 0; jy < mysub; jy++) {
ylocce = (jy+1)*nsmxsub2;
yy = (jy+jysub*mysub)*dy;
for (ix = 0; ix < mxsub; ix++) {
locce = ylocce + (ix+1)*NUM_SPECIES;
xx = (ix + ixsub*mxsub)*dx;
ratesxy = IJ_Vptr(rates,ix,jy);
WebRates(xx, yy, &(cext[locce]), ratesxy, webdata);
resxy = IJ_Vptr(rr,ix,jy);
cpxy = IJ_Vptr(cp,ix,jy);
for (is = 0; is < NUM_SPECIES; is++) {
dcyli = cext[locce+is] - cext[locce+is-nsmxsub2];
dcyui = cext[locce+is+nsmxsub2] - cext[locce+is];
dcxli = cext[locce+is] - cext[locce+is-NUM_SPECIES];
dcxui = cext[locce+is+NUM_SPECIES] - cext[locce+is];
rhs[is] = cox[is]*(dcxui-dcxli) + coy[is]*(dcyui-dcyli) + ratesxy[is];
if (is < np) resxy[is] = cpxy[is] - rhs[is];
else resxy[is] = - rhs[is];
}
}
}
return(0);
}
static int Precondbd(realtype tt, N_Vector cc,
N_Vector cp, N_Vector rr,
realtype cj, void *user_data,
N_Vector tempv1, N_Vector tempv2, N_Vector tempv3)
{
int flag, thispe;
realtype uround;
realtype xx, yy, *cxy, *ewtxy, cctemp, **Pxy, *ratesxy, *Pxycol, *cpxy;
realtype inc, sqru, fac, perturb_rates[NUM_SPECIES];
int is, js, ix, jy, ret;
UserData webdata;
void *mem;
N_Vector ewt;
realtype hh;
webdata = (UserData)user_data;
uround = UNIT_ROUNDOFF;
sqru = SQRT(uround);
thispe = webdata->thispe;
mem = webdata->ida_mem;
ewt = webdata->ewt;
flag = IDAGetErrWeights(mem, ewt);
check_flag(&flag, "IDAGetErrWeights", 1, thispe);
flag = IDAGetCurrentStep(mem, &hh);
check_flag(&flag, "IDAGetCurrentStep", 1, thispe);
for (jy = 0; jy < mysub; jy++) {
yy = (jy + jysub*mysub)*dy;
for (ix = 0; ix < mxsub; ix++) {
xx = (ix+ ixsub*mxsub)*dx;
Pxy = (webdata->PP)[ix][jy];
cxy = IJ_Vptr(cc,ix,jy);
cpxy = IJ_Vptr(cp,ix,jy);
ewtxy= IJ_Vptr(ewt,ix,jy);
ratesxy = IJ_Vptr(rates,ix,jy);
for (js = 0; js < ns; js++) {
inc = sqru*(MAX(ABS(cxy[js]), MAX(hh*ABS(cpxy[js]), ONE/ewtxy[js])));
cctemp = cxy[js]; /* Save the (js,ix,jy) element of cc. */
cxy[js] += inc; /* Perturb the (js,ix,jy) element of cc. */
fac = -ONE/inc;
WebRates(xx, yy, cxy, perturb_rates, webdata);
Pxycol = Pxy[js];
for (is = 0; is < ns; is++)
Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac;
if (js < np) Pxycol[js] += cj; /* Add partial with respect to cp. */
cxy[js] = cctemp; /* Restore (js,ix,jy) element of cc. */
} /* End of js loop. */
/* Do LU decomposition of matrix block for grid point (ix,jy). */
ret = denseGETRF(Pxy, ns, ns, (webdata->pivot)[ix][jy]);
if (ret != 0) return(1);
} /* End of ix loop. */
} /* End of jy loop. */
return(0);
}
static int PrecSetupBD(N_Vector cc, N_Vector cscale,
N_Vector fval, N_Vector fscale,
void *user_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) user_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 < MY; jy++) {
yy = jy*dely;
for (jx = 0; jx < MX; jx++) {
xx = jx*delx;
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 = SUNMAX(sqruround*SUNRabs(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];
#pragma omp parallel for default(shared) private(i)
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 = denseGETRF(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 Precond(realtype tt,
N_Vector cc, N_Vector cp, N_Vector rr,
realtype cj, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
int flag;
realtype uround, xx, yy, del_x, del_y;
realtype **Pxy, *ratesxy, *Pxycol, *cxy, *cpxy, *ewtxy, cctmp;
realtype inc, fac, sqru, perturb_rates[NUM_SPECIES];
int is, js, jx, jy, ret;
void *mem;
N_Vector ewt;
realtype hh;
UserData webdata;
webdata = (UserData) user_data;
del_x = webdata->dx;
del_y = webdata->dy;
uround = UNIT_ROUNDOFF;
sqru = SUNRsqrt(uround);
mem = webdata->ida_mem;
ewt = webdata->ewt;
flag = IDAGetErrWeights(mem, ewt);
if(check_flag(&flag, "IDAGetErrWeights", 1)) return(1);
flag = IDAGetCurrentStep(mem, &hh);
if(check_flag(&flag, "IDAGetCurrentStep", 1)) return(1);
for (jy = 0; jy < MY; jy++) {
yy = jy * del_y;
for (jx = 0; jx < MX; jx++) {
xx = jx * del_x;
Pxy = (webdata->PP)[jx][jy];
cxy = IJ_Vptr(cc, jx, jy);
cpxy = IJ_Vptr(cp, jx, jy);
ewtxy = IJ_Vptr(ewt, jx, jy);
ratesxy = IJ_Vptr((webdata->rates), jx, jy);
for (js = 0; js < NUM_SPECIES; js++) {
inc = sqru*(SUNMAX(SUNRabs(cxy[js]), SUNMAX(hh*SUNRabs(cpxy[js]), ONE/ewtxy[js])));
cctmp = cxy[js];
cxy[js] += inc;
fac = -ONE/inc;
WebRates(xx, yy, cxy, perturb_rates, webdata);
Pxycol = Pxy[js];
for (is = 0; is < NUM_SPECIES; is++)
Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac;
if (js < 1) Pxycol[js] += cj;
cxy[js] = cctmp;
}
ret = denseGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (webdata->pivot)[jx][jy]);
if (ret != 0) return(1);
}
}
return(0);
}
