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

Cbind base fixes

Browse Source
merge-kinsol-maint
sfilippone 1 week ago
parent 42a2c67482
commit 8a57d90d06
16 changed files with 1134 additions and 969 deletions
Show Stats Download Patch File Download Diff File

2
cbind/base/psb_c_cbase.h
Unescape Escape View File

@ -39,6 +39,8 @@ psb_i_t psb_c_cgeasb_options_format(psb_c_cvector *xh, psb_c_descriptor *cdh,
psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_cgereinit(psb_c_cvector *xh, psb_c_descriptor *cdh, bool clear); psb_i_t psb_c_cgereinit(psb_c_cvector *xh, psb_c_descriptor *cdh, bool clear);
psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd); psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_i_t psb_c_csetelem(psb_l_t index, psb_c_t val,
psb_c_cvector *xh, psb_c_descriptor *cd);
psb_c_t psb_c_cmatgetelem(psb_c_cspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh); psb_c_t psb_c_cmatgetelem(psb_c_cspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
/* sparse matrices*/ /* sparse matrices*/

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

@ -39,6 +39,8 @@ psb_i_t psb_c_dgeasb_options_format(psb_c_dvector *xh, psb_c_descriptor *cdh,
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_dgereinit(psb_c_dvector *xh, psb_c_descriptor *cdh, bool clear); psb_i_t psb_c_dgereinit(psb_c_dvector *xh, psb_c_descriptor *cdh, bool clear);
psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd); psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_i_t psb_c_dsetelem(psb_l_t index, psb_d_t val,
psb_c_dvector *xh, psb_c_descriptor *cd);
psb_d_t psb_c_dmatgetelem(psb_c_dspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh); psb_d_t psb_c_dmatgetelem(psb_c_dspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
@ -65,7 +67,9 @@ psb_i_t psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh,
const char *afmt, psb_i_t upd, psb_i_t dupl); const char *afmt, psb_i_t upd, psb_i_t dupl);
psb_i_t psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear); psb_i_t psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear);
psb_i_t psb_c_dmat_name_print(psb_c_dspmat *mh, char *name); psb_i_t psb_c_dmat_name_print(psb_c_dspmat *mh, char *name);
psb_i_t psb_c_dvect_set_scal(psb_c_dvector *xh, psb_d_t val); psb_i_t psb_c_dvect_set_scal(psb_c_dvector *xh, psb_d_t val);
psb_i_t psb_c_dvect_set_scal_bound(psb_c_dvector *xh, psb_d_t val,
psb_i_t ifirst, psb_i_t ilast);
psb_i_t psb_c_dvect_set_vect(psb_c_dvector *xh, psb_d_t *val, psb_i_t n); psb_i_t psb_c_dvect_set_vect(psb_c_dvector *xh, psb_d_t *val, psb_i_t n);
psb_d_t psb_c_dvect_get_entry(psb_c_dvector *xh, psb_i_t index); psb_d_t psb_c_dvect_get_entry(psb_c_dvector *xh, psb_i_t index);
psb_i_t psb_c_dvect_set_entry(psb_c_dvector *xh, psb_i_t index, psb_d_t val); psb_i_t psb_c_dvect_set_entry(psb_c_dvector *xh, psb_i_t index, psb_d_t val);

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

