diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index b510621f..49e1c784 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -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) :: mold => psb_c_base_mold 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. @@ -434,18 +434,18 @@ module psb_c_base_mat_mod ! ! - !> Function add_unit_diag: - !! \memberof psb_c_base_add_unit_diag + !> Function make_nonunit: + !! \memberof psb_c_base_make_nonunit !! \brief Given a matrix for which is_unit() is true, explicitly !! store the unit diagonal and set is_unit() to false. !! This is needed e.g. when scaling ! interface - subroutine psb_c_base_add_unit_diag(a) + subroutine psb_c_base_make_nonunit(a) import :: psb_c_base_sparse_mat implicit none 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 diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index e190d0f9..5b52d2f0 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -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) :: mold => psb_d_base_mold 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. @@ -434,18 +434,18 @@ module psb_d_base_mat_mod ! ! - !> Function add_unit_diag: - !! \memberof psb_d_base_add_unit_diag + !> Function make_nonunit: + !! \memberof psb_d_base_make_nonunit !! \brief Given a matrix for which is_unit() is true, explicitly !! store the unit diagonal and set is_unit() to false. !! This is needed e.g. when scaling ! interface - subroutine psb_d_base_add_unit_diag(a) + subroutine psb_d_base_make_nonunit(a) import :: psb_d_base_sparse_mat implicit none 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 diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 724f0eea..5910920a 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -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) :: mold => psb_s_base_mold 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. @@ -434,18 +434,18 @@ module psb_s_base_mat_mod ! ! - !> Function add_unit_diag: - !! \memberof psb_s_base_add_unit_diag + !> Function make_nonunit: + !! \memberof psb_s_base_make_nonunit !! \brief Given a matrix for which is_unit() is true, explicitly !! store the unit diagonal and set is_unit() to false. !! This is needed e.g. when scaling ! interface - subroutine psb_s_base_add_unit_diag(a) + subroutine psb_s_base_make_nonunit(a) import :: psb_s_base_sparse_mat implicit none 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 diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 0b78a0a5..48aacace 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -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) :: mold => psb_z_base_mold 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. @@ -434,18 +434,18 @@ module psb_z_base_mat_mod ! ! - !> Function add_unit_diag: - !! \memberof psb_z_base_add_unit_diag + !> Function make_nonunit: + !! \memberof psb_z_base_make_nonunit !! \brief Given a matrix for which is_unit() is true, explicitly !! store the unit diagonal and set is_unit() to false. !! This is needed e.g. when scaling ! interface - subroutine psb_z_base_add_unit_diag(a) + subroutine psb_z_base_make_nonunit(a) import :: psb_z_base_sparse_mat implicit none 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 diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index 683fa266..9e003a6a 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -580,8 +580,8 @@ subroutine psb_c_base_clone(a,b,info) end subroutine psb_c_base_clone -subroutine psb_c_base_add_unit_diag(a) - use psb_c_base_mat_mod, psb_protect_name => psb_c_base_add_unit_diag +subroutine psb_c_base_make_nonunit(a) + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_make_nonunit use psb_error_mod implicit none 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) 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) use psb_c_base_mat_mod, psb_protect_name => psb_c_base_mold diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 0c4a7892..58624f9e 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -102,7 +102,7 @@ subroutine psb_c_coo_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -172,7 +172,7 @@ subroutine psb_c_coo_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() @@ -1691,15 +1691,16 @@ function psb_c_coo_csnmi(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_coo_csnmi' logical, parameter :: debug=.false. res = szero nnz = a%get_nzeros() + is_unit = a%is_unit() if (a%is_sorted()) then i = 1 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)) j = j+1 enddo - if (a%is_unit()) then + if (is_unit) then acc = sone else acc = szero @@ -1723,7 +1724,7 @@ function psb_c_coo_csnmi(a) result(res) m = a%get_nrows() allocate(vt(m),stat=info) if (info /= 0) return - if (a%is_unit()) then + if (is_unit) then vt = sone else vt = szero diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 4fa47574..e67dce07 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -1147,9 +1147,9 @@ function psb_c_csc_csnm1(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csc_csnm1' logical, parameter :: debug=.false. @@ -1157,8 +1157,9 @@ function psb_c_csc_csnm1(a) result(res) res = szero m = a%get_nrows() n = a%get_ncols() + is_unit = a%is_unit() do j=1, n - if (a%is_unit()) then + if (is_unit) then acc = sone else acc = szero @@ -1183,9 +1184,9 @@ subroutine psb_c_csc_colsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc complex(psb_spk_) :: acc complex(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1198,9 +1199,9 @@ subroutine psb_c_csc_colsum(d,a) call psb_errpush(info,name,i_err=ierr) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = cone else d(i) = czero @@ -1235,9 +1236,9 @@ subroutine psb_c_csc_aclsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1251,9 +1252,9 @@ subroutine psb_c_csc_aclsum(d,a) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = sone else d(i) = szero @@ -1477,7 +1478,7 @@ subroutine psb_c_csc_scal(d,a,info,side) end if if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if left = (side_ == 'L') @@ -1541,7 +1542,7 @@ subroutine psb_c_csc_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index b541e4f0..c14dc010 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1666,7 +1666,7 @@ subroutine psb_c_csr_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -1739,7 +1739,7 @@ subroutine psb_c_csr_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index 17192097..a59687eb 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -580,8 +580,8 @@ subroutine psb_d_base_clone(a,b,info) end subroutine psb_d_base_clone -subroutine psb_d_base_add_unit_diag(a) - use psb_d_base_mat_mod, psb_protect_name => psb_d_base_add_unit_diag +subroutine psb_d_base_make_nonunit(a) + use psb_d_base_mat_mod, psb_protect_name => psb_d_base_make_nonunit use psb_error_mod implicit none 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) 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) use psb_d_base_mat_mod, psb_protect_name => psb_d_base_mold diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index db4f426d..88bc3dd3 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -102,7 +102,7 @@ subroutine psb_d_coo_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -172,7 +172,7 @@ subroutine psb_d_coo_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() @@ -1691,15 +1691,16 @@ function psb_d_coo_csnmi(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_coo_csnmi' logical, parameter :: debug=.false. res = dzero nnz = a%get_nzeros() + is_unit = a%is_unit() if (a%is_sorted()) then i = 1 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)) j = j+1 enddo - if (a%is_unit()) then + if (is_unit) then acc = done else acc = dzero @@ -1723,7 +1724,7 @@ function psb_d_coo_csnmi(a) result(res) m = a%get_nrows() allocate(vt(m),stat=info) if (info /= 0) return - if (a%is_unit()) then + if (is_unit) then vt = done else vt = dzero diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index ffdb2afd..4ce2974f 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -1147,9 +1147,9 @@ function psb_d_csc_csnm1(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csc_csnm1' logical, parameter :: debug=.false. @@ -1157,8 +1157,9 @@ function psb_d_csc_csnm1(a) result(res) res = dzero m = a%get_nrows() n = a%get_ncols() + is_unit = a%is_unit() do j=1, n - if (a%is_unit()) then + if (is_unit) then acc = done else acc = dzero @@ -1183,9 +1184,9 @@ subroutine psb_d_csc_colsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1198,9 +1199,9 @@ subroutine psb_d_csc_colsum(d,a) call psb_errpush(info,name,i_err=ierr) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = done else d(i) = dzero @@ -1235,9 +1236,9 @@ subroutine psb_d_csc_aclsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1251,9 +1252,9 @@ subroutine psb_d_csc_aclsum(d,a) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = done else d(i) = dzero @@ -1477,7 +1478,7 @@ subroutine psb_d_csc_scal(d,a,info,side) end if if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if left = (side_ == 'L') @@ -1541,7 +1542,7 @@ subroutine psb_d_csc_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 007c45cf..e26b6846 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1666,7 +1666,7 @@ subroutine psb_d_csr_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -1739,7 +1739,7 @@ subroutine psb_d_csr_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index b31c1fad..6f19f22f 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -580,8 +580,8 @@ subroutine psb_s_base_clone(a,b,info) end subroutine psb_s_base_clone -subroutine psb_s_base_add_unit_diag(a) - use psb_s_base_mat_mod, psb_protect_name => psb_s_base_add_unit_diag +subroutine psb_s_base_make_nonunit(a) + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_make_nonunit use psb_error_mod implicit none 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) 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) use psb_s_base_mat_mod, psb_protect_name => psb_s_base_mold diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 4a8eaa94..b4e238ea 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -102,7 +102,7 @@ subroutine psb_s_coo_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -172,7 +172,7 @@ subroutine psb_s_coo_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() @@ -1691,15 +1691,16 @@ function psb_s_coo_csnmi(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_coo_csnmi' logical, parameter :: debug=.false. res = szero nnz = a%get_nzeros() + is_unit = a%is_unit() if (a%is_sorted()) then i = 1 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)) j = j+1 enddo - if (a%is_unit()) then + if (is_unit) then acc = sone else acc = szero @@ -1723,7 +1724,7 @@ function psb_s_coo_csnmi(a) result(res) m = a%get_nrows() allocate(vt(m),stat=info) if (info /= 0) return - if (a%is_unit()) then + if (is_unit) then vt = sone else vt = szero diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index 0c5601cb..cd08ee88 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -1147,9 +1147,9 @@ function psb_s_csc_csnm1(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csc_csnm1' logical, parameter :: debug=.false. @@ -1157,8 +1157,9 @@ function psb_s_csc_csnm1(a) result(res) res = szero m = a%get_nrows() n = a%get_ncols() + is_unit = a%is_unit() do j=1, n - if (a%is_unit()) then + if (is_unit) then acc = sone else acc = szero @@ -1183,9 +1184,9 @@ subroutine psb_s_csc_colsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1198,9 +1199,9 @@ subroutine psb_s_csc_colsum(d,a) call psb_errpush(info,name,i_err=ierr) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = sone else d(i) = szero @@ -1235,9 +1236,9 @@ subroutine psb_s_csc_aclsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc real(psb_spk_) :: acc real(psb_spk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1251,9 +1252,9 @@ subroutine psb_s_csc_aclsum(d,a) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = sone else d(i) = szero @@ -1477,7 +1478,7 @@ subroutine psb_s_csc_scal(d,a,info,side) end if if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if left = (side_ == 'L') @@ -1541,7 +1542,7 @@ subroutine psb_s_csc_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 027162bd..eff1b3eb 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -1666,7 +1666,7 @@ subroutine psb_s_csr_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -1739,7 +1739,7 @@ subroutine psb_s_csr_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index 58206e22..a69a1795 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -580,8 +580,8 @@ subroutine psb_z_base_clone(a,b,info) end subroutine psb_z_base_clone -subroutine psb_z_base_add_unit_diag(a) - use psb_z_base_mat_mod, psb_protect_name => psb_z_base_add_unit_diag +subroutine psb_z_base_make_nonunit(a) + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_make_nonunit use psb_error_mod implicit none 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) 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) use psb_z_base_mat_mod, psb_protect_name => psb_z_base_mold diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index a1b5c081..aff1ee4f 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -102,7 +102,7 @@ subroutine psb_z_coo_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -172,7 +172,7 @@ subroutine psb_z_coo_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() @@ -1691,15 +1691,16 @@ function psb_z_coo_csnmi(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_coo_csnmi' logical, parameter :: debug=.false. res = dzero nnz = a%get_nzeros() + is_unit = a%is_unit() if (a%is_sorted()) then i = 1 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)) j = j+1 enddo - if (a%is_unit()) then + if (is_unit) then acc = done else acc = dzero @@ -1723,7 +1724,7 @@ function psb_z_coo_csnmi(a) result(res) m = a%get_nrows() allocate(vt(m),stat=info) if (info /= 0) return - if (a%is_unit()) then + if (is_unit) then vt = done else vt = dzero diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index e5e7e90a..9fe50dab 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -1147,9 +1147,9 @@ function psb_z_csc_csnm1(a) result(res) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csc_csnm1' logical, parameter :: debug=.false. @@ -1157,8 +1157,9 @@ function psb_z_csc_csnm1(a) result(res) res = dzero m = a%get_nrows() n = a%get_ncols() + is_unit = a%is_unit() do j=1, n - if (a%is_unit()) then + if (is_unit) then acc = done else acc = dzero @@ -1183,9 +1184,9 @@ subroutine psb_z_csc_colsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc complex(psb_dpk_) :: acc complex(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1198,9 +1199,9 @@ subroutine psb_z_csc_colsum(d,a) call psb_errpush(info,name,i_err=ierr) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = zone else d(i) = zzero @@ -1235,9 +1236,9 @@ subroutine psb_z_csc_aclsum(d,a) integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc real(psb_dpk_) :: acc real(psb_dpk_), allocatable :: vt(:) - logical :: tra - integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) + logical :: tra, is_unit + integer(psb_ipk_) :: err_act, info + integer(psb_ipk_) :: ierr(5) character(len=20) :: name='colsum' logical, parameter :: debug=.false. @@ -1251,9 +1252,9 @@ subroutine psb_z_csc_aclsum(d,a) goto 9999 end if - + is_unit = a%is_unit() do i = 1, a%get_ncols() - if (a%is_unit()) then + if (is_unit) then d(i) = done else d(i) = dzero @@ -1477,7 +1478,7 @@ subroutine psb_z_csc_scal(d,a,info,side) end if if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if left = (side_ == 'L') @@ -1541,7 +1542,7 @@ subroutine psb_z_csc_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 45781ab6..b1db743d 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1666,7 +1666,7 @@ subroutine psb_z_csr_scal(d,a,info,side) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if side_ = 'L' @@ -1739,7 +1739,7 @@ subroutine psb_z_csr_scals(d,a,info) call psb_erractionsave(err_act) if (a%is_unit()) then - call a%add_unit_diag() + call a%make_nonunit() end if do i=1,a%get_nzeros() diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index 19d1fa52..239c3bc2 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -43,8 +43,6 @@ module psb_c_bjacprec procedure, pass(prec) :: precbld => psb_c_bjac_precbld procedure, pass(prec) :: precinit => psb_c_bjac_precinit 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) :: dump => psb_c_bjac_dump procedure, pass(prec) :: clone => psb_c_bjac_clone diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 85bd3c61..f89cf3f7 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -43,8 +43,6 @@ module psb_d_bjacprec procedure, pass(prec) :: precbld => psb_d_bjac_precbld procedure, pass(prec) :: precinit => psb_d_bjac_precinit 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) :: dump => psb_d_bjac_dump procedure, pass(prec) :: clone => psb_d_bjac_clone diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 5b48d68b..ce090e57 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -43,8 +43,6 @@ module psb_s_bjacprec procedure, pass(prec) :: precbld => psb_s_bjac_precbld procedure, pass(prec) :: precinit => psb_s_bjac_precinit 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) :: dump => psb_s_bjac_dump procedure, pass(prec) :: clone => psb_s_bjac_clone diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index 45f9995b..174aac2e 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -43,8 +43,6 @@ module psb_z_bjacprec procedure, pass(prec) :: precbld => psb_z_bjac_precbld procedure, pass(prec) :: precinit => psb_z_bjac_precinit 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) :: dump => psb_z_bjac_dump procedure, pass(prec) :: clone => psb_z_bjac_clone