From b664291532b15d92217f7915123a40c4311e317a Mon Sep 17 00:00:00 2001 From: cirdans-home Date: Fri, 1 Apr 2022 13:02:38 -0400 Subject: [PATCH] Added C interface for remote vector allocate --- cbind/base/psb_c_cbase.h | 1 + cbind/base/psb_c_dbase.h | 1 + cbind/base/psb_c_sbase.h | 1 + cbind/base/psb_c_tools_cbind_mod.F90 | 31 +++++++++++++++++++++++++++- cbind/base/psb_c_zbase.h | 1 + cbind/base/psb_d_tools_cbind_mod.F90 | 31 +++++++++++++++++++++++++++- cbind/base/psb_s_tools_cbind_mod.F90 | 31 +++++++++++++++++++++++++++- cbind/base/psb_z_tools_cbind_mod.F90 | 31 +++++++++++++++++++++++++++- 8 files changed, 124 insertions(+), 4 deletions(-) diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index 83b51b8b..bff9633a 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -24,6 +24,7 @@ psb_i_t psb_c_cvect_zero(psb_c_cvector *xh); psb_i_t *psb_c_cvect_f_get_pnt(psb_c_cvector *xh); psb_i_t psb_c_cgeall(psb_c_cvector *xh, psb_c_descriptor *cdh); +psb_i_t psb_c_cgeall_remote(psb_c_cvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_cgeins(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val, psb_c_cvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_cgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val, diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 8733dd46..591f885b 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -24,6 +24,7 @@ psb_i_t psb_c_dvect_zero(psb_c_dvector *xh); psb_d_t *psb_c_dvect_f_get_pnt( psb_c_dvector *xh); psb_i_t psb_c_dgeall(psb_c_dvector *xh, psb_c_descriptor *cdh); +psb_i_t psb_c_dgeall_remote(psb_c_dvector *xh, psb_c_descriptor *cdh); 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, diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index d3a88044..68abefdd 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -24,6 +24,7 @@ psb_i_t psb_c_svect_zero(psb_c_svector *xh); psb_s_t *psb_c_svect_f_get_pnt( psb_c_svector *xh); psb_i_t psb_c_sgeall(psb_c_svector *xh, psb_c_descriptor *cdh); +psb_i_t psb_c_sgeall_remote(psb_c_svector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_sgeins(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val, psb_c_svector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_sgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val, diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index 8346dc14..8f64cbb0 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -38,6 +38,35 @@ contains return end function psb_c_cgeall + function psb_c_cgeall_remote(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer(psb_c_ipk_) :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_cgeall_remote + function psb_c_cgeasb(xh,cdh) bind(c) result(res) implicit none @@ -193,7 +222,7 @@ contains return end if allocate(ap) - call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) mh%item = c_loc(ap) res = min(0,info) diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index ce2c5d3e..9a27e9c0 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -24,6 +24,7 @@ psb_i_t psb_c_zvect_zero(psb_c_zvector *xh); psb_z_t *psb_c_zvect_f_get_pnt( psb_c_zvector *xh); psb_i_t psb_c_zgeall(psb_c_zvector *xh, psb_c_descriptor *cdh); +psb_i_t psb_c_zgeall_remote(psb_c_zvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_zgeins(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val, psb_c_zvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_zgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val, diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index eb42dcb3..67ae8b86 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -38,6 +38,35 @@ contains return end function psb_c_dgeall + function psb_c_dgeall_remote(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_d_vect_type), pointer :: xp + integer(psb_c_ipk_) :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_dgeall_remote + function psb_c_dgeasb(xh,cdh) bind(c) result(res) implicit none @@ -193,7 +222,7 @@ contains return end if allocate(ap) - call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) mh%item = c_loc(ap) res = min(0,info) diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index fc3e57f0..91d9b322 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -38,6 +38,35 @@ contains return end function psb_c_sgeall + function psb_c_sgeall_remote(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer(psb_c_ipk_) :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_sgeall_remote + function psb_c_sgeasb(xh,cdh) bind(c) result(res) implicit none @@ -193,7 +222,7 @@ contains return end if allocate(ap) - call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) mh%item = c_loc(ap) res = min(0,info) diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 13cdf3c1..59d4cca8 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -38,6 +38,35 @@ contains return end function psb_c_zgeall + function psb_c_zgeall_remote(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_ipk_) :: res + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer(psb_c_ipk_) :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_zgeall_remote + function psb_c_zgeasb(xh,cdh) bind(c) result(res) implicit none @@ -193,7 +222,7 @@ contains return end if allocate(ap) - call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_) + call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_,dupl=psb_dupl_add_) mh%item = c_loc(ap) res = min(0,info)