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

Merge pull request #29 from fdrmrc/local_idx

Browse Source 
Expose psb_cdall() routine that takes local indices to C interface
This commit is contained in:
Salvatore Filippone
2025-10-06 19:11:15 +02:00
committed by GitHub
parent 6ef434bcbe 1bba419d79
commit 30c8fd7a6d
2 changed files with 43 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cbind/base/psb_base_tools_cbind_mod.F90
+42
View File
@@ -141,6 +141,48 @@ contains
end function psb_c_cdall_vl_opt
function psb_c_cdall_vl_lidx(nl,vl,lidx,cctxt,cdh) bind(c,name='psb_c_cdall_vl_lidx') result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: nl
integer(psb_c_lpk_) :: vl(*)
integer(psb_c_lpk_) :: lidx(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (nl <=0) then
write(0,*) 'Invalid size'
return
end if
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
call descp%free(info)
if (info == 0) deallocate(descp,stat=info)
if (info /= 0) return
end if
allocate(descp,stat=info)
if (info < 0) return
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_))
else
call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb)),lidx=int(lidx(1:nl)+(1-ixb),psb_ipk_))
end if
cdh%item = c_loc(descp)
res = info
end function psb_c_cdall_vl_lidx
function psb_c_cdall_nl(nl,cctxt,cdh) bind(c,name='psb_c_cdall_nl') result(res)
implicit none
cbind/base/psb_c_base.h
+1
View File
@@ -75,6 +75,7 @@ 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_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);