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) :: 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

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) :: 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

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) :: 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

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) :: 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

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
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

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)
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,7 +1691,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_c_coo_csnmi(a) result(res)
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

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
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csc_csnm1'
@ -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,7 +1184,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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,7 +1236,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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()

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)
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()

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
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

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)
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,7 +1691,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_d_coo_csnmi(a) result(res)
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

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
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csc_csnm1'
@ -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,7 +1184,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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,7 +1236,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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()

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)
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()

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
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

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)
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,7 +1691,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_s_coo_csnmi(a) result(res)
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

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
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csc_csnm1'
@ -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,7 +1184,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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,7 +1236,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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()

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)
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()

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
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

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)
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,7 +1691,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_coo_csnmi'
@ -1700,6 +1700,7 @@ function psb_z_coo_csnmi(a) result(res)
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

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
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csc_csnm1'
@ -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,7 +1184,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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,7 +1236,7 @@ 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
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='colsum'
@ -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()

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)
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()

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) :: 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

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) :: 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

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) :: 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

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) :: 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

Write Preview
Loading…
Cancel
Save