diff --git a/base/modules/serial/psb_c_base_mat_mod.F90 b/base/modules/serial/psb_c_base_mat_mod.F90 index 8233f5cc..c7ba1a56 100644 --- a/base/modules/serial/psb_c_base_mat_mod.F90 +++ b/base/modules/serial/psb_c_base_mat_mod.F90 @@ -126,6 +126,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: colsum => psb_c_base_colsum procedure, pass(a) :: aclsum => psb_c_base_aclsum procedure, pass(a) :: scalpid => psb_c_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_c_base_spaxpby end type psb_c_base_sparse_mat private :: c_base_mat_sync, c_base_mat_is_host, c_base_mat_is_dev, & @@ -228,7 +229,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: colsum => psb_c_coo_colsum procedure, pass(a) :: aclsum => psb_c_coo_aclsum procedure, pass(a) :: scalpid => psb_c_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_c_coo_spaxpby end type psb_c_coo_sparse_mat private :: c_coo_get_nzeros, c_coo_set_nzeros, & @@ -293,6 +294,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: colsum => psb_lc_base_colsum procedure, pass(a) :: aclsum => psb_lc_base_aclsum procedure, pass(a) :: scalpid => psb_lc_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_lc_base_spaxpby ! ! Convert internal indices ! @@ -394,7 +396,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: colsum => psb_lc_coo_colsum procedure, pass(a) :: aclsum => psb_lc_coo_aclsum procedure, pass(a) :: scalpid => psb_lc_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_lc_coo_spaxpby ! ! This is COO specific ! @@ -1475,6 +1477,28 @@ module psb_c_base_mat_mod end subroutine psb_c_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_c_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_c_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_c_base_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_base_spaxpby + end interface + ! !> Function base_maxval: !! \memberof psb_c_base_sparse_mat @@ -2131,6 +2155,19 @@ module psb_c_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_c_coo_scalplusidentity end interface + ! + !! \memberof psb_c_coo_sparse_mat + !! \see psb_c_base_mat_mod::psb_c_base_spaxpby + interface + subroutine psb_c_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_c_coo_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_coo_spaxpby + end interface ! == ================= ! @@ -2887,6 +2924,28 @@ module psb_c_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_lc_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_lc_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_lc_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_lc_base_sparse_mat), intent(inout) :: a + class(psb_lc_base_sparse_mat), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_base_spaxpby + end interface + ! !> Function base_scal: @@ -3496,6 +3555,19 @@ module psb_c_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_lc_coo_scalplusidentity end interface + !> + !! \memberof psb_lc_coo_sparse_mat + !! \see psb_lc_base_mat_mod::psb_lc_base_spaxpby + interface + subroutine psb_lc_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_lc_coo_sparse_mat), intent(inout) :: a + class(psb_lc_base_sparse_mat), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_coo_spaxpby + end interface contains diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index ff74c348..3beb188a 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -234,6 +234,7 @@ module psb_c_mat_mod procedure, pass(a) :: cssm => psb_c_cssm generic, public :: spsm => cssm, cssv, cssv_v procedure, pass(a) :: scalpid => psb_c_scalplusidentity + procedure, pass(a) :: spaxpby => psb_c_spaxpby end type psb_cspmat_type @@ -419,6 +420,7 @@ module psb_c_mat_mod procedure, pass(a) :: scalv => psb_lc_scal generic, public :: scal => scals, scalv procedure, pass(a) :: scalpid => psb_lc_scalplusidentity + procedure, pass(a) :: spaxpby => psb_lc_spaxpby end type psb_lcspmat_type @@ -1168,6 +1170,17 @@ module psb_c_mat_mod end subroutine psb_c_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_c_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(inout) :: a + class(psb_cspmat_type), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_spaxpby + end interface + ! == =================================== ! ! @@ -1772,6 +1785,17 @@ module psb_c_mat_mod end subroutine psb_lc_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_lc_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_ + class(psb_lcspmat_type), intent(inout) :: a + class(psb_lcspmat_type), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_spaxpby + end interface + interface function psb_lc_maxval(a) result(res) import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_ diff --git a/base/modules/serial/psb_d_base_mat_mod.F90 b/base/modules/serial/psb_d_base_mat_mod.F90 index b8cd3a9c..6e3c7a46 100644 --- a/base/modules/serial/psb_d_base_mat_mod.F90 +++ b/base/modules/serial/psb_d_base_mat_mod.F90 @@ -126,6 +126,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: colsum => psb_d_base_colsum procedure, pass(a) :: aclsum => psb_d_base_aclsum procedure, pass(a) :: scalpid => psb_d_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_d_base_spaxpby end type psb_d_base_sparse_mat private :: d_base_mat_sync, d_base_mat_is_host, d_base_mat_is_dev, & @@ -228,7 +229,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: colsum => psb_d_coo_colsum procedure, pass(a) :: aclsum => psb_d_coo_aclsum procedure, pass(a) :: scalpid => psb_d_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_d_coo_spaxpby end type psb_d_coo_sparse_mat private :: d_coo_get_nzeros, d_coo_set_nzeros, & @@ -293,6 +294,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: colsum => psb_ld_base_colsum procedure, pass(a) :: aclsum => psb_ld_base_aclsum procedure, pass(a) :: scalpid => psb_ld_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_ld_base_spaxpby ! ! Convert internal indices ! @@ -394,7 +396,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: colsum => psb_ld_coo_colsum procedure, pass(a) :: aclsum => psb_ld_coo_aclsum procedure, pass(a) :: scalpid => psb_ld_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_ld_coo_spaxpby ! ! This is COO specific ! @@ -1475,6 +1477,28 @@ module psb_d_base_mat_mod end subroutine psb_d_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_d_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_d_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_d_base_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_base_spaxpby + end interface + ! !> Function base_maxval: !! \memberof psb_d_base_sparse_mat @@ -2131,6 +2155,19 @@ module psb_d_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_d_coo_scalplusidentity end interface + ! + !! \memberof psb_d_coo_sparse_mat + !! \see psb_d_base_mat_mod::psb_d_base_spaxpby + interface + subroutine psb_d_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_d_coo_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_coo_spaxpby + end interface ! == ================= ! @@ -2887,6 +2924,28 @@ module psb_d_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_ld_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_ld_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_ld_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_ld_base_sparse_mat), intent(inout) :: a + class(psb_ld_base_sparse_mat), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_base_spaxpby + end interface + ! !> Function base_scal: @@ -3496,6 +3555,19 @@ module psb_d_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_ld_coo_scalplusidentity end interface + !> + !! \memberof psb_ld_coo_sparse_mat + !! \see psb_ld_base_mat_mod::psb_ld_base_spaxpby + interface + subroutine psb_ld_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_ld_coo_sparse_mat), intent(inout) :: a + class(psb_ld_base_sparse_mat), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_coo_spaxpby + end interface contains diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index 446ffea5..c0f1577b 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -234,6 +234,7 @@ module psb_d_mat_mod procedure, pass(a) :: cssm => psb_d_cssm generic, public :: spsm => cssm, cssv, cssv_v procedure, pass(a) :: scalpid => psb_d_scalplusidentity + procedure, pass(a) :: spaxpby => psb_d_spaxpby end type psb_dspmat_type @@ -419,6 +420,7 @@ module psb_d_mat_mod procedure, pass(a) :: scalv => psb_ld_scal generic, public :: scal => scals, scalv procedure, pass(a) :: scalpid => psb_ld_scalplusidentity + procedure, pass(a) :: spaxpby => psb_ld_spaxpby end type psb_ldspmat_type @@ -1168,6 +1170,17 @@ module psb_d_mat_mod end subroutine psb_d_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_d_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_ + class(psb_dspmat_type), intent(inout) :: a + class(psb_dspmat_type), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_spaxpby + end interface + ! == =================================== ! ! @@ -1772,6 +1785,17 @@ module psb_d_mat_mod end subroutine psb_ld_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_ld_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_ + class(psb_ldspmat_type), intent(inout) :: a + class(psb_ldspmat_type), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_spaxpby + end interface + interface function psb_ld_maxval(a) result(res) import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_ diff --git a/base/modules/serial/psb_s_base_mat_mod.F90 b/base/modules/serial/psb_s_base_mat_mod.F90 index bb2ba958..27f053a4 100644 --- a/base/modules/serial/psb_s_base_mat_mod.F90 +++ b/base/modules/serial/psb_s_base_mat_mod.F90 @@ -126,6 +126,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: colsum => psb_s_base_colsum procedure, pass(a) :: aclsum => psb_s_base_aclsum procedure, pass(a) :: scalpid => psb_s_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_s_base_spaxpby end type psb_s_base_sparse_mat private :: s_base_mat_sync, s_base_mat_is_host, s_base_mat_is_dev, & @@ -228,7 +229,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: colsum => psb_s_coo_colsum procedure, pass(a) :: aclsum => psb_s_coo_aclsum procedure, pass(a) :: scalpid => psb_s_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_s_coo_spaxpby end type psb_s_coo_sparse_mat private :: s_coo_get_nzeros, s_coo_set_nzeros, & @@ -293,6 +294,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: colsum => psb_ls_base_colsum procedure, pass(a) :: aclsum => psb_ls_base_aclsum procedure, pass(a) :: scalpid => psb_ls_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_ls_base_spaxpby ! ! Convert internal indices ! @@ -394,7 +396,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: colsum => psb_ls_coo_colsum procedure, pass(a) :: aclsum => psb_ls_coo_aclsum procedure, pass(a) :: scalpid => psb_ls_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_ls_coo_spaxpby ! ! This is COO specific ! @@ -1475,6 +1477,28 @@ module psb_s_base_mat_mod end subroutine psb_s_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_s_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_s_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_s_base_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_base_spaxpby + end interface + ! !> Function base_maxval: !! \memberof psb_s_base_sparse_mat @@ -2131,6 +2155,19 @@ module psb_s_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_s_coo_scalplusidentity end interface + ! + !! \memberof psb_s_coo_sparse_mat + !! \see psb_s_base_mat_mod::psb_s_base_spaxpby + interface + subroutine psb_s_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_s_coo_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_coo_spaxpby + end interface ! == ================= ! @@ -2887,6 +2924,28 @@ module psb_s_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_ls_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_ls_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_ls_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_ls_base_sparse_mat), intent(inout) :: a + class(psb_ls_base_sparse_mat), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_base_spaxpby + end interface + ! !> Function base_scal: @@ -3496,6 +3555,19 @@ module psb_s_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_ls_coo_scalplusidentity end interface + !> + !! \memberof psb_ls_coo_sparse_mat + !! \see psb_ls_base_mat_mod::psb_ls_base_spaxpby + interface + subroutine psb_ls_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_ls_coo_sparse_mat), intent(inout) :: a + class(psb_ls_base_sparse_mat), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_coo_spaxpby + end interface contains diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index d02caca7..c3b19516 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -234,6 +234,7 @@ module psb_s_mat_mod procedure, pass(a) :: cssm => psb_s_cssm generic, public :: spsm => cssm, cssv, cssv_v procedure, pass(a) :: scalpid => psb_s_scalplusidentity + procedure, pass(a) :: spaxpby => psb_s_spaxpby end type psb_sspmat_type @@ -419,6 +420,7 @@ module psb_s_mat_mod procedure, pass(a) :: scalv => psb_ls_scal generic, public :: scal => scals, scalv procedure, pass(a) :: scalpid => psb_ls_scalplusidentity + procedure, pass(a) :: spaxpby => psb_ls_spaxpby end type psb_lsspmat_type @@ -1168,6 +1170,17 @@ module psb_s_mat_mod end subroutine psb_s_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_s_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(inout) :: a + class(psb_sspmat_type), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_spaxpby + end interface + ! == =================================== ! ! @@ -1772,6 +1785,17 @@ module psb_s_mat_mod end subroutine psb_ls_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_ls_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_ + class(psb_lsspmat_type), intent(inout) :: a + class(psb_lsspmat_type), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_spaxpby + end interface + interface function psb_ls_maxval(a) result(res) import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_ diff --git a/base/modules/serial/psb_z_base_mat_mod.F90 b/base/modules/serial/psb_z_base_mat_mod.F90 index f739af05..c43373db 100644 --- a/base/modules/serial/psb_z_base_mat_mod.F90 +++ b/base/modules/serial/psb_z_base_mat_mod.F90 @@ -126,6 +126,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: colsum => psb_z_base_colsum procedure, pass(a) :: aclsum => psb_z_base_aclsum procedure, pass(a) :: scalpid => psb_z_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_z_base_spaxpby end type psb_z_base_sparse_mat private :: z_base_mat_sync, z_base_mat_is_host, z_base_mat_is_dev, & @@ -228,7 +229,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: colsum => psb_z_coo_colsum procedure, pass(a) :: aclsum => psb_z_coo_aclsum procedure, pass(a) :: scalpid => psb_z_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_z_coo_spaxpby end type psb_z_coo_sparse_mat private :: z_coo_get_nzeros, z_coo_set_nzeros, & @@ -293,6 +294,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: colsum => psb_lz_base_colsum procedure, pass(a) :: aclsum => psb_lz_base_aclsum procedure, pass(a) :: scalpid => psb_lz_base_scalplusidentity + procedure, pass(a) :: spaxpby => psb_lz_base_spaxpby ! ! Convert internal indices ! @@ -394,7 +396,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: colsum => psb_lz_coo_colsum procedure, pass(a) :: aclsum => psb_lz_coo_aclsum procedure, pass(a) :: scalpid => psb_lz_coo_scalplusidentity - + procedure, pass(a) :: spaxpby => psb_lz_coo_spaxpby ! ! This is COO specific ! @@ -1475,6 +1477,28 @@ module psb_z_base_mat_mod end subroutine psb_z_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_z_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_z_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_z_base_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_base_spaxpby + end interface + ! !> Function base_maxval: !! \memberof psb_z_base_sparse_mat @@ -2131,6 +2155,19 @@ module psb_z_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_z_coo_scalplusidentity end interface + ! + !! \memberof psb_z_coo_sparse_mat + !! \see psb_z_base_mat_mod::psb_z_base_spaxpby + interface + subroutine psb_z_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_z_coo_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_coo_spaxpby + end interface ! == ================= ! @@ -2887,6 +2924,28 @@ module psb_z_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_lz_base_scalplusidentity end interface + ! + !> Function base_spaxpby: + !! \memberof psb_lz_base_sparse_mat + !! \brief Scale add tow sparse matrices A = alpha A + beta B + !! + !! \param alpha scaling for A + !! \param A sparse matrix A (intent inout) + !! \param beta scaling for B + !! \param B sparse matrix B (intent in) + !! \param info return code + ! + interface + subroutine psb_lz_base_spaxpby(alpha,a,beta,b,info) + import + class(psb_lz_base_sparse_mat), intent(inout) :: a + class(psb_lz_base_sparse_mat), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_base_spaxpby + end interface + ! !> Function base_scal: @@ -3496,6 +3555,19 @@ module psb_z_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_lz_coo_scalplusidentity end interface + !> + !! \memberof psb_lz_coo_sparse_mat + !! \see psb_lz_base_mat_mod::psb_lz_base_spaxpby + interface + subroutine psb_lz_coo_spaxpby(alpha,a,beta,b,info) + import + class(psb_lz_coo_sparse_mat), intent(inout) :: a + class(psb_lz_base_sparse_mat), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_coo_spaxpby + end interface contains diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index 6a8ed3d6..da7776a3 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -234,6 +234,7 @@ module psb_z_mat_mod procedure, pass(a) :: cssm => psb_z_cssm generic, public :: spsm => cssm, cssv, cssv_v procedure, pass(a) :: scalpid => psb_z_scalplusidentity + procedure, pass(a) :: spaxpby => psb_z_spaxpby end type psb_zspmat_type @@ -419,6 +420,7 @@ module psb_z_mat_mod procedure, pass(a) :: scalv => psb_lz_scal generic, public :: scal => scals, scalv procedure, pass(a) :: scalpid => psb_lz_scalplusidentity + procedure, pass(a) :: spaxpby => psb_lz_spaxpby end type psb_lzspmat_type @@ -1168,6 +1170,17 @@ module psb_z_mat_mod end subroutine psb_z_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_z_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(inout) :: a + class(psb_zspmat_type), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_spaxpby + end interface + ! == =================================== ! ! @@ -1772,6 +1785,17 @@ module psb_z_mat_mod end subroutine psb_lz_scalplusidentity end interface + interface psb_spaxpby + subroutine psb_lz_spaxpby(alpha,a,beta,b,info) + import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_ + class(psb_lzspmat_type), intent(inout) :: a + class(psb_lzspmat_type), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_spaxpby + end interface + interface function psb_lz_maxval(a) result(res) import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_ diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index ad631d94..db076ba2 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -1812,6 +1812,58 @@ subroutine psb_c_base_get_diag(a,d,info) end subroutine psb_c_base_get_diag +subroutine psb_c_base_spaxpby(alpha,a,beta,b,info) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_spaxpby + + complex(psb_spk_), intent(in) :: alpha + class(psb_c_base_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: beta + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + ! Auxiliary + integer(psb_ipk_) :: err_act + character(len=20) :: name='spaxpby' + logical, parameter :: debug=.false. + type(psb_c_coo_sparse_mat) :: acoo + + call psb_erractionsave(err_act) + if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + + call a%mv_to_coo(acoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call acoo%spaxpby(alpha,beta,b,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='spaxby') + goto 9999 + end if + + call acoo%mv_to_fmt(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_fmt') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_c_base_spaxpby ! == ================================== ! diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 06cc09c9..7f6dee46 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -219,6 +219,63 @@ subroutine psb_c_coo_scalplusidentity(d,a,info) end subroutine psb_c_coo_scalplusidentity +subroutine psb_c_coo_spaxpby(alpha,a,beta,b,info) + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_spaxpby + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_c_coo_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + complex(psb_spk_), intent(in) :: alpha + complex(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + + !Local + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_coo_spaxpby' + type(psb_c_coo_sparse_mat) :: tcoo,bcoo + integer(psb_ipk_) :: nza, nzb, M, N + + call psb_erractionsave(err_act) + ! Copy (whatever) b format to coo + call b%cp_to_coo(bcoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='cp_to_coo') + goto 9999 + end if + ! Get information on the matrix + M = a%get_nrows() + N = a%get_ncols() + nza = a%get_nzeros() + nzb = b%get_nzeros() + ! Allocate (temporary) space for the solution + call tcoo%allocate(M,N,(nza+nzb)) + ! Compute the sum + tcoo%ia(1:nza) = a%ia(1:nza) + tcoo%ja(1:nza) = a%ja(1:nza) + tcoo%val(1:nza) = alpha*a%val(1:nza) + tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) + tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb) + tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb) + ! Fix the indexes + call tcoo%fix(info) + ! Move to correct output format + call tcoo%mv_to_coo(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_c_coo_spaxpby subroutine psb_c_coo_reallocate_nz(nz,a) use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_reallocate_nz diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index cb96bebe..9bcf0e39 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -1812,6 +1812,58 @@ subroutine psb_d_base_get_diag(a,d,info) end subroutine psb_d_base_get_diag +subroutine psb_d_base_spaxpby(alpha,a,beta,b,info) + use psb_error_mod + use psb_const_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_base_spaxpby + + real(psb_dpk_), intent(in) :: alpha + class(psb_d_base_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: beta + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + ! Auxiliary + integer(psb_ipk_) :: err_act + character(len=20) :: name='spaxpby' + logical, parameter :: debug=.false. + type(psb_d_coo_sparse_mat) :: acoo + + call psb_erractionsave(err_act) + if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + + call a%mv_to_coo(acoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call acoo%spaxpby(alpha,beta,b,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='spaxby') + goto 9999 + end if + + call acoo%mv_to_fmt(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_fmt') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_d_base_spaxpby ! == ================================== ! diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 18c27a37..a2d5ce49 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -219,6 +219,63 @@ subroutine psb_d_coo_scalplusidentity(d,a,info) end subroutine psb_d_coo_scalplusidentity +subroutine psb_d_coo_spaxpby(alpha,a,beta,b,info) + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_spaxpby + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_d_coo_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + real(psb_dpk_), intent(in) :: alpha + real(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + + !Local + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_coo_spaxpby' + type(psb_d_coo_sparse_mat) :: tcoo,bcoo + integer(psb_ipk_) :: nza, nzb, M, N + + call psb_erractionsave(err_act) + ! Copy (whatever) b format to coo + call b%cp_to_coo(bcoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='cp_to_coo') + goto 9999 + end if + ! Get information on the matrix + M = a%get_nrows() + N = a%get_ncols() + nza = a%get_nzeros() + nzb = b%get_nzeros() + ! Allocate (temporary) space for the solution + call tcoo%allocate(M,N,(nza+nzb)) + ! Compute the sum + tcoo%ia(1:nza) = a%ia(1:nza) + tcoo%ja(1:nza) = a%ja(1:nza) + tcoo%val(1:nza) = alpha*a%val(1:nza) + tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) + tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb) + tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb) + ! Fix the indexes + call tcoo%fix(info) + ! Move to correct output format + call tcoo%mv_to_coo(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_d_coo_spaxpby subroutine psb_d_coo_reallocate_nz(nz,a) use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_reallocate_nz diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index f59e7b00..be3cae97 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -1812,6 +1812,58 @@ subroutine psb_s_base_get_diag(a,d,info) end subroutine psb_s_base_get_diag +subroutine psb_s_base_spaxpby(alpha,a,beta,b,info) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_spaxpby + + real(psb_spk_), intent(in) :: alpha + class(psb_s_base_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: beta + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + ! Auxiliary + integer(psb_ipk_) :: err_act + character(len=20) :: name='spaxpby' + logical, parameter :: debug=.false. + type(psb_s_coo_sparse_mat) :: acoo + + call psb_erractionsave(err_act) + if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + + call a%mv_to_coo(acoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call acoo%spaxpby(alpha,beta,b,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='spaxby') + goto 9999 + end if + + call acoo%mv_to_fmt(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_fmt') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_s_base_spaxpby ! == ================================== ! diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index ed92304a..067ef58a 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -219,6 +219,63 @@ subroutine psb_s_coo_scalplusidentity(d,a,info) end subroutine psb_s_coo_scalplusidentity +subroutine psb_s_coo_spaxpby(alpha,a,beta,b,info) + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_spaxpby + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_s_coo_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + real(psb_spk_), intent(in) :: alpha + real(psb_spk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + + !Local + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_coo_spaxpby' + type(psb_s_coo_sparse_mat) :: tcoo,bcoo + integer(psb_ipk_) :: nza, nzb, M, N + + call psb_erractionsave(err_act) + ! Copy (whatever) b format to coo + call b%cp_to_coo(bcoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='cp_to_coo') + goto 9999 + end if + ! Get information on the matrix + M = a%get_nrows() + N = a%get_ncols() + nza = a%get_nzeros() + nzb = b%get_nzeros() + ! Allocate (temporary) space for the solution + call tcoo%allocate(M,N,(nza+nzb)) + ! Compute the sum + tcoo%ia(1:nza) = a%ia(1:nza) + tcoo%ja(1:nza) = a%ja(1:nza) + tcoo%val(1:nza) = alpha*a%val(1:nza) + tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) + tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb) + tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb) + ! Fix the indexes + call tcoo%fix(info) + ! Move to correct output format + call tcoo%mv_to_coo(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_s_coo_spaxpby subroutine psb_s_coo_reallocate_nz(nz,a) use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_reallocate_nz diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index cf3669ab..254a5450 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -1812,6 +1812,58 @@ subroutine psb_z_base_get_diag(a,d,info) end subroutine psb_z_base_get_diag +subroutine psb_z_base_spaxpby(alpha,a,beta,b,info) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_spaxpby + + complex(psb_dpk_), intent(in) :: alpha + class(psb_z_base_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: beta + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + ! Auxiliary + integer(psb_ipk_) :: err_act + character(len=20) :: name='spaxpby' + logical, parameter :: debug=.false. + type(psb_z_coo_sparse_mat) :: acoo + + call psb_erractionsave(err_act) + if((a%get_ncols() /= b%get_ncols()).or.(a%get_nrows() /= b%get_nrows())) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + + call a%mv_to_coo(acoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call acoo%spaxpby(alpha,beta,b,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='spaxby') + goto 9999 + end if + + call acoo%mv_to_fmt(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_fmt') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_z_base_spaxpby ! == ================================== ! diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index d4f97770..281f308c 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -219,6 +219,63 @@ subroutine psb_z_coo_scalplusidentity(d,a,info) end subroutine psb_z_coo_scalplusidentity +subroutine psb_z_coo_spaxpby(alpha,a,beta,b,info) + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_spaxpby + use psb_error_mod + use psb_const_mod + implicit none + + class(psb_z_coo_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + complex(psb_dpk_), intent(in) :: alpha + complex(psb_dpk_), intent(in) :: beta + integer(psb_ipk_), intent(out) :: info + + !Local + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_coo_spaxpby' + type(psb_z_coo_sparse_mat) :: tcoo,bcoo + integer(psb_ipk_) :: nza, nzb, M, N + + call psb_erractionsave(err_act) + ! Copy (whatever) b format to coo + call b%cp_to_coo(bcoo,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='cp_to_coo') + goto 9999 + end if + ! Get information on the matrix + M = a%get_nrows() + N = a%get_ncols() + nza = a%get_nzeros() + nzb = b%get_nzeros() + ! Allocate (temporary) space for the solution + call tcoo%allocate(M,N,(nza+nzb)) + ! Compute the sum + tcoo%ia(1:nza) = a%ia(1:nza) + tcoo%ja(1:nza) = a%ja(1:nza) + tcoo%val(1:nza) = alpha*a%val(1:nza) + tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) + tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb) + tcoo%val(nza+1:nza+nzb) = beta*bcoo%val(1:nzb) + ! Fix the indexes + call tcoo%fix(info) + ! Move to correct output format + call tcoo%mv_to_coo(a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='mv_to_coo') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_z_coo_spaxpby subroutine psb_z_coo_reallocate_nz(nz,a) use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_reallocate_nz diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 index bf9a3f36..dbf8a88a 100644 --- a/cbind/base/psb_c_psblas_cbind_mod.f90 +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -1151,4 +1151,40 @@ contains end function psb_c_cspscalpid + function psb_c_cspaxpby(alpha,ah,beta,bh,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + complex(c_float_complex), value :: alpha + type(psb_c_cspmat) :: ah + complex(c_float_complex), value :: beta + type(psb_c_cspmat) :: 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%spaxpby(alpha,beta,bp,info) + + res = info + end function psb_c_cspaxpby + end module psb_c_psblas_cbind_mod diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index 4c92514e..aef9636f 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -1252,4 +1252,40 @@ contains end function psb_c_dspscalpid + function psb_c_dspaxpby(alpha,ah,beta,bh,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + real(c_double), value :: alpha + type(psb_c_dspmat) :: ah + real(c_double), value :: beta + type(psb_c_dspmat) :: 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%spaxpby(alpha,beta,bp,info) + + res = info + end function psb_c_dspaxpby + 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 4e85e91c..ab773819 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -1252,4 +1252,40 @@ contains end function psb_c_sspscalpid + function psb_c_sspaxpby(alpha,ah,beta,bh,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + real(c_float), value :: alpha + type(psb_c_sspmat) :: ah + real(c_float), value :: beta + type(psb_c_sspmat) :: 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%spaxpby(alpha,beta,bp,info) + + res = info + end function psb_c_sspaxpby + 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 10066591..b7bf0038 100644 --- a/cbind/base/psb_z_psblas_cbind_mod.f90 +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -1151,4 +1151,40 @@ contains end function psb_c_zspscalpid + function psb_c_zspaxpby(alpha,ah,beta,bh,cdh) bind(c) result(res) + implicit none + integer(psb_c_ipk_) :: res + + complex(c_double_complex), value :: alpha + type(psb_c_zspmat) :: ah + complex(c_double_complex), value :: beta + type(psb_c_zspmat) :: 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%spaxpby(alpha,beta,bp,info) + + res = info + end function psb_c_zspaxpby + end module psb_z_psblas_cbind_mod