From 0ff5321fc1eaedb238ac5a123659ec02d9d2dd4c Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 6 Apr 2020 16:00:35 +0200 Subject: [PATCH] Added c interface for sparse matrix copy --- cbind/base/psb_c_cbase.h | 1 + cbind/base/psb_c_dbase.h | 1 + cbind/base/psb_c_psblas_cbind_mod.f90 | 34 +++++++++++++++++++++++++++ cbind/base/psb_c_sbase.h | 1 + cbind/base/psb_c_zbase.h | 2 ++ cbind/base/psb_d_psblas_cbind_mod.f90 | 34 +++++++++++++++++++++++++++ cbind/base/psb_s_psblas_cbind_mod.f90 | 34 +++++++++++++++++++++++++++ cbind/base/psb_z_psblas_cbind_mod.f90 | 34 +++++++++++++++++++++++++++ 8 files changed, 141 insertions(+) diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index 452b74ef..1130018a 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -47,6 +47,7 @@ bool psb_c_cis_matbld(psb_c_cspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_cset_matupd(psb_c_cspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_cset_matasb(psb_c_cspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_cset_matbld(psb_c_cspmat *mh,psb_c_descriptor *cdh); +psb_i_t psb_c_ccopy_mat(psb_c_cspmat *ah,psb_c_cspmat *bh,psb_c_descriptor *cdh); /* psb_i_t psb_c_cspasb_opt(psb_c_cspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index 0705b6ba..09feea6f 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -47,6 +47,7 @@ bool psb_c_dis_matbld(psb_c_dspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_dset_matupd(psb_c_dspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_dset_matasb(psb_c_dspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_dset_matbld(psb_c_dspmat *mh,psb_c_descriptor *cdh); +psb_i_t psb_c_dcopy_mat(psb_c_dspmat *ah,psb_c_dspmat *bh,psb_c_descriptor *cdh); /* 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); */ diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 index c68626f5..7193236c 100644 --- a/cbind/base/psb_c_psblas_cbind_mod.f90 +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -1057,4 +1057,38 @@ contains 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_psblas_cbind_mod diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index cc80bee3..97384968 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -47,6 +47,7 @@ bool psb_c_sis_matbld(psb_c_sspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_sset_matupd(psb_c_sspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_sset_matasb(psb_c_sspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_sset_matbld(psb_c_sspmat *mh,psb_c_descriptor *cdh); +psb_i_t psb_c_scopy_mat(psb_c_sspmat *ah,psb_c_sspmat *bh,psb_c_descriptor *cdh); /* psb_i_t psb_c_sspasb_opt(psb_c_sspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index 38056aff..01be0f68 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -47,6 +47,8 @@ bool psb_c_zis_matbld(psb_c_zspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_zset_matupd(psb_c_zspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_zset_matasb(psb_c_zspmat *mh,psb_c_descriptor *cdh); psb_i_t psb_c_zset_matbld(psb_c_zspmat *mh,psb_c_descriptor *cdh); +psb_i_t psb_c_zcopy_mat(psb_c_zspmat *ah,psb_c_zspmat *bh,psb_c_descriptor *cdh); + /* psb_i_t psb_c_zspasb_opt(psb_c_zspmat *mh, psb_c_descriptor *cdh, */ /* const char *afmt, psb_i_t upd, psb_i_t dupl); */ diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index 50eca563..672fb742 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -1158,4 +1158,38 @@ contains 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_psblas_cbind_mod diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 index dbc5de0f..64d751bf 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -1158,4 +1158,38 @@ contains 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_psblas_cbind_mod diff --git a/cbind/base/psb_z_psblas_cbind_mod.f90 b/cbind/base/psb_z_psblas_cbind_mod.f90 index 73a55a52..01fcb588 100644 --- a/cbind/base/psb_z_psblas_cbind_mod.f90 +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -1057,4 +1057,38 @@ contains 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_psblas_cbind_mod