static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id,
N_Vector res, UserData data)
{
int i, iloc, j, jloc, offset, loc, ixsub, jysub;
int ixbegin, ixend, jybegin, jyend;
realtype xfact, yfact, *udata, *iddata, dx, dy;
/* Initialize uu. */
udata = N_VGetArrayPointer_Parallel(uu);
iddata = N_VGetArrayPointer_Parallel(id);
/* Set mesh spacings and subgrid indices for this PE. */
dx = data->dx;
dy = data->dy;
ixsub = data->ixsub;
jysub = data->jysub;
/* Set beginning and ending locations in the global array corresponding
to the portion of that array assigned to this processor. */
ixbegin = MXSUB*ixsub;
ixend = MXSUB*(ixsub+1) - 1;
jybegin = MYSUB*jysub;
jyend = MYSUB*(jysub+1) - 1;
/* Loop over the local array, computing the initial profile value.
The global indices are (i,j) and the local indices are (iloc,jloc).
Also set the id vector to zero for boundary points, one otherwise. */
N_VConst(ONE,id);
for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) {
yfact = data->dy*j;
offset= jloc*MXSUB;
for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) {
xfact = data->dx * i;
loc = offset + iloc;
udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact);
if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO;
}
}
/* Initialize up. */
N_VConst(ZERO, up); /* Initially set up = 0. */
/* heatres sets res to negative of ODE RHS values at interior points. */
heatres(ZERO, uu, up, res, data);
/* Copy -res into up to get correct initial up values. */
N_VScale(-ONE, res, up);
return(0);
}
/* Preconditioner solve routine */
static int PSolve(realtype tn, N_Vector u, N_Vector fu,
N_Vector r, N_Vector z,
realtype gamma, realtype delta,
int lr, void *user_data, N_Vector vtemp)
{
realtype **(*P)[MYSUB];
long int nvmxsub;
long int *(*pivot)[MYSUB];
int lx, ly;
realtype *zdata, *v;
UserData data;
/* Extract the P and pivot arrays from user_data */
data = (UserData) user_data;
P = data->P;
pivot = data->pivot;
/* Solve the block-diagonal system Px = r using LU factors stored
in P and pivot data in pivot, and return the solution in z.
First copy vector r to z. */
N_VScale(RCONST(1.0), r, z);
nvmxsub = data->nvmxsub;
zdata = N_VGetArrayPointer_Parallel(z);
for (lx = 0; lx < MXSUB; lx++) {
for (ly = 0; ly < MYSUB; ly++) {
v = &(zdata[lx*NVARS + ly*nvmxsub]);
denseGETRS(P[lx][ly], NVARS, pivot[lx][ly], v);
}
}
return(0);
}
static void fucomm(realtype t, N_Vector u, void *user_data)
{
UserData data;
realtype *uarray, *uext, buffer[2*NVARS*MYSUB];
MPI_Comm comm;
int my_pe, isubx, isuby;
long int nvmxsub, nvmysub;
MPI_Request request[4];
data = (UserData) user_data;
uarray = N_VGetArrayPointer_Parallel(u);
/* Get comm, my_pe, subgrid indices, data sizes, extended array uext */
comm = data->comm; my_pe = data->my_pe;
isubx = data->isubx; isuby = data->isuby;
nvmxsub = data->nvmxsub;
nvmysub = NVARS*MYSUB;
uext = data->uext;
/* Start receiving boundary data from neighboring PEs */
BRecvPost(comm, request, my_pe, isubx, isuby, nvmxsub, nvmysub, uext, buffer);
/* Send data from boundary of local grid to neighboring PEs */
BSend(comm, my_pe, isubx, isuby, nvmxsub, nvmysub, uarray);
/* Finish receiving boundary data from neighboring PEs */
BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer);
}
static realtype Compute_g(N_Vector u, UserData data)
{
realtype intgr, my_intgr, dx, *udata;
sunindextype my_length;
int npes, my_pe, i;
MPI_Status status;
MPI_Comm comm;
/* Extract MPI info. from data */
comm = data->comm;
npes = data->npes;
my_pe = data->my_pe;
dx = data->dx;
if (my_pe == npes) { /* Loop over all other processes and sum */
intgr = ZERO;
for (i=0; i<npes; i++) {
MPI_Recv(&my_intgr, 1, PVEC_REAL_MPI_TYPE, i, 0, comm, &status);
intgr += my_intgr;
}
return(intgr);
} else { /* Compute local portion of the integral */
udata = N_VGetArrayPointer_Parallel(u);
my_length = N_VGetLocalLength_Parallel(u);
my_intgr = Xintgr(udata, my_length, dx);
MPI_Send(&my_intgr, 1, PVEC_REAL_MPI_TYPE, npes, 0, comm);
return(my_intgr);
}
}
static int rescomm(long int Nlocal, realtype tt,
N_Vector uu, N_Vector up, void *user_data)
{
UserData data;
realtype *uarray, *uext, buffer[2*MYSUB];
MPI_Comm comm;
int thispe, ixsub, jysub, mxsub, mysub;
MPI_Request request[4];
data = (UserData) user_data;
uarray = N_VGetArrayPointer_Parallel(uu);
/* Get comm, thispe, subgrid indices, data sizes, extended array uext. */
comm = data->comm; thispe = data->thispe;
ixsub = data->ixsub; jysub = data->jysub;
mxsub = data->mxsub; mysub = data->mysub;
uext = data->uext;
/* Start receiving boundary data from neighboring PEs. */
BRecvPost(comm, request, thispe, ixsub, jysub, mxsub, mysub, uext, buffer);
/* Send data from boundary of local grid to neighboring PEs. */
BSend(comm, thispe, ixsub, jysub, mxsub, mysub, uarray);
/* Finish receiving boundary data from neighboring PEs. */
BRecvWait(request, ixsub, jysub, mxsub, uext, buffer);
return(0);
}
static int f(realtype t, N_Vector u, N_Vector udot, void *user_data)
{
realtype *udata, *dudata;
UserData data;
udata = N_VGetArrayPointer_Parallel(u);
dudata = N_VGetArrayPointer_Parallel(udot);
data = (UserData) user_data;
/* Call ucomm to do inter-processor communication */
ucomm(t, u, data);
/* Call fcalc to calculate all right-hand sides */
fcalc(t, udata, dudata, data);
return(0);
}
static void PrintOutput(void *mem, N_Vector cc, realtype tt,
UserData webdata, MPI_Comm comm)
{
MPI_Status status;
realtype *cdata, clast[2], hused;
long int nst;
int i, kused, flag, thispe, npelast, ilast;;
thispe = webdata->thispe;
npelast = webdata->npes - 1;
cdata = N_VGetArrayPointer_Parallel(cc);
/* Send conc. at top right mesh point from PE npes-1 to PE 0. */
if (thispe == npelast) {
ilast = NUM_SPECIES*MXSUB*MYSUB - 2;
if (npelast != 0)
MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm);
else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; }
}
/* On PE 0, receive conc. at top right from PE npes - 1.
Then print performance data and sampled solution values. */
if (thispe == 0) {
if (npelast != 0)
MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status);
flag = IDAGetLastOrder(mem, &kused);
check_flag(&flag, "IDAGetLastOrder", 1, thispe);
flag = IDAGetNumSteps(mem, &nst);
check_flag(&flag, "IDAGetNumSteps", 1, thispe);
flag = IDAGetLastStep(mem, &hused);
check_flag(&flag, "IDAGetLastStep", 1, thispe);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n",
tt, cdata[0], clast[0], nst, kused, hused);
for (i=1;i<NUM_SPECIES;i++)
printf(" %12.4Le %12.4Le |\n",cdata[i],clast[i]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%8.2e %12.4e %12.4e | %3ld %1d %12.4e\n",
tt, cdata[0], clast[0], nst, kused, hused);
for (i=1;i<NUM_SPECIES;i++)
printf(" %12.4e %12.4e |\n",cdata[i],clast[i]);
#else
printf("%8.2e %12.4e %12.4e | %3ld %1d %12.4e\n",
tt, cdata[0], clast[0], nst, kused, hused);
for (i=1;i<NUM_SPECIES;i++)
printf(" %12.4e %12.4e |\n",cdata[i],clast[i]);
#endif
printf("\n");
}
}
static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm,
N_Vector u, realtype t)
{
int qu, flag;
realtype hu, *udata, tempu[2];
int npelast;
long int i0, i1, nst;
MPI_Status status;
npelast = NPEX*NPEY - 1;
udata = N_VGetArrayPointer_Parallel(u);
/* Send c1,c2 at top right mesh point to PE 0 */
if (my_pe == npelast) {
i0 = NVARS*MXSUB*MYSUB - 2;
i1 = i0 + 1;
if (npelast != 0)
MPI_Send(&udata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm);
else {
tempu[0] = udata[i0];
tempu[1] = udata[i1];
}
}
/* On PE 0, receive c1,c2 at top right, then print performance data
and sampled solution values */
if (my_pe == 0) {
if (npelast != 0)
MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status);
flag = CVodeGetNumSteps(cvode_mem, &nst);
check_flag(&flag, "CVodeGetNumSteps", 1, my_pe);
flag = CVodeGetLastOrder(cvode_mem, &qu);
check_flag(&flag, "CVodeGetLastOrder", 1, my_pe);
flag = CVodeGetLastStep(cvode_mem, &hu);
check_flag(&flag, "CVodeGetLastStep", 1, my_pe);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n",
t, nst, qu, hu);
printf("At bottom left: c1, c2 = %12.3Le %12.3Le \n", udata[0], udata[1]);
printf("At top right: c1, c2 = %12.3Le %12.3Le \n\n", tempu[0], tempu[1]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n",
t, nst, qu, hu);
printf("At bottom left: c1, c2 = %12.3e %12.3e \n", udata[0], udata[1]);
printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]);
#else
printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n",
t, nst, qu, hu);
printf("At bottom left: c1, c2 = %12.3e %12.3e \n", udata[0], udata[1]);
printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]);
#endif
}
}
static void SetICback(N_Vector uB, sunindextype my_base)
{
int i;
realtype *uBdata;
sunindextype my_length;
/* Set pointer to data array and get local length of uB */
uBdata = N_VGetArrayPointer_Parallel(uB);
my_length = N_VGetLocalLength_Parallel(uB);
/* Set adjoint states to 1.0 and quadrature variables to 0.0 */
if (my_base == -1) for (i=0; i<my_length; i++) uBdata[i] = ZERO;
else for (i=0; i<my_length; i++) uBdata[i] = ONE;
}
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 SetInitialProfiles(N_Vector u, UserData data)
{
int isubx, isuby;
int lx, ly, jx, jy;
long int offset;
realtype dx, dy, x, y, cx, cy, xmid, ymid;
realtype *uarray;
/* Set pointer to data array in vector u */
uarray = N_VGetArrayPointer_Parallel(u);
/* Get mesh spacings, and subgrid indices for this PE */
dx = data->dx; dy = data->dy;
isubx = data->isubx; isuby = data->isuby;
/* Load initial profiles of c1 and c2 into local u vector.
Here lx and ly are local mesh point indices on the local subgrid,
and jx and jy are the global mesh point indices. */
offset = 0;
xmid = RCONST(0.5)*(XMIN + XMAX);
ymid = RCONST(0.5)*(YMIN + YMAX);
for (ly = 0; ly < MYSUB; ly++) {
jy = ly + isuby*MYSUB;
y = YMIN + jy*dy;
cy = SUNSQR(RCONST(0.1)*(y - ymid));
cy = RCONST(1.0) - cy + RCONST(0.5)*SUNSQR(cy);
for (lx = 0; lx < MXSUB; lx++) {
jx = lx + isubx*MXSUB;
x = XMIN + jx*dx;
cx = SUNSQR(RCONST(0.1)*(x - xmid));
cx = RCONST(1.0) - cx + RCONST(0.5)*SUNSQR(cx);
uarray[offset ] = C1_SCALE*cx*cy;
uarray[offset+1] = C2_SCALE*cx*cy;
offset = offset + 2;
}
}
}
static int rescomm(long int Nlocal, realtype tt,
N_Vector cc, N_Vector cp,
void *user_data)
{
UserData webdata;
realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB];
int thispe, ixsub, jysub, nsmxsub, nsmysub;
MPI_Comm comm;
MPI_Request request[4];
webdata = (UserData) user_data;
cdata = N_VGetArrayPointer_Parallel(cc);
/* Get comm, thispe, subgrid indices, data sizes, extended array cext. */
comm = webdata->comm;
thispe = webdata->thispe;
ixsub = webdata->ixsub;
jysub = webdata->jysub;
cext = webdata->cext;
nsmxsub = webdata->nsmxsub;
nsmysub = (webdata->ns)*(webdata->mysub);
/* Start receiving boundary data from neighboring PEs. */
BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub,
cext, buffer);
/* Send data from boundary of local grid to neighboring PEs. */
BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata);
/* Finish receiving boundary data from neighboring PEs. */
BRecvWait(request, ixsub, jysub, nsmxsub, cext, buffer);
return(0);
}
static int f(realtype t, N_Vector u, N_Vector udot, void *user_data)
{
realtype uLeft, uRight, ui, ult, urt;
realtype hordc, horac, hdiff, hadv;
realtype *udata, *dudata;
sunindextype i, my_length;
int npes, my_pe, my_pe_m1, my_pe_p1, last_pe;
UserData data;
MPI_Status status;
MPI_Comm comm;
/* Extract MPI info. from data */
data = (UserData) user_data;
comm = data->comm;
npes = data->npes;
my_pe = data->my_pe;
/* If this process is inactive, return now */
if (my_pe == npes) return(0);
/* Extract problem constants from data */
hordc = data->hdcoef;
horac = data->hacoef;
/* Find related processes */
my_pe_m1 = my_pe - 1;
my_pe_p1 = my_pe + 1;
last_pe = npes - 1;
/* Obtain local arrays */
udata = N_VGetArrayPointer_Parallel(u);
dudata = N_VGetArrayPointer_Parallel(udot);
my_length = N_VGetLocalLength_Parallel(u);
/* Pass needed data to processes before and after current process. */
if (my_pe != 0)
MPI_Send(&udata[0], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm);
if (my_pe != last_pe)
MPI_Send(&udata[my_length-1], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm);
/* Receive needed data from processes before and after current process. */
if (my_pe != 0)
MPI_Recv(&uLeft, 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status);
else uLeft = ZERO;
if (my_pe != last_pe)
MPI_Recv(&uRight, 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm,
&status);
else uRight = ZERO;
/* Loop over all grid points in current process. */
for (i=0; i<my_length; i++) {
/* Extract u at x_i and two neighboring points */
ui = udata[i];
ult = (i==0) ? uLeft: udata[i-1];
urt = (i==my_length-1) ? uRight : udata[i+1];
/* Set diffusion and advection terms and load into udot */
hdiff = hordc*(ult - TWO*ui + urt);
hadv = horac*(urt - ult);
dudata[i] = hdiff + hadv;
}
return(0);
}
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 void PrintOutput(realtype g_val, N_Vector uB, UserData data)
{
MPI_Comm comm;
MPI_Status status;
int npes, my_pe;
sunindextype i, Ni, indx, local_N, nperpe, nrem;
realtype *uBdata;
realtype *mu;
comm = data->comm;
npes = data->npes;
my_pe = data->my_pe;
local_N = data->local_N;
nperpe = data->nperpe;
nrem = data->nrem;
uBdata = N_VGetArrayPointer_Parallel(uB);
if (my_pe == npes) {
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("\ng(tf) = %8Le\n\n", g_val);
printf("dgdp(tf)\n [ 1]: %8Le\n [ 2]: %8Le\n\n", -uBdata[0], -uBdata[1]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("\ng(tf) = %8e\n\n", g_val);
printf("dgdp(tf)\n [ 1]: %8e\n [ 2]: %8e\n\n", -uBdata[0], -uBdata[1]);
#else
printf("\ng(tf) = %8e\n\n", g_val);
printf("dgdp(tf)\n [ 1]: %8e\n [ 2]: %8e\n\n", -uBdata[0], -uBdata[1]);
#endif
mu = (realtype *)malloc(NEQ*sizeof(realtype));
if (check_retval((void *)mu, "malloc", 2, my_pe)) MPI_Abort(comm, 1);
indx = 0;
for ( i = 0; i < npes; i++) {
Ni = ( i < nrem ) ? nperpe+1 : nperpe;
MPI_Recv(&mu[indx], Ni, PVEC_REAL_MPI_TYPE, i, 0, comm, &status);
indx += Ni;
}
printf("mu(t0)\n");
#if defined(SUNDIALS_EXTENDED_PRECISION)
for (i=0; i<NEQ; i++)
printf(" [%2ld]: %8Le\n", (long int) i+1, mu[i]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
for (i=0; i<NEQ; i++)
printf(" [%2ld]: %8e\n", (long int) i+1, mu[i]);
#else
for (i=0; i<NEQ; i++)
printf(" [%2ld]: %8e\n", (long int) i+1, mu[i]);
#endif
free(mu);
} else {
MPI_Send(uBdata, local_N, PVEC_REAL_MPI_TYPE, npes, 0, comm);
}
}
static int reslocal(long int Nlocal, realtype tt,
N_Vector uv, N_Vector uvp, N_Vector rr,
void *user_data)
{
realtype *uvdata, *uvpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui, dx2, dy2;
realtype ixend, ixstart, jystart, jyend;
int ix, jy, is, i, locc, ylocce, locce;
realtype rates[2];
UserData data;
data = (UserData) user_data;
/* Get data pointers, subgrid data, array sizes, work array cext. */
uvdata = N_VGetArrayPointer_Parallel(uv);
dx2 = dx * dx;
dy2 = dy * dy;
/* Copy local segment of uv vector into the working extended array gridext. */
locc = 0;
locce = nsmxsub2 + NUM_SPECIES;
for (jy = 0; jy < mysub; jy++) {
for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[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 uv to gridext. */
/* If jysub = 0, copy x-line 2 of uv to gridext. */
if (jysub == 0)
{ for (i = 0; i < nsmxsub; i++) gridext[NUM_SPECIES+i] = uvdata[nsmxsub+i]; }
/* If jysub = npey-1, copy x-line mysub-1 of uv to gridext. */
if (jysub == npey-1) {
locc = (mysub-2)*nsmxsub;
locce = (mysub+1)*nsmxsub2 + NUM_SPECIES;
for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i];
}
/* If ixsub = 0, copy y-line 2 of uv to gridext. */
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++) gridext[locce+i] = uvdata[locc+i];
}
}
/* If ixsub = npex-1, copy y-line mxsub-1 of uv to gridext. */
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++) gridext[locce+i] = uvdata[locc+i];
}
}
/* Loop over all grid points, setting local array rates to right-hand sides.
Then set rr values appropriately (ODE in the interior and DAE on the boundary)*/
ixend = ixstart = jystart = jyend = 0;
if (jysub==0) jystart = 1;
if (jysub==npey-1) jyend = 1;
if (ixsub==0) ixstart = 1;
if (ixsub==npex-1) ixend = 1;
for (jy = jystart; jy < mysub-jyend; jy++) {
ylocce = (jy+1)*nsmxsub2;
yy = (jy+jysub*mysub)*dy;
for (ix = ixstart; ix < mxsub-ixend; ix++) {
locce = ylocce + (ix+1)*NUM_SPECIES;
xx = (ix + ixsub*mxsub)*dx;
ReactRates(xx, yy, &(gridext[locce]), rates, data);
resxy = IJ_Vptr(rr,ix,jy);
uvpxy = IJ_Vptr(uvp,ix,jy);
for (is = 0; is < NUM_SPECIES; is++) {
dcyli = gridext[locce+is] - gridext[locce+is-nsmxsub2];
dcyui = gridext[locce+is+nsmxsub2] - gridext[locce+is];
dcxli = gridext[locce+is] - gridext[locce+is-NUM_SPECIES];
dcxui = gridext[locce+is+NUM_SPECIES] - gridext[locce+is];
resxy[is] = uvpxy[is]- eps[is]*( (dcxui-dcxli)/dx2 + (dcyui-dcyli)/dy2 ) - rates[is];
}
}
}
/* Algebraic equation correspoding to boundary mesh point. */
if (jysub==0) {
for (ix=0; ix<mxsub; ix++) {
locce = nsmxsub2 + NUM_SPECIES * (ix+1);
resxy = IJ_Vptr(rr,ix,0);
for (is=0; is<NUM_SPECIES; is++)
resxy[is] = gridext[locce+is+nsmxsub2] - gridext[locce+is];
}
}
if (ixsub==npex-1) {
for(jy=0; jy<mysub; jy++) {
locce = (jy+1)*nsmxsub2 + nsmxsub2-NUM_SPECIES;
resxy = IJ_Vptr(rr,mxsub-1,jy);
for (is=0; is<NUM_SPECIES; is++)
resxy[is] = gridext[locce+is-NUM_SPECIES] - gridext[locce+is];
}
}
if (ixsub==0) {
for (jy=0; jy<mysub; jy++) {
locce = (jy+1)*nsmxsub2 + NUM_SPECIES;
resxy = IJ_Vptr(rr,0,jy);
for (is=0; is<NUM_SPECIES; is++)
resxy[is] = gridext[locce+is-NUM_SPECIES] - gridext[locce+is];
}
}
if (jysub==npey-1) {
for(ix=0; ix<mxsub; ix++) {
locce = nsmxsub2*mysub + (ix+1)*NUM_SPECIES;
resxy = IJ_Vptr(rr,ix, mysub-1);
for (is=0; is<NUM_SPECIES; is++)
resxy[is] = gridext[locce+is-nsmxsub2] - gridext[locce+is];
}
}
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);
}
/* 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 *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];
long int nvmxsub, offset;
long int *(*pivot)[MYSUB], ier;
int lx, ly, jx, jy, isubx, isuby;
realtype *udata, **a, **j;
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;
udata = N_VGetArrayPointer_Parallel(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++)
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
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*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++) {
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;
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);
}
static int reslocal(long int Nlocal, realtype tres,
N_Vector uu, N_Vector up, N_Vector res,
void *user_data)
{
realtype *uext, *uuv, *upv, *resv;
realtype termx, termy, termctr;
int lx, ly, offsetu, offsetue, locu, locue;
int ixsub, jysub, mxsub, mxsub2, mysub, npex, npey;
int ixbegin, ixend, jybegin, jyend;
UserData data;
/* Get subgrid indices, array sizes, extended work array uext. */
data = (UserData) user_data;
uext = data->uext;
uuv = N_VGetArrayPointer_Parallel(uu);
upv = N_VGetArrayPointer_Parallel(up);
resv = N_VGetArrayPointer_Parallel(res);
ixsub = data->ixsub; jysub = data->jysub;
mxsub = data->mxsub; mxsub2 = data->mxsub + 2;
mysub = data->mysub; npex = data->npex; npey = data->npey;
/* Initialize all elements of res to uu. This sets the boundary
elements simply without indexing hassles. */
N_VScale(ONE, uu, res);
/* Copy local segment of u vector into the working extended array uext.
This completes uext prior to the computation of the res vector. */
offsetu = 0;
offsetue = mxsub2 + 1;
for (ly = 0; ly < mysub; ly++) {
for (lx = 0; lx < mxsub; lx++) uext[offsetue+lx] = uuv[offsetu+lx];
offsetu = offsetu + mxsub;
offsetue = offsetue + mxsub2;
}
/* Set loop limits for the interior of the local subgrid. */
ixbegin = 0;
ixend = mxsub-1;
jybegin = 0;
jyend = mysub-1;
if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--;
if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--;
/* Loop over all grid points in local subgrid. */
for (ly = jybegin; ly <=jyend; ly++) {
for (lx = ixbegin; lx <= ixend; lx++) {
locu = lx + ly*mxsub;
locue = (lx+1) + (ly+1)*mxsub2;
termx = data->coeffx *(uext[locue-1] + uext[locue+1]);
termy = data->coeffy *(uext[locue-mxsub2] + uext[locue+mxsub2]);
termctr = data->coeffxy*uext[locue];
resv[locu] = upv[locu] - (termx + termy - termctr);
}
}
return(0);
}
static int f(realtype t, N_Vector u, N_Vector udot, void *user_data)
{
realtype ui, ult, urt, hordc, horac, hdiff, hadv;
realtype *udata, *dudata, *z;
int i;
int npes, my_pe, my_length, my_pe_m1, my_pe_p1, last_pe, my_last;
UserData data;
MPI_Status status;
MPI_Comm comm;
udata = N_VGetArrayPointer_Parallel(u);
dudata = N_VGetArrayPointer_Parallel(udot);
/* Extract needed problem constants from data */
data = (UserData) user_data;
hordc = data->hdcoef;
horac = data->hacoef;
/* Extract parameters for parallel computation. */
comm = data->comm;
npes = data->npes; /* Number of processes. */
my_pe = data->my_pe; /* Current process number. */
my_length = N_VGetLocalLength_Parallel(u); /* Number of local elements of u. */
z = data->z;
/* Compute related parameters. */
my_pe_m1 = my_pe - 1;
my_pe_p1 = my_pe + 1;
last_pe = npes - 1;
my_last = my_length - 1;
/* Store local segment of u in the working array z. */
for (i = 1; i <= my_length; i++)
z[i] = udata[i - 1];
/* Pass needed data to processes before and after current process. */
if (my_pe != 0)
MPI_Send(&z[1], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm);
if (my_pe != last_pe)
MPI_Send(&z[my_length], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm);
/* Receive needed data from processes before and after current process. */
if (my_pe != 0)
MPI_Recv(&z[0], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status);
else z[0] = ZERO;
if (my_pe != last_pe)
MPI_Recv(&z[my_length+1], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm,
&status);
else z[my_length + 1] = ZERO;
/* Loop over all grid points in current process. */
for (i=1; i<=my_length; i++) {
/* Extract u at x_i and two neighboring points */
ui = z[i];
ult = z[i-1];
urt = z[i+1];
/* Set diffusion and advection terms and load into udot */
hdiff = hordc*(ult - RCONST(2.0)*ui + urt);
hadv = horac*(urt - ult);
dudata[i-1] = hdiff + hadv;
}
return(0);
}
static int fB(realtype t, N_Vector u,
N_Vector uB, N_Vector uBdot, void *user_dataB)
{
realtype *uBdata, *duBdata, *udata;
realtype uBLeft, uBRight, uBi, uBlt, uBrt;
realtype uLeft, uRight, ui, ult, urt;
realtype dx, hordc, horac, hdiff, hadv;
realtype *z1, *z2, intgr1, intgr2;
sunindextype i, my_length;
int npes, my_pe, my_pe_m1, my_pe_p1, last_pe;
UserData data;
realtype data_in[2], data_out[2];
MPI_Status status;
MPI_Comm comm;
/* Extract MPI info. from data */
data = (UserData) user_dataB;
comm = data->comm;
npes = data->npes;
my_pe = data->my_pe;
if (my_pe == npes) { /* This process performs the quadratures */
/* Obtain local arrays */
duBdata = N_VGetArrayPointer_Parallel(uBdot);
my_length = N_VGetLocalLength_Parallel(uB);
/* Loop over all other processes and load right hand side of quadrature eqs. */
duBdata[0] = ZERO;
duBdata[1] = ZERO;
for (i=0; i<npes; i++) {
MPI_Recv(&intgr1, 1, PVEC_REAL_MPI_TYPE, i, 0, comm, &status);
duBdata[0] += intgr1;
MPI_Recv(&intgr2, 1, PVEC_REAL_MPI_TYPE, i, 0, comm, &status);
duBdata[1] += intgr2;
}
} else { /* This process integrates part of the PDE */
/* Extract problem constants and work arrays from data */
dx = data->dx;
hordc = data->hdcoef;
horac = data->hacoef;
z1 = data->z1;
z2 = data->z2;
/* Obtain local arrays */
uBdata = N_VGetArrayPointer_Parallel(uB);
duBdata = N_VGetArrayPointer_Parallel(uBdot);
udata = N_VGetArrayPointer_Parallel(u);
my_length = N_VGetLocalLength_Parallel(uB);
/* Compute related parameters. */
my_pe_m1 = my_pe - 1;
my_pe_p1 = my_pe + 1;
last_pe = npes - 1;
/* Pass needed data to processes before and after current process. */
if (my_pe != 0) {
data_out[0] = udata[0];
data_out[1] = uBdata[0];
MPI_Send(data_out, 2, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm);
}
if (my_pe != last_pe) {
data_out[0] = udata[my_length-1];
data_out[1] = uBdata[my_length-1];
MPI_Send(data_out, 2, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm);
}
/* Receive needed data from processes before and after current process. */
if (my_pe != 0) {
MPI_Recv(data_in, 2, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status);
uLeft = data_in[0];
uBLeft = data_in[1];
} else {
uLeft = ZERO;
uBLeft = ZERO;
}
if (my_pe != last_pe) {
MPI_Recv(data_in, 2, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm, &status);
uRight = data_in[0];
uBRight = data_in[1];
} else {
uRight = ZERO;
uBRight = ZERO;
}
/* Loop over all grid points in current process. */
for (i=0; i<my_length; i++) {
/* Extract uB at x_i and two neighboring points */
uBi = uBdata[i];
uBlt = (i==0) ? uBLeft: uBdata[i-1];
uBrt = (i==my_length-1) ? uBRight : uBdata[i+1];
/* Set diffusion and advection terms and load into udot */
hdiff = hordc*(uBlt - TWO*uBi + uBrt);
hadv = horac*(uBrt - uBlt);
duBdata[i] = - hdiff + hadv;
/* Extract u at x_i and two neighboring points */
ui = udata[i];
ult = (i==0) ? uLeft: udata[i-1];
urt = (i==my_length-1) ? uRight : udata[i+1];
/* Load integrands of the two space integrals */
z1[i] = uBdata[i]*(ult - TWO*ui + urt)/(dx*dx);
z2[i] = uBdata[i]*(urt - ult)/(TWO*dx);
}
/* Compute local integrals */
intgr1 = Xintgr(z1, my_length, dx);
intgr2 = Xintgr(z2, my_length, dx);
/* Send local integrals to 'quadrature' process */
MPI_Send(&intgr1, 1, PVEC_REAL_MPI_TYPE, npes, 0, comm);
MPI_Send(&intgr2, 1, PVEC_REAL_MPI_TYPE, npes, 0, comm);
}
return(0);
}
