fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Corrected implementation of scale plus identity for sparse matrices

Browse Source
merge-paraggr-newops
Cirdans-Home 5 years ago
parent d22d15a0f4
commit 01f4f718de
20 changed files with 820 additions and 644 deletions
Show Stats Download Patch File Download Diff File

36
base/modules/serial/psb_c_csc_mat_mod.f90
Unescape Escape View File

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

18
base/modules/serial/psb_c_csr_mat_mod.f90
Unescape Escape View File

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

36
base/modules/serial/psb_d_csc_mat_mod.f90
Unescape Escape View File

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

18
base/modules/serial/psb_d_csr_mat_mod.f90
Unescape Escape View File

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

36
base/modules/serial/psb_s_csc_mat_mod.f90
Unescape Escape View File

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

18
base/modules/serial/psb_s_csr_mat_mod.f90
Unescape Escape View File

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

36
base/modules/serial/psb_z_csc_mat_mod.f90
Unescape Escape View File

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

18
base/modules/serial/psb_z_csr_mat_mod.f90
Unescape Escape View File

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

64
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -1561,16 +1561,38 @@ subroutine psb_c_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_scalplusidentity' character(len=20) :: name='c_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_scalplusidentity end subroutine psb_c_base_scalplusidentity
subroutine psb_c_base_scal(d,a,info,side) subroutine psb_c_base_scal(d,a,info,side)
@ -3629,16 +3651,38 @@ subroutine psb_lc_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='lc_scalplusidentity' character(len=20) :: name='lc_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_base_scalplusidentity end subroutine psb_lc_base_scalplusidentity
subroutine psb_lc_base_scal(d,a,info,side) subroutine psb_lc_base_scal(d,a,info,side)

168
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

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

80
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

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

64
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -1561,16 +1561,38 @@ subroutine psb_d_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_scalplusidentity' character(len=20) :: name='d_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_base_scalplusidentity end subroutine psb_d_base_scalplusidentity
subroutine psb_d_base_scal(d,a,info,side) subroutine psb_d_base_scal(d,a,info,side)
@ -3629,16 +3651,38 @@ subroutine psb_ld_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='ld_scalplusidentity' character(len=20) :: name='ld_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_scalplusidentity end subroutine psb_ld_base_scalplusidentity
subroutine psb_ld_base_scal(d,a,info,side) subroutine psb_ld_base_scal(d,a,info,side)

168
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

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

80
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

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

64
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -1561,16 +1561,38 @@ subroutine psb_s_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_scalplusidentity' character(len=20) :: name='s_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_base_scalplusidentity end subroutine psb_s_base_scalplusidentity
subroutine psb_s_base_scal(d,a,info,side) subroutine psb_s_base_scal(d,a,info,side)
@ -3629,16 +3651,38 @@ subroutine psb_ls_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='ls_scalplusidentity' character(len=20) :: name='ls_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_base_scalplusidentity end subroutine psb_ls_base_scalplusidentity
subroutine psb_ls_base_scal(d,a,info,side) subroutine psb_ls_base_scal(d,a,info,side)

168
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

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

80
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

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

64
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -1561,16 +1561,38 @@ subroutine psb_z_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_scalplusidentity' character(len=20) :: name='z_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_scalplusidentity end subroutine psb_z_base_scalplusidentity
subroutine psb_z_base_scal(d,a,info,side) subroutine psb_z_base_scal(d,a,info,side)
@ -3629,16 +3651,38 @@ subroutine psb_lz_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='lz_scalplusidentity' character(len=20) :: name='lz_scalplusidentity'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! This is the base version. If we get here call a%mv_to_coo(acoo,info)
! it means the derived class is incomplete, if (info /= psb_success_) then
! so we throw an error. info = psb_err_from_subroutine_
info = psb_err_missing_override_method_ call psb_errpush(info,name, a_err='mv_to_coo')
call psb_errpush(info,name,a_err=a%get_fmt()) goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
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_error_handler(err_act) call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_base_scalplusidentity end subroutine psb_lz_base_scalplusidentity
subroutine psb_lz_base_scal(d,a,info,side) subroutine psb_lz_base_scal(d,a,info,side)

168
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

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

80
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save