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_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
15 changed files with 2469 additions and 44 deletions
Show Stats Download Patch File Download Diff File

22
cbind/base/Makefile
Unescape Escape View File

@ -9,8 +9,11 @@ CINCLUDES=-I$(INCLUDEDIR)
FOBJS= psb_objhandle_mod.o psb_base_cbind_mod.o psb_cpenv_mod.o \
psb_base_tools_cbind_mod.o psb_base_string_cbind_mod.o \
psb_base_psblas_cbind_mod.o psb_d_tools_cbind_mod.o \
psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o
psb_base_psblas_cbind_mod.o \
psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o psb_s_psblas_cbind_mod.o \
psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o \
psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o psb_c_psblas_cbind_mod.o \
psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o psb_z_psblas_cbind_mod.o
COBJS= psb_c_base.o psb_c_dbase.o
CMOD=psb_base_cbind.h psb_c_base.h psb_c_dbase.h
@ -18,7 +21,10 @@ OBJS=$(FOBJS) $(COBJS)
LIBMOD=psb_base_cbind_mod$(.mod) psb_cpenv_mod$(.mod) psb_objhandle_mod$(.mod)\
psb_base_tools_cbind_mod$(.mod) psb_base_string_cbind_mod$(.mod) psb_base_psblas_cbind_mod$(.mod)\
psb_d_tools_cbind_mod$(.mod) psb_d_serial_cbind_mod$(.mod) psb_d_psblas_cbind_mod$(.mod)
psb_s_tools_cbind_mod$(.mod) psb_s_serial_cbind_mod$(.mod) psb_s_psblas_cbind_mod$(.mod) \
psb_d_tools_cbind_mod$(.mod) psb_d_serial_cbind_mod$(.mod) psb_d_psblas_cbind_mod$(.mod) \
psb_c_tools_cbind_mod$(.mod) psb_c_serial_cbind_mod$(.mod) psb_c_psblas_cbind_mod$(.mod) \
psb_z_tools_cbind_mod$(.mod) psb_z_serial_cbind_mod$(.mod) psb_z_psblas_cbind_mod$(.mod)
LOCAL_MODS=$(LIBMOD)
LIBNAME=$(CBINDLIBNAME)
@ -33,10 +39,16 @@ $(COBJS): $(CMOD)
psb_base_cbind_mod.o: psb_cpenv_mod.o psb_objhandle_mod.o psb_base_tools_cbind_mod.o \
psb_base_string_cbind_mod.o psb_base_psblas_cbind_mod.o
psb_base_tools_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o
psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o: psb_base_tools_cbind_mod.o
psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o \
psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o \
psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o \
psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o \
psb_s_psblas_cbind_mod.o psb_d_psblas_cbind_mod.o \
psb_c_psblas_cbind_mod.o psb_z_psblas_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o
psb_base_psblas_cbind_mod.o: psb_d_psblas_cbind_mod.o
psb_d_psblas_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o
psb_cpenv_mod.o: psb_base_string_cbind_mod.o psb_objhandle_mod.o
veryclean: clean

6
cbind/base/psb_c_dbase.c
Unescape Escape View File

@ -10,9 +10,9 @@ psb_c_dvector* psb_c_new_dvector()
return(temp);
}
double* psb_c_dvect_get_cpy(psb_c_dvector *xh)
psb_d_t* psb_c_dvect_get_cpy(psb_c_dvector *xh)
{
double *temp=NULL;
psb_d_t *temp=NULL;
psb_i_t vsize=0;
if ((vsize=psb_c_dvect_get_nrows(xh))<0)
@ -21,7 +21,7 @@ double* psb_c_dvect_get_cpy(psb_c_dvector *xh)
if (vsize==0)
vsize=1;
if ((temp=(double *)malloc(vsize*sizeof(double)))!=NULL)
if ((temp=(psb_d_t *)malloc(vsize*sizeof(psb_d_t)))!=NULL)
psb_c_dvect_f_get_cpy(temp,xh);
return(temp);

289
cbind/base/psb_c_psblas_cbind_mod.f90
Unescape Escape View File

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

119
cbind/base/psb_c_serial_cbind_mod.F90
Unescape Escape View File

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

385
cbind/base/psb_c_tools_cbind_mod.F90
Unescape Escape View File

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

32
cbind/base/psb_d_psblas_cbind_mod.f90
Unescape Escape View File

@ -10,7 +10,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: xh,yh, cdh
type(psb_c_dvector) :: xh,yh
type(psb_c_descriptor) :: cdh
real(c_double), value :: alpha,beta
type(psb_desc_type), pointer :: descp
@ -49,7 +50,8 @@ contains
implicit none
real(c_double) :: res
type(psb_c_object_type) :: xh,cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
integer :: info
@ -78,7 +80,8 @@ contains
implicit none
real(c_double) :: res
type(psb_c_object_type) :: xh,cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
integer :: info
@ -106,7 +109,8 @@ contains
implicit none
real(c_double) :: res
type(psb_c_object_type) :: xh,cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
integer :: info
@ -129,14 +133,15 @@ contains
end function psb_c_dgeasum
function psb_c_dspnrmi(mh,cdh) bind(c) result(res)
function psb_c_dspnrmi(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) :: res
type(psb_c_object_type) :: mh,cdh
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer :: info
@ -147,8 +152,8 @@ contains
else
return
end if
if (c_associated(mh%item)) then
call c_f_pointer(mh%item,ap)
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
@ -164,7 +169,8 @@ contains
implicit none
real(c_double) :: res
type(psb_c_object_type) :: xh,yh,cdh
type(psb_c_dvector) :: xh,yh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp,yp
integer :: info
@ -197,7 +203,9 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: ah,xh,yh, cdh
type(psb_c_dspmat) :: ah
type(psb_c_dvector) :: xh,yh
type(psb_c_descriptor) :: cdh
real(c_double), value :: alpha, beta
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp,yp
@ -240,7 +248,9 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: ah,xh,yh, cdh
type(psb_c_dspmat) :: ah
type(psb_c_dvector) :: xh,yh
type(psb_c_descriptor) :: cdh
real(c_double), value :: alpha, beta
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp,yp

2
cbind/base/psb_d_serial_cbind_mod.F90
Unescape Escape View File

@ -62,7 +62,7 @@ contains
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,vp)
call vp%set(dzero)
call vp%zero()
end if
end function psb_c_dvect_zero

