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

psblas3:

Browse Source 
base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/serial/impl/psb_c_base_mat_impl.F90
 base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_c_csr_impl.f90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90
 base/serial/impl/psb_s_base_mat_impl.F90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_s_csr_impl.f90
 base/serial/impl/psb_z_base_mat_impl.F90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 base/serial/impl/psb_z_csr_impl.f90
 prec/psb_c_bjacprec.f90
 prec/psb_d_bjacprec.f90
 prec/psb_s_bjacprec.f90
 prec/psb_z_bjacprec.f90

Optimizations for  IS_UNIT() usages.
psblas3-final
Salvatore Filippone 12 years ago
parent 5510d3242b
commit 15978c589f
24 changed files with 140 additions and 140 deletions
Show Stats Download Patch File Download Diff File

10
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -73,7 +73,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_c_base_mv_from_fmt procedure, pass(a) :: mv_from_fmt => psb_c_base_mv_from_fmt
procedure, pass(a) :: mold => psb_c_base_mold procedure, pass(a) :: mold => psb_c_base_mold
procedure, pass(a) :: clone => psb_c_base_clone procedure, pass(a) :: clone => psb_c_base_clone
procedure, pass(a) :: add_unit_diag => psb_c_base_add_unit_diag procedure, pass(a) :: make_nonunit => psb_c_base_make_nonunit
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -434,18 +434,18 @@ module psb_c_base_mat_mod
! !
! !
!> Function add_unit_diag: !> Function make_nonunit:
!! \memberof psb_c_base_add_unit_diag !! \memberof psb_c_base_make_nonunit
!! \brief Given a matrix for which is_unit() is true, explicitly !! \brief Given a matrix for which is_unit() is true, explicitly
!! store the unit diagonal and set is_unit() to false. !! store the unit diagonal and set is_unit() to false.
!! This is needed e.g. when scaling !! This is needed e.g. when scaling
! !
interface interface
subroutine psb_c_base_add_unit_diag(a) subroutine psb_c_base_make_nonunit(a)
import :: psb_c_base_sparse_mat import :: psb_c_base_sparse_mat
implicit none implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: a
end subroutine psb_c_base_add_unit_diag end subroutine psb_c_base_make_nonunit
end interface end interface

10
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -73,7 +73,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_d_base_mv_from_fmt procedure, pass(a) :: mv_from_fmt => psb_d_base_mv_from_fmt
procedure, pass(a) :: mold => psb_d_base_mold procedure, pass(a) :: mold => psb_d_base_mold
procedure, pass(a) :: clone => psb_d_base_clone procedure, pass(a) :: clone => psb_d_base_clone
procedure, pass(a) :: add_unit_diag => psb_d_base_add_unit_diag procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -434,18 +434,18 @@ module psb_d_base_mat_mod
! !
! !
!> Function add_unit_diag: !> Function make_nonunit:
!! \memberof psb_d_base_add_unit_diag !! \memberof psb_d_base_make_nonunit
!! \brief Given a matrix for which is_unit() is true, explicitly !! \brief Given a matrix for which is_unit() is true, explicitly
!! store the unit diagonal and set is_unit() to false. !! store the unit diagonal and set is_unit() to false.
!! This is needed e.g. when scaling !! This is needed e.g. when scaling
! !
interface interface
subroutine psb_d_base_add_unit_diag(a) subroutine psb_d_base_make_nonunit(a)
import :: psb_d_base_sparse_mat import :: psb_d_base_sparse_mat
implicit none implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_add_unit_diag end subroutine psb_d_base_make_nonunit
end interface end interface

