diff --git a/cbind/base/Makefile b/cbind/base/Makefile index 9d6e9814..00a5f656 100644 --- a/cbind/base/Makefile +++ b/cbind/base/Makefile @@ -13,10 +13,13 @@ FOBJS= psb_objhandle_mod.o psb_base_cbind_mod.o psb_cpenv_mod.o \ psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o psb_s_psblas_cbind_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_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o psb_z_psblas_cbind_mod.o \ + psb_d_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 -CMOD=psb_base_cbind.h psb_c_base.h psb_c_sbase.h psb_c_dbase.h psb_c_cbase.h psb_c_zbase.h +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 +CMOD=psb_base_cbind.h psb_c_base.h psb_c_sbase.h psb_c_dbase.h psb_c_cbase.h psb_c_zbase.h \ + psb_c_dcomm.h OBJS=$(FOBJS) $(COBJS) LIBMOD=psb_base_cbind_mod$(.mod) psb_cpenv_mod$(.mod) psb_objhandle_mod$(.mod)\ @@ -24,7 +27,9 @@ LIBMOD=psb_base_cbind_mod$(.mod) psb_cpenv_mod$(.mod) psb_objhandle_mod$(.mod)\ psb_s_tools_cbind_mod$(.mod) psb_s_serial_cbind_mod$(.mod) psb_s_psblas_cbind_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_z_tools_cbind_mod$(.mod) psb_z_serial_cbind_mod$(.mod) psb_z_psblas_cbind_mod$(.mod) \ + psb_d_comm_cbind_mod$(.mod) + LOCAL_MODS=$(LIBMOD) LIBNAME=$(CBINDLIBNAME) @@ -41,7 +46,8 @@ psb_base_cbind_mod.o: psb_cpenv_mod.o psb_objhandle_mod.o psb_base_tools_cbind_m psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o psb_s_psblas_cbind_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_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o psb_z_psblas_cbind_mod.o \ + psb_d_comm_cbind_mod.o psb_base_tools_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o @@ -50,7 +56,8 @@ psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o \ psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o \ psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o \ psb_s_psblas_cbind_mod.o psb_d_psblas_cbind_mod.o \ -psb_c_psblas_cbind_mod.o psb_z_psblas_cbind_mod.o: psb_base_tools_cbind_mod.o psb_objhandle_mod.o psb_base_string_cbind_mod.o +psb_c_psblas_cbind_mod.o psb_z_psblas_cbind_mod.o \ +psb_d_comm_cbind_mod.o : psb_base_tools_cbind_mod.o psb_objhandle_mod.o psb_base_string_cbind_mod.o psb_base_psblas_cbind_mod.o: psb_s_psblas_cbind_mod.o psb_d_psblas_cbind_mod.o psb_c_psblas_cbind_mod.o psb_z_psblas_cbind_mod.o diff --git a/cbind/base/psb_c_dcomm.c b/cbind/base/psb_c_dcomm.c index b6d708df..2a700d18 100644 --- a/cbind/base/psb_c_dcomm.c +++ b/cbind/base/psb_c_dcomm.c @@ -1,4 +1,35 @@ #include #include "psb_c_dcomm.h" +#include +#include "psb_c_dbase.h" + + +psb_d_t* psb_c_dvgather(psb_c_dvector *xh, psb_c_descriptor *cdh) +{ + psb_d_t *temp=NULL; + psb_i_t vsize=0; + + if ((vsize=psb_c_cd_get_global_rows(cdh))<0) + return(temp); + + if (vsize==0) + vsize=1; + + if ((temp=(psb_d_t *)malloc(vsize*sizeof(psb_d_t)))!=NULL) + psb_c_dvgather_f(temp,xh,cdh); + + return(temp); + +} + + +psb_c_dspmat* psb_c_dspgather(psb_c_dspmat *ah, psb_c_descriptor *cdh) +{ + psb_c_dspmat* temp=psb_c_new_dspmat(); + + psb_c_dspgather_f(temp, ah, cdh); + return(temp); +} + diff --git a/cbind/base/psb_c_dcomm.h b/cbind/base/psb_c_dcomm.h index 9c906117..1c78b5a1 100644 --- a/cbind/base/psb_c_dcomm.h +++ b/cbind/base/psb_c_dcomm.h @@ -7,12 +7,18 @@ extern "C" { #endif psb_i_t psb_c_dhalo(psb_c_dvector *xh, psb_c_descriptor *cdh); - psb_i_t psb_c_dhalo_opt(psb_c_dvector *xh, psb_c_descriptor *cdh); + psb_i_t psb_c_dhalo_opt(psb_c_dvector *xh, psb_c_descriptor *cdh, + char *trans, psb_i_t mode); psb_i_t psb_c_dovrl(psb_c_dvector *xh, psb_c_descriptor *cdh); - psb_i_t psb_c_dovrl_opt(psb_c_dvector *xh, psb_c_descriptor *cdh); + psb_i_t psb_c_dovrl_opt(psb_c_dvector *xh, psb_c_descriptor *cdh, + psb_i_t update, psb_i_t mode); psb_i_t psb_c_dvscatter(psb_c_dvector *xh, psb_c_descriptor *cdh); + psb_d_t* psb_c_dvgather(psb_c_dvector *xh, psb_c_descriptor *cdh); psb_c_dspmat* psb_c_dspgather(psb_c_dspmat *ah, psb_c_descriptor *cdh); + + psb_i_t psb_c_dvgather_f(psb_d_t* gv, psb_c_dvector *xh, psb_c_descriptor *cdh); + psb_i_t psb_c_dspgather_f(psb_c_dspmat* ga, psb_c_dspmat *ah, psb_c_descriptor *cdh); #ifdef __cplusplus diff --git a/cbind/base/psb_d_comm_cbind.f90 b/cbind/base/psb_d_comm_cbind.f90 new file mode 100644 index 00000000..5caec196 --- /dev/null +++ b/cbind/base/psb_d_comm_cbind.f90 @@ -0,0 +1,74 @@ +module psb_d_comm_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + + function psb_c_dvgather_f(v,xh,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + real(c_double) :: v(*) + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_d_vect_type), pointer :: vp + real(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) + call psb_gather(fv,vp,descp,info) + res = info + if (res /=0) return + sz = size(fv) + v(1:sz) = fv(1:sz) + end if + end function psb_c_dvgather_f + + function psb_c_dspgather_f(gah,ah,cdh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_dspmat) :: ah, gah + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_dspmat_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_dspgather_f + + +end module psb_d_comm_cbind_mod +