void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
xd = zd = NULL;
if (z == x) { /* BLAS usage: scale x <- cx */
VScaleBy_Parallel(c, x);
return;
}
if (c == ONE) {
VCopy_Parallel(x, z);
} else if (c == -ONE) {
VNeg_Parallel(x, z);
} else {
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++)
zd[i] = c*xd[i];
}
return;
}
booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m)
{
long int i, N;
realtype temp;
realtype *cd, *xd, *md;
MPI_Comm comm;
cd = xd = md = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
cd = NV_DATA_P(c);
md = NV_DATA_P(m);
comm = NV_COMM_P(x);
temp = ONE;
for (i = 0; i < N; i++) {
md[i] = ZERO;
if (cd[i] == ZERO) continue;
if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) {
if (xd[i]*cd[i] <= ZERO) { temp = ZERO; md[i] = ONE; }
continue;
}
if (cd[i] > HALF || cd[i] < -HALF) {
if (xd[i]*cd[i] < ZERO ) { temp = ZERO; md[i] = ONE; }
}
}
temp = VAllReduce_Parallel(temp, 3, comm);
if (temp == ONE) return(TRUE);
else return(FALSE);
}
booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd, val, gval;
MPI_Comm comm;
xd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
zd = NV_DATA_P(z);
comm = NV_COMM_P(x);
val = ONE;
for (i = 0; i < N; i++) {
if (xd[i] == ZERO)
val = ZERO;
else
zd[i] = ONE/xd[i];
}
gval = VAllReduce_Parallel(val, 3, comm);
if (gval == ZERO)
return(FALSE);
else
return(TRUE);
}
realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id)
{
long int i, N, N_global;
realtype sum, prodi, *xd, *wd, *idd, gsum;
MPI_Comm comm;
sum = ZERO;
xd = wd = idd = NULL;
N = NV_LOCLENGTH_P(x);
N_global = NV_GLOBLENGTH_P(x);
xd = NV_DATA_P(x);
wd = NV_DATA_P(w);
idd = NV_DATA_P(id);
comm = NV_COMM_P(x);
for (i = 0; i < N; i++) {
if (idd[i] > ZERO) {
prodi = xd[i]*wd[i];
sum += SUNSQR(prodi);
}
}
gsum = VAllReduce_Parallel(sum, 1, comm);
return(SUNRsqrt(gsum/N_global));
}
realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom)
{
booleantype notEvenOnce;
long int i, N;
realtype *nd, *dd, min;
MPI_Comm comm;
nd = dd = NULL;
N = NV_LOCLENGTH_P(num);
nd = NV_DATA_P(num);
dd = NV_DATA_P(denom);
comm = NV_COMM_P(num);
notEvenOnce = TRUE;
min = BIG_REAL;
for (i = 0; i < N; i++) {
if (dd[i] == ZERO) continue;
else {
if (!notEvenOnce) min = SUNMIN(min, nd[i]/dd[i]);
else {
min = nd[i]/dd[i];
notEvenOnce = FALSE;
}
}
}
return(VAllReduce_Parallel(min, 3, comm));
}
static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y)
{
long int i, N;
realtype *xd, *yd;
xd = yd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
yd = NV_DATA_P(y);
if (a == ONE) {
for (i = 0; i < N; i++)
yd[i] += xd[i];
return;
}
if (a == -ONE) {
for (i = 0; i < N; i++)
yd[i] -= xd[i];
return;
}
for (i = 0; i < N; i++)
yd[i] += a*xd[i];
return;
}
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 = NV_DATA_P(uu);
iddata = NV_DATA_P(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);
}
void N_VDestroy_Parallel(N_Vector v)
{
if ((NV_OWN_DATA_P(v) == TRUE) && (NV_DATA_P(v) != NULL)) {
free(NV_DATA_P(v));
NV_DATA_P(v) = NULL;
}
free(v->content); v->content = NULL;
free(v->ops); v->ops = NULL;
free(v); v = NULL;
return;
}
static int cvode_rhs(real t,
N_Vector u, N_Vector du,
void *user_data)
{
real *udata = NV_DATA_P(u);
real *dudata = NV_DATA_P(du);
Solver *s = (Solver*) user_data;
// Calculate residuals
s->rhs(t, udata, dudata);
return 0;
}
/// Jacobian-vector multiplication function
static int cvode_jac(N_Vector v, N_Vector Jv,
realtype t, N_Vector y, N_Vector fy,
void *user_data, N_Vector tmp)
{
real *ydata = NV_DATA_P(y); ///< System state
real *vdata = NV_DATA_P(v); ///< Input vector
real *Jvdata = NV_DATA_P(Jv); ///< Jacobian*vector output
Solver *s = (Solver*) user_data;
s->jac(t, ydata, vdata, Jvdata);
return 0;
}
void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
xd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++) zd[i] = xd[i]+b;
return;
}
static void ucomm(realtype t, N_Vector u, UserData data)
{
realtype *udata, *uext, buffer[2*NVARS*MYSUB];
MPI_Comm comm;
int my_pe, isubx, isuby;
long int nvmxsub, nvmysub;
MPI_Request request[4];
udata = NV_DATA_P(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, udata);
/* Finish receiving boundary data from neighboring PEs */
BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer);
}
N_Vector N_VClone_Parallel(N_Vector w)
{
N_Vector v;
realtype *data;
long int local_length;
v = NULL;
v = N_VCloneEmpty_Parallel(w);
if (v == NULL) return(NULL);
local_length = NV_LOCLENGTH_P(w);
/* Create data */
if(local_length > 0) {
/* Allocate memory */
data = NULL;
data = (realtype *) malloc(local_length * sizeof(realtype));
if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); }
/* Attach data */
NV_OWN_DATA_P(v) = TRUE;
NV_DATA_P(v) = data;
}
return(v);
}
N_Vector N_VNew_Parallel(MPI_Comm comm,
long int local_length,
long int global_length)
{
N_Vector v;
realtype *data;
v = NULL;
v = N_VNewEmpty_Parallel(comm, local_length, global_length);
if (v == NULL) return(NULL);
/* Create data */
if(local_length > 0) {
/* Allocate memory */
data = NULL;
data = (realtype *) malloc(local_length * sizeof(realtype));
if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); }
/* Attach data */
NV_OWN_DATA_P(v) = TRUE;
NV_DATA_P(v) = data;
}
return(v);
}
/// Preconditioner function
static int cvode_pre(real t, N_Vector yy, N_Vector yp,
N_Vector rvec, N_Vector zvec,
real gamma, real delta, int lr,
void *user_data, N_Vector tmp)
{
real *udata = NV_DATA_P(yy);
real *rdata = NV_DATA_P(rvec);
real *zdata = NV_DATA_P(zvec);
Solver *s = (Solver*) user_data;
// Calculate residuals
s->pre(t, gamma, delta, udata, rdata, zdata);
return 0;
}
static int ccomm(long int Nlocal, N_Vector cc, void *userdata)
{
realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB];
UserData data;
MPI_Comm comm;
int my_pe, isubx, isuby, nsmxsub, nsmysub;
MPI_Request request[4];
/* Get comm, my_pe, subgrid indices, data sizes, extended array cext */
data = (UserData) userdata;
comm = data->comm; my_pe = data->my_pe;
isubx = data->isubx; isuby = data->isuby;
nsmxsub = data->nsmxsub;
nsmysub = NUM_SPECIES*MYSUB;
cext = data->cext;
cdata = NV_DATA_P(cc);
/* Start receiving boundary data from neighboring PEs */
BRecvPost(comm, request, my_pe, isubx, isuby, nsmxsub, nsmysub, cext, buffer);
/* Send data from boundary of local grid to neighboring PEs */
BSend(comm, my_pe, isubx, isuby, nsmxsub, nsmysub, cdata);
/* Finish receiving boundary data from neighboring PEs */
BRecvWait(request, isubx, isuby, nsmxsub, cext, buffer);
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 *P_data, N_Vector vtemp)
{
realtype **(*P)[MYSUB];
long int nvmxsub, *(*pivot)[MYSUB];
int lx, ly;
realtype *zdata, *v;
PreconData predata;
UserData data;
/* Extract the P and pivot arrays from P_data */
predata = (PreconData) P_data;
data = (UserData) (predata->f_data);
P = predata->P;
pivot = predata->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 = NV_DATA_P(z);
for (lx = 0; lx < MXSUB; lx++) {
for (ly = 0; ly < MYSUB; ly++) {
v = &(zdata[lx*NVARS + ly*nvmxsub]);
denGETRS(P[lx][ly], NVARS, pivot[lx][ly], v);
}
}
return(0);
}
static int rescomm(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 = NV_DATA_P(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 rescomm(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 = NV_DATA_P(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 realtype Compute_g(N_Vector u, UserData data)
{
realtype intgr, my_intgr, dx, *udata;
long int 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 = NV_DATA_P(u);
my_length = NV_LOCLENGTH_P(u);
my_intgr = Xintgr(udata, my_length, dx);
MPI_Send(&my_intgr, 1, PVEC_REAL_MPI_TYPE, npes, 0, comm);
return(my_intgr);
}
}
realtype N_VMin_Parallel(N_Vector x)
{
long int i, N;
realtype min, *xd, gmin;
MPI_Comm comm;
xd = NULL;
N = NV_LOCLENGTH_P(x);
comm = NV_COMM_P(x);
min = BIG_REAL;
if (N > 0) {
xd = NV_DATA_P(x);
min = xd[0];
for (i = 1; i < N; i++) {
if (xd[i] < min) min = xd[i];
}
}
gmin = VAllReduce_Parallel(min, 3, comm);
return(gmin);
}
void N_VInv_Parallel(N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
xd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++)
zd[i] = ONE/xd[i];
return;
}
static int funcprpr(N_Vector cc, N_Vector fval, void *f_data)
{
realtype *cdata, *fvdata;
UserData data;
cdata = NV_DATA_P(cc);
fvdata = NV_DATA_P(fval);
data = (UserData) f_data;
/* Call ccomm to do inter-processor communicaiton */
ccomm (cdata, data);
/* Call fcalcprpr to calculate all right-hand sides */
fcalcprpr (cc, fval, data);
return(0);
}
static int f(realtype t, N_Vector u, N_Vector udot, void *f_data)
{
realtype *udata, *dudata;
UserData data;
udata = NV_DATA_P(u);
dudata = NV_DATA_P(udot);
data = (UserData) f_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);
}
void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
xd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++) {
zd[i] = (SUNRabs(xd[i]) >= c) ? ONE : ZERO;
}
return;
}
static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z)
{
long int i, N;
realtype *xd, *yd, *zd;
xd = yd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
yd = NV_DATA_P(y);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++)
zd[i] = c*(xd[i]-yd[i]);
return;
}
static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z)
{
long int i, N;
realtype *xd, *yd, *zd;
xd = yd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
yd = NV_DATA_P(y);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++)
zd[i] = (a*xd[i])-yd[i];
return;
}
void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z)
{
long int i, N;
realtype *xd, *yd, *zd;
xd = yd = zd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
yd = NV_DATA_P(y);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++)
zd[i] = xd[i]/yd[i];
return;
}
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 = NV_DATA_P(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 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
}
}
}
