fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3-mcbind:

Browse Source 
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 9 years ago
parent baa173d4d4
commit 4ad85e75ab
5 changed files with 806 additions and 69 deletions
Show Stats Download Patch File Download Diff File

9
cbind/base/Makefile
Unescape Escape View File

@ -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_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_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_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 \ 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 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_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_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) 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) LOCAL_MODS=$(LIBMOD)
LIBNAME=$(CBINDLIBNAME) 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_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_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_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 psb_base_tools_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o

239
cbind/base/psb_c_comm_cbind_mod.f90
Unescape Escape View File

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

149
cbind/base/psb_d_comm_cbind_mod.f90
Unescape Escape View File

@ -3,21 +3,20 @@ module psb_d_comm_cbind_mod
use psb_base_mod use psb_base_mod
use psb_objhandle_mod use psb_objhandle_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
use psb_base_tools_cbind_mod
contains contains
function psb_c_d_ovrl(xh,cdh) bind(c) result(res)
function psb_c_dhalo(xh,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_int) :: res
integer(psb_c_int) :: res
type(psb_c_dvector) :: xh type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: vp type(psb_d_vect_type), pointer :: xp
integer :: info, sz integer :: info
res = -1 res = -1
@ -27,27 +26,29 @@ contains
return return
end if end if
if (c_associated(xh%item)) then if (c_associated(xh%item)) then
call c_f_pointer(xh%item,vp) call c_f_pointer(xh%item,xp)
call psb_halo(vp,descp,info) else
res = info return
end if end if
end function psb_c_dhalo call psb_ovrl(xp,descp,info)
function psb_c_dhalo_opt(xh,cdh,trans,mode) bind(c) result(res) res = info
end function psb_c_d_ovrl
function psb_c_d_ovrl_opt(xh,cdh,update,mode) bind(c) result(res)
implicit none 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_dvector) :: xh
type(psb_c_descriptor) :: cdh type(psb_c_descriptor) :: cdh
character(c_char) :: trans
integer(psb_c_int), value :: mode
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: vp type(psb_d_vect_type), pointer :: xp
character :: trans_ integer :: info
integer(psb_ipk_) :: mode_
integer :: info, sz
res = -1 res = -1
@ -56,26 +57,30 @@ contains
else else
return return
end if end if
trans_ = trans
mode_ = mode
if (c_associated(xh%item)) then if (c_associated(xh%item)) then
call c_f_pointer(xh%item,vp) call c_f_pointer(xh%item,xp)
call psb_halo(vp,descp,info,tran=trans_, mode=mode_) else
res = info return
end if end if
end function psb_c_dhalo_opt call psb_ovrl(xp,descp,info,update=update,mode=mode)
function psb_c_dovrl(xh,cdh) bind(c) result(res) res = info
end function psb_c_d_ovrl_opt
function psb_c_d_halo(xh,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_int) :: res
integer(psb_c_int) :: res
type(psb_c_dvector) :: xh type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: vp type(psb_d_vect_type), pointer :: xp
integer :: info, sz integer :: info
res = -1 res = -1
@ -85,25 +90,32 @@ contains
return return
end if end if
if (c_associated(xh%item)) then if (c_associated(xh%item)) then
call c_f_pointer(xh%item,vp) call c_f_pointer(xh%item,xp)
call psb_ovrl(vp,descp,info) else
res = info return
end if end if
end function psb_c_dovrl call psb_halo(xp,descp,info)
function psb_c_dovrl_opt(xh,cdh,update,mode) bind(c) result(res) 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 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_dvector) :: xh
type(psb_c_descriptor) :: cdh type(psb_c_descriptor) :: cdh
integer(psb_c_int), value :: update, mode
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: vp type(psb_d_vect_type), pointer :: xp
integer(psb_ipk_) :: mode_, update_ character :: ftrans
integer :: info, sz integer :: info
res = -1 res = -1
@ -112,17 +124,21 @@ contains
else else
return return
end if end if
update_ = update
mode_ = mode
if (c_associated(xh%item)) then if (c_associated(xh%item)) then
call c_f_pointer(xh%item,vp) call c_f_pointer(xh%item,xp)
call psb_ovrl(vp,descp,info,update=update_,mode=mode_) else
res = info return
end if 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 implicit none
integer(psb_c_int) :: res integer(psb_c_int) :: res
@ -154,13 +170,13 @@ contains
call psb_scatter(pgx,vp,descp,info) call psb_scatter(pgx,vp,descp,info)
res = 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 implicit none
integer(psb_c_int) :: res integer(psb_c_int) :: res
real(c_double) :: v(*) real(c_double), target :: v(*)
type(psb_c_dvector) :: xh type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh type(psb_c_descriptor) :: cdh
@ -178,15 +194,18 @@ contains
end if end if
if (c_associated(xh%item)) then if (c_associated(xh%item)) then
call c_f_pointer(xh%item,vp) call c_f_pointer(xh%item,vp)
call psb_gather(fv,vp,descp,info) else
res = info return
if (res /=0) return
sz = size(fv)
v(1:sz) = fv(1:sz)
end if 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 implicit none
integer(psb_c_int) :: res integer(psb_c_int) :: res
@ -215,8 +234,6 @@ contains
end if end if
call psb_gather(gap,ap,descp,info) call psb_gather(gap,ap,descp,info)
res = info res = info
end function psb_c_dspgather_f end function psb_c_dspgather
end module psb_d_comm_cbind_mod end module psb_d_comm_cbind_mod

239
cbind/base/psb_s_comm_cbind_mod.f90
Unescape Escape View File

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

239
cbind/base/psb_z_comm_cbind_mod.f90
Unescape Escape View File

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