psblas3-mcbind:

cbind/base/Makefile
 cbind/base/psb_c_comm_cbind_mod.f90
 cbind/base/psb_d_comm_cbind_mod.f90
 cbind/base/psb_s_comm_cbind_mod.f90
 cbind/base/psb_z_comm_cbind_mod.f90

Added COMM module.
psblas3-mcbind
Salvatore Filippone 8 years ago
parent baa173d4d4
commit 4ad85e75ab

@ -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

@ -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

@ -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

@ -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

@ -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
Loading…
Cancel
Save