diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index 67651f572..dcb342e46 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -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*/ diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 6a6de8be7..eb98dea83 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -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); diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 index ad3aee04c..110e91c9f 100644 --- a/cbind/base/psb_c_psblas_cbind_mod.f90 +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index ae1ff71e2..6c81a3005 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -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); diff --git a/cbind/base/psb_c_serial_cbind_mod.F90 b/cbind/base/psb_c_serial_cbind_mod.F90 index 7de87ccce..dbcebc097 100644 --- a/cbind/base/psb_c_serial_cbind_mod.F90 +++ b/cbind/base/psb_c_serial_cbind_mod.F90 @@ -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_) :: 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 - type(psb_c_cvector) :: xh,yh + res = 0 - 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 - call c_f_pointer(xh%item,xp) + 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 + return end if - if (c_associated(yh%item)) then - call c_f_pointer(yh%item,yp) + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) 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 - 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 diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index 05267b7a8..d796ffab2 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -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 diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index bb77272e0..fc541eb3b 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_d_serial_cbind_mod.F90 b/cbind/base/psb_d_serial_cbind_mod.F90 index c365eb55b..ac3ad20c8 100644 --- a/cbind/base/psb_d_serial_cbind_mod.F90 +++ b/cbind/base/psb_d_serial_cbind_mod.F90 @@ -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_) :: 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 - type(psb_c_dvector) :: xh,yh + res = 0 - 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 - call c_f_pointer(xh%item,xp) + 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 + return end if - if (c_associated(yh%item)) then - call c_f_pointer(yh%item,yp) + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) 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 - 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 diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 11d56d2b9..56acfe0c3 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -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 diff --git a/cbind/base/psb_objhandle_mod.F90 b/cbind/base/psb_objhandle_mod.F90 index e7cb8aeb3..7712e186f 100644 --- a/cbind/base/psb_objhandle_mod.F90 +++ b/cbind/base/psb_objhandle_mod.F90 @@ -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 diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 index 382cabd00..2809440da 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_s_serial_cbind_mod.F90 b/cbind/base/psb_s_serial_cbind_mod.F90 index d78cc5495..995884718 100644 --- a/cbind/base/psb_s_serial_cbind_mod.F90 +++ b/cbind/base/psb_s_serial_cbind_mod.F90 @@ -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_) :: 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 - type(psb_c_svector) :: xh,yh + res = 0 - 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 - call c_f_pointer(xh%item,xp) + 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 + return end if - if (c_associated(yh%item)) then - call c_f_pointer(yh%item,yp) + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) 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 - 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 diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index fe6b0aae7..b36b878ea 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -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 diff --git a/cbind/base/psb_z_psblas_cbind_mod.f90 b/cbind/base/psb_z_psblas_cbind_mod.f90 index 5255485f2..4abea1222 100644 --- a/cbind/base/psb_z_psblas_cbind_mod.f90 +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -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 diff --git a/cbind/base/psb_z_serial_cbind_mod.F90 b/cbind/base/psb_z_serial_cbind_mod.F90 index 8c6154af9..6b8dfbd71 100644 --- a/cbind/base/psb_z_serial_cbind_mod.F90 +++ b/cbind/base/psb_z_serial_cbind_mod.F90 @@ -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_) :: 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 - type(psb_c_zvector) :: xh,yh + res = 0 - 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 - call c_f_pointer(xh%item,xp) + 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 + return end if - if (c_associated(yh%item)) then - call c_f_pointer(yh%item,yp) + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) 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 - 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 diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 2721924cd..12d20d76d 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -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