10
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -73,7 +73,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_s_base_mv_from_fmt procedure, pass(a) :: mv_from_fmt => psb_s_base_mv_from_fmt
procedure, pass(a) :: mold => psb_s_base_mold procedure, pass(a) :: mold => psb_s_base_mold
procedure, pass(a) :: clone => psb_s_base_clone procedure, pass(a) :: clone => psb_s_base_clone
procedure, pass(a) :: add_unit_diag => psb_s_base_add_unit_diag procedure, pass(a) :: make_nonunit => psb_s_base_make_nonunit
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -434,18 +434,18 @@ module psb_s_base_mat_mod
! !
! !
!> Function add_unit_diag: !> Function make_nonunit:
!! \memberof psb_s_base_add_unit_diag !! \memberof psb_s_base_make_nonunit
!! \brief Given a matrix for which is_unit() is true, explicitly !! \brief Given a matrix for which is_unit() is true, explicitly
!! store the unit diagonal and set is_unit() to false. !! store the unit diagonal and set is_unit() to false.
!! This is needed e.g. when scaling !! This is needed e.g. when scaling
! !
interface interface
subroutine psb_s_base_add_unit_diag(a) subroutine psb_s_base_make_nonunit(a)
import :: psb_s_base_sparse_mat import :: psb_s_base_sparse_mat
implicit none implicit none
class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: a
end subroutine psb_s_base_add_unit_diag end subroutine psb_s_base_make_nonunit
end interface end interface

10
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -73,7 +73,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_z_base_mv_from_fmt procedure, pass(a) :: mv_from_fmt => psb_z_base_mv_from_fmt
procedure, pass(a) :: mold => psb_z_base_mold procedure, pass(a) :: mold => psb_z_base_mold
procedure, pass(a) :: clone => psb_z_base_clone procedure, pass(a) :: clone => psb_z_base_clone
procedure, pass(a) :: add_unit_diag => psb_z_base_add_unit_diag procedure, pass(a) :: make_nonunit => psb_z_base_make_nonunit
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -434,18 +434,18 @@ module psb_z_base_mat_mod
! !
! !
!> Function add_unit_diag: !> Function make_nonunit:
!! \memberof psb_z_base_add_unit_diag !! \memberof psb_z_base_make_nonunit
!! \brief Given a matrix for which is_unit() is true, explicitly !! \brief Given a matrix for which is_unit() is true, explicitly
!! store the unit diagonal and set is_unit() to false. !! store the unit diagonal and set is_unit() to false.
!! This is needed e.g. when scaling !! This is needed e.g. when scaling
! !
interface interface
subroutine psb_z_base_add_unit_diag(a) subroutine psb_z_base_make_nonunit(a)
import :: psb_z_base_sparse_mat import :: psb_z_base_sparse_mat
implicit none implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: a
end subroutine psb_z_base_add_unit_diag end subroutine psb_z_base_make_nonunit
end interface end interface

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

