mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 19:02:09 +00:00
Cbind base fixes
This commit is contained in:
sfilippone
@@ -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_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_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);
|
||||
|
||||
/* sparse matrices*/
|
||||
|
||||
@@ -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_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_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);
|
||||
|
||||
|
||||
@@ -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);
|
||||
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_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_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);
|
||||
|
||||
@@ -939,234 +939,6 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
@@ -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_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_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);
|
||||
|
||||
|
||||
@@ -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_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_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_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);
|
||||
|
||||
@@ -176,6 +176,30 @@ contains
|
||||
|
||||
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)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -246,28 +270,232 @@ contains
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
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
|
||||
|
||||
integer(psb_c_ipk_) :: info
|
||||
type(psb_c_cvector) :: xh,yh
|
||||
|
||||
type(psb_c_vect_type), pointer :: xp,yp
|
||||
|
||||
info = -1
|
||||
|
||||
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 xp%clone(yp,info)
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
end function psb_c_cvect_clone
|
||||
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
|
||||
|
||||
end module psb_c_serial_cbind_mod
|
||||
|
||||
@@ -665,6 +665,42 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -1040,234 +1040,6 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
@@ -176,6 +176,30 @@ contains
|
||||
|
||||
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)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -246,28 +270,232 @@ contains
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
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
|
||||
|
||||
integer(psb_c_ipk_) :: info
|
||||
type(psb_c_dvector) :: xh,yh
|
||||
|
||||
type(psb_d_vect_type), pointer :: xp,yp
|
||||
|
||||
info = -1
|
||||
|
||||
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 xp%clone(yp,info)
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
end function psb_c_dvect_clone
|
||||
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
|
||||
|
||||
end module psb_d_serial_cbind_mod
|
||||
|
||||
@@ -675,6 +675,42 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -42,4 +42,15 @@ module psb_objhandle_mod
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
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
|
||||
|
||||
@@ -1040,234 +1040,6 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
@@ -176,6 +176,30 @@ contains
|
||||
|
||||
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)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -246,28 +270,232 @@ contains
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
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
|
||||
|
||||
integer(psb_c_ipk_) :: info
|
||||
type(psb_c_svector) :: xh,yh
|
||||
|
||||
type(psb_s_vect_type), pointer :: xp,yp
|
||||
|
||||
info = -1
|
||||
|
||||
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 xp%clone(yp,info)
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
end function psb_c_svect_clone
|
||||
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
|
||||
|
||||
end module psb_s_serial_cbind_mod
|
||||
|
||||
@@ -675,6 +675,42 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -939,234 +939,6 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
@@ -176,6 +176,30 @@ contains
|
||||
|
||||
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)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -246,28 +270,232 @@ contains
|
||||
res = xp%get_entry((index+(1-ixb)))
|
||||
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
|
||||
|
||||
integer(psb_c_ipk_) :: info
|
||||
type(psb_c_zvector) :: xh,yh
|
||||
|
||||
type(psb_z_vect_type), pointer :: xp,yp
|
||||
|
||||
info = -1
|
||||
|
||||
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 xp%clone(yp,info)
|
||||
integer(psb_c_ipk_) :: res
|
||||
|
||||
end function psb_c_zvect_clone
|
||||
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
|
||||
|
||||
end module psb_z_serial_cbind_mod
|
||||
|
||||
@@ -665,6 +665,42 @@ contains
|
||||
|
||||
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)
|
||||
implicit none
|
||||
|
||||
|
||||
Reference in New Issue
Block a user