CAMLprim value c_arraybandmatrix_copy(value va, value vb, value vsizes) { CAMLparam3(va, vb, vsizes); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat am = ba->dim[0]; int a_smu = Long_val(Field(vsizes, 0)); int b_smu = Long_val(Field(vsizes, 1)); int copymu = Long_val(Field(vsizes, 2)); int copyml = Long_val(Field(vsizes, 3)); #if SUNDIALS_ML_SAFE == 1 intnat an = ba->dim[1]; struct caml_ba_array *bb = ARRAY2_DATA(vb); intnat bm = bb->dim[0]; intnat bn = bb->dim[1]; if (an < copymu + copyml + 1) caml_invalid_argument("ArrayBandMatrix.blit: source matrix too small."); if (bn < copymu + copyml + 1) caml_invalid_argument("ArrayBandMatrix.blit: destination matrix too small."); if ((am != bm) || (bm != bn)) caml_invalid_argument("ArrayBandMatrix.blit: matrix sizes differ."); #endif bandCopy(ARRAY2_ACOLS(va), ARRAY2_ACOLS(vb), am, a_smu, b_smu, copymu, copyml); CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_ormqr(value va, value vormqr) { CAMLparam2(va, vormqr); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; intnat n = ba->dim[0]; realtype *beta = REAL_ARRAY(Field(vormqr, 0)); realtype *vv = REAL_ARRAY(Field(vormqr, 1)); realtype *vw = REAL_ARRAY(Field(vormqr, 2)); realtype *work = REAL_ARRAY(Field(vormqr, 3)); #if SUNDIALS_ML_SAFE == 1 if (m < n) caml_invalid_argument("ArrayDenseMatrix.ormqr: fewer rows than columns."); if (ARRAY1_LEN(Field(vormqr, 0)) < n) caml_invalid_argument("ArrayDenseMatrix.ormqr: beta is too small."); if (ARRAY1_LEN(Field(vormqr, 1)) < n) caml_invalid_argument("ArrayDenseMatrix.ormqr: v is too small."); if (ARRAY1_LEN(Field(vormqr, 2)) < m) caml_invalid_argument("ArrayDenseMatrix.ormqr: w is too small."); if (ARRAY1_LEN(Field(vormqr, 3)) < m) caml_invalid_argument("ArrayDenseMatrix.ormqr: work is too small."); #endif denseORMQR(ARRAY2_ACOLS(va), m, n, beta, vv, vw, work); CAMLreturn (Val_unit); }
CAMLprim value sunml_spils_qr_sol(value vn, value vh, value vq, value vb) { CAMLparam4(vn, vh, vq, vb); int r; int n = Int_val(vn); #if SUNDIALS_ML_SAFE == 1 struct caml_ba_array *bh = ARRAY2_DATA(vh); intnat hm = bh->dim[1]; intnat hn = bh->dim[0]; if (hn < n + 1) caml_invalid_argument("qr_sol: h is too small (< n + 1)."); if (hm < n) caml_invalid_argument("qr_sol: h is too small (< n)."); if (ARRAY1_LEN(vq) < 2 * n) caml_invalid_argument("qr_sol: q is too small (< 2n)."); if (ARRAY1_LEN(vb) < n + 1) caml_invalid_argument("qr_sol: b is too small (< n + 1)."); #endif r = QRsol(n, ARRAY2_ACOLS(vh), REAL_ARRAY(vq), REAL_ARRAY(vb)); if (r != 0) { caml_raise_with_arg(MATRIX_EXN_TAG(ZeroDiagonalElement), Val_long(r)); } CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_scale(value vc, value va) { CAMLparam2(vc, va); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; intnat n = ba->dim[0]; denseScale(Double_val(vc), ARRAY2_ACOLS(va), m, n); CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_potrf(value va) { CAMLparam1(va); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; #if SUNDIALS_ML_SAFE == 1 intnat n = ba->dim[0]; if (m != n) caml_invalid_argument("ArrayDenseMatrix.potrf: matrix not square"); #endif densePOTRF(ARRAY2_ACOLS(va), m); 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 c_arraybandmatrix_add_identity(value va, value vsmu) { CAMLparam2(va, vsmu); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[0]; intnat smu = Long_val(vsmu); #if SUNDIALS_ML_SAFE == 1 intnat n = ba->dim[1]; if (n <= smu) caml_invalid_argument("ArrayBandMatrix.add_identity: matrix badly sized."); #endif bandAddIdentity(ARRAY2_ACOLS(va), m, smu); CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_potrs(value va, value vb) { CAMLparam2(va, vb); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; #if SUNDIALS_ML_SAFE == 1 intnat n = ba->dim[0]; if (m != n) caml_invalid_argument("ArrayDenseMatrix.potrs: matrix not square."); if (ARRAY1_LEN(vb) < m) caml_invalid_argument("ArrayDenseMatrix.potrs: b is too small."); #endif densePOTRS(ARRAY2_ACOLS(va), m, REAL_ARRAY(vb)); CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_geqrf(value va, value vbeta, value vv) { CAMLparam3(va, vbeta, vv); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; intnat n = ba->dim[0]; #if SUNDIALS_ML_SAFE == 1 if (m < n) caml_invalid_argument("ArrayDenseMatrix.geqrf: fewer rows than columns."); if (ARRAY1_LEN(vbeta) < n) caml_invalid_argument("ArrayDenseMatrix.geqrf: beta is too small."); if (ARRAY1_LEN(vv) < m) caml_invalid_argument("ArrayDenseMatrix.geqrf: work is too small."); #endif denseGEQRF(ARRAY2_ACOLS(va), m, n, REAL_ARRAY(vbeta), REAL_ARRAY(vv)); CAMLreturn (Val_unit); }
CAMLprim value c_arraybandmatrix_scale(value vc, value va, value vsizes) { CAMLparam3(vc, va, vsizes); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[0]; long int mu = Long_val(Field(vsizes, 0)); long int ml = Long_val(Field(vsizes, 1)); long int smu = Long_val(Field(vsizes, 2)); #if SUNDIALS_ML_SAFE == 1 intnat n = ba->dim[1]; if (n < mu + ml + 1) caml_invalid_argument("ArrayBandMatrix.scale: matrix badly sized."); #endif bandScale(Double_val(vc), ARRAY2_ACOLS(va), m, mu, ml, smu); CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_getrf(value va, value vp) { CAMLparam2(va, vp); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; intnat n = ba->dim[0]; #if SUNDIALS_ML_SAFE == 1 if (ARRAY1_LEN(vp) < n) caml_invalid_argument("ArrayDenseMatrix.getrf: p is too small."); #endif int r = denseGETRF(ARRAY2_ACOLS(va), m, n, LONG_ARRAY(vp)); if (r != 0) { caml_raise_with_arg(DLS_EXN(ZeroDiagonalElement), Val_long(r)); } CAMLreturn (Val_unit); }
CAMLprim value c_arraydensematrix_getrs_off(value va, value vp, value vb, value vboff) { CAMLparam4(va, vp, vb, vboff); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[1]; intnat boff = Int_val(vboff); #if SUNDIALS_ML_SAFE == 1 intnat n = ba->dim[0]; if (m != n) caml_invalid_argument("ArrayDenseMatrix.getrs: matrix not square."); if (ARRAY1_LEN(vb) - boff < n) caml_invalid_argument("ArrayDenseMatrix.getrs: b is too small."); if (ARRAY1_LEN(vp) < n) caml_invalid_argument("ArrayDenseMatrix.getrs: p is too small."); #endif denseGETRS(ARRAY2_ACOLS(va), m, LONG_ARRAY(vp), REAL_ARRAY(vb) + boff); CAMLreturn (Val_unit); }
CAMLprim value c_arraybandmatrix_gbtrf(value va, value vsizes, value vp) { CAMLparam3(va, vsizes, vp); struct caml_ba_array *ba = ARRAY2_DATA(va); intnat m = ba->dim[0]; long int mu = Long_val(Field(vsizes, 0)); long int ml = Long_val(Field(vsizes, 1)); long int smu = Long_val(Field(vsizes, 2)); #if SUNDIALS_ML_SAFE == 1 intnat n = ba->dim[1]; if (n < mu + ml + 1) caml_invalid_argument("ArrayBandMatrix.gbtrf: matrix badly sized."); if (ARRAY1_LEN(vp) < m) caml_invalid_argument("ArrayBandMatrix.gbtrf: p is too small."); #endif bandGBTRF(ARRAY2_ACOLS(va), m, mu, ml, smu, LONG_ARRAY(vp)); CAMLreturn (Val_unit); }
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)); }