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

Modify clean_zeros and have it only at base%

Browse Source
This commit is contained in:
sfilippone
2025-01-08 17:18:54 +01:00
parent 66a9d5e50a
commit 4e71fa971c
20 changed files with 688 additions and 684 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/impl/psb_c_csr_impl.F90
+60 -60
View File
@@ -3624,36 +3624,36 @@ subroutine psb_c_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_c_cp_csr_from_fmt
subroutine psb_c_csr_clean_zeros(a, info)
use psb_error_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_clean_zeros
implicit none
class(psb_c_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i, j, k, nr
integer(psb_ipk_), allocatable :: ilrp(:)
info = 0
call a%sync()
nr = a%get_nrows()
ilrp = a%irp
a%irp(1) = 1
j = a%irp(1)
do i=1, nr
do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= czero).or.(i == a%ja(k))) then
a%val(j) = a%val(k)
a%ja(j) = a%ja(k)
j = j + 1
end if
end do
a%irp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_c_csr_clean_zeros
!!$subroutine psb_c_csr_clean_zeros(a, info)
!!$ use psb_error_mod
!!$ use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_clean_zeros
!!$ implicit none
!!$ class(psb_c_csr_sparse_mat), intent(inout) :: a
!!$ integer(psb_ipk_), intent(out) :: info
!!$ !
!!$ integer(psb_ipk_) :: i, j, k, nr
!!$ integer(psb_ipk_), allocatable :: ilrp(:)
!!$
!!$ info = 0
!!$ call a%sync()
!!$ nr = a%get_nrows()
!!$ ilrp = a%irp
!!$ a%irp(1) = 1
!!$ j = a%irp(1)
!!$ do i=1, nr
!!$ do k = ilrp(i), ilrp(i+1) -1
!!$ ! Always keep the diagonal, even if numerically zero
!!$ if ((a%val(k) /= czero).or.(i == a%ja(k))) then
!!$ a%val(j) = a%val(k)
!!$ a%ja(j) = a%ja(k)
!!$ j = j + 1
!!$ end if
!!$ end do
!!$ a%irp(i+1) = j
!!$ end do
!!$ call a%trim()
!!$ call a%set_host()
!!$end subroutine psb_c_csr_clean_zeros
#if defined(OPENMP)
subroutine psb_ccsrspspmm(a,b,c,info)
@@ -6544,36 +6544,36 @@ subroutine psb_lc_cp_csr_from_fmt(a,b,info)
end subroutine psb_lc_cp_csr_from_fmt
subroutine psb_lc_csr_clean_zeros(a, info)
use psb_error_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_clean_zeros
implicit none
class(psb_lc_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
!
integer(psb_lpk_) :: i, j, k, nr
integer(psb_lpk_), allocatable :: ilrp(:)
info = 0
call a%sync()
nr = a%get_nrows()
ilrp = a%irp
a%irp(1) = 1
j = a%irp(1)
do i=1, nr
do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= czero).or.(i == a%ja(k))) then
a%val(j) = a%val(k)
a%ja(j) = a%ja(k)
j = j + 1
end if
end do
a%irp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_lc_csr_clean_zeros
!!$subroutine psb_lc_csr_clean_zeros(a, info)
!!$ use psb_error_mod
!!$ use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_clean_zeros
!!$ implicit none
!!$ class(psb_lc_csr_sparse_mat), intent(inout) :: a
!!$ integer(psb_ipk_), intent(out) :: info
!!$ !
!!$ integer(psb_lpk_) :: i, j, k, nr
!!$ integer(psb_lpk_), allocatable :: ilrp(:)
!!$
!!$ info = 0
!!$ call a%sync()
!!$ nr = a%get_nrows()
!!$ ilrp = a%irp
!!$ a%irp(1) = 1
!!$ j = a%irp(1)
!!$ do i=1, nr
!!$ do k = ilrp(i), ilrp(i+1) -1
!!$ ! Always keep the diagonal, even if numerically zero
!!$ if ((a%val(k) /= czero).or.(i == a%ja(k))) then
!!$ a%val(j) = a%val(k)
!!$ a%ja(j) = a%ja(k)
!!$ j = j + 1
!!$ end if
!!$ end do
!!$ a%irp(i+1) = j
!!$ end do
!!$ call a%trim()
!!$ call a%set_host()
!!$end subroutine psb_lc_csr_clean_zeros
subroutine psb_lccsrspspmm(a,b,c,info)
use psb_c_mat_mod