fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

Expose variant of psb_cdins() with local indices to C interface

Browse Source
This commit is contained in:
Marco Feder
2025-10-07 09:27:38 +02:00
parent 30c8fd7a6d
commit cd72888cd4
2 changed files with 35 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cbind/base/psb_base_tools_cbind_mod.F90
+33 -3
View File
@@ -148,7 +148,7 @@ contains
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: nl
integer(psb_c_lpk_) :: vl(*)
integer(psb_c_lpk_) :: lidx(*)
integer(psb_c_ipk_) :: lidx(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
@@ -174,9 +174,9 @@ contains
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_cdall(ctxt,descp,info,vl=vl(1:nl),lidx=int(lidx(1:nl),psb_ipk_))
call psb_cdall(ctxt,descp,info,vl=vl(1:nl),lidx=lidx(1:nl))
else
call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb)),lidx=int(lidx(1:nl)+(1-ixb),psb_ipk_))
call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb)),lidx=(lidx(1:nl)+(1-ixb)))
end if
cdh%item = c_loc(descp)
res = info
@@ -319,6 +319,36 @@ contains
return
end function psb_c_cdins
function psb_c_cdins_lidx(nz,ja,lidx,cdh) bind(c,name='psb_c_cdins_lidx') result(res)
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nz
type(psb_c_object_type) :: cdh
integer(psb_c_lpk_) :: ja(*)
integer(psb_c_ipk_) :: lidx(*)
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: ixb,info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_cdins(nz,ja(1:nz),descp,info,lidx=lidx(1:nz))
else
call psb_cdins(nz,(ja(1:nz)+(1-ixb)),descp,info,lidx=(lidx(1:nz)+(1-ixb)))
end if
res = info
end if
return
end function psb_c_cdins_lidx
function psb_c_cd_is_asb(cdh) bind(c,name='psb_c_cd_is_asb') result(res)
implicit none
cbind/base/psb_c_base.h
+2 -1
View File
@@ -75,12 +75,13 @@ extern "C" {
void psb_c_delete_ctxt(psb_c_ctxt *);
psb_i_t psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_vl_lidx(psb_i_t nl, psb_l_t *vl, psb_l_t *lidx,psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_vl_lidx(psb_i_t nl, psb_l_t *vl, psb_i_t *lidx, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_nl(psb_i_t nl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_repl(psb_l_t n, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdasb(psb_c_descriptor *cd);
psb_i_t psb_c_cdfree(psb_c_descriptor *cd);
psb_i_t psb_c_cdins(psb_i_t nz, const psb_l_t *ia, const psb_l_t *ja, psb_c_descriptor *cd);
psb_i_t psb_c_cdins_lidx(psb_i_t nz, const psb_l_t *ja, const psb_i_t *lidx, psb_c_descriptor *cd);
bool psb_c_is_owned(psb_l_t gindex, psb_c_descriptor *cd);
bool psb_c_cd_is_asb(psb_c_descriptor *cd);