From 1bba419d795d1888869be09b4bbfd813ada0f645 Mon Sep 17 00:00:00 2001 From: Marco Feder Date: Mon, 6 Oct 2025 19:05:59 +0200 Subject: [PATCH] Add local indices to psb_c_cdall C interface --- cbind/base/psb_base_tools_cbind_mod.F90 | 42 +++++++++++++++++++++++++ cbind/base/psb_c_base.h | 1 + 2 files changed, 43 insertions(+) diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index 5f9cdf75..b5ee8cff 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -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 diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index 5ae62cac..81cddb05 100644 --- a/cbind/base/psb_c_base.h +++ b/cbind/base/psb_c_base.h @@ -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);