Added function for scaled sparse matrix plus identity

merge-paraggr-newops
Cirdans-Home 5 years ago
parent 0ff5321fc1
commit e108416719

@ -125,6 +125,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: arwsum => psb_c_base_arwsum
procedure, pass(a) :: colsum => psb_c_base_colsum
procedure, pass(a) :: aclsum => psb_c_base_aclsum
procedure, pass(a) :: scalpid => psb_c_base_scalplusidentity
end type psb_c_base_sparse_mat
private :: c_base_mat_sync, c_base_mat_is_host, c_base_mat_is_dev, &
@ -226,6 +227,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: arwsum => psb_c_coo_arwsum
procedure, pass(a) :: colsum => psb_c_coo_colsum
procedure, pass(a) :: aclsum => psb_c_coo_aclsum
procedure, pass(a) :: scalpid => psb_c_coo_scalplusidentity
end type psb_c_coo_sparse_mat
@ -290,6 +292,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: arwsum => psb_lc_base_arwsum
procedure, pass(a) :: colsum => psb_lc_base_colsum
procedure, pass(a) :: aclsum => psb_lc_base_aclsum
procedure, pass(a) :: scalpid => psb_lc_base_scalplusidentity
!
! Convert internal indices
!
@ -390,6 +393,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: arwsum => psb_lc_coo_arwsum
procedure, pass(a) :: colsum => psb_lc_coo_colsum
procedure, pass(a) :: aclsum => psb_lc_coo_aclsum
procedure, pass(a) :: scalpid => psb_lc_coo_scalplusidentity
!
! This is COO specific
@ -1454,6 +1458,23 @@ module psb_c_base_mat_mod
end subroutine psb_c_base_scal
end interface
!
!> Function base_scalplusidentity:
!! \memberof psb_c_base_sparse_mat
!! \brief Scale a matrix by a vector and sums an identity
!!
!! \param d Scaling
!! \param info return code
!
interface
subroutine psb_c_base_scalplusidentity(d,a,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_scalplusidentity
end interface
!
!> Function base_maxval:
!! \memberof psb_c_base_sparse_mat
@ -2099,6 +2120,17 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_scals
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scalplusidentity
interface
subroutine psb_c_coo_scalplusidentity(d,a,info)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_scalplusidentity
end interface
! == =================
!
@ -2839,6 +2871,23 @@ module psb_c_base_mat_mod
end subroutine psb_lc_base_scals
end interface
!
!> Function base_scalsplusidentity:
!! \memberof psb_lc_base_sparse_mat
!! \brief Scale a matrix by a single scalar value and adds identity
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_lc_base_scalplusidentity(d,a,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_scalplusidentity
end interface
!
!> Function base_scal:
!! \memberof psb_lc_base_sparse_mat
@ -3436,6 +3485,18 @@ module psb_c_base_mat_mod
end subroutine psb_lc_coo_scals
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_scalplusidentity
interface
subroutine psb_lc_coo_scalplusidentity(d,a,info)
import
class(psb_lc_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_coo_scalplusidentity
end interface
contains
@ -3899,6 +3960,3 @@ contains
end module psb_c_base_mat_mod

@ -71,6 +71,7 @@ module psb_c_csc_mat_mod
procedure, pass(a) :: inner_cssv => psb_c_csc_cssv
procedure, pass(a) :: scals => psb_c_csc_scals
procedure, pass(a) :: scalv => psb_c_csc_scal
procedure, pass(a) :: scalpid => psb_c_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_c_csc_maxval
procedure, pass(a) :: spnm1 => psb_c_csc_csnm1
procedure, pass(a) :: rowsum => psb_c_csc_rowsum
@ -127,6 +128,7 @@ module psb_c_csc_mat_mod
procedure, pass(a) :: sizeof => lc_csc_sizeof
procedure, pass(a) :: scals => psb_lc_csc_scals
procedure, pass(a) :: scalv => psb_lc_csc_scal
procedure, pass(a) :: scalpid => psb_lc_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_lc_csc_maxval
procedure, pass(a) :: spnm1 => psb_lc_csc_csnm1
procedure, pass(a) :: rowsum => psb_lc_csc_rowsum
@ -561,6 +563,17 @@ module psb_c_csc_mat_mod
end subroutine psb_c_csc_scals
end interface
!> \memberof psb_c_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scalplusidentity
interface
subroutine psb_c_csc_scalplusidentity(d,a,info)
import
class(psb_c_csc_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_csc_scalplusidentity
end interface
!
! lc
@ -913,7 +926,16 @@ module psb_c_csc_mat_mod
end subroutine psb_lc_csc_scals
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_scalplusidentity
interface
subroutine psb_lc_csc_scalplusidentity(d,a,info)
import
class(psb_lc_csc_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csc_scalplusidentity
end interface
contains

@ -73,6 +73,7 @@ module psb_c_csr_mat_mod
procedure, pass(a) :: inner_cssv => psb_c_csr_cssv
procedure, pass(a) :: scals => psb_c_csr_scals
procedure, pass(a) :: scalv => psb_c_csr_scal
procedure, pass(a) :: scalpid => psb_c_csr_scalplusidentity
procedure, pass(a) :: maxval => psb_c_csr_maxval
procedure, pass(a) :: spnmi => psb_c_csr_csnmi
procedure, pass(a) :: rowsum => psb_c_csr_rowsum
@ -579,6 +580,17 @@ module psb_c_csr_mat_mod
end subroutine psb_c_csr_scals
end interface
!> \memberof psb_c_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scalplusidentity
interface
subroutine psb_c_csr_scalplusidentity(d,a,info)
import
class(psb_c_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_csr_scalplusidentity
end interface
!> \namespace psb_base_mod \class psb_lc_csr_sparse_mat
!! \extends psb_lc_base_mat_mod::psb_lc_base_sparse_mat

@ -233,6 +233,7 @@ module psb_c_mat_mod
procedure, pass(a) :: cssv => psb_c_cssv
procedure, pass(a) :: cssm => psb_c_cssm
generic, public :: spsm => cssm, cssv, cssv_v
procedure, pass(a) :: scalpid => psb_c_scalplusidentity
end type psb_cspmat_type
@ -1157,6 +1158,14 @@ module psb_c_mat_mod
end subroutine psb_c_scals
end interface
interface psb_scalplusidentity
subroutine psb_c_scalplusidentity(d,a,info)
import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_scalplusidentity
end interface
! == ===================================
!

@ -125,6 +125,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: arwsum => psb_d_base_arwsum
procedure, pass(a) :: colsum => psb_d_base_colsum
procedure, pass(a) :: aclsum => psb_d_base_aclsum
procedure, pass(a) :: scalpid => psb_d_base_scalplusidentity
end type psb_d_base_sparse_mat
private :: d_base_mat_sync, d_base_mat_is_host, d_base_mat_is_dev, &
@ -226,6 +227,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: arwsum => psb_d_coo_arwsum
procedure, pass(a) :: colsum => psb_d_coo_colsum
procedure, pass(a) :: aclsum => psb_d_coo_aclsum
procedure, pass(a) :: scalpid => psb_d_coo_scalplusidentity
end type psb_d_coo_sparse_mat
@ -290,6 +292,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: arwsum => psb_ld_base_arwsum
procedure, pass(a) :: colsum => psb_ld_base_colsum
procedure, pass(a) :: aclsum => psb_ld_base_aclsum
procedure, pass(a) :: scalpid => psb_ld_base_scalplusidentity
!
! Convert internal indices
!
@ -390,6 +393,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: arwsum => psb_ld_coo_arwsum
procedure, pass(a) :: colsum => psb_ld_coo_colsum
procedure, pass(a) :: aclsum => psb_ld_coo_aclsum
procedure, pass(a) :: scalpid => psb_ld_coo_scalplusidentity
!
! This is COO specific
@ -1454,6 +1458,23 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_scal
end interface
!
!> Function base_scalplusidentity:
!! \memberof psb_d_base_sparse_mat
!! \brief Scale a matrix by a vector and sums an identity
!!
!! \param d Scaling
!! \param info return code
!
interface
subroutine psb_d_base_scalplusidentity(d,a,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_scalplusidentity
end interface
!
!> Function base_maxval:
!! \memberof psb_d_base_sparse_mat
@ -2099,6 +2120,17 @@ module psb_d_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_scals
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scalplusidentity
interface
subroutine psb_d_coo_scalplusidentity(d,a,info)
import
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_scalplusidentity
end interface
! == =================
!
@ -2839,6 +2871,23 @@ module psb_d_base_mat_mod
end subroutine psb_ld_base_scals
end interface
!
!> Function base_scalsplusidentity:
!! \memberof psb_ld_base_sparse_mat
!! \brief Scale a matrix by a single scalar value and adds identity
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_ld_base_scalplusidentity(d,a,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_scalplusidentity
end interface
!
!> Function base_scal:
!! \memberof psb_ld_base_sparse_mat
@ -3436,6 +3485,18 @@ module psb_d_base_mat_mod
end subroutine psb_ld_coo_scals
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scalplusidentity
interface
subroutine psb_ld_coo_scalplusidentity(d,a,info)
import
class(psb_ld_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_coo_scalplusidentity
end interface
contains
@ -3899,6 +3960,3 @@ contains
end module psb_d_base_mat_mod

@ -71,6 +71,7 @@ module psb_d_csc_mat_mod
procedure, pass(a) :: inner_cssv => psb_d_csc_cssv
procedure, pass(a) :: scals => psb_d_csc_scals
procedure, pass(a) :: scalv => psb_d_csc_scal
procedure, pass(a) :: scalpid => psb_d_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_d_csc_maxval
procedure, pass(a) :: spnm1 => psb_d_csc_csnm1
procedure, pass(a) :: rowsum => psb_d_csc_rowsum
@ -127,6 +128,7 @@ module psb_d_csc_mat_mod
procedure, pass(a) :: sizeof => ld_csc_sizeof
procedure, pass(a) :: scals => psb_ld_csc_scals
procedure, pass(a) :: scalv => psb_ld_csc_scal
procedure, pass(a) :: scalpid => psb_ld_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_ld_csc_maxval
procedure, pass(a) :: spnm1 => psb_ld_csc_csnm1
procedure, pass(a) :: rowsum => psb_ld_csc_rowsum
@ -561,6 +563,17 @@ module psb_d_csc_mat_mod
end subroutine psb_d_csc_scals
end interface
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scalplusidentity
interface
subroutine psb_d_csc_scalplusidentity(d,a,info)
import
class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_csc_scalplusidentity
end interface
!
! ld
@ -913,7 +926,16 @@ module psb_d_csc_mat_mod
end subroutine psb_ld_csc_scals
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scalplusidentity
interface
subroutine psb_ld_csc_scalplusidentity(d,a,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csc_scalplusidentity
end interface
contains

@ -73,6 +73,7 @@ module psb_d_csr_mat_mod
procedure, pass(a) :: inner_cssv => psb_d_csr_cssv
procedure, pass(a) :: scals => psb_d_csr_scals
procedure, pass(a) :: scalv => psb_d_csr_scal
procedure, pass(a) :: scalpid => psb_d_csr_scalplusidentity
procedure, pass(a) :: maxval => psb_d_csr_maxval
procedure, pass(a) :: spnmi => psb_d_csr_csnmi
procedure, pass(a) :: rowsum => psb_d_csr_rowsum
@ -579,6 +580,17 @@ module psb_d_csr_mat_mod
end subroutine psb_d_csr_scals
end interface
!> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scalplusidentity
interface
subroutine psb_d_csr_scalplusidentity(d,a,info)
import
class(psb_d_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_csr_scalplusidentity
end interface
!> \namespace psb_base_mod \class psb_ld_csr_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat

@ -233,6 +233,7 @@ module psb_d_mat_mod
procedure, pass(a) :: cssv => psb_d_cssv
procedure, pass(a) :: cssm => psb_d_cssm
generic, public :: spsm => cssm, cssv, cssv_v
procedure, pass(a) :: scalpid => psb_d_scalplusidentity
end type psb_dspmat_type
@ -1157,6 +1158,14 @@ module psb_d_mat_mod
end subroutine psb_d_scals
end interface
interface psb_scalplusidentity
subroutine psb_d_scalplusidentity(d,a,info)
import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_scalplusidentity
end interface
! == ===================================
!

@ -125,6 +125,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: arwsum => psb_s_base_arwsum
procedure, pass(a) :: colsum => psb_s_base_colsum
procedure, pass(a) :: aclsum => psb_s_base_aclsum
procedure, pass(a) :: scalpid => psb_s_base_scalplusidentity
end type psb_s_base_sparse_mat
private :: s_base_mat_sync, s_base_mat_is_host, s_base_mat_is_dev, &
@ -226,6 +227,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: arwsum => psb_s_coo_arwsum
procedure, pass(a) :: colsum => psb_s_coo_colsum
procedure, pass(a) :: aclsum => psb_s_coo_aclsum
procedure, pass(a) :: scalpid => psb_s_coo_scalplusidentity
end type psb_s_coo_sparse_mat
@ -290,6 +292,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: arwsum => psb_ls_base_arwsum
procedure, pass(a) :: colsum => psb_ls_base_colsum
procedure, pass(a) :: aclsum => psb_ls_base_aclsum
procedure, pass(a) :: scalpid => psb_ls_base_scalplusidentity
!
! Convert internal indices
!
@ -390,6 +393,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: arwsum => psb_ls_coo_arwsum
procedure, pass(a) :: colsum => psb_ls_coo_colsum
procedure, pass(a) :: aclsum => psb_ls_coo_aclsum
procedure, pass(a) :: scalpid => psb_ls_coo_scalplusidentity
!
! This is COO specific
@ -1454,6 +1458,23 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_scal
end interface
!
!> Function base_scalplusidentity:
!! \memberof psb_s_base_sparse_mat
!! \brief Scale a matrix by a vector and sums an identity
!!
!! \param d Scaling
!! \param info return code
!
interface
subroutine psb_s_base_scalplusidentity(d,a,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_scalplusidentity
end interface
!
!> Function base_maxval:
!! \memberof psb_s_base_sparse_mat
@ -2099,6 +2120,17 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_scals
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scalplusidentity
interface
subroutine psb_s_coo_scalplusidentity(d,a,info)
import
class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_scalplusidentity
end interface
! == =================
!
@ -2839,6 +2871,23 @@ module psb_s_base_mat_mod
end subroutine psb_ls_base_scals
end interface
!
!> Function base_scalsplusidentity:
!! \memberof psb_ls_base_sparse_mat
!! \brief Scale a matrix by a single scalar value and adds identity
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_ls_base_scalplusidentity(d,a,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_scalplusidentity
end interface
!
!> Function base_scal:
!! \memberof psb_ls_base_sparse_mat
@ -3436,6 +3485,18 @@ module psb_s_base_mat_mod
end subroutine psb_ls_coo_scals
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_scalplusidentity
interface
subroutine psb_ls_coo_scalplusidentity(d,a,info)
import
class(psb_ls_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_coo_scalplusidentity
end interface
contains
@ -3899,6 +3960,3 @@ contains
end module psb_s_base_mat_mod

@ -71,6 +71,7 @@ module psb_s_csc_mat_mod
procedure, pass(a) :: inner_cssv => psb_s_csc_cssv
procedure, pass(a) :: scals => psb_s_csc_scals
procedure, pass(a) :: scalv => psb_s_csc_scal
procedure, pass(a) :: scalpid => psb_s_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_s_csc_maxval
procedure, pass(a) :: spnm1 => psb_s_csc_csnm1
procedure, pass(a) :: rowsum => psb_s_csc_rowsum
@ -127,6 +128,7 @@ module psb_s_csc_mat_mod
procedure, pass(a) :: sizeof => ls_csc_sizeof
procedure, pass(a) :: scals => psb_ls_csc_scals
procedure, pass(a) :: scalv => psb_ls_csc_scal
procedure, pass(a) :: scalpid => psb_ls_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_ls_csc_maxval
procedure, pass(a) :: spnm1 => psb_ls_csc_csnm1
procedure, pass(a) :: rowsum => psb_ls_csc_rowsum
@ -561,6 +563,17 @@ module psb_s_csc_mat_mod
end subroutine psb_s_csc_scals
end interface
!> \memberof psb_s_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scalplusidentity
interface
subroutine psb_s_csc_scalplusidentity(d,a,info)
import
class(psb_s_csc_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_csc_scalplusidentity
end interface
!
! ls
@ -913,7 +926,16 @@ module psb_s_csc_mat_mod
end subroutine psb_ls_csc_scals
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_scalplusidentity
interface
subroutine psb_ls_csc_scalplusidentity(d,a,info)
import
class(psb_ls_csc_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csc_scalplusidentity
end interface
contains

@ -73,6 +73,7 @@ module psb_s_csr_mat_mod
procedure, pass(a) :: inner_cssv => psb_s_csr_cssv
procedure, pass(a) :: scals => psb_s_csr_scals
procedure, pass(a) :: scalv => psb_s_csr_scal
procedure, pass(a) :: scalpid => psb_s_csr_scalplusidentity
procedure, pass(a) :: maxval => psb_s_csr_maxval
procedure, pass(a) :: spnmi => psb_s_csr_csnmi
procedure, pass(a) :: rowsum => psb_s_csr_rowsum
@ -579,6 +580,17 @@ module psb_s_csr_mat_mod
end subroutine psb_s_csr_scals
end interface
!> \memberof psb_s_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scalplusidentity
interface
subroutine psb_s_csr_scalplusidentity(d,a,info)
import
class(psb_s_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_csr_scalplusidentity
end interface
!> \namespace psb_base_mod \class psb_ls_csr_sparse_mat
!! \extends psb_ls_base_mat_mod::psb_ls_base_sparse_mat

@ -233,6 +233,7 @@ module psb_s_mat_mod
procedure, pass(a) :: cssv => psb_s_cssv
procedure, pass(a) :: cssm => psb_s_cssm
generic, public :: spsm => cssm, cssv, cssv_v
procedure, pass(a) :: scalpid => psb_s_scalplusidentity
end type psb_sspmat_type
@ -1157,6 +1158,14 @@ module psb_s_mat_mod
end subroutine psb_s_scals
end interface
interface psb_scalplusidentity
subroutine psb_s_scalplusidentity(d,a,info)
import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_scalplusidentity
end interface
! == ===================================
!

@ -125,6 +125,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: arwsum => psb_z_base_arwsum
procedure, pass(a) :: colsum => psb_z_base_colsum
procedure, pass(a) :: aclsum => psb_z_base_aclsum
procedure, pass(a) :: scalpid => psb_z_base_scalplusidentity
end type psb_z_base_sparse_mat
private :: z_base_mat_sync, z_base_mat_is_host, z_base_mat_is_dev, &
@ -226,6 +227,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: arwsum => psb_z_coo_arwsum
procedure, pass(a) :: colsum => psb_z_coo_colsum
procedure, pass(a) :: aclsum => psb_z_coo_aclsum
procedure, pass(a) :: scalpid => psb_z_coo_scalplusidentity
end type psb_z_coo_sparse_mat
@ -290,6 +292,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: arwsum => psb_lz_base_arwsum
procedure, pass(a) :: colsum => psb_lz_base_colsum
procedure, pass(a) :: aclsum => psb_lz_base_aclsum
procedure, pass(a) :: scalpid => psb_lz_base_scalplusidentity
!
! Convert internal indices
!
@ -390,6 +393,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: arwsum => psb_lz_coo_arwsum
procedure, pass(a) :: colsum => psb_lz_coo_colsum
procedure, pass(a) :: aclsum => psb_lz_coo_aclsum
procedure, pass(a) :: scalpid => psb_lz_coo_scalplusidentity
!
! This is COO specific
@ -1454,6 +1458,23 @@ module psb_z_base_mat_mod
end subroutine psb_z_base_scal
end interface
!
!> Function base_scalplusidentity:
!! \memberof psb_z_base_sparse_mat
!! \brief Scale a matrix by a vector and sums an identity
!!
!! \param d Scaling
!! \param info return code
!
interface
subroutine psb_z_base_scalplusidentity(d,a,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_scalplusidentity
end interface
!
!> Function base_maxval:
!! \memberof psb_z_base_sparse_mat
@ -2099,6 +2120,17 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_scals
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scalplusidentity
interface
subroutine psb_z_coo_scalplusidentity(d,a,info)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_scalplusidentity
end interface
! == =================
!
@ -2839,6 +2871,23 @@ module psb_z_base_mat_mod
end subroutine psb_lz_base_scals
end interface
!
!> Function base_scalsplusidentity:
!! \memberof psb_lz_base_sparse_mat
!! \brief Scale a matrix by a single scalar value and adds identity
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_lz_base_scalplusidentity(d,a,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_scalplusidentity
end interface
!
!> Function base_scal:
!! \memberof psb_lz_base_sparse_mat
@ -3436,6 +3485,18 @@ module psb_z_base_mat_mod
end subroutine psb_lz_coo_scals
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_scalplusidentity
interface
subroutine psb_lz_coo_scalplusidentity(d,a,info)
import
class(psb_lz_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_coo_scalplusidentity
end interface
contains
@ -3899,6 +3960,3 @@ contains
end module psb_z_base_mat_mod

@ -71,6 +71,7 @@ module psb_z_csc_mat_mod
procedure, pass(a) :: inner_cssv => psb_z_csc_cssv
procedure, pass(a) :: scals => psb_z_csc_scals
procedure, pass(a) :: scalv => psb_z_csc_scal
procedure, pass(a) :: scalpid => psb_z_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_z_csc_maxval
procedure, pass(a) :: spnm1 => psb_z_csc_csnm1
procedure, pass(a) :: rowsum => psb_z_csc_rowsum
@ -127,6 +128,7 @@ module psb_z_csc_mat_mod
procedure, pass(a) :: sizeof => lz_csc_sizeof
procedure, pass(a) :: scals => psb_lz_csc_scals
procedure, pass(a) :: scalv => psb_lz_csc_scal
procedure, pass(a) :: scalpid => psb_lz_csc_scalplusidentity
procedure, pass(a) :: maxval => psb_lz_csc_maxval
procedure, pass(a) :: spnm1 => psb_lz_csc_csnm1
procedure, pass(a) :: rowsum => psb_lz_csc_rowsum
@ -561,6 +563,17 @@ module psb_z_csc_mat_mod
end subroutine psb_z_csc_scals
end interface
!> \memberof psb_z_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scalplusidentity
interface
subroutine psb_z_csc_scalplusidentity(d,a,info)
import
class(psb_z_csc_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_csc_scalplusidentity
end interface
!
! lz
@ -913,7 +926,16 @@ module psb_z_csc_mat_mod
end subroutine psb_lz_csc_scals
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_scalplusidentity
interface
subroutine psb_lz_csc_scalplusidentity(d,a,info)
import
class(psb_lz_csc_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csc_scalplusidentity
end interface
contains

@ -73,6 +73,7 @@ module psb_z_csr_mat_mod
procedure, pass(a) :: inner_cssv => psb_z_csr_cssv
procedure, pass(a) :: scals => psb_z_csr_scals
procedure, pass(a) :: scalv => psb_z_csr_scal
procedure, pass(a) :: scalpid => psb_z_csr_scalplusidentity
procedure, pass(a) :: maxval => psb_z_csr_maxval
procedure, pass(a) :: spnmi => psb_z_csr_csnmi
procedure, pass(a) :: rowsum => psb_z_csr_rowsum
@ -579,6 +580,17 @@ module psb_z_csr_mat_mod
end subroutine psb_z_csr_scals
end interface
!> \memberof psb_z_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scalplusidentity
interface
subroutine psb_z_csr_scalplusidentity(d,a,info)
import
class(psb_z_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_csr_scalplusidentity
end interface
!> \namespace psb_base_mod \class psb_lz_csr_sparse_mat
!! \extends psb_lz_base_mat_mod::psb_lz_base_sparse_mat

@ -233,6 +233,7 @@ module psb_z_mat_mod
procedure, pass(a) :: cssv => psb_z_cssv
procedure, pass(a) :: cssm => psb_z_cssm
generic, public :: spsm => cssm, cssv, cssv_v
procedure, pass(a) :: scalpid => psb_z_scalplusidentity
end type psb_zspmat_type
@ -1157,6 +1158,14 @@ module psb_z_mat_mod
end subroutine psb_z_scals
end interface
interface psb_scalplusidentity
subroutine psb_z_scalplusidentity(d,a,info)
import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_scalplusidentity
end interface
! == ===================================
!

@ -1550,7 +1550,28 @@ subroutine psb_c_base_scals(d,a,info)
end subroutine psb_c_base_scals
subroutine psb_c_base_scalplusidentity(d,a,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_scalplusidentity
use psb_error_mod
implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_scalplusidentity'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_c_base_scalplusidentity
subroutine psb_c_base_scal(d,a,info,side)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_scal
@ -4026,5 +4047,3 @@ subroutine psb_lc_base_mv_from_ifmt(a,b,info)
return
end subroutine psb_lc_base_mv_from_ifmt

@ -167,6 +167,7 @@ subroutine psb_c_coo_scals(d,a,info)
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
enddo
call a%set_host()
call psb_erractionrestore(err_act)
@ -178,6 +179,46 @@ subroutine psb_c_coo_scals(d,a,info)
end subroutine psb_c_coo_scals
subroutine psb_c_coo_scalplusidentity(d,a,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_scalplusidentity
use psb_error_mod
use psb_const_mod
implicit none
class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
j=a%ia(i)
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
a%val(i) = a%val(i) + cone
endif
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_coo_scalplusidentity
subroutine psb_c_coo_reallocate_nz(nz,a)
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_reallocate_nz
@ -6908,4 +6949,3 @@ subroutine psb_lc_cp_coo_from_icoo(a,b,info)
return
end subroutine psb_lc_cp_coo_from_icoo

@ -1485,6 +1485,49 @@ subroutine psb_c_csc_scals(d,a,info)
end subroutine psb_c_csc_scals
subroutine psb_c_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_scalplusidentity
implicit none
class(psb_c_csc_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%icp(i),a%icp(i+1)-1
j=a%ia(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + cone
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_csc_scalplusidentity
! == ===================================
!

@ -1677,6 +1677,47 @@ subroutine psb_c_csr_scals(d,a,info)
end subroutine psb_c_csr_scals
subroutine psb_c_csr_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_scalplusidentity
implicit none
class(psb_c_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%irp(i),a%irp(i+1)-1
j=a%ja(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + cone
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_csr_scalplusidentity
@ -5500,4 +5541,3 @@ contains
end subroutine csr_spspmm
end subroutine psb_lccsrspspmm

@ -2453,6 +2453,39 @@ subroutine psb_c_scals(d,a,info)
end subroutine psb_c_scals
subroutine psb_c_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_c_mat_mod, psb_protect_name => psb_c_scalplusidentity
implicit none
class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%scalpid(d,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_scalplusidentity
subroutine psb_c_mv_from_lb(a,b)
use psb_error_mod
use psb_const_mod
@ -4952,7 +4985,3 @@ subroutine psb_lc_cp_to_i(a,b)
end if
end subroutine psb_lc_cp_to_i

@ -1550,7 +1550,28 @@ subroutine psb_d_base_scals(d,a,info)
end subroutine psb_d_base_scals
subroutine psb_d_base_scalplusidentity(d,a,info)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_scalplusidentity
use psb_error_mod
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_scalplusidentity'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_d_base_scalplusidentity
subroutine psb_d_base_scal(d,a,info,side)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_scal
@ -4026,5 +4047,3 @@ subroutine psb_ld_base_mv_from_ifmt(a,b,info)
return
end subroutine psb_ld_base_mv_from_ifmt

@ -167,6 +167,7 @@ subroutine psb_d_coo_scals(d,a,info)
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
enddo
call a%set_host()
call psb_erractionrestore(err_act)
@ -178,6 +179,46 @@ subroutine psb_d_coo_scals(d,a,info)
end subroutine psb_d_coo_scals
subroutine psb_d_coo_scalplusidentity(d,a,info)
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_scalplusidentity
use psb_error_mod
use psb_const_mod
implicit none
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
j=a%ia(i)
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
a%val(i) = a%val(i) + done
endif
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_coo_scalplusidentity
subroutine psb_d_coo_reallocate_nz(nz,a)
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_reallocate_nz
@ -6908,4 +6949,3 @@ subroutine psb_ld_cp_coo_from_icoo(a,b,info)
return
end subroutine psb_ld_cp_coo_from_icoo

@ -1485,6 +1485,49 @@ subroutine psb_d_csc_scals(d,a,info)
end subroutine psb_d_csc_scals
subroutine psb_d_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_scalplusidentity
implicit none
class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%icp(i),a%icp(i+1)-1
j=a%ia(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + done
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_csc_scalplusidentity
! == ===================================
!

@ -1677,6 +1677,47 @@ subroutine psb_d_csr_scals(d,a,info)
end subroutine psb_d_csr_scals
subroutine psb_d_csr_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_scalplusidentity
implicit none
class(psb_d_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%irp(i),a%irp(i+1)-1
j=a%ja(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + done
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_csr_scalplusidentity
@ -5500,4 +5541,3 @@ contains
end subroutine csr_spspmm
end subroutine psb_ldcsrspspmm

@ -2453,6 +2453,39 @@ subroutine psb_d_scals(d,a,info)
end subroutine psb_d_scals
subroutine psb_d_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_d_mat_mod, psb_protect_name => psb_d_scalplusidentity
implicit none
class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%scalpid(d,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_scalplusidentity
subroutine psb_d_mv_from_lb(a,b)
use psb_error_mod
use psb_const_mod
@ -4952,7 +4985,3 @@ subroutine psb_ld_cp_to_i(a,b)
end if
end subroutine psb_ld_cp_to_i

@ -1550,7 +1550,28 @@ subroutine psb_s_base_scals(d,a,info)
end subroutine psb_s_base_scals
subroutine psb_s_base_scalplusidentity(d,a,info)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_scalplusidentity
use psb_error_mod
implicit none
class(psb_s_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_scalplusidentity'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_s_base_scalplusidentity
subroutine psb_s_base_scal(d,a,info,side)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_scal
@ -4026,5 +4047,3 @@ subroutine psb_ls_base_mv_from_ifmt(a,b,info)
return
end subroutine psb_ls_base_mv_from_ifmt

@ -167,6 +167,7 @@ subroutine psb_s_coo_scals(d,a,info)
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
enddo
call a%set_host()
call psb_erractionrestore(err_act)
@ -178,6 +179,46 @@ subroutine psb_s_coo_scals(d,a,info)
end subroutine psb_s_coo_scals
subroutine psb_s_coo_scalplusidentity(d,a,info)
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_scalplusidentity
use psb_error_mod
use psb_const_mod
implicit none
class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
j=a%ia(i)
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
a%val(i) = a%val(i) + sone
endif
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_coo_scalplusidentity
subroutine psb_s_coo_reallocate_nz(nz,a)
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_reallocate_nz
@ -6908,4 +6949,3 @@ subroutine psb_ls_cp_coo_from_icoo(a,b,info)
return
end subroutine psb_ls_cp_coo_from_icoo

@ -1485,6 +1485,49 @@ subroutine psb_s_csc_scals(d,a,info)
end subroutine psb_s_csc_scals
subroutine psb_s_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_scalplusidentity
implicit none
class(psb_s_csc_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%icp(i),a%icp(i+1)-1
j=a%ia(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + sone
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_csc_scalplusidentity
! == ===================================
!

@ -1677,6 +1677,47 @@ subroutine psb_s_csr_scals(d,a,info)
end subroutine psb_s_csr_scals
subroutine psb_s_csr_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_scalplusidentity
implicit none
class(psb_s_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%irp(i),a%irp(i+1)-1
j=a%ja(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + sone
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_csr_scalplusidentity
@ -5500,4 +5541,3 @@ contains
end subroutine csr_spspmm
end subroutine psb_lscsrspspmm

@ -2453,6 +2453,39 @@ subroutine psb_s_scals(d,a,info)
end subroutine psb_s_scals
subroutine psb_s_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_s_mat_mod, psb_protect_name => psb_s_scalplusidentity
implicit none
class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%scalpid(d,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_scalplusidentity
subroutine psb_s_mv_from_lb(a,b)
use psb_error_mod
use psb_const_mod
@ -4952,7 +4985,3 @@ subroutine psb_ls_cp_to_i(a,b)
end if
end subroutine psb_ls_cp_to_i

@ -1550,7 +1550,28 @@ subroutine psb_z_base_scals(d,a,info)
end subroutine psb_z_base_scals
subroutine psb_z_base_scalplusidentity(d,a,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_scalplusidentity
use psb_error_mod
implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_scalplusidentity'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_z_base_scalplusidentity
subroutine psb_z_base_scal(d,a,info,side)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_scal
@ -4026,5 +4047,3 @@ subroutine psb_lz_base_mv_from_ifmt(a,b,info)
return
end subroutine psb_lz_base_mv_from_ifmt

@ -167,6 +167,7 @@ subroutine psb_z_coo_scals(d,a,info)
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
enddo
call a%set_host()
call psb_erractionrestore(err_act)
@ -178,6 +179,46 @@ subroutine psb_z_coo_scals(d,a,info)
end subroutine psb_z_coo_scals
subroutine psb_z_coo_scalplusidentity(d,a,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_scalplusidentity
use psb_error_mod
use psb_const_mod
implicit none
class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
j=a%ia(i)
if ((j == a%ja(i)) .and.(j <= mnm ) .and.(j>0)) then
a%val(i) = a%val(i) + zone
endif
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_coo_scalplusidentity
subroutine psb_z_coo_reallocate_nz(nz,a)
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_reallocate_nz
@ -6908,4 +6949,3 @@ subroutine psb_lz_cp_coo_from_icoo(a,b,info)
return
end subroutine psb_lz_cp_coo_from_icoo

@ -1485,6 +1485,49 @@ subroutine psb_z_csc_scals(d,a,info)
end subroutine psb_z_csc_scals
subroutine psb_z_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_scalplusidentity
implicit none
class(psb_z_csc_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%icp(i),a%icp(i+1)-1
j=a%ia(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + zone
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_csc_scalplusidentity
! == ===================================
!

@ -1677,6 +1677,47 @@ subroutine psb_z_csr_scals(d,a,info)
end subroutine psb_z_csr_scals
subroutine psb_z_csr_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_scalplusidentity
implicit none
class(psb_z_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, k, m
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
call a%make_nonunit()
end if
mnm = min(a%get_nrows(),a%get_ncols())
do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d
do k=a%irp(i),a%irp(i+1)-1
j=a%ja(k)
if ((j == i) .and.(j <= mnm )) then
a%val(k) = a%val(k) + zone
endif
enddo
enddo
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_csr_scalplusidentity
@ -5500,4 +5541,3 @@ contains
end subroutine csr_spspmm
end subroutine psb_lzcsrspspmm

@ -2453,6 +2453,39 @@ subroutine psb_z_scals(d,a,info)
end subroutine psb_z_scals
subroutine psb_z_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_z_mat_mod, psb_protect_name => psb_z_scalplusidentity
implicit none
class(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='scalplusidentity'
logical, parameter :: debug=.false.
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%scalpid(d,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_scalplusidentity
subroutine psb_z_mv_from_lb(a,b)
use psb_error_mod
use psb_const_mod
@ -4952,7 +4985,3 @@ subroutine psb_lz_cp_to_i(a,b)
end if
end subroutine psb_lz_cp_to_i

@ -1091,4 +1091,64 @@ contains
res = info
end function
function psb_c_cspscal(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
complex(c_float_complex), value :: alpha
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 = -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%scal(alpha,info)
res = info
end function psb_c_cspscal
function psb_c_cspscalpid(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
complex(c_float_complex), value :: alpha
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 = -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%scalpid(alpha,info)
res = info
end function psb_c_cspscalpid
end module psb_c_psblas_cbind_mod

@ -1192,4 +1192,64 @@ contains
res = info
end function
function psb_c_dspscal(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
real(c_double), value :: alpha
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 = -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%scal(alpha,info)
res = info
end function psb_c_dspscal
function psb_c_dspscalpid(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
real(c_double), value :: alpha
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 = -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%scalpid(alpha,info)
res = info
end function psb_c_dspscalpid
end module psb_d_psblas_cbind_mod

@ -1192,4 +1192,64 @@ contains
res = info
end function
function psb_c_sspscal(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
real(c_float), value :: alpha
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 = -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%scal(alpha,info)
res = info
end function psb_c_sspscal
function psb_c_sspscalpid(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
real(c_float), value :: alpha
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 = -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%scalpid(alpha,info)
res = info
end function psb_c_sspscalpid
end module psb_s_psblas_cbind_mod

@ -1091,4 +1091,64 @@ contains
res = info
end function
function psb_c_zspscal(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
complex(c_double_complex), value :: alpha
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 = -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%scal(alpha,info)
res = info
end function psb_c_zspscal
function psb_c_zspscalpid(alpha,ah,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
complex(c_double_complex), value :: alpha
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 = -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%scalpid(alpha,info)
res = info
end function psb_c_zspscalpid
end module psb_z_psblas_cbind_mod

Loading…
Cancel
Save