diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index 1242fd81..fcea4510 100644 --- a/cbind/base/psb_c_base.h +++ b/cbind/base/psb_c_base.h @@ -115,16 +115,25 @@ extern "C" { #define psb_Trans_ "T" #define psb_ConjTrans_ "C" + /* legal values for dupl argument (must match Fortran psb_const_mod) */ +#define psb_dupl_null_ 0 +#define psb_dupl_add_ 1 +#define psb_dupl_ovwrt_ 2 +#define psb_dupl_err_ 3 +#define psb_dupl_def_ psb_dupl_add_ + +/* PETSc-style insertion mode aliases */ +#define PSB_INSERT_VALUES psb_dupl_ovwrt_ +#define PSB_ADD_VALUES psb_dupl_add_ +/* Error code returned by psb_c_dgeins_v when insertion mode is changed + * while entries are already buffered (i.e. without an intervening assembly). */ +#define PSB_ERR_MODE_MISMATCH (-2) + #if 0 /* legal values for upd argument */ #define psb_upd_srch_ 98764 #define psb_upd_perm_ 98765 #define psb_upd_def_ psb_upd_srch_ - /* legal values for dupl argument */ -#define psb_dupl_ovwrt_ 0 -#define psb_dupl_add_ 1 -#define psb_dupl_err_ 2 -#define psb_dupl_def_ psb_dupl_ovwrt_ /* legal values for halo swap modes argument */ #define psb_swap_send_ 1 diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 6a82fe77..2cb81623 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -32,6 +32,8 @@ psb_i_t psb_c_dgeins(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val, psb_c_dvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_dgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val, psb_c_dvector *xh, psb_c_descriptor *cdh); +psb_i_t psb_c_dgeins_options(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val, + psb_c_dvector *xh, psb_c_descriptor *cdh, psb_i_t mode); psb_i_t psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_dgeasb_options(psb_c_dvector *xh, psb_c_descriptor *cdh, psb_i_t dupl); psb_i_t psb_c_dgeasb_options_format(psb_c_dvector *xh, psb_c_descriptor *cdh, diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 935b6cc6..6f216c08 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -293,6 +293,78 @@ contains return end function psb_c_dgeins + + function psb_c_dgeins_options(nz,irw,val,xh,cdh,mode) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + integer(psb_c_ipk_), value :: nz + integer(psb_c_lpk_) :: irw(*) + real(c_double) :: val(*) + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh + integer(psb_c_ipk_), value :: mode + + type(psb_desc_type), pointer :: descp + type(psb_d_vect_type), pointer :: xp + integer(psb_c_ipk_) :: ixb, info + integer(psb_ipk_) :: nrmt_ + + res = -1 + info = 0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + if (xp%is_asb()) then + if (mode == psb_dupl_ovwrt_) then + call xp%zero() + call xp%set_bld() + else + call xp%set_upd() + end if + call xp%set_dupl(mode) + call xp%set_remote_build(psb_matbld_remote_) + call xp%set_nrmv(izero) + call xp%set_ncfs(izero) + nrmt_ = max(100, descp%get_local_cols() - descp%get_local_rows()) + call psb_ensure_size(nrmt_, xp%rmtv, info) + if (info == 0) call psb_ensure_size(nrmt_, xp%rmidx, info) + if (info /= 0) then + res = -1 + return + end if + end if + + ! avoid mode mixing + if ((xp%get_ncfs() > izero .or. xp%get_nrmv() > izero) & + & .and. xp%get_dupl() /= mode) then + res = -2 ! PSB_ERR_MODE_MISMATCH + return + end if + + + call xp%set_dupl(mode) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info) + else + call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),& + & xp,descp,info) + end if + + res = min(0,info) + + return + end function psb_c_dgeins_options function psb_c_dspall(mh,cdh) bind(c) result(res)