psblas3-mcbind:
cbind/base/Makefile cbind/base/psb_c_dbase.c cbind/base/psb_c_psblas_cbind_mod.f90 cbind/base/psb_c_serial_cbind_mod.F90 cbind/base/psb_c_tools_cbind_mod.F90 cbind/base/psb_d_psblas_cbind_mod.f90 cbind/base/psb_d_serial_cbind_mod.F90 cbind/base/psb_d_tools_cbind_mod.F90 cbind/base/psb_objhandle_mod.F90 cbind/base/psb_s_psblas_cbind_mod.f90 cbind/base/psb_s_serial_cbind_mod.F90 cbind/base/psb_s_tools_cbind_mod.F90 cbind/base/psb_z_psblas_cbind_mod.f90 cbind/base/psb_z_serial_cbind_mod.F90 cbind/base/psb_z_tools_cbind_mod.F90 New bindings for S/C/D/Z, base routines.psblas3-mcbind
Salvatore Filippone
8 years ago
parent
8471f213be
commit
d536410cbe
@ -0,0 +1,289 @@
|
||||
module psb_c_psblas_cbind_mod
|
||||
use iso_c_binding
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_cgeaxpby(alpha,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_cvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_float_complex), value :: alpha,beta
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp,yp
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_geaxpby(alpha,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_cgeaxpby
|
||||
|
||||
function psb_c_cgenrm2(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float_complex) :: 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.0
|
||||
|
||||
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
|
||||
|
||||
res = psb_genrm2(xp,descp,info)
|
||||
|
||||
end function psb_c_cgenrm2
|
||||
|
||||
function psb_c_cgeamax(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float_complex) :: 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.0
|
||||
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
|
||||
|
||||
res = psb_geamax(xp,descp,info)
|
||||
|
||||
end function psb_c_cgeamax
|
||||
|
||||
function psb_c_cgeasum(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float_complex) :: 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.0
|
||||
|
||||
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
|
||||
|
||||
res = psb_geasum(xp,descp,info)
|
||||
|
||||
end function psb_c_cgeasum
|
||||
|
||||
|
||||
function psb_c_cspnrmi(ah,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float_complex) :: res
|
||||
|
||||
type(psb_c_cspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = -1.0
|
||||
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
|
||||
|
||||
res = psb_spnrmi(ap,descp,info)
|
||||
|
||||
end function psb_c_cspnrmi
|
||||
|
||||
function psb_c_cgedot(xh,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
complex(c_float_complex) :: res
|
||||
|
||||
type(psb_c_cvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp,yp
|
||||
integer :: info
|
||||
|
||||
res = -1.0
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
res = psb_gedot(xp,yp,descp,info)
|
||||
|
||||
end function psb_c_cgedot
|
||||
|
||||
|
||||
function psb_c_cspmm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_cspmat) :: ah
|
||||
type(psb_c_cvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_float_complex), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp,yp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_cspmm
|
||||
|
||||
|
||||
function psb_c_cspsm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_cspmat) :: ah
|
||||
type(psb_c_cvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_float_complex), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp,yp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spsm(alpha,ap,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_cspsm
|
||||
|
||||
|
||||
end module psb_c_psblas_cbind_mod
|
||||
@ -0,0 +1,119 @@
|
||||
module psb_c_serial_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_cvect_get_nrows(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_cvector) :: xh
|
||||
|
||||
type(psb_c_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
res = vp%get_nrows()
|
||||
end if
|
||||
|
||||
end function psb_c_cvect_get_nrows
|
||||
|
||||
function psb_c_cvect_f_get_cpy(v,xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
complex(c_float_complex) :: v(*)
|
||||
type(psb_c_cvector) :: xh
|
||||
|
||||
type(psb_c_vect_type), pointer :: vp
|
||||
complex(psb_spk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
fv = vp%get_vect()
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end if
|
||||
|
||||
end function psb_c_cvect_f_get_cpy
|
||||
|
||||
|
||||
function psb_c_cvect_zero(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_cvector) :: xh
|
||||
|
||||
type(psb_c_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
call vp%zero()
|
||||
end if
|
||||
|
||||
end function psb_c_cvect_zero
|
||||
|
||||
|
||||
function psb_c_cmat_get_nrows(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = ap%get_nrows()
|
||||
|
||||
end function psb_c_cmat_get_nrows
|
||||
|
||||
|
||||
function psb_c_cmat_get_ncols(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = ap%get_ncols()
|
||||
|
||||
end function psb_c_cmat_get_ncols
|
||||
|
||||
|
||||
|
||||
end module psb_c_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,385 @@
|
||||
module psb_c_tools_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_cgeall(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
|
||||
return
|
||||
end if
|
||||
allocate(xp)
|
||||
call psb_geall(xp,descp,info)
|
||||
xh%item = c_loc(xp)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cgeall
|
||||
|
||||
function psb_c_cgeasb(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_geasb(xp,descp,info)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cgeasb
|
||||
|
||||
function psb_c_cgefree(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_gefree(xp,descp,info)
|
||||
res = min(0,info)
|
||||
xh%item = c_null_ptr
|
||||
|
||||
return
|
||||
end function psb_c_cgefree
|
||||
|
||||
|
||||
function psb_c_cgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
complex(c_float_complex) :: val(*)
|
||||
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_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cgeins
|
||||
|
||||
|
||||
function psb_c_cgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
complex(c_float_complex) :: val(*)
|
||||
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_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cgeins_add
|
||||
|
||||
|
||||
function psb_c_cspall(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
return
|
||||
end if
|
||||
allocate(ap)
|
||||
call psb_spall(ap,descp,info)
|
||||
mh%item = c_loc(ap)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cspall
|
||||
|
||||
|
||||
|
||||
function psb_c_cspasb(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spasb(ap,descp,info)
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_cspasb
|
||||
|
||||
|
||||
function psb_c_cspfree(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spfree(ap,descp,info)
|
||||
res = min(0,info)
|
||||
mh%item=c_null_ptr
|
||||
return
|
||||
end function psb_c_cspfree
|
||||
|
||||
|
||||
#if 0
|
||||
|
||||
function psb_c_cspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
|
||||
|
||||
#ifdef HAVE_LIBRSB
|
||||
use psb_c_rsb_mat_mod
|
||||
#endif
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: cdh, mh,upd,dupl
|
||||
character(c_char) :: afmt(*)
|
||||
integer :: info,n, fdupl
|
||||
character(len=5) :: fafmt
|
||||
#ifdef HAVE_LIBRSB
|
||||
type(psb_c_rsb_sparse_mat) :: arsb
|
||||
#endif
|
||||
|
||||
res = -1
|
||||
call psb_check_descriptor_handle(cdh,info)
|
||||
if (info < 0) return
|
||||
call psb_check_double_spmat_handle(mh,info)
|
||||
if (info < 0) return
|
||||
|
||||
call stringc2f(afmt,fafmt)
|
||||
select case(fafmt)
|
||||
#ifdef HAVE_LIBRSB
|
||||
case('RSB')
|
||||
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
|
||||
& upd=upd,dupl=dupl,mold=arsb)
|
||||
#endif
|
||||
case default
|
||||
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
|
||||
& afmt=fafmt,upd=upd,dupl=dupl)
|
||||
end select
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cspasb_opt
|
||||
#endif
|
||||
|
||||
function psb_c_cspins(nz,irw,icl,val,mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*), icl(*)
|
||||
complex(c_float_complex) :: val(*)
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_cspins
|
||||
|
||||
|
||||
function psb_c_csprn(mh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
logical(c_bool), value :: clear
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call psb_sprn(ap,descp,info,clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_csprn
|
||||
!!$
|
||||
!!$ function psb_c_cspprint(mh) bind(c) result(res)
|
||||
!!$
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_c_int) :: res
|
||||
!!$ integer(psb_c_int), value :: mh
|
||||
!!$ integer :: info
|
||||
!!$
|
||||
!!$
|
||||
!!$ res = -1
|
||||
!!$ call psb_check_double_spmat_handle(mh,info)
|
||||
!!$ if (info < 0) return
|
||||
!!$
|
||||
!!$ call psb_csprt(0,double_spmat_pool(mh)%item,head='Debug mat')
|
||||
!!$
|
||||
!!$ res = 0
|
||||
!!$
|
||||
!!$ return
|
||||
!!$ end function psb_c_cspprint
|
||||
|
||||
|
||||
end module psb_c_tools_cbind_mod
|
||||
|
||||
@ -0,0 +1,289 @@
|
||||
module psb_s_psblas_cbind_mod
|
||||
use iso_c_binding
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_sgeaxpby(alpha,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_svector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_float), value :: alpha,beta
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp,yp
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_geaxpby(alpha,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_sgeaxpby
|
||||
|
||||
function psb_c_sgenrm2(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float) :: 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.0
|
||||
|
||||
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
|
||||
|
||||
res = psb_genrm2(xp,descp,info)
|
||||
|
||||
end function psb_c_sgenrm2
|
||||
|
||||
function psb_c_sgeamax(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float) :: 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.0
|
||||
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
|
||||
|
||||
res = psb_geamax(xp,descp,info)
|
||||
|
||||
end function psb_c_sgeamax
|
||||
|
||||
function psb_c_sgeasum(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float) :: 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.0
|
||||
|
||||
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
|
||||
|
||||
res = psb_geasum(xp,descp,info)
|
||||
|
||||
end function psb_c_sgeasum
|
||||
|
||||
|
||||
function psb_c_sspnrmi(ah,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float) :: res
|
||||
|
||||
type(psb_c_sspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = -1.0
|
||||
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
|
||||
|
||||
res = psb_spnrmi(ap,descp,info)
|
||||
|
||||
end function psb_c_sspnrmi
|
||||
|
||||
function psb_c_sgedot(xh,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_float) :: res
|
||||
|
||||
type(psb_c_svector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp,yp
|
||||
integer :: info
|
||||
|
||||
res = -1.0
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
res = psb_gedot(xp,yp,descp,info)
|
||||
|
||||
end function psb_c_sgedot
|
||||
|
||||
|
||||
function psb_c_sspmm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_sspmat) :: ah
|
||||
type(psb_c_svector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_float), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp,yp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_sspmm
|
||||
|
||||
|
||||
function psb_c_sspsm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_sspmat) :: ah
|
||||
type(psb_c_svector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_float), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp,yp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spsm(alpha,ap,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_sspsm
|
||||
|
||||
|
||||
end module psb_s_psblas_cbind_mod
|
||||
@ -0,0 +1,119 @@
|
||||
module psb_s_serial_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_svect_get_nrows(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_svector) :: xh
|
||||
|
||||
type(psb_s_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
res = vp%get_nrows()
|
||||
end if
|
||||
|
||||
end function psb_c_svect_get_nrows
|
||||
|
||||
function psb_c_svect_f_get_cpy(v,xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
real(c_float) :: v(*)
|
||||
type(psb_c_svector) :: xh
|
||||
|
||||
type(psb_s_vect_type), pointer :: vp
|
||||
real(psb_spk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
fv = vp%get_vect()
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end if
|
||||
|
||||
end function psb_c_svect_f_get_cpy
|
||||
|
||||
|
||||
function psb_c_svect_zero(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_svector) :: xh
|
||||
|
||||
type(psb_s_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
call vp%zero()
|
||||
end if
|
||||
|
||||
end function psb_c_svect_zero
|
||||
|
||||
|
||||
function psb_c_smat_get_nrows(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = ap%get_nrows()
|
||||
|
||||
end function psb_c_smat_get_nrows
|
||||
|
||||
|
||||
function psb_c_smat_get_ncols(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = ap%get_ncols()
|
||||
|
||||
end function psb_c_smat_get_ncols
|
||||
|
||||
|
||||
|
||||
end module psb_s_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,385 @@
|
||||
module psb_s_tools_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_sgeall(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
|
||||
return
|
||||
end if
|
||||
allocate(xp)
|
||||
call psb_geall(xp,descp,info)
|
||||
xh%item = c_loc(xp)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sgeall
|
||||
|
||||
function psb_c_sgeasb(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_geasb(xp,descp,info)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sgeasb
|
||||
|
||||
function psb_c_sgefree(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_gefree(xp,descp,info)
|
||||
res = min(0,info)
|
||||
xh%item = c_null_ptr
|
||||
|
||||
return
|
||||
end function psb_c_sgefree
|
||||
|
||||
|
||||
function psb_c_sgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
real(c_float) :: val(*)
|
||||
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_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sgeins
|
||||
|
||||
|
||||
function psb_c_sgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
real(c_float) :: val(*)
|
||||
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_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sgeins_add
|
||||
|
||||
|
||||
function psb_c_sspall(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
return
|
||||
end if
|
||||
allocate(ap)
|
||||
call psb_spall(ap,descp,info)
|
||||
mh%item = c_loc(ap)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sspall
|
||||
|
||||
|
||||
|
||||
function psb_c_sspasb(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spasb(ap,descp,info)
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_sspasb
|
||||
|
||||
|
||||
function psb_c_sspfree(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spfree(ap,descp,info)
|
||||
res = min(0,info)
|
||||
mh%item=c_null_ptr
|
||||
return
|
||||
end function psb_c_sspfree
|
||||
|
||||
|
||||
#if 0
|
||||
|
||||
function psb_c_sspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
|
||||
|
||||
#ifdef HAVE_LIBRSB
|
||||
use psb_s_rsb_mat_mod
|
||||
#endif
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: cdh, mh,upd,dupl
|
||||
character(c_char) :: afmt(*)
|
||||
integer :: info,n, fdupl
|
||||
character(len=5) :: fafmt
|
||||
#ifdef HAVE_LIBRSB
|
||||
type(psb_s_rsb_sparse_mat) :: arsb
|
||||
#endif
|
||||
|
||||
res = -1
|
||||
call psb_check_descriptor_handle(cdh,info)
|
||||
if (info < 0) return
|
||||
call psb_check_double_spmat_handle(mh,info)
|
||||
if (info < 0) return
|
||||
|
||||
call stringc2f(afmt,fafmt)
|
||||
select case(fafmt)
|
||||
#ifdef HAVE_LIBRSB
|
||||
case('RSB')
|
||||
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
|
||||
& upd=upd,dupl=dupl,mold=arsb)
|
||||
#endif
|
||||
case default
|
||||
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
|
||||
& afmt=fafmt,upd=upd,dupl=dupl)
|
||||
end select
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sspasb_opt
|
||||
#endif
|
||||
|
||||
function psb_c_sspins(nz,irw,icl,val,mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*), icl(*)
|
||||
real(c_float) :: val(*)
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_sspins
|
||||
|
||||
|
||||
function psb_c_ssprn(mh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
logical(c_bool), value :: clear
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call psb_sprn(ap,descp,info,clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_ssprn
|
||||
!!$
|
||||
!!$ function psb_c_sspprint(mh) bind(c) result(res)
|
||||
!!$
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_c_int) :: res
|
||||
!!$ integer(psb_c_int), value :: mh
|
||||
!!$ integer :: info
|
||||
!!$
|
||||
!!$
|
||||
!!$ res = -1
|
||||
!!$ call psb_check_double_spmat_handle(mh,info)
|
||||
!!$ if (info < 0) return
|
||||
!!$
|
||||
!!$ call psb_csprt(0,double_spmat_pool(mh)%item,head='Debug mat')
|
||||
!!$
|
||||
!!$ res = 0
|
||||
!!$
|
||||
!!$ return
|
||||
!!$ end function psb_c_sspprint
|
||||
|
||||
|
||||
end module psb_s_tools_cbind_mod
|
||||
|
||||
@ -0,0 +1,289 @@
|
||||
module psb_z_psblas_cbind_mod
|
||||
use iso_c_binding
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_zgeaxpby(alpha,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_zvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_double_complex), value :: alpha,beta
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp,yp
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_geaxpby(alpha,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_zgeaxpby
|
||||
|
||||
function psb_c_zgenrm2(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_double_complex) :: 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.0
|
||||
|
||||
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
|
||||
|
||||
res = psb_genrm2(xp,descp,info)
|
||||
|
||||
end function psb_c_zgenrm2
|
||||
|
||||
function psb_c_zgeamax(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_double_complex) :: 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.0
|
||||
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
|
||||
|
||||
res = psb_geamax(xp,descp,info)
|
||||
|
||||
end function psb_c_zgeamax
|
||||
|
||||
function psb_c_zgeasum(xh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_double_complex) :: 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.0
|
||||
|
||||
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
|
||||
|
||||
res = psb_geasum(xp,descp,info)
|
||||
|
||||
end function psb_c_zgeasum
|
||||
|
||||
|
||||
function psb_c_zspnrmi(ah,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
real(c_double_complex) :: res
|
||||
|
||||
type(psb_c_zspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = -1.0
|
||||
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
|
||||
|
||||
res = psb_spnrmi(ap,descp,info)
|
||||
|
||||
end function psb_c_zspnrmi
|
||||
|
||||
function psb_c_zgedot(xh,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
complex(c_double_complex) :: res
|
||||
|
||||
type(psb_c_zvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp,yp
|
||||
integer :: info
|
||||
|
||||
res = -1.0
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
res = psb_gedot(xp,yp,descp,info)
|
||||
|
||||
end function psb_c_zgedot
|
||||
|
||||
|
||||
function psb_c_zspmm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_zspmat) :: ah
|
||||
type(psb_c_zvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_double_complex), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp,yp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_zspmm
|
||||
|
||||
|
||||
function psb_c_zspsm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_zspmat) :: ah
|
||||
type(psb_c_zvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
complex(c_double_complex), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp,yp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
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
|
||||
if (c_associated(yh%item)) then
|
||||
call c_f_pointer(yh%item,yp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spsm(alpha,ap,xp,beta,yp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_zspsm
|
||||
|
||||
|
||||
end module psb_z_psblas_cbind_mod
|
||||
@ -0,0 +1,119 @@
|
||||
module psb_z_serial_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_zvect_get_nrows(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_zvector) :: xh
|
||||
|
||||
type(psb_z_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
res = vp%get_nrows()
|
||||
end if
|
||||
|
||||
end function psb_c_zvect_get_nrows
|
||||
|
||||
function psb_c_zvect_f_get_cpy(v,xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
complex(c_double_complex) :: v(*)
|
||||
type(psb_c_zvector) :: xh
|
||||
|
||||
type(psb_z_vect_type), pointer :: vp
|
||||
complex(psb_dpk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
fv = vp%get_vect()
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end if
|
||||
|
||||
end function psb_c_zvect_f_get_cpy
|
||||
|
||||
|
||||
function psb_c_zvect_zero(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_zvector) :: xh
|
||||
|
||||
type(psb_z_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
call vp%zero()
|
||||
end if
|
||||
|
||||
end function psb_c_zvect_zero
|
||||
|
||||
|
||||
function psb_c_zmat_get_nrows(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = ap%get_nrows()
|
||||
|
||||
end function psb_c_zmat_get_nrows
|
||||
|
||||
|
||||
function psb_c_zmat_get_ncols(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = ap%get_ncols()
|
||||
|
||||
end function psb_c_zmat_get_ncols
|
||||
|
||||
|
||||
|
||||
end module psb_z_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,385 @@
|
||||
module psb_z_tools_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_zgeall(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
|
||||
return
|
||||
end if
|
||||
allocate(xp)
|
||||
call psb_geall(xp,descp,info)
|
||||
xh%item = c_loc(xp)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zgeall
|
||||
|
||||
function psb_c_zgeasb(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_geasb(xp,descp,info)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zgeasb
|
||||
|
||||
function psb_c_zgefree(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_gefree(xp,descp,info)
|
||||
res = min(0,info)
|
||||
xh%item = c_null_ptr
|
||||
|
||||
return
|
||||
end function psb_c_zgefree
|
||||
|
||||
|
||||
function psb_c_zgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
complex(c_double_complex) :: val(*)
|
||||
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_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zgeins
|
||||
|
||||
|
||||
function psb_c_zgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
complex(c_double_complex) :: val(*)
|
||||
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_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zgeins_add
|
||||
|
||||
|
||||
function psb_c_zspall(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
return
|
||||
end if
|
||||
allocate(ap)
|
||||
call psb_spall(ap,descp,info)
|
||||
mh%item = c_loc(ap)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zspall
|
||||
|
||||
|
||||
|
||||
function psb_c_zspasb(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spasb(ap,descp,info)
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_zspasb
|
||||
|
||||
|
||||
function psb_c_zspfree(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_spfree(ap,descp,info)
|
||||
res = min(0,info)
|
||||
mh%item=c_null_ptr
|
||||
return
|
||||
end function psb_c_zspfree
|
||||
|
||||
|
||||
#if 0
|
||||
|
||||
function psb_c_zspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
|
||||
|
||||
#ifdef HAVE_LIBRSB
|
||||
use psb_z_rsb_mat_mod
|
||||
#endif
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: cdh, mh,upd,dupl
|
||||
character(c_char) :: afmt(*)
|
||||
integer :: info,n, fdupl
|
||||
character(len=5) :: fafmt
|
||||
#ifdef HAVE_LIBRSB
|
||||
type(psb_z_rsb_sparse_mat) :: arsb
|
||||
#endif
|
||||
|
||||
res = -1
|
||||
call psb_check_descriptor_handle(cdh,info)
|
||||
if (info < 0) return
|
||||
call psb_check_double_spmat_handle(mh,info)
|
||||
if (info < 0) return
|
||||
|
||||
call stringc2f(afmt,fafmt)
|
||||
select case(fafmt)
|
||||
#ifdef HAVE_LIBRSB
|
||||
case('RSB')
|
||||
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
|
||||
& upd=upd,dupl=dupl,mold=arsb)
|
||||
#endif
|
||||
case default
|
||||
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
|
||||
& afmt=fafmt,upd=upd,dupl=dupl)
|
||||
end select
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zspasb_opt
|
||||
#endif
|
||||
|
||||
function psb_c_zspins(nz,irw,icl,val,mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*), icl(*)
|
||||
complex(c_double_complex) :: val(*)
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info,n
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_zspins
|
||||
|
||||
|
||||
function psb_c_zsprn(mh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
logical(c_bool), value :: clear
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
logical :: fclear
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
fclear = clear
|
||||
call psb_sprn(ap,descp,info,clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zsprn
|
||||
!!$
|
||||
!!$ function psb_c_zspprint(mh) bind(c) result(res)
|
||||
!!$
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_c_int) :: res
|
||||
!!$ integer(psb_c_int), value :: mh
|
||||
!!$ integer :: info
|
||||
!!$
|
||||
!!$
|
||||
!!$ res = -1
|
||||
!!$ call psb_check_double_spmat_handle(mh,info)
|
||||
!!$ if (info < 0) return
|
||||
!!$
|
||||
!!$ call psb_csprt(0,double_spmat_pool(mh)%item,head='Debug mat')
|
||||
!!$
|
||||
!!$ res = 0
|
||||
!!$
|
||||
!!$ return
|
||||
!!$ end function psb_c_zspprint
|
||||
|
||||
|
||||
end module psb_z_tools_cbind_mod
|
||||
|
||||
Loading…
Reference in New Issue