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); }