40
cbind/base/psb_d_tools_cbind_mod.F90
Unescape Escape View File

@ -11,8 +11,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: xh
type(psb_c_object_type) :: cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
@ -40,8 +40,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: xh
type(psb_c_object_type) :: cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
@ -70,8 +70,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: xh
type(psb_c_object_type) :: cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
@ -105,8 +105,8 @@ contains
integer(psb_c_int), value :: nz
integer(psb_c_int) :: irw(*)
real(c_double) :: val(*)
type(psb_c_object_type) :: xh
type(psb_c_object_type) :: cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
@ -139,8 +139,8 @@ contains
integer(psb_c_int), value :: nz
integer(psb_c_int) :: irw(*)
real(c_double) :: val(*)
type(psb_c_object_type) :: xh
type(psb_c_object_type) :: cdh
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
@ -170,8 +170,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: mh
type(psb_c_object_type) :: cdh
type(psb_c_dspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
@ -200,8 +200,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: mh
type(psb_c_object_type) :: cdh
type(psb_c_dspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
@ -229,8 +229,8 @@ contains
implicit none
integer(psb_c_int) :: res
type(psb_c_object_type) :: mh
type(psb_c_object_type) :: cdh
type(psb_c_dspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
@ -303,8 +303,8 @@ contains
integer(psb_c_int), value :: nz
integer(psb_c_int) :: irw(*), icl(*)
real(c_double) :: val(*)
type(psb_c_object_type) :: mh
type(psb_c_object_type) :: cdh
type(psb_c_dspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
@ -334,8 +334,8 @@ contains
implicit none
integer(psb_c_int) :: res
logical(c_bool), value :: clear
type(psb_c_object_type) :: mh
type(psb_c_object_type) :: cdh
type(psb_c_dspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap

32
cbind/base/psb_objhandle_mod.F90
Unescape Escape View File

@ -6,15 +6,23 @@ module psb_objhandle_mod
#else
integer, parameter :: psb_c_int = c_int32_t
#endif
type, bind(c) :: psb_c_object_type
type(c_ptr) :: item = c_null_ptr
end type psb_c_object_type
type, bind(c) :: psb_c_descriptor
type(c_ptr) :: item = c_null_ptr
end type psb_c_descriptor
type, bind(c) :: psb_c_svector
type(c_ptr) :: item = c_null_ptr
end type psb_c_svector
type, bind(c) :: psb_c_sspmat
type(c_ptr) :: item = c_null_ptr
end type psb_c_sspmat
type, bind(c) :: psb_c_dvector
type(c_ptr) :: item = c_null_ptr
end type psb_c_dvector
@ -22,5 +30,21 @@ module psb_objhandle_mod
type, bind(c) :: psb_c_dspmat
type(c_ptr) :: item = c_null_ptr
end type psb_c_dspmat
type, bind(c) :: psb_c_cvector
type(c_ptr) :: item = c_null_ptr
end type psb_c_cvector
type, bind(c) :: psb_c_cspmat
type(c_ptr) :: item = c_null_ptr
end type psb_c_cspmat
type, bind(c) :: psb_c_zvector
type(c_ptr) :: item = c_null_ptr
end type psb_c_zvector
type, bind(c) :: psb_c_zspmat
type(c_ptr) :: item = c_null_ptr
end type psb_c_zspmat
end module psb_objhandle_mod

289
cbind/base/psb_s_psblas_cbind_mod.f90
Unescape Escape View File

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

119
cbind/base/psb_s_serial_cbind_mod.F90
Unescape Escape View File

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

385
cbind/base/psb_s_tools_cbind_mod.F90
Unescape Escape View File

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

289
cbind/base/psb_z_psblas_cbind_mod.f90
Unescape Escape View File

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

119
cbind/base/psb_z_serial_cbind_mod.F90
Unescape Escape View File

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

385
cbind/base/psb_z_tools_cbind_mod.F90
Unescape Escape View File

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