diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index dc05fd66..7126ced8 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -100,6 +100,47 @@ contains end function psb_c_cdall_vl + function psb_c_cdall_vl_opt(nl,vl,cctxt,cdh) bind(c,name='psb_c_cdall_vl_opt') 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(*) + 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),globalcheck=.true.) + else + call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb)),globalcheck=.true.) + end if + cdh%item = c_loc(descp) + res = info + + end function psb_c_cdall_vl_opt + 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_cbase.h b/cbind/base/psb_c_cbase.h index dd64d6e2..83b51b8b 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -35,6 +35,7 @@ psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd); /* sparse matrices*/ psb_c_cspmat* psb_c_new_cspmat(); psb_i_t psb_c_cspall(psb_c_cspmat *mh, psb_c_descriptor *cdh); +psb_i_t psb_c_cspall_remote(psb_c_cspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_cspasb(psb_c_cspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_cspfree(psb_c_cspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_cspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 8c2c6a61..8733dd46 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -35,6 +35,7 @@ psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd); /* sparse matrices*/ psb_c_dspmat* psb_c_new_dspmat(); psb_i_t psb_c_dspall(psb_c_dspmat *mh, psb_c_descriptor *cdh); +psb_i_t psb_c_dspall_remote(psb_c_dspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_dspasb(psb_c_dspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_dspfree(psb_c_dspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_dspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index b2e18ba5..d3a88044 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -35,6 +35,7 @@ psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd); /* sparse matrices*/ psb_c_sspmat* psb_c_new_sspmat(); psb_i_t psb_c_sspall(psb_c_sspmat *mh, psb_c_descriptor *cdh); +psb_i_t psb_c_sspall_remote(psb_c_sspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_sspasb(psb_c_sspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_sspfree(psb_c_sspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_sspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index 84fea6d7..4eb23742 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -212,6 +212,33 @@ contains end function psb_c_cspall + function psb_c_cspall_remote(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_cspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info,n + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(mh%item)) then + return + end if + allocate(ap) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_cspall_remote function psb_c_cspasb(mh,cdh) bind(c) result(res) @@ -241,7 +268,6 @@ contains return end function psb_c_cspasb - function psb_c_cspfree(mh,cdh) bind(c) result(res) implicit none diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index 16ee1ac4..ce2c5d3e 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -35,6 +35,7 @@ psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd); /* sparse matrices*/ psb_c_zspmat* psb_c_new_zspmat(); psb_i_t psb_c_zspall(psb_c_zspmat *mh, psb_c_descriptor *cdh); +psb_i_t psb_c_zspall_remote(psb_c_zspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_zspasb(psb_c_zspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_zspfree(psb_c_zspmat *mh, psb_c_descriptor *cdh); psb_i_t psb_c_zspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl, diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 08e214a5..009e7b17 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -212,6 +212,33 @@ contains end function psb_c_dspall + function psb_c_dspall_remote(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_dspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_dspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info,n + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(mh%item)) then + return + end if + allocate(ap) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_dspall_remote function psb_c_dspasb(mh,cdh) bind(c) result(res) @@ -241,7 +268,6 @@ contains return end function psb_c_dspasb - function psb_c_dspfree(mh,cdh) bind(c) result(res) implicit none diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index d9584338..f6cef638 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -212,6 +212,33 @@ contains end function psb_c_sspall + function psb_c_sspall_remote(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_sspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info,n + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(mh%item)) then + return + end if + allocate(ap) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_sspall_remote function psb_c_sspasb(mh,cdh) bind(c) result(res) @@ -241,7 +268,6 @@ contains return end function psb_c_sspasb - function psb_c_sspfree(mh,cdh) bind(c) result(res) implicit none diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 572eeb95..03827a3f 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -212,6 +212,33 @@ contains end function psb_c_zspall + function psb_c_zspall_remote(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_zspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer(psb_c_ipk_) :: info,n + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(mh%item)) then + return + end if + allocate(ap) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_zspall_remote function psb_c_zspasb(mh,cdh) bind(c) result(res) @@ -241,7 +268,6 @@ contains return end function psb_c_zspasb - function psb_c_zspfree(mh,cdh) bind(c) result(res) implicit none