fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 20:02:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

Corrected implementation of scale plus identity for sparse matrices

Browse Source
This commit is contained in:
Cirdans-Home
2020-04-14 18:56:22 +02:00
parent d22d15a0f4
commit 01f4f718de
20 changed files with 820 additions and 644 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/serial/psb_c_csc_mat_mod.f90
+18 -18
View File
@@ -71,7 +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) :: 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
@@ -128,7 +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) :: 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
@@ -565,14 +565,14 @@ module psb_c_csc_mat_mod
!> \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
! 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
!
@@ -928,14 +928,14 @@ module psb_c_csc_mat_mod
!> \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
! 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
base/modules/serial/psb_c_csr_mat_mod.f90
+9 -9
View File
@@ -73,7 +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) :: 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
@@ -582,14 +582,14 @@ module psb_c_csr_mat_mod
!> \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
! 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
base/modules/serial/psb_d_csc_mat_mod.f90
+18 -18
View File
@@ -71,7 +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) :: 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
@@ -128,7 +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) :: 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
@@ -565,14 +565,14 @@ module psb_d_csc_mat_mod
!> \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
! 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
!
@@ -928,14 +928,14 @@ module psb_d_csc_mat_mod
!> \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
! 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
base/modules/serial/psb_d_csr_mat_mod.f90
+9 -9
View File
@@ -73,7 +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) :: 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
@@ -582,14 +582,14 @@ module psb_d_csr_mat_mod
!> \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
! 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
base/modules/serial/psb_s_csc_mat_mod.f90
+18 -18
View File
@@ -71,7 +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) :: 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
@@ -128,7 +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) :: 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
@@ -565,14 +565,14 @@ module psb_s_csc_mat_mod
!> \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
! 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
!
@@ -928,14 +928,14 @@ module psb_s_csc_mat_mod
!> \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
! 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
base/modules/serial/psb_s_csr_mat_mod.f90
+9 -9
View File
@@ -73,7 +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) :: 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
@@ -582,14 +582,14 @@ module psb_s_csr_mat_mod
!> \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
! 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
base/modules/serial/psb_z_csc_mat_mod.f90
+18 -18
View File
@@ -71,7 +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) :: 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
@@ -128,7 +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) :: 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
@@ -565,14 +565,14 @@ module psb_z_csc_mat_mod
!> \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
! 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
!
@@ -928,14 +928,14 @@ module psb_z_csc_mat_mod
!> \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
! 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
base/modules/serial/psb_z_csr_mat_mod.f90
+9 -9
View File
@@ -73,7 +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) :: 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
@@ -582,14 +582,14 @@ module psb_z_csr_mat_mod
!> \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
! 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
base/serial/impl/psb_c_base_mat_impl.F90
+54 -10
View File
@@ -1561,16 +1561,38 @@ subroutine psb_c_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_scalplusidentity
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
character(len=20) :: name='lc_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_base_scalplusidentity
subroutine psb_lc_base_scal(d,a,info,side)
base/serial/impl/psb_c_csc_impl.f90
+84 -84
View File
@@ -1485,48 +1485,48 @@ 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
! 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
! == ===================================
@@ -3107,48 +3107,48 @@ subroutine psb_lc_csc_scals(d,a,info)
end subroutine psb_lc_csc_scals
subroutine psb_lc_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_scalplusidentity
implicit none
class(psb_lc_csc_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_) :: mnm, i, j, k, m
integer(psb_ipk_) :: err_act, 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_lc_csc_scalplusidentity
! subroutine psb_lc_csc_scalplusidentity(d,a,info)
! use psb_error_mod
! use psb_const_mod
! use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_scalplusidentity
! implicit none
! class(psb_lc_csc_sparse_mat), intent(inout) :: a
! complex(psb_spk_), intent(in) :: d
! integer(psb_ipk_), intent(out) :: info
!
! integer(psb_lpk_) :: mnm, i, j, k, m
! integer(psb_ipk_) :: err_act, 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_lc_csc_scalplusidentity
function psb_lc_csc_maxval(a) result(res)
use psb_error_mod
base/serial/impl/psb_c_csr_impl.f90
+40 -40
View File
@@ -1677,46 +1677,46 @@ 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
! 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
base/serial/impl/psb_d_base_mat_impl.F90
+54 -10
View File
@@ -1561,16 +1561,38 @@ subroutine psb_d_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_base_scalplusidentity
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
character(len=20) :: name='ld_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_scalplusidentity
subroutine psb_ld_base_scal(d,a,info,side)
base/serial/impl/psb_d_csc_impl.f90
+84 -84
View File
@@ -1485,48 +1485,48 @@ 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
! 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
! == ===================================
@@ -3107,48 +3107,48 @@ subroutine psb_ld_csc_scals(d,a,info)
end subroutine psb_ld_csc_scals
subroutine psb_ld_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_scalplusidentity
implicit none
class(psb_ld_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_) :: mnm, i, j, k, m
integer(psb_ipk_) :: err_act, 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_ld_csc_scalplusidentity
! subroutine psb_ld_csc_scalplusidentity(d,a,info)
! use psb_error_mod
! use psb_const_mod
! use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_scalplusidentity
! implicit none
! class(psb_ld_csc_sparse_mat), intent(inout) :: a
! real(psb_dpk_), intent(in) :: d
! integer(psb_ipk_), intent(out) :: info
!
! integer(psb_lpk_) :: mnm, i, j, k, m
! integer(psb_ipk_) :: err_act, 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_ld_csc_scalplusidentity
function psb_ld_csc_maxval(a) result(res)
use psb_error_mod
base/serial/impl/psb_d_csr_impl.f90
+40 -40
View File
@@ -1677,46 +1677,46 @@ 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
! 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
base/serial/impl/psb_s_base_mat_impl.F90
+54 -10
View File
@@ -1561,16 +1561,38 @@ subroutine psb_s_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_base_scalplusidentity
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
character(len=20) :: name='ls_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_base_scalplusidentity
subroutine psb_ls_base_scal(d,a,info,side)
base/serial/impl/psb_s_csc_impl.f90
+84 -84
View File
@@ -1485,48 +1485,48 @@ 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
! 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
! == ===================================
@@ -3107,48 +3107,48 @@ subroutine psb_ls_csc_scals(d,a,info)
end subroutine psb_ls_csc_scals
subroutine psb_ls_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_scalplusidentity
implicit none
class(psb_ls_csc_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_) :: mnm, i, j, k, m
integer(psb_ipk_) :: err_act, 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_ls_csc_scalplusidentity
! subroutine psb_ls_csc_scalplusidentity(d,a,info)
! use psb_error_mod
! use psb_const_mod
! use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_scalplusidentity
! implicit none
! class(psb_ls_csc_sparse_mat), intent(inout) :: a
! real(psb_spk_), intent(in) :: d
! integer(psb_ipk_), intent(out) :: info
!
! integer(psb_lpk_) :: mnm, i, j, k, m
! integer(psb_ipk_) :: err_act, 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_ls_csc_scalplusidentity
function psb_ls_csc_maxval(a) result(res)
use psb_error_mod
base/serial/impl/psb_s_csr_impl.f90
+40 -40
View File
@@ -1677,46 +1677,46 @@ 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
! 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
base/serial/impl/psb_z_base_mat_impl.F90
+54 -10
View File
@@ -1561,16 +1561,38 @@ subroutine psb_z_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_scalplusidentity
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
character(len=20) :: name='lz_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: acoo
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 a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%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)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_base_scalplusidentity
subroutine psb_lz_base_scal(d,a,info,side)
base/serial/impl/psb_z_csc_impl.f90
+84 -84
View File
@@ -1485,48 +1485,48 @@ 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
! 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
! == ===================================
@@ -3107,48 +3107,48 @@ subroutine psb_lz_csc_scals(d,a,info)
end subroutine psb_lz_csc_scals
subroutine psb_lz_csc_scalplusidentity(d,a,info)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_scalplusidentity
implicit none
class(psb_lz_csc_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_) :: mnm, i, j, k, m
integer(psb_ipk_) :: err_act, 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_lz_csc_scalplusidentity
! subroutine psb_lz_csc_scalplusidentity(d,a,info)
! use psb_error_mod
! use psb_const_mod
! use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_scalplusidentity
! implicit none
! class(psb_lz_csc_sparse_mat), intent(inout) :: a
! complex(psb_dpk_), intent(in) :: d
! integer(psb_ipk_), intent(out) :: info
!
! integer(psb_lpk_) :: mnm, i, j, k, m
! integer(psb_ipk_) :: err_act, 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_lz_csc_scalplusidentity
function psb_lz_csc_maxval(a) result(res)
use psb_error_mod
base/serial/impl/psb_z_csr_impl.f90
+40 -40
View File
@@ -1677,46 +1677,46 @@ 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
! 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