Skip to content

Add variant of geins taking insertion mode to C interface #39

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
fdrmrc wants to merge 1 commit into
base: development
Choose a base branch
from
Open

Add variant of geins taking insertion mode to C interface #39

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 14 additions & 5 deletions cbind/base/psb_c_base.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions cbind/base/psb_c_dbase.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
72 changes: 72 additions & 0 deletions cbind/base/psb_d_tools_cbind_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -293,6 +293,78 @@ function psb_c_dgeins(nz,irw,val,xh,cdh) bind(c) result(res)

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)

Expand Down