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

Implement clean_zeros for CSC and CSR

Browse Source
This commit is contained in:
Salvatore Filippone
2019-03-31 12:01:19 +01:00
parent a96cd70afa
commit e5535835ec
16 changed files with 720 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/impl/psb_c_csc_impl.f90
+59 -1
View File
@@ -2366,7 +2366,35 @@ subroutine psb_c_mv_csc_from_fmt(a,b,info)
end subroutine psb_c_mv_csc_from_fmt
subroutine psb_c_csc_clean_zeros(a, info)
use psb_error_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_clean_zeros
implicit none
class(psb_c_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= czero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_c_csc_clean_zeros
subroutine psb_c_cp_csc_from_fmt(a,b,info)
use psb_const_mod
@@ -4233,6 +4261,36 @@ subroutine psb_lc_cp_csc_from_fmt(a,b,info)
end subroutine psb_lc_cp_csc_from_fmt
subroutine psb_lc_csc_clean_zeros(a, info)
use psb_error_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_clean_zeros
implicit none
class(psb_lc_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= czero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_lc_csc_clean_zeros
subroutine psb_lc_csc_mold(a,b,info)
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_mold
base/serial/impl/psb_c_csr_impl.f90
+61
View File
@@ -3225,6 +3225,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_) :: 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
if (a%val(k) /= czero) 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_ccsrspspmm(a,b,c,info)
use psb_c_mat_mod
use psb_serial_mod, psb_protect_name => psb_ccsrspspmm
@@ -5323,6 +5353,37 @@ subroutine psb_lc_cp_csr_from_fmt(a,b,info)
end select
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_) :: 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
if (a%val(k) /= czero) 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
use psb_serial_mod, psb_protect_name => psb_lccsrspspmm
base/serial/impl/psb_d_csc_impl.f90
+59 -1
View File
@@ -2366,7 +2366,35 @@ subroutine psb_d_mv_csc_from_fmt(a,b,info)
end subroutine psb_d_mv_csc_from_fmt
subroutine psb_d_csc_clean_zeros(a, info)
use psb_error_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_clean_zeros
implicit none
class(psb_d_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= dzero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_d_csc_clean_zeros
subroutine psb_d_cp_csc_from_fmt(a,b,info)
use psb_const_mod
@@ -4233,6 +4261,36 @@ subroutine psb_ld_cp_csc_from_fmt(a,b,info)
end subroutine psb_ld_cp_csc_from_fmt
subroutine psb_ld_csc_clean_zeros(a, info)
use psb_error_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_clean_zeros
implicit none
class(psb_ld_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= dzero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_ld_csc_clean_zeros
subroutine psb_ld_csc_mold(a,b,info)
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_mold
base/serial/impl/psb_d_csr_impl.f90
+61
View File
@@ -3225,6 +3225,36 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_d_cp_csr_from_fmt
subroutine psb_d_csr_clean_zeros(a, info)
use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_clean_zeros
implicit none
class(psb_d_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: 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
if (a%val(k) /= dzero) 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_d_csr_clean_zeros
subroutine psb_dcsrspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_dcsrspspmm
@@ -5323,6 +5353,37 @@ subroutine psb_ld_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_ld_cp_csr_from_fmt
subroutine psb_ld_csr_clean_zeros(a, info)
use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_clean_zeros
implicit none
class(psb_ld_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: 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
if (a%val(k) /= dzero) 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_ld_csr_clean_zeros
subroutine psb_ldcsrspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_ldcsrspspmm
base/serial/impl/psb_s_csc_impl.f90
+59 -1
View File
@@ -2366,7 +2366,35 @@ subroutine psb_s_mv_csc_from_fmt(a,b,info)
end subroutine psb_s_mv_csc_from_fmt
subroutine psb_s_csc_clean_zeros(a, info)
use psb_error_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_clean_zeros
implicit none
class(psb_s_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= szero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_s_csc_clean_zeros
subroutine psb_s_cp_csc_from_fmt(a,b,info)
use psb_const_mod
@@ -4233,6 +4261,36 @@ subroutine psb_ls_cp_csc_from_fmt(a,b,info)
end subroutine psb_ls_cp_csc_from_fmt
subroutine psb_ls_csc_clean_zeros(a, info)
use psb_error_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_clean_zeros
implicit none
class(psb_ls_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= szero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_ls_csc_clean_zeros
subroutine psb_ls_csc_mold(a,b,info)
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_mold
base/serial/impl/psb_s_csr_impl.f90
+61
View File
@@ -3225,6 +3225,36 @@ subroutine psb_s_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_s_cp_csr_from_fmt
subroutine psb_s_csr_clean_zeros(a, info)
use psb_error_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_clean_zeros
implicit none
class(psb_s_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: 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
if (a%val(k) /= szero) 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_s_csr_clean_zeros
subroutine psb_scsrspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_scsrspspmm
@@ -5323,6 +5353,37 @@ subroutine psb_ls_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_ls_cp_csr_from_fmt
subroutine psb_ls_csr_clean_zeros(a, info)
use psb_error_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_clean_zeros
implicit none
class(psb_ls_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: 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
if (a%val(k) /= szero) 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_ls_csr_clean_zeros
subroutine psb_lscsrspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_lscsrspspmm
base/serial/impl/psb_z_csc_impl.f90
+59 -1
View File
@@ -2366,7 +2366,35 @@ subroutine psb_z_mv_csc_from_fmt(a,b,info)
end subroutine psb_z_mv_csc_from_fmt
subroutine psb_z_csc_clean_zeros(a, info)
use psb_error_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_clean_zeros
implicit none
class(psb_z_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= zzero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_z_csc_clean_zeros
subroutine psb_z_cp_csc_from_fmt(a,b,info)
use psb_const_mod
@@ -4233,6 +4261,36 @@ subroutine psb_lz_cp_csc_from_fmt(a,b,info)
end subroutine psb_lz_cp_csc_from_fmt
subroutine psb_lz_csc_clean_zeros(a, info)
use psb_error_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_clean_zeros
implicit none
class(psb_lz_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: info
!
integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:)
info = 0
call a%sync()
nc = a%get_ncols()
ilcp = a%icp(:)
a%icp(1) = 1
j = a%icp(1)
do i=1, nc
do k = ilcp(i), ilcp(i+1) -1
if (a%val(k) /= zzero) then
a%val(j) = a%val(k)
a%ia(j) = a%ia(k)
j = j + 1
end if
end do
a%icp(i+1) = j
end do
call a%trim()
call a%set_host()
end subroutine psb_lz_csc_clean_zeros
subroutine psb_lz_csc_mold(a,b,info)
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_mold
base/serial/impl/psb_z_csr_impl.f90
+61
View File
@@ -3225,6 +3225,36 @@ subroutine psb_z_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_z_cp_csr_from_fmt
subroutine psb_z_csr_clean_zeros(a, info)
use psb_error_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_clean_zeros
implicit none
class(psb_z_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: 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
if (a%val(k) /= zzero) 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_z_csr_clean_zeros
subroutine psb_zcsrspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_zcsrspspmm
@@ -5323,6 +5353,37 @@ subroutine psb_lz_cp_csr_from_fmt(a,b,info)
end select
end subroutine psb_lz_cp_csr_from_fmt
subroutine psb_lz_csr_clean_zeros(a, info)
use psb_error_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_clean_zeros
implicit none
class(psb_lz_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: 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
if (a%val(k) /= zzero) 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_lz_csr_clean_zeros
subroutine psb_lzcsrspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_lzcsrspspmm