@ -580,8 +580,8 @@ subroutine psb_c_base_clone(a,b,info)
end subroutine psb_c_base_clone end subroutine psb_c_base_clone
subroutine psb_c_base_add_unit_diag(a) subroutine psb_c_base_make_nonunit(a)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_add_unit_diag use psb_c_base_mat_mod, psb_protect_name => psb_c_base_make_nonunit
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: a
@ -609,7 +609,7 @@ subroutine psb_c_base_add_unit_diag(a)
& call a%mv_from_coo(tmp,info) & call a%mv_from_coo(tmp,info)
end if end if
end subroutine psb_c_base_add_unit_diag end subroutine psb_c_base_make_nonunit
subroutine psb_c_base_mold(a,b,info) subroutine psb_c_base_mold(a,b,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_mold use psb_c_base_mat_mod, psb_protect_name => psb_c_base_mold

11
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -102,7 +102,7 @@ subroutine psb_c_coo_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -172,7 +172,7 @@ subroutine psb_c_coo_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
@ -1691,7 +1691,7 @@ function psb_c_coo_csnmi(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_coo_csnmi' character(len=20) :: name='c_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_c_coo_csnmi(a) result(res)
res = szero res = szero
nnz = a%get_nzeros() nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then if (a%is_sorted()) then
i = 1 i = 1
j = i j = i
@ -1708,7 +1709,7 @@ function psb_c_coo_csnmi(a) result(res)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1 j = j+1
enddo enddo
if (a%is_unit()) then if (is_unit) then
acc = sone acc = sone
else else
acc = szero acc = szero
@ -1723,7 +1724,7 @@ function psb_c_coo_csnmi(a) result(res)
m = a%get_nrows() m = a%get_nrows()
allocate(vt(m),stat=info) allocate(vt(m),stat=info)
if (info /= 0) return if (info /= 0) return
if (a%is_unit()) then if (is_unit) then
vt = sone vt = sone
else else
vt = szero vt = szero

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

@ -1147,7 +1147,7 @@ function psb_c_csc_csnm1(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csc_csnm1' character(len=20) :: name='c_csc_csnm1'
@ -1157,8 +1157,9 @@ function psb_c_csc_csnm1(a) result(res)
res = szero res = szero
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n do j=1, n
if (a%is_unit()) then if (is_unit) then
acc = sone acc = sone
else else
acc = szero acc = szero
@ -1183,7 +1184,7 @@ subroutine psb_c_csc_colsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
complex(psb_spk_) :: acc complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:) complex(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1198,9 +1199,9 @@ subroutine psb_c_csc_colsum(d,a)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = cone d(i) = cone
else else
d(i) = czero d(i) = czero
@ -1235,7 +1236,7 @@ subroutine psb_c_csc_aclsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1251,9 +1252,9 @@ subroutine psb_c_csc_aclsum(d,a)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = sone d(i) = sone
else else
d(i) = szero d(i) = szero
@ -1477,7 +1478,7 @@ subroutine psb_c_csc_scal(d,a,info,side)
end if end if
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
left = (side_ == 'L') left = (side_ == 'L')
@ -1541,7 +1542,7 @@ subroutine psb_c_csc_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -1666,7 +1666,7 @@ subroutine psb_c_csr_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -1739,7 +1739,7 @@ subroutine psb_c_csr_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -580,8 +580,8 @@ subroutine psb_d_base_clone(a,b,info)
end subroutine psb_d_base_clone end subroutine psb_d_base_clone
subroutine psb_d_base_add_unit_diag(a) subroutine psb_d_base_make_nonunit(a)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_add_unit_diag use psb_d_base_mat_mod, psb_protect_name => psb_d_base_make_nonunit
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: a
@ -609,7 +609,7 @@ subroutine psb_d_base_add_unit_diag(a)
& call a%mv_from_coo(tmp,info) & call a%mv_from_coo(tmp,info)
end if end if
end subroutine psb_d_base_add_unit_diag end subroutine psb_d_base_make_nonunit
subroutine psb_d_base_mold(a,b,info) subroutine psb_d_base_mold(a,b,info)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_mold use psb_d_base_mat_mod, psb_protect_name => psb_d_base_mold

11
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -102,7 +102,7 @@ subroutine psb_d_coo_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -172,7 +172,7 @@ subroutine psb_d_coo_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
@ -1691,7 +1691,7 @@ function psb_d_coo_csnmi(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_coo_csnmi' character(len=20) :: name='d_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_d_coo_csnmi(a) result(res)
res = dzero res = dzero
nnz = a%get_nzeros() nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then if (a%is_sorted()) then
i = 1 i = 1
j = i j = i
@ -1708,7 +1709,7 @@ function psb_d_coo_csnmi(a) result(res)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1 j = j+1
enddo enddo
if (a%is_unit()) then if (is_unit) then
acc = done acc = done
else else
acc = dzero acc = dzero
@ -1723,7 +1724,7 @@ function psb_d_coo_csnmi(a) result(res)
m = a%get_nrows() m = a%get_nrows()
allocate(vt(m),stat=info) allocate(vt(m),stat=info)
if (info /= 0) return if (info /= 0) return
if (a%is_unit()) then if (is_unit) then
vt = done vt = done
else else
vt = dzero vt = dzero

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

@ -1147,7 +1147,7 @@ function psb_d_csc_csnm1(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csc_csnm1' character(len=20) :: name='d_csc_csnm1'
@ -1157,8 +1157,9 @@ function psb_d_csc_csnm1(a) result(res)
res = dzero res = dzero
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n do j=1, n
if (a%is_unit()) then if (is_unit) then
acc = done acc = done
else else
acc = dzero acc = dzero
@ -1183,7 +1184,7 @@ subroutine psb_d_csc_colsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1198,9 +1199,9 @@ subroutine psb_d_csc_colsum(d,a)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = done d(i) = done
else else
d(i) = dzero d(i) = dzero
@ -1235,7 +1236,7 @@ subroutine psb_d_csc_aclsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1251,9 +1252,9 @@ subroutine psb_d_csc_aclsum(d,a)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = done d(i) = done
else else
d(i) = dzero d(i) = dzero
@ -1477,7 +1478,7 @@ subroutine psb_d_csc_scal(d,a,info,side)
end if end if
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
left = (side_ == 'L') left = (side_ == 'L')
@ -1541,7 +1542,7 @@ subroutine psb_d_csc_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -1666,7 +1666,7 @@ subroutine psb_d_csr_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -1739,7 +1739,7 @@ subroutine psb_d_csr_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -580,8 +580,8 @@ subroutine psb_s_base_clone(a,b,info)
end subroutine psb_s_base_clone end subroutine psb_s_base_clone
subroutine psb_s_base_add_unit_diag(a) subroutine psb_s_base_make_nonunit(a)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_add_unit_diag use psb_s_base_mat_mod, psb_protect_name => psb_s_base_make_nonunit
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: a
@ -609,7 +609,7 @@ subroutine psb_s_base_add_unit_diag(a)
& call a%mv_from_coo(tmp,info) & call a%mv_from_coo(tmp,info)
end if end if
end subroutine psb_s_base_add_unit_diag end subroutine psb_s_base_make_nonunit
subroutine psb_s_base_mold(a,b,info) subroutine psb_s_base_mold(a,b,info)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_mold use psb_s_base_mat_mod, psb_protect_name => psb_s_base_mold

11
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -102,7 +102,7 @@ subroutine psb_s_coo_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -172,7 +172,7 @@ subroutine psb_s_coo_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
@ -1691,7 +1691,7 @@ function psb_s_coo_csnmi(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_coo_csnmi' character(len=20) :: name='s_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_s_coo_csnmi(a) result(res)
res = szero res = szero
nnz = a%get_nzeros() nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then if (a%is_sorted()) then
i = 1 i = 1
j = i j = i
@ -1708,7 +1709,7 @@ function psb_s_coo_csnmi(a) result(res)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1 j = j+1
enddo enddo
if (a%is_unit()) then if (is_unit) then
acc = sone acc = sone
else else
acc = szero acc = szero
@ -1723,7 +1724,7 @@ function psb_s_coo_csnmi(a) result(res)
m = a%get_nrows() m = a%get_nrows()
allocate(vt(m),stat=info) allocate(vt(m),stat=info)
if (info /= 0) return if (info /= 0) return
if (a%is_unit()) then if (is_unit) then
vt = sone vt = sone
else else
vt = szero vt = szero

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

@ -1147,7 +1147,7 @@ function psb_s_csc_csnm1(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csc_csnm1' character(len=20) :: name='s_csc_csnm1'
@ -1157,8 +1157,9 @@ function psb_s_csc_csnm1(a) result(res)
res = szero res = szero
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n do j=1, n
if (a%is_unit()) then if (is_unit) then
acc = sone acc = sone
else else
acc = szero acc = szero
@ -1183,7 +1184,7 @@ subroutine psb_s_csc_colsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1198,9 +1199,9 @@ subroutine psb_s_csc_colsum(d,a)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = sone d(i) = sone
else else
d(i) = szero d(i) = szero
@ -1235,7 +1236,7 @@ subroutine psb_s_csc_aclsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:) real(psb_spk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1251,9 +1252,9 @@ subroutine psb_s_csc_aclsum(d,a)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = sone d(i) = sone
else else
d(i) = szero d(i) = szero
@ -1477,7 +1478,7 @@ subroutine psb_s_csc_scal(d,a,info,side)
end if end if
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
left = (side_ == 'L') left = (side_ == 'L')
@ -1541,7 +1542,7 @@ subroutine psb_s_csc_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -1666,7 +1666,7 @@ subroutine psb_s_csr_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -1739,7 +1739,7 @@ subroutine psb_s_csr_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -580,8 +580,8 @@ subroutine psb_z_base_clone(a,b,info)
end subroutine psb_z_base_clone end subroutine psb_z_base_clone
subroutine psb_z_base_add_unit_diag(a) subroutine psb_z_base_make_nonunit(a)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_add_unit_diag use psb_z_base_mat_mod, psb_protect_name => psb_z_base_make_nonunit
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: a
@ -609,7 +609,7 @@ subroutine psb_z_base_add_unit_diag(a)
& call a%mv_from_coo(tmp,info) & call a%mv_from_coo(tmp,info)
end if end if
end subroutine psb_z_base_add_unit_diag end subroutine psb_z_base_make_nonunit
subroutine psb_z_base_mold(a,b,info) subroutine psb_z_base_mold(a,b,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_mold use psb_z_base_mat_mod, psb_protect_name => psb_z_base_mold

11
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -102,7 +102,7 @@ subroutine psb_z_coo_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -172,7 +172,7 @@ subroutine psb_z_coo_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
@ -1691,7 +1691,7 @@ function psb_z_coo_csnmi(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_coo_csnmi' character(len=20) :: name='z_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_z_coo_csnmi(a) result(res)
res = dzero res = dzero
nnz = a%get_nzeros() nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then if (a%is_sorted()) then
i = 1 i = 1
j = i j = i
@ -1708,7 +1709,7 @@ function psb_z_coo_csnmi(a) result(res)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1 j = j+1
enddo enddo
if (a%is_unit()) then if (is_unit) then
acc = done acc = done
else else
acc = dzero acc = dzero
@ -1723,7 +1724,7 @@ function psb_z_coo_csnmi(a) result(res)
m = a%get_nrows() m = a%get_nrows()
allocate(vt(m),stat=info) allocate(vt(m),stat=info)
if (info /= 0) return if (info /= 0) return
if (a%is_unit()) then if (is_unit) then
vt = done vt = done
else else
vt = dzero vt = dzero

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

@ -1147,7 +1147,7 @@ function psb_z_csc_csnm1(a) result(res)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csc_csnm1' character(len=20) :: name='z_csc_csnm1'
@ -1157,8 +1157,9 @@ function psb_z_csc_csnm1(a) result(res)
res = dzero res = dzero
m = a%get_nrows() m = a%get_nrows()
n = a%get_ncols() n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n do j=1, n
if (a%is_unit()) then if (is_unit) then
acc = done acc = done
else else
acc = dzero acc = dzero
@ -1183,7 +1184,7 @@ subroutine psb_z_csc_colsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
complex(psb_dpk_) :: acc complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:) complex(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1198,9 +1199,9 @@ subroutine psb_z_csc_colsum(d,a)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = zone d(i) = zone
else else
d(i) = zzero d(i) = zzero
@ -1235,7 +1236,7 @@ subroutine psb_z_csc_aclsum(d,a)
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:) real(psb_dpk_), allocatable :: vt(:)
logical :: tra logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum' character(len=20) :: name='colsum'
@ -1251,9 +1252,9 @@ subroutine psb_z_csc_aclsum(d,a)
goto 9999 goto 9999
end if end if
is_unit = a%is_unit()
do i = 1, a%get_ncols() do i = 1, a%get_ncols()
if (a%is_unit()) then if (is_unit) then
d(i) = done d(i) = done
else else
d(i) = dzero d(i) = dzero
@ -1477,7 +1478,7 @@ subroutine psb_z_csc_scal(d,a,info,side)
end if end if
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
left = (side_ == 'L') left = (side_ == 'L')
@ -1541,7 +1542,7 @@ subroutine psb_z_csc_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

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

@ -1666,7 +1666,7 @@ subroutine psb_z_csr_scal(d,a,info,side)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
side_ = 'L' side_ = 'L'
@ -1739,7 +1739,7 @@ subroutine psb_z_csr_scals(d,a,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (a%is_unit()) then if (a%is_unit()) then
call a%add_unit_diag() call a%make_nonunit()
end if end if
do i=1,a%get_nzeros() do i=1,a%get_nzeros()

2
prec/psb_c_bjacprec.f90
Unescape Escape View File

@ -43,8 +43,6 @@ module psb_c_bjacprec
procedure, pass(prec) :: precbld => psb_c_bjac_precbld procedure, pass(prec) :: precbld => psb_c_bjac_precbld
procedure, pass(prec) :: precinit => psb_c_bjac_precinit procedure, pass(prec) :: precinit => psb_c_bjac_precinit
procedure, pass(prec) :: precseti => psb_c_bjac_precseti procedure, pass(prec) :: precseti => psb_c_bjac_precseti
!!$ procedure, pass(prec) :: precsetr => psb_c_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_c_bjac_precsetc
procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr
procedure, pass(prec) :: dump => psb_c_bjac_dump procedure, pass(prec) :: dump => psb_c_bjac_dump
procedure, pass(prec) :: clone => psb_c_bjac_clone procedure, pass(prec) :: clone => psb_c_bjac_clone

2
prec/psb_d_bjacprec.f90
Unescape Escape View File

@ -43,8 +43,6 @@ module psb_d_bjacprec
procedure, pass(prec) :: precbld => psb_d_bjac_precbld procedure, pass(prec) :: precbld => psb_d_bjac_precbld
procedure, pass(prec) :: precinit => psb_d_bjac_precinit procedure, pass(prec) :: precinit => psb_d_bjac_precinit
procedure, pass(prec) :: precseti => psb_d_bjac_precseti procedure, pass(prec) :: precseti => psb_d_bjac_precseti
!!$ procedure, pass(prec) :: precsetr => psb_d_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_d_bjac_precsetc
procedure, pass(prec) :: precdescr => psb_d_bjac_precdescr procedure, pass(prec) :: precdescr => psb_d_bjac_precdescr
procedure, pass(prec) :: dump => psb_d_bjac_dump procedure, pass(prec) :: dump => psb_d_bjac_dump
procedure, pass(prec) :: clone => psb_d_bjac_clone procedure, pass(prec) :: clone => psb_d_bjac_clone

2
prec/psb_s_bjacprec.f90
Unescape Escape View File

@ -43,8 +43,6 @@ module psb_s_bjacprec
procedure, pass(prec) :: precbld => psb_s_bjac_precbld procedure, pass(prec) :: precbld => psb_s_bjac_precbld
procedure, pass(prec) :: precinit => psb_s_bjac_precinit procedure, pass(prec) :: precinit => psb_s_bjac_precinit
procedure, pass(prec) :: precseti => psb_s_bjac_precseti procedure, pass(prec) :: precseti => psb_s_bjac_precseti
!!$ procedure, pass(prec) :: precsetr => psb_s_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_s_bjac_precsetc
procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr
procedure, pass(prec) :: dump => psb_s_bjac_dump procedure, pass(prec) :: dump => psb_s_bjac_dump
procedure, pass(prec) :: clone => psb_s_bjac_clone procedure, pass(prec) :: clone => psb_s_bjac_clone

2
prec/psb_z_bjacprec.f90
Unescape Escape View File

@ -43,8 +43,6 @@ module psb_z_bjacprec
procedure, pass(prec) :: precbld => psb_z_bjac_precbld procedure, pass(prec) :: precbld => psb_z_bjac_precbld
procedure, pass(prec) :: precinit => psb_z_bjac_precinit procedure, pass(prec) :: precinit => psb_z_bjac_precinit
procedure, pass(prec) :: precseti => psb_z_bjac_precseti procedure, pass(prec) :: precseti => psb_z_bjac_precseti
!!$ procedure, pass(prec) :: precsetr => psb_z_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_z_bjac_precsetc
procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr
procedure, pass(prec) :: dump => psb_z_bjac_dump procedure, pass(prec) :: dump => psb_z_bjac_dump
procedure, pass(prec) :: clone => psb_z_bjac_clone procedure, pass(prec) :: clone => psb_z_bjac_clone

Write Preview
Loading…
Cancel
Save