@ -939,234 +939,6 @@ contains
end function psb_c_cspsm end function psb_c_cspsm
function psb_c_cnnz(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = 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_nnz(ap,descp,info)
end function psb_c_cnnz
function psb_c_cis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_upd()
end function
function psb_c_cis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_cis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_bld()
end function
function psb_c_cset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_cset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_cset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_ccopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
function psb_c_cspscal(alpha,ah,cdh) bind(c) result(res) function psb_c_cspscal(alpha,ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res

4
cbind/base/psb_c_sbase.h
Unescape Escape View File

@ -39,6 +39,8 @@ psb_i_t psb_c_sgeasb_options_format(psb_c_svector *xh, psb_c_descriptor *cdh,
psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh); psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
psb_i_t psb_c_sgereinit(psb_c_svector *xh, psb_c_descriptor *cdh, bool clear); psb_i_t psb_c_sgereinit(psb_c_svector *xh, psb_c_descriptor *cdh, bool clear);
psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd); psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
psb_i_t psb_c_ssetelem(psb_l_t index, psb_s_t val,
psb_c_svector *xh, psb_c_descriptor *cd);
psb_s_t psb_c_smatgetelem(psb_c_sspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh); psb_s_t psb_c_smatgetelem(psb_c_sspmat *ah,psb_l_t rowindex,psb_l_t colindex,psb_c_descriptor *cdh);
@ -66,6 +68,8 @@ psb_i_t psb_c_scopy_mat(psb_c_sspmat *ah,psb_c_sspmat *bh,psb_c_descriptor *cd
psb_i_t psb_c_ssprn(psb_c_sspmat *mh, psb_c_descriptor *cdh, _Bool clear); psb_i_t psb_c_ssprn(psb_c_sspmat *mh, psb_c_descriptor *cdh, _Bool clear);
psb_i_t psb_c_smat_name_print(psb_c_sspmat *mh, char *name); psb_i_t psb_c_smat_name_print(psb_c_sspmat *mh, char *name);
psb_i_t psb_c_svect_set_scal(psb_c_svector *xh, psb_s_t val); psb_i_t psb_c_svect_set_scal(psb_c_svector *xh, psb_s_t val);
psb_i_t psb_c_svect_set_scal_bound(psb_c_svector *xh, psb_s_t val,
psb_i_t ifirst, psb_i_t ilast);
psb_i_t psb_c_svect_set_vect(psb_c_svector *xh, psb_s_t *val, psb_i_t n); psb_i_t psb_c_svect_set_vect(psb_c_svector *xh, psb_s_t *val, psb_i_t n);
psb_s_t psb_c_svect_get_entry(psb_c_svector *xh, psb_i_t index); psb_s_t psb_c_svect_get_entry(psb_c_svector *xh, psb_i_t index);
psb_i_t psb_c_svect_set_entry(psb_c_svector *xh, psb_i_t index, psb_s_t val); psb_i_t psb_c_svect_set_entry(psb_c_svector *xh, psb_i_t index, psb_s_t val);

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

@ -176,6 +176,30 @@ contains
end function psb_c_cvect_set_scal end function psb_c_cvect_set_scal
function psb_c_cvect_set_scal_bound(x,val,ifirst,ilast) bind(c) result(info)
use psb_base_mod
implicit none
type(psb_c_cvector) :: x
type(psb_c_vect_type), pointer :: xp
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_), value :: ifirst, ilast
complex(c_float_complex) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_cvect_set_scal_bound
function psb_c_cvect_set_vect(x,val,n) bind(c) result(info) function psb_c_cvect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@ -246,28 +270,232 @@ contains
res = xp%get_entry((index+(1-ixb))) res = xp%get_entry((index+(1-ixb)))
end function psb_c_cvect_get_entry end function psb_c_cvect_get_entry
function psb_c_cvect_clone(xh,yh) bind(c) result(info) function psb_c_cnnz(ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_) :: info res = 0
type(psb_c_cvector) :: xh,yh
type(psb_c_vect_type), pointer :: xp,yp 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
info = -1 res = psb_nnz(ap,descp,info)
if (c_associated(xh%item)) then end function psb_c_cnnz
call c_f_pointer(xh%item,xp)
function psb_c_cis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else else
return return
end if end if
if (c_associated(yh%item)) then if (c_associated(ah%item)) then
call c_f_pointer(yh%item,yp) call c_f_pointer(ah%item,ap)
else else
return return
end if
res = ap%is_upd()
end function
function psb_c_cis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_cis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 end if
call xp%clone(yp,info)
end function psb_c_cvect_clone
res = ap%is_bld()
end function
function psb_c_cset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_cset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_cset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_ccopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
end module psb_c_serial_cbind_mod end module psb_c_serial_cbind_mod

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

@ -665,6 +665,42 @@ contains
end function psb_c_cgetelem end function psb_c_cgetelem
function psb_c_csetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_cvector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
complex(c_float_complex), value :: val
integer(psb_c_ipk_) :: res
type(psb_c_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
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
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_csetelem
function psb_c_cmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res) function psb_c_cmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none implicit none

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

@ -1040,234 +1040,6 @@ contains
end function psb_c_dspsm end function psb_c_dspsm
function psb_c_dnnz(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = 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_nnz(ap,descp,info)
end function psb_c_dnnz
function psb_c_dis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_upd()
end function
function psb_c_dis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_dis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_bld()
end function
function psb_c_dset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_dset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_dset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_dcopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
function psb_c_dspscal(alpha,ah,cdh) bind(c) result(res) function psb_c_dspscal(alpha,ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res

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

@ -176,6 +176,30 @@ contains
end function psb_c_dvect_set_scal end function psb_c_dvect_set_scal
function psb_c_dvect_set_scal_bound(x,val,ifirst,ilast) bind(c) result(info)
use psb_base_mod
implicit none
type(psb_c_dvector) :: x
type(psb_d_vect_type), pointer :: xp
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_), value :: ifirst, ilast
real(c_double) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_dvect_set_scal_bound
function psb_c_dvect_set_vect(x,val,n) bind(c) result(info) function psb_c_dvect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@ -246,28 +270,232 @@ contains
res = xp%get_entry((index+(1-ixb))) res = xp%get_entry((index+(1-ixb)))
end function psb_c_dvect_get_entry end function psb_c_dvect_get_entry
function psb_c_dvect_clone(xh,yh) bind(c) result(info) function psb_c_dnnz(ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_) :: info res = 0
type(psb_c_dvector) :: xh,yh
type(psb_d_vect_type), pointer :: xp,yp 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
info = -1 res = psb_nnz(ap,descp,info)
if (c_associated(xh%item)) then end function psb_c_dnnz
call c_f_pointer(xh%item,xp)
function psb_c_dis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else else
return return
end if end if
if (c_associated(yh%item)) then if (c_associated(ah%item)) then
call c_f_pointer(yh%item,yp) call c_f_pointer(ah%item,ap)
else else
return return
end if
res = ap%is_upd()
end function
function psb_c_dis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_dis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 end if
call xp%clone(yp,info)
end function psb_c_dvect_clone
res = ap%is_bld()
end function
function psb_c_dset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_dset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_dset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_dcopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
end module psb_d_serial_cbind_mod end module psb_d_serial_cbind_mod

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

@ -675,6 +675,42 @@ contains
end function psb_c_dgetelem end function psb_c_dgetelem
function psb_c_dsetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_dvector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
real(c_double), value :: val
integer(psb_c_ipk_) :: res
type(psb_d_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
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
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_dsetelem
function psb_c_dmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res) function psb_c_dmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none implicit none

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

@ -42,4 +42,15 @@ module psb_objhandle_mod
type(c_ptr) :: item = c_null_ptr type(c_ptr) :: item = c_null_ptr
end type psb_c_zspmat end type psb_c_zspmat
interface
subroutine psb_c_print_pointer(p) bind(c,name='psb_c_print_pointer')
use iso_c_binding
type(c_ptr), value :: p
end subroutine psb_c_print_pointer
end interface
contains
function psb_c_get_new_object() result(res)
type(psb_c_object_type) :: res
res%item = c_null_ptr
end function psb_c_get_new_object
end module psb_objhandle_mod end module psb_objhandle_mod

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

@ -1040,234 +1040,6 @@ contains
end function psb_c_sspsm end function psb_c_sspsm
function psb_c_snnz(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = 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_nnz(ap,descp,info)
end function psb_c_snnz
function psb_c_sis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_upd()
end function
function psb_c_sis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_sis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_bld()
end function
function psb_c_sset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_sset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_sset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_scopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
function psb_c_sspscal(alpha,ah,cdh) bind(c) result(res) function psb_c_sspscal(alpha,ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res

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

@ -176,6 +176,30 @@ contains
end function psb_c_svect_set_scal end function psb_c_svect_set_scal
function psb_c_svect_set_scal_bound(x,val,ifirst,ilast) bind(c) result(info)
use psb_base_mod
implicit none
type(psb_c_svector) :: x
type(psb_s_vect_type), pointer :: xp
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_), value :: ifirst, ilast
real(c_float) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_svect_set_scal_bound
function psb_c_svect_set_vect(x,val,n) bind(c) result(info) function psb_c_svect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@ -246,28 +270,232 @@ contains
res = xp%get_entry((index+(1-ixb))) res = xp%get_entry((index+(1-ixb)))
end function psb_c_svect_get_entry end function psb_c_svect_get_entry
function psb_c_svect_clone(xh,yh) bind(c) result(info) function psb_c_snnz(ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_) :: info res = 0
type(psb_c_svector) :: xh,yh
type(psb_s_vect_type), pointer :: xp,yp 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
info = -1 res = psb_nnz(ap,descp,info)
if (c_associated(xh%item)) then end function psb_c_snnz
call c_f_pointer(xh%item,xp)
function psb_c_sis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else else
return return
end if end if
if (c_associated(yh%item)) then if (c_associated(ah%item)) then
call c_f_pointer(yh%item,yp) call c_f_pointer(ah%item,ap)
else else
return return
end if
res = ap%is_upd()
end function
function psb_c_sis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_sis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 end if
call xp%clone(yp,info)
end function psb_c_svect_clone
res = ap%is_bld()
end function
function psb_c_sset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_sset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_sset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_scopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
end module psb_s_serial_cbind_mod end module psb_s_serial_cbind_mod

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

@ -675,6 +675,42 @@ contains
end function psb_c_sgetelem end function psb_c_sgetelem
function psb_c_ssetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_svector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
real(c_float), value :: val
integer(psb_c_ipk_) :: res
type(psb_s_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
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
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_ssetelem
function psb_c_smatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res) function psb_c_smatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none implicit none

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

@ -939,234 +939,6 @@ contains
end function psb_c_zspsm end function psb_c_zspsm
function psb_c_znnz(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = 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_nnz(ap,descp,info)
end function psb_c_znnz
function psb_c_zis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_upd()
end function
function psb_c_zis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_zis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_bld()
end function
function psb_c_zset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_zset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_zset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_zcopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
function psb_c_zspscal(alpha,ah,cdh) bind(c) result(res) function psb_c_zspscal(alpha,ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res

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

@ -176,6 +176,30 @@ contains
end function psb_c_zvect_set_scal end function psb_c_zvect_set_scal
function psb_c_zvect_set_scal_bound(x,val,ifirst,ilast) bind(c) result(info)
use psb_base_mod
implicit none
type(psb_c_zvector) :: x
type(psb_z_vect_type), pointer :: xp
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_), value :: ifirst, ilast
complex(c_double_complex) :: val
info = -1;
if (c_associated(x%item)) then
call c_f_pointer(x%item,xp)
else
return
end if
call xp%set(val,first=ifirst,last=ilast)
info = 0
end function psb_c_zvect_set_scal_bound
function psb_c_zvect_set_vect(x,val,n) bind(c) result(info) function psb_c_zvect_set_vect(x,val,n) bind(c) result(info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@ -246,28 +270,232 @@ contains
res = xp%get_entry((index+(1-ixb))) res = xp%get_entry((index+(1-ixb)))
end function psb_c_zvect_get_entry end function psb_c_zvect_get_entry
function psb_c_zvect_clone(xh,yh) bind(c) result(info) function psb_c_znnz(ah,cdh) bind(c) result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
integer(psb_c_ipk_) :: info res = 0
type(psb_c_zvector) :: xh,yh
type(psb_z_vect_type), pointer :: xp,yp 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
info = -1 res = psb_nnz(ap,descp,info)
if (c_associated(xh%item)) then end function psb_c_znnz
call c_f_pointer(xh%item,xp)
function psb_c_zis_matupd(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else else
return return
end if end if
if (c_associated(yh%item)) then if (c_associated(ah%item)) then
call c_f_pointer(yh%item,yp) call c_f_pointer(ah%item,ap)
else else
return return
end if
res = ap%is_upd()
end function
function psb_c_zis_matasb(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 = ap%is_asb()
end function
function psb_c_zis_matbld(ah,cdh) bind(c) result(res)
implicit none
logical(c_bool) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info
res = .false.
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 end if
call xp%clone(yp,info)
end function psb_c_zvect_clone
res = ap%is_bld()
end function
function psb_c_zset_matupd(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_upd()
res = psb_success_
end function
function psb_c_zset_matasb(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
res = -1;
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_asb()
res = psb_success_
end function
function psb_c_zset_matbld(ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
call ap%set_bld()
res = psb_success_
end function
function psb_c_zcopy_mat(ah,bh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: ah,bh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap,bp
integer(psb_c_ipk_) :: info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(ah%item)) then
call c_f_pointer(ah%item,ap)
else
return
end if
if (c_associated(bh%item)) then
call c_f_pointer(bh%item,bp)
else
return
end if
call ap%clone(bp,info)
res = info
end function
end module psb_z_serial_cbind_mod end module psb_z_serial_cbind_mod

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

@ -665,6 +665,42 @@ contains
end function psb_c_zgetelem end function psb_c_zgetelem
function psb_c_zsetelem(index,val,xh,cdh) bind(c) result(res)
implicit none
type(psb_c_zvector) :: xh
integer(psb_c_lpk_), value :: index
type(psb_c_descriptor) :: cdh
complex(c_double_complex), value :: val
integer(psb_c_ipk_) :: res
type(psb_z_vect_type), pointer :: xp
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
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
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_setelem(index,val,xp,descp,info)
else
call psb_setelem(index+(1-ixb),val,xp,descp,info)
end if
res=info
return
end function psb_c_zsetelem
function psb_c_zmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res) function psb_c_zmatgetelem(ah,rowindex,colindex,cdh) bind(c) result(res)
implicit none implicit none

Write Preview
Loading…
Cancel
Save