/*
This routine computes one block of the interaction terms of the
system, namely block (jx,jy), for use in preconditioning.
Here jx and jy count from 0.
*/
static void fblock(realtype t, realtype cdata[], int jx, int jy,
realtype cdotdata[], WebData wdata)
{
int iblok, ic;
realtype x, y;
iblok = jx + jy*(wdata->mx);
y = jy*(wdata->dy);
x = jx*(wdata->dx);
ic = (wdata->ns)*(iblok);
WebRates(x, y, t, cdata+ic, cdotdata, wdata);
}
static int f(realtype t, N_Vector c, N_Vector cdot, void *user_data)
{
int i, ic, ici, idxl, idxu, idyl, idyu, iyoff, jx, jy, ns, mxns;
realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, dx, dy;
realtype *cdata, *cdotdata;
WebData wdata;
wdata = (WebData) user_data;
cdata = N_VGetArrayPointer(c);
cdotdata = N_VGetArrayPointer(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];
}
}
}
/* Quadrature equation (species 1) */
cdotdata[NEQ] = doubleIntgr(c,ISPEC,wdata);
return(0);
}
static void Fweb(realtype tcalc, N_Vector cc, N_Vector crate,
UserData webdata)
{
sunindextype jx, jy, is, idyu, idyl, idxu, idxl;
realtype xx, yy, *cxy, *ratesxy, *cratexy, dcyli, dcyui, dcxli, dcxui;
/* Loop over grid points, evaluate interaction vector (length ns),
form diffusion difference terms, and load crate. */
for (jy = 0; jy < MY; jy++) {
yy = (webdata->dy) * jy ;
idyu = (jy!=MY-1) ? NSMX : -NSMX;
idyl = (jy!= 0 ) ? NSMX : -NSMX;
for (jx = 0; jx < MX; jx++) {
xx = (webdata->dx) * jx;
idxu = (jx!= MX-1) ? NUM_SPECIES : -NUM_SPECIES;
idxl = (jx!= 0 ) ? NUM_SPECIES : -NUM_SPECIES;
cxy = IJ_Vptr(cc,jx,jy);
ratesxy = IJ_Vptr(webdata->rates,jx,jy);
cratexy = IJ_Vptr(crate,jx,jy);
/* Get interaction vector at this grid point. */
WebRates(xx, yy, cxy, ratesxy, webdata);
/* Loop over species, do differencing, load crate segment. */
#pragma omp parallel for default(shared) private(is, dcyli, dcyui, dcxli, dcxui) schedule(static) num_threads(webdata->nthreads)
for (is = 0; is < NUM_SPECIES; is++) {
/* Differencing in y. */
dcyli = *(cxy+is) - *(cxy - idyl + is) ;
dcyui = *(cxy + idyu + is) - *(cxy+is);
/* Differencing in x. */
dcxli = *(cxy+is) - *(cxy - idxl + is);
dcxui = *(cxy + idxu +is) - *(cxy+is);
/* Compute the crate values at (xx,yy). */
cratexy[is] = coy[is] * (dcyui - dcyli) +
cox[is] * (dcxui - dcxli) + ratesxy[is];
} /* End is loop */
} /* End of jx loop */
} /* End of jy loop */
}
static int reslocal(long int Nlocal, realtype tt,
N_Vector cc, N_Vector cp, N_Vector rr,
void *user_data)
{
realtype *cdata, *ratesxy, *cpxy, *resxy,
xx, yy, dcyli, dcyui, dcxli, dcxui;
int ix, jy, is, i, locc, ylocce, locce;
UserData webdata;
webdata = (UserData) user_data;
/* Get data pointers, subgrid data, array sizes, work array cext. */
cdata = N_VGetArrayPointer_Parallel(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 = SUNRsqrt(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*(SUNMAX(SUNRabs(cxy[js]), SUNMAX(hh*SUNRabs(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 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);
}