CAMLprim value sunml_nvec_par_n_vwrmsnormmask(value vx, value vw, value vid)
{
CAMLparam3(vx, vw, vid);
realtype r = N_VWrmsNormMask_Parallel(NVEC_VAL(vx), NVEC_VAL(vw),
NVEC_VAL(vid));
CAMLreturn(caml_copy_double(r));
}
CAMLprim value sunml_lsolver_lapack_band(value vnvec, value vbmat)
{
CAMLparam2(vnvec, vbmat);
#if SUNDIALS_LIB_VERSION >= 300 && defined SUNDIALS_ML_LAPACK
SUNMatrix bmat = MAT_VAL(vbmat);
SUNLinearSolver ls = SUNLapackBand(NVEC_VAL(vnvec), bmat);
if (ls == NULL) {
if (SUNBandMatrix_Rows(bmat) != SUNBandMatrix_Columns(bmat))
caml_raise_constant(LSOLVER_EXN(MatrixNotSquare));
if (SUNBandMatrix_StoredUpperBandwidth(bmat) <
SUNMIN(SUNBandMatrix_Rows(bmat) - 1,
SUNBandMatrix_LowerBandwidth(bmat)
+ SUNBandMatrix_UpperBandwidth(bmat)))
caml_raise_constant(LSOLVER_EXN(InsufficientStorageUpperBandwidth));
if (SUNBandMatrix_Rows(bmat) != NV_LENGTH_S(NVEC_VAL(vnvec)))
caml_raise_constant(LSOLVER_EXN(MatrixVectorMismatch));
caml_raise_out_of_memory();
}
CAMLreturn(alloc_lsolver(ls));
#else
CAMLreturn(Val_unit);
#endif
}
CAMLprim value sunml_nvec_par_n_vconstrmask(value vc, value vx, value vm)
{
CAMLparam3(vc, vx, vm);
booleantype r = N_VConstrMask_Parallel(NVEC_VAL(vc), NVEC_VAL(vx),
NVEC_VAL(vm));
CAMLreturn(Val_bool(r));
}
CAMLprim value sunml_nvec_par_n_vlinearsum(value va, value vx, value vb, value vy,
value vz)
{
CAMLparam5(va, vx, vb, vy, vz);
N_VLinearSum_Parallel(Double_val(va), NVEC_VAL(vx), Double_val(vb),
NVEC_VAL(vy), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value sunml_lsolver_call_atimes(value vcptr, value vv, value vz)
{
CAMLparam3(vcptr, vv, vz);
int r;
r = ATIMES_WITH_DATA(vcptr)->atimes_func(
ATIMES_WITH_DATA(vcptr)->atimes_data, NVEC_VAL(vv), NVEC_VAL(vz));
if (r != 0)
caml_raise_with_arg(LSOLVER_EXN(ATimesFailure), Val_bool(r > 0));
CAMLreturn(Val_unit);
}
CAMLprim value sunml_spils_classical_gs(value vargs)
{
CAMLparam1(vargs);
CAMLlocal3(vv, vh, vs);
int k = Int_val(Field(vargs, 2));
int p = Int_val(Field(vargs, 3));
N_Vector temp = NVEC_VAL(Field(vargs, 4));
int i;
int i0 = SUNMAX(k-p, 0);
realtype new_vk_norm;
N_Vector* v;
vv = Field(vargs, 0);
vh = Field(vargs, 1);
vs = Field(vargs, 5);
#if SUNDIALS_ML_SAFE == 1
struct caml_ba_array *bh = ARRAY2_DATA(vh);
intnat hn = bh->dim[0];
intnat hm = bh->dim[1];
if (hn < k + 1)
caml_invalid_argument("classical_gs: h is too small (< k + 1).");
if (hm < k)
caml_invalid_argument("classical_gs: h is too small (< k).");
if (Wosize_val (vv) < k + 1)
caml_invalid_argument("classical_gs: v is too small (< k + 1).");
if (ARRAY1_LEN(vs) < k)
caml_invalid_argument("classical_gs: s is too small (< k).");
#endif
v = calloc(p + 1, sizeof(N_Vector));
if (v == NULL) caml_raise_out_of_memory();
for (i = i0; i <= k; ++i)
v[i] = NVEC_VAL(Field(vv, i));
ClassicalGS(v, ARRAY2_ACOLS(vh), k, p, &new_vk_norm,
temp, REAL_ARRAY(vs));
free(v);
CAMLreturn(caml_copy_double(new_vk_norm));
}
CAMLprim value sunml_lsolver_call_psolve(value vcptr, value vr, value vz,
value vtol, value vlr)
{
CAMLparam5(vcptr, vr, vz, vtol, vlr);
int r;
PSolveFn psolve = PRECOND_WITH_DATA(vcptr)->psolve_func;
if (psolve != NULL) {
r = psolve(PRECOND_WITH_DATA(vcptr)->precond_data,
NVEC_VAL(vr),
NVEC_VAL(vz),
Double_val(vtol),
Bool_val(vlr) ? 1 : 2);
if (r != 0)
caml_raise_with_arg(LSOLVER_EXN(PSolveFailure), Val_bool(r > 0));
}
CAMLreturn(Val_unit);
}
CAMLprim value sunml_lsolver_pcg(value vmaxl, value vnvec)
{
CAMLparam2(vmaxl, vnvec);
#if SUNDIALS_LIB_VERSION >= 300
SUNLinearSolver ls = SUNPCG(NVEC_VAL(vnvec), PREC_NONE, Int_val(vmaxl));
if (ls == NULL) caml_raise_out_of_memory();
CAMLreturn(alloc_lsolver(ls));
#else
CAMLreturn(Val_unit);
#endif
}
CAMLprim value sunml_lsolver_dense(value vnvec, value vdmat)
{
CAMLparam2(vnvec, vdmat);
#if SUNDIALS_LIB_VERSION >= 300
SUNMatrix dmat = MAT_VAL(vdmat);
SUNLinearSolver ls = SUNDenseLinearSolver(NVEC_VAL(vnvec), dmat);
if (ls == NULL) {
if (SUNDenseMatrix_Rows(dmat) != SUNDenseMatrix_Columns(dmat))
caml_raise_constant(LSOLVER_EXN(MatrixNotSquare));
if (SUNDenseMatrix_Rows(dmat) != NV_LENGTH_S(NVEC_VAL(vnvec)))
caml_raise_constant(LSOLVER_EXN(MatrixVectorMismatch));
caml_raise_out_of_memory();
}
CAMLreturn(alloc_lsolver(ls));
#else
CAMLreturn(Val_unit);
#endif
}
CAMLprim value sunml_lsolver_klu(value vnvec, value vsmat)
{
CAMLparam2(vnvec, vsmat);
#if SUNDIALS_LIB_VERSION >= 300 && defined SUNDIALS_ML_KLU
SUNMatrix smat = MAT_VAL(vsmat);
SUNLinearSolver ls = SUNKLU(NVEC_VAL(vnvec), smat);
if (ls == NULL) {
if (SUNSparseMatrix_Rows(smat) != SUNSparseMatrix_Columns(smat))
caml_raise_constant(LSOLVER_EXN(MatrixNotSquare));
if (SUNBandMatrix_Rows(smat) != NV_LENGTH_S(NVEC_VAL(vnvec)))
caml_raise_constant(LSOLVER_EXN(MatrixVectorMismatch));
caml_raise_out_of_memory();
}
CAMLreturn(alloc_lsolver(ls));
#else
CAMLreturn(Val_unit);
#endif
}
static N_Vector callml_custom_resid(SUNLinearSolver ls)
{
CAMLparam0();
CAMLlocal1(r);
r = caml_callback_exn(GET_OP(ls, GET_RES_ID), Val_unit);
if (Is_exception_result (r)) {
sunml_warn_discarded_exn (Extract_exception (r),
"user-defined res id handler");
CAMLreturnT(N_Vector, NULL);
}
CAMLreturnT(N_Vector, NVEC_VAL(r));
}
CAMLprim value sunml_nvec_par_n_vspace(value vx)
{
CAMLparam1(vx);
CAMLlocal1(r);
sundials_ml_index lrw, liw;
N_VSpace_Parallel(NVEC_VAL(vx), &lrw, &liw);
r = caml_alloc_tuple(2);
Store_field(r, 0, Val_index(lrw));
Store_field(r, 1, Val_index(liw));
CAMLreturn(r);
}
CAMLprim value sunml_spils_modified_gs(value vv, value vh, value vk, value vp)
{
CAMLparam4(vv, vh, vk, vp);
int p = Int_val(vp);
int k = Int_val(vk);
int i;
int i0 = SUNMAX(k-p, 0);
realtype new_vk_norm;
N_Vector* v;
#if SUNDIALS_ML_SAFE == 1
struct caml_ba_array *bh = ARRAY2_DATA(vh);
intnat hn = bh->dim[0];
intnat hm = bh->dim[1];
if (hn < k + 1)
caml_invalid_argument("modified_gs: h is too small (dim1 < k + 1).");
if (hm < k)
caml_invalid_argument("modified_gs: h is too small (dim2 < k).");
if (Wosize_val (vv) < k + 1)
caml_invalid_argument("modified_gs: v is too small (< k + 1).");
#endif
v = calloc(k + 1, sizeof(N_Vector));
if (v == NULL) caml_raise_out_of_memory();
for (i = i0; i <= k; ++i)
v[i] = NVEC_VAL(Field(vv, i));
ModifiedGS(v, ARRAY2_ACOLS(vh), k, p, &new_vk_norm);
free(v);
CAMLreturn(caml_copy_double(new_vk_norm));
}
CAMLprim value sunml_nvec_par_n_vconst(value vc, value vz)
{
CAMLparam2(vc, vz);
N_VConst_Parallel(Double_val(vc), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value sunml_nvec_par_n_vminquotient(value vnum, value vdenom)
{
CAMLparam2(vnum, vdenom);
realtype r = N_VMinQuotient_Parallel(NVEC_VAL(vnum), NVEC_VAL(vdenom));
CAMLreturn(caml_copy_double(r));
}
CAMLprim value sunml_nvec_par_n_vcompare(value vc, value vx, value vz)
{
CAMLparam3(vc, vx, vz);
N_VCompare_Parallel(Double_val(vc), NVEC_VAL(vx), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value sunml_nvec_par_n_vinvtest(value vx, value vz)
{
CAMLparam2(vx, vz);
booleantype r = N_VInvTest_Parallel(NVEC_VAL(vx), NVEC_VAL(vz));
CAMLreturn(Val_bool(r));
}
CAMLprim value sunml_nvec_par_n_vwl2norm(value vx, value vw)
{
CAMLparam2(vx, vw);
realtype r = N_VWL2Norm_Parallel(NVEC_VAL(vx), NVEC_VAL(vw));
CAMLreturn(caml_copy_double(r));
}
CAMLprim value sunml_nvec_par_n_vl1norm(value vx)
{
CAMLparam1(vx);
realtype r = N_VL1Norm_Parallel(NVEC_VAL(vx));
CAMLreturn(caml_copy_double(r));
}
CAMLprim value sunml_nvec_par_n_vdotprod(value vx, value vy)
{
CAMLparam2(vx, vy);
realtype r = N_VDotProd_Parallel(NVEC_VAL(vx), NVEC_VAL(vy));
CAMLreturn(caml_copy_double(r));
}
CAMLprim value ml_nvec_par_n_vprod(value vx, value vy, value vz)
{
CAMLparam3(vx, vy, vz);
N_VProd_Parallel(NVEC_VAL(vx), NVEC_VAL(vy), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value sunml_nvec_par_n_vaddconst(value vx, value vb, value vz)
{
CAMLparam3(vx, vb, vz);
N_VAddConst_Parallel(NVEC_VAL(vx), Double_val(vb), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value sunml_nvec_par_n_vinv(value vx, value vz)
{
CAMLparam2(vx, vz);
N_VInv_Parallel(NVEC_VAL(vx), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value sunml_nvec_par_n_vdiv(value vx, value vy, value vz)
{
CAMLparam3(vx, vy, vz);
N_VDiv_Parallel(NVEC_VAL(vx), NVEC_VAL(vy), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value ml_nvec_par_n_vabs(value vx, value vz)
{
CAMLparam2(vx, vz);
N_VAbs_Parallel(NVEC_VAL(vx), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
CAMLprim value ml_nvec_par_n_vmin(value vx)
{
CAMLparam1(vx);
realtype r = N_VMin_Parallel(NVEC_VAL(vx));
CAMLreturn(caml_copy_double(r));
}
