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));
}
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;
}
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;
}
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);
}
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);
}
void Solver::pre(real t, real gamma, real delta, real *udata, real *rvec, real *zvec)
{
#ifdef CHECK
int msg_point = msg_stack.push("Running preconditioner: Solver::pre(%e)", t);
#endif
real tstart = MPI_Wtime();
int N = NV_LOCLENGTH_P(uvec);
if(prefunc == NULL) {
// Identity (but should never happen)
for(int i=0;i<N;i++)
zvec[i] = rvec[i];
return;
}
// Load state from udata (as with res function)
load_vars(udata);
// Load vector to be inverted into F_vars
load_derivs(rvec);
(*prefunc)(t, gamma, delta);
// Save the solution from vars
save_vars(zvec);
pre_Wtime += MPI_Wtime() - tstart;
pre_ncalls++;
#ifdef CHECK
msg_stack.pop(msg_point);
#endif
}
/* Adapted from sundials-2.5.0/src/nvec_par/nvector_parallel.c:
N_VCloneEmpty_Parallel */
static N_Vector clone_parallel(N_Vector w)
{
CAMLparam0();
CAMLlocal2(v_payload, w_payload);
N_Vector v;
N_VectorContent_Parallel content;
if (w == NULL) CAMLreturnT (N_Vector, NULL);
w_payload = NVEC_BACKLINK(w);
struct caml_ba_array *w_ba = Caml_ba_array_val(Field(w_payload, 0));
/* Create vector (we need not copy the data) */
v_payload = caml_alloc_tuple(3);
Store_field(v_payload, 0,
caml_ba_alloc(w_ba->flags, w_ba->num_dims, NULL, w_ba->dim));
Store_field(v_payload, 1, Field(w_payload, 1));
Store_field(v_payload, 2, Field(w_payload, 2));
v = sunml_alloc_cnvec(sizeof(struct _N_VectorContent_Parallel), v_payload);
if (v == NULL) CAMLreturnT (N_Vector, NULL);
content = (N_VectorContent_Parallel) v->content;
/* Create vector operation structure */
sunml_clone_cnvec_ops(v, w);
/* Attach lengths and communicator */
content->local_length = NV_LOCLENGTH_P(w);
content->global_length = NV_GLOBLENGTH_P(w);
content->comm = NV_COMM_P(w);
content->own_data = 0;
content->data = Caml_ba_data_val(Field(v_payload, 0));
CAMLreturnT(N_Vector, v);
}
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);
}
}
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);
}
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));
}
void N_VConst_Parallel(realtype c, N_Vector z)
{
long int i, N;
realtype *zd;
zd = NULL;
N = NV_LOCLENGTH_P(z);
zd = NV_DATA_P(z);
for (i = 0; i < N; i++) zd[i] = c;
return;
}
static void SetICback(N_Vector uB, long int my_base)
{
int i;
realtype *uBdata;
long int my_length;
/* Set pointer to data array and get local length of uB */
uBdata = NV_DATA_P(uB);
my_length = NV_LOCLENGTH_P(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;
}
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 VScaleBy_Parallel(realtype a, N_Vector x)
{
long int i, N;
realtype *xd;
xd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
for (i = 0; i < N; i++)
xd[i] *= a;
return;
}
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;
}
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 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 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 SetIC(N_Vector u, realtype dx, long int my_length, long int my_base)
{
int i;
long int iglobal;
realtype x;
realtype *udata;
/* Set pointer to data array and get local length of u */
udata = NV_DATA_P(u);
my_length = NV_LOCLENGTH_P(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)*EXP(TWO*x);
}
}
realtype N_VL1Norm_Parallel(N_Vector x)
{
long int i, N;
realtype sum, gsum, *xd;
MPI_Comm comm;
sum = ZERO;
xd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
comm = NV_COMM_P(x);
for (i = 0; i<N; i++)
sum += SUNRabs(xd[i]);
gsum = VAllReduce_Parallel(sum, 1, comm);
return(gsum);
}
realtype N_VDotProd_Parallel(N_Vector x, N_Vector y)
{
long int i, N;
realtype sum, *xd, *yd, gsum;
MPI_Comm comm;
sum = ZERO;
xd = yd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
yd = NV_DATA_P(y);
comm = NV_COMM_P(x);
for (i = 0; i < N; i++) sum += xd[i]*yd[i];
gsum = VAllReduce_Parallel(sum, 1, comm);
return(gsum);
}
realtype N_VMaxNorm_Parallel(N_Vector x)
{
long int i, N;
realtype max, *xd, gmax;
MPI_Comm comm;
xd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
comm = NV_COMM_P(x);
max = ZERO;
for (i = 0; i < N; i++) {
if (SUNRabs(xd[i]) > max) max = SUNRabs(xd[i]);
}
gmax = VAllReduce_Parallel(max, 2, comm);
return(gmax);
}
void N_VPrint_Parallel(N_Vector x)
{
long int i, N;
realtype *xd;
xd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
for (i = 0; i < N; i++) {
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%Lg\n", xd[i]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%g\n", xd[i]);
#else
printf("%g\n", xd[i]);
#endif
}
printf("\n");
return;
}
realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w)
{
long int i, N;
realtype sum, prodi, *xd, *wd, gsum;
MPI_Comm comm;
sum = ZERO;
xd = wd = NULL;
N = NV_LOCLENGTH_P(x);
xd = NV_DATA_P(x);
wd = NV_DATA_P(w);
comm = NV_COMM_P(x);
for (i = 0; i < N; i++) {
prodi = xd[i]*wd[i];
sum += SUNSQR(prodi);
}
gsum = VAllReduce_Parallel(sum, 1, comm);
return(SUNRsqrt(gsum));
}
N_Vector N_VCloneEmpty_Parallel(N_Vector w)
{
N_Vector v;
N_Vector_Ops ops;
N_VectorContent_Parallel content;
if (w == NULL) return(NULL);
/* Create vector */
v = NULL;
v = (N_Vector) malloc(sizeof *v);
if (v == NULL) return(NULL);
/* Create vector operation structure */
ops = NULL;
ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops));
if (ops == NULL) { free(v); return(NULL); }
ops->nvgetvectorid = w->ops->nvgetvectorid;
ops->nvclone = w->ops->nvclone;
ops->nvcloneempty = w->ops->nvcloneempty;
ops->nvdestroy = w->ops->nvdestroy;
ops->nvspace = w->ops->nvspace;
ops->nvgetarraypointer = w->ops->nvgetarraypointer;
ops->nvsetarraypointer = w->ops->nvsetarraypointer;
ops->nvlinearsum = w->ops->nvlinearsum;
ops->nvconst = w->ops->nvconst;
ops->nvprod = w->ops->nvprod;
ops->nvdiv = w->ops->nvdiv;
ops->nvscale = w->ops->nvscale;
ops->nvabs = w->ops->nvabs;
ops->nvinv = w->ops->nvinv;
ops->nvaddconst = w->ops->nvaddconst;
ops->nvdotprod = w->ops->nvdotprod;
ops->nvmaxnorm = w->ops->nvmaxnorm;
ops->nvwrmsnormmask = w->ops->nvwrmsnormmask;
ops->nvwrmsnorm = w->ops->nvwrmsnorm;
ops->nvmin = w->ops->nvmin;
ops->nvwl2norm = w->ops->nvwl2norm;
ops->nvl1norm = w->ops->nvl1norm;
ops->nvcompare = w->ops->nvcompare;
ops->nvinvtest = w->ops->nvinvtest;
ops->nvconstrmask = w->ops->nvconstrmask;
ops->nvminquotient = w->ops->nvminquotient;
/* Create content */
content = NULL;
content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel));
if (content == NULL) { free(ops); free(v); return(NULL); }
/* Attach lengths and communicator */
content->local_length = NV_LOCLENGTH_P(w);
content->global_length = NV_GLOBLENGTH_P(w);
content->comm = NV_COMM_P(w);
content->own_data = FALSE;
content->data = NULL;
/* Attach content and ops */
v->content = content;
v->ops = ops;
return(v);
}
void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z)
{
long int i, N;
realtype c, *xd, *yd, *zd;
N_Vector v1, v2;
booleantype test;
xd = yd = zd = NULL;
if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */
Vaxpy_Parallel(a, x, y);
return;
}
if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */
Vaxpy_Parallel(b, y, x);
return;
}
/* Case: a == b == 1.0 */
if ((a == ONE) && (b == ONE)) {
VSum_Parallel(x, y, z);
return;
}
/* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */
if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) {
v1 = test ? y : x;
v2 = test ? x : y;
VDiff_Parallel(v2, v1, z);
return;
}
/* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */
/* if a or b is 0.0, then user should have called N_VScale */
if ((test = (a == ONE)) || (b == ONE)) {
c = test ? b : a;
v1 = test ? y : x;
v2 = test ? x : y;
VLin1_Parallel(c, v1, v2, z);
return;
}
/* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */
if ((test = (a == -ONE)) || (b == -ONE)) {
c = test ? b : a;
v1 = test ? y : x;
v2 = test ? x : y;
VLin2_Parallel(c, v1, v2, z);
return;
}
/* Case: a == b */
/* catches case both a and b are 0.0 - user should have called N_VConst */
if (a == b) {
VScaleSum_Parallel(a, x, y, z);
return;
}
/* Case: a == -b */
if (a == -b) {
VScaleDiff_Parallel(a, x, y, z);
return;
}
/* Do all cases not handled above:
(1) a == other, b == 0.0 - user should have called N_VScale
(2) a == 0.0, b == other - user should have called N_VScale
(3) a,b == other, a !=b, a != -b */
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])+(b*yd[i]);
return;
}
void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v)
{
if (NV_LOCLENGTH_P(v) > 0) NV_DATA_P(v) = v_data;
return;
}
long int N_VGetLocalLength_Parallel(N_Vector v)
{
return NV_LOCLENGTH_P(v);
}