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));
}
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);
}
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);
}
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_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);
}
/* 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);
}
void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw)
{
MPI_Comm comm;
int npes;
comm = NV_COMM_P(v);
MPI_Comm_size(comm, &npes);
*lrw = NV_GLOBLENGTH_P(v);
*liw = 2*npes;
return;
}
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);
}
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);
}