diff --git a/cbind/base/Makefile b/cbind/base/Makefile index 00a5f656..88eb30a0 100644 --- a/cbind/base/Makefile +++ b/cbind/base/Makefile @@ -14,7 +14,8 @@ FOBJS= psb_objhandle_mod.o psb_base_cbind_mod.o psb_cpenv_mod.o \ psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o \ psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o psb_c_psblas_cbind_mod.o \ psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o psb_z_psblas_cbind_mod.o \ - psb_d_comm_cbind_mod.o + psb_s_comm_cbind_mod.o psb_d_comm_cbind_mod.o \ + psb_c_comm_cbind_mod.o psb_z_comm_cbind_mod.o COBJS= psb_c_base.o psb_c_sbase.o psb_c_dbase.o psb_c_cbase.o psb_c_zbase.o \ psb_c_dcomm.o @@ -28,7 +29,8 @@ LIBMOD=psb_base_cbind_mod$(.mod) psb_cpenv_mod$(.mod) psb_objhandle_mod$(.mod)\ psb_d_tools_cbind_mod$(.mod) psb_d_serial_cbind_mod$(.mod) psb_d_psblas_cbind_mod$(.mod) \ psb_c_tools_cbind_mod$(.mod) psb_c_serial_cbind_mod$(.mod) psb_c_psblas_cbind_mod$(.mod) \ psb_z_tools_cbind_mod$(.mod) psb_z_serial_cbind_mod$(.mod) psb_z_psblas_cbind_mod$(.mod) \ - psb_d_comm_cbind_mod$(.mod) + psb_s_comm_cbind_mod$(.mod) psb_d_comm_cbind_mod$(.mod) \ + psb_c_comm_cbind_mod$(.mod) psb_z_comm_cbind_mod$(.mod) LOCAL_MODS=$(LIBMOD) LIBNAME=$(CBINDLIBNAME) @@ -47,7 +49,8 @@ psb_base_cbind_mod.o: psb_cpenv_mod.o psb_objhandle_mod.o psb_base_tools_cbind_m psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o \ psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o psb_c_psblas_cbind_mod.o \ psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o psb_z_psblas_cbind_mod.o \ - psb_d_comm_cbind_mod.o + psb_s_comm_cbind_mod.o psb_d_comm_cbind_mod.o \ + psb_c_comm_cbind_mod.o psb_z_comm_cbind_mod.o psb_base_tools_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o diff --git a/cbind/base/psb_c_comm_cbind_mod.f90 b/cbind/base/psb_c_comm_cbind_mod.f90 new file mode 100644 index 00000000..1c6e4944 --- /dev/null +++ b/cbind/base/psb_c_comm_cbind_mod.f90 @@ -0,0 +1,239 @@ +module psb_c_comm_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + +contains + + function psb_c_c_ovrl(xh,cdh) bind(c) result(res) + implicit none + integer(psb_c_int) :: 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 :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_ovrl(xp,descp,info) + + res = info + + end function psb_c_c_ovrl + + function psb_c_c_ovrl_opt(xh,cdh,update,mode) bind(c) result(res) + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: update, mode + + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_ovrl(xp,descp,info,update=update,mode=mode) + + res = info + + end function psb_c_c_ovrl_opt + + + function psb_c_c_halo(xh,cdh) bind(c) result(res) + implicit none + integer(psb_c_int) :: 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 :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_halo(xp,descp,info) + + res = info + + end function psb_c_c_halo + + function psb_c_c_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res) + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: data, mode + character(c_char) :: tran + + + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + character :: ftrans + integer :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + ftrans = trans + call psb_halo(xp,descp,info,data=data,mode=mode,tran=tran) + + res = info + + end function psb_c_c_halo_opt + + + function psb_c_c_vscatter(ng,gx,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + integer(psb_c_int), value :: ng + complex(c_float_complex), target :: gx(*) + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: vp + complex(psb_spk_), pointer :: pgx(:) + integer :: info, sz + + 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 + call c_f_pointer(xh%item,vp) + else + return + end if + + pgx => gx(1:ng) + + call psb_scatter(pgx,vp,descp,info) + res = info + + end function psb_c_c_vscatter + + function psb_c_cvgather(v,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + complex(c_float_complex), target :: v(*) + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: vp + complex(psb_spk_), allocatable :: fv(:) + integer :: info, sz + + 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 + call c_f_pointer(xh%item,vp) + else + return + end if + + call psb_gather(fv,vp,descp,info) + res = info + if (res /=0) return + sz = size(fv) + v(1:sz) = fv(1:sz) + end function psb_c_cvgather + + function psb_c_cspgather(gah,ah,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_cspmat) :: ah, gah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap, gap + integer :: info, sz + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + if (c_associated(gah%item)) then + call c_f_pointer(gah%item,gap) + else + return + end if + call psb_gather(gap,ap,descp,info) + res = info + end function psb_c_cspgather + +end module psb_c_comm_cbind_mod diff --git a/cbind/base/psb_d_comm_cbind_mod.f90 b/cbind/base/psb_d_comm_cbind_mod.f90 index 895074e2..ece954b1 100644 --- a/cbind/base/psb_d_comm_cbind_mod.f90 +++ b/cbind/base/psb_d_comm_cbind_mod.f90 @@ -3,21 +3,20 @@ module psb_d_comm_cbind_mod use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod - use psb_base_tools_cbind_mod - + contains - - function psb_c_dhalo(xh,cdh) bind(c) result(res) + function psb_c_d_ovrl(xh,cdh) bind(c) result(res) implicit none + integer(psb_c_int) :: res - integer(psb_c_int) :: res type(psb_c_dvector) :: xh type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp - type(psb_d_vect_type), pointer :: vp - integer :: info, sz + type(psb_d_vect_type), pointer :: xp + integer :: info + res = -1 @@ -27,27 +26,29 @@ contains return end if if (c_associated(xh%item)) then - call c_f_pointer(xh%item,vp) - call psb_halo(vp,descp,info) - res = info + call c_f_pointer(xh%item,xp) + else + return end if - - end function psb_c_dhalo - - function psb_c_dhalo_opt(xh,cdh,trans,mode) bind(c) result(res) + + call psb_ovrl(xp,descp,info) + + res = info + + end function psb_c_d_ovrl + + function psb_c_d_ovrl_opt(xh,cdh,update,mode) bind(c) result(res) implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: update, mode - integer(psb_c_int) :: res type(psb_c_dvector) :: xh type(psb_c_descriptor) :: cdh - character(c_char) :: trans - integer(psb_c_int), value :: mode type(psb_desc_type), pointer :: descp - type(psb_d_vect_type), pointer :: vp - character :: trans_ - integer(psb_ipk_) :: mode_ - integer :: info, sz + type(psb_d_vect_type), pointer :: xp + integer :: info + res = -1 @@ -56,26 +57,30 @@ contains else return end if - trans_ = trans - mode_ = mode if (c_associated(xh%item)) then - call c_f_pointer(xh%item,vp) - call psb_halo(vp,descp,info,tran=trans_, mode=mode_) - res = info + call c_f_pointer(xh%item,xp) + else + return end if - - end function psb_c_dhalo_opt - - function psb_c_dovrl(xh,cdh) bind(c) result(res) + + call psb_ovrl(xp,descp,info,update=update,mode=mode) + + res = info + + end function psb_c_d_ovrl_opt + + + function psb_c_d_halo(xh,cdh) bind(c) result(res) implicit none + integer(psb_c_int) :: res - integer(psb_c_int) :: res type(psb_c_dvector) :: xh type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp - type(psb_d_vect_type), pointer :: vp - integer :: info, sz + type(psb_d_vect_type), pointer :: xp + integer :: info + res = -1 @@ -85,25 +90,32 @@ contains return end if if (c_associated(xh%item)) then - call c_f_pointer(xh%item,vp) - call psb_ovrl(vp,descp,info) - res = info + call c_f_pointer(xh%item,xp) + else + return end if - - end function psb_c_dovrl - - function psb_c_dovrl_opt(xh,cdh,update,mode) bind(c) result(res) + + call psb_halo(xp,descp,info) + + res = info + + end function psb_c_d_halo + + function psb_c_d_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res) implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: data, mode + character(c_char) :: tran + - integer(psb_c_int) :: res type(psb_c_dvector) :: xh type(psb_c_descriptor) :: cdh - integer(psb_c_int), value :: update, mode type(psb_desc_type), pointer :: descp - type(psb_d_vect_type), pointer :: vp - integer(psb_ipk_) :: mode_, update_ - integer :: info, sz + type(psb_d_vect_type), pointer :: xp + character :: ftrans + integer :: info + res = -1 @@ -112,17 +124,21 @@ contains else return end if - update_ = update - mode_ = mode if (c_associated(xh%item)) then - call c_f_pointer(xh%item,vp) - call psb_ovrl(vp,descp,info,update=update_,mode=mode_) - res = info + call c_f_pointer(xh%item,xp) + else + return end if + + ftrans = trans + call psb_halo(xp,descp,info,data=data,mode=mode,tran=tran) + + res = info - end function psb_c_dovrl_opt + end function psb_c_d_halo_opt + - function psb_c_dvscatter(ng,gx,xh,cdh) bind(c) result(res) + function psb_c_d_vscatter(ng,gx,xh,cdh) bind(c) result(res) implicit none integer(psb_c_int) :: res @@ -154,13 +170,13 @@ contains call psb_scatter(pgx,vp,descp,info) res = info - end function psb_c_dvscatter + end function psb_c_d_vscatter - function psb_c_dvgather_f(v,xh,cdh) bind(c) result(res) + function psb_c_dvgather(v,xh,cdh) bind(c) result(res) implicit none integer(psb_c_int) :: res - real(c_double) :: v(*) + real(c_double), target :: v(*) type(psb_c_dvector) :: xh type(psb_c_descriptor) :: cdh @@ -178,15 +194,18 @@ contains end if if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) - call psb_gather(fv,vp,descp,info) - res = info - if (res /=0) return - sz = size(fv) - v(1:sz) = fv(1:sz) + else + return end if - end function psb_c_dvgather_f + + call psb_gather(fv,vp,descp,info) + res = info + if (res /=0) return + sz = size(fv) + v(1:sz) = fv(1:sz) + end function psb_c_dvgather - function psb_c_dspgather_f(gah,ah,cdh) bind(c) result(res) + function psb_c_dspgather(gah,ah,cdh) bind(c) result(res) implicit none integer(psb_c_int) :: res @@ -215,8 +234,6 @@ contains end if call psb_gather(gap,ap,descp,info) res = info - end function psb_c_dspgather_f - - + end function psb_c_dspgather + end module psb_d_comm_cbind_mod - diff --git a/cbind/base/psb_s_comm_cbind_mod.f90 b/cbind/base/psb_s_comm_cbind_mod.f90 new file mode 100644 index 00000000..0fc3da6b --- /dev/null +++ b/cbind/base/psb_s_comm_cbind_mod.f90 @@ -0,0 +1,239 @@ +module psb_s_comm_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + +contains + + function psb_c_s_ovrl(xh,cdh) bind(c) result(res) + implicit none + integer(psb_c_int) :: 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 :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_ovrl(xp,descp,info) + + res = info + + end function psb_c_s_ovrl + + function psb_c_s_ovrl_opt(xh,cdh,update,mode) bind(c) result(res) + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: update, mode + + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_ovrl(xp,descp,info,update=update,mode=mode) + + res = info + + end function psb_c_s_ovrl_opt + + + function psb_c_s_halo(xh,cdh) bind(c) result(res) + implicit none + integer(psb_c_int) :: 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 :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_halo(xp,descp,info) + + res = info + + end function psb_c_s_halo + + function psb_c_s_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res) + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: data, mode + character(c_char) :: tran + + + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + character :: ftrans + integer :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + ftrans = trans + call psb_halo(xp,descp,info,data=data,mode=mode,tran=tran) + + res = info + + end function psb_c_s_halo_opt + + + function psb_c_s_vscatter(ng,gx,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + integer(psb_c_int), value :: ng + real(c_float), target :: gx(*) + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: vp + real(psb_spk_), pointer :: pgx(:) + integer :: info, sz + + 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 + call c_f_pointer(xh%item,vp) + else + return + end if + + pgx => gx(1:ng) + + call psb_scatter(pgx,vp,descp,info) + res = info + + end function psb_c_s_vscatter + + function psb_c_svgather(v,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + real(c_float), target :: v(*) + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: vp + real(psb_spk_), allocatable :: fv(:) + integer :: info, sz + + 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 + call c_f_pointer(xh%item,vp) + else + return + end if + + call psb_gather(fv,vp,descp,info) + res = info + if (res /=0) return + sz = size(fv) + v(1:sz) = fv(1:sz) + end function psb_c_svgather + + function psb_c_sspgather(gah,ah,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_sspmat) :: ah, gah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap, gap + integer :: info, sz + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + if (c_associated(gah%item)) then + call c_f_pointer(gah%item,gap) + else + return + end if + call psb_gather(gap,ap,descp,info) + res = info + end function psb_c_sspgather + +end module psb_s_comm_cbind_mod diff --git a/cbind/base/psb_z_comm_cbind_mod.f90 b/cbind/base/psb_z_comm_cbind_mod.f90 new file mode 100644 index 00000000..6b43dd67 --- /dev/null +++ b/cbind/base/psb_z_comm_cbind_mod.f90 @@ -0,0 +1,239 @@ +module psb_z_comm_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + +contains + + function psb_c_z_ovrl(xh,cdh) bind(c) result(res) + implicit none + integer(psb_c_int) :: 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 :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_ovrl(xp,descp,info) + + res = info + + end function psb_c_z_ovrl + + function psb_c_z_ovrl_opt(xh,cdh,update,mode) bind(c) result(res) + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: update, mode + + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_ovrl(xp,descp,info,update=update,mode=mode) + + res = info + + end function psb_c_z_ovrl_opt + + + function psb_c_z_halo(xh,cdh) bind(c) result(res) + implicit none + integer(psb_c_int) :: 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 :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_halo(xp,descp,info) + + res = info + + end function psb_c_z_halo + + function psb_c_z_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res) + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: data, mode + character(c_char) :: tran + + + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + character :: ftrans + integer :: 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 + call c_f_pointer(xh%item,xp) + else + return + end if + + ftrans = trans + call psb_halo(xp,descp,info,data=data,mode=mode,tran=tran) + + res = info + + end function psb_c_z_halo_opt + + + function psb_c_z_vscatter(ng,gx,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + integer(psb_c_int), value :: ng + complex(c_double_complex), target :: gx(*) + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: vp + complex(psb_dpk_), pointer :: pgx(:) + integer :: info, sz + + 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 + call c_f_pointer(xh%item,vp) + else + return + end if + + pgx => gx(1:ng) + + call psb_scatter(pgx,vp,descp,info) + res = info + + end function psb_c_z_vscatter + + function psb_c_zvgather(v,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + complex(c_double_complex), target :: v(*) + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: vp + complex(psb_dpk_), allocatable :: fv(:) + integer :: info, sz + + 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 + call c_f_pointer(xh%item,vp) + else + return + end if + + call psb_gather(fv,vp,descp,info) + res = info + if (res /=0) return + sz = size(fv) + v(1:sz) = fv(1:sz) + end function psb_c_zvgather + + function psb_c_zspgather(gah,ah,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_zspmat) :: ah, gah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap, gap + integer :: info, sz + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + if (c_associated(gah%item)) then + call c_f_pointer(gah%item,gap) + else + return + end if + call psb_gather(gap,ap,descp,info) + res = info + end function psb_c_zspgather + +end module psb_z_comm_cbind_mod