mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 19:02:09 +00:00
psblas3:
base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_comm_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_comm_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_comm_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_comm_mod.f90 base/modules/psb_z_mat_mod.f90 base/serial/impl/psb_c_base_mat_impl.F90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_d_base_mat_impl.F90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_s_base_mat_impl.F90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_z_base_mat_impl.F90 base/serial/impl/psb_z_coo_impl.f90 Add clean_zeros method.
This commit is contained in:
@@ -318,6 +318,22 @@ subroutine psb_c_base_mv_from_fmt(a,b,info)
|
||||
|
||||
end subroutine psb_c_base_mv_from_fmt
|
||||
|
||||
subroutine psb_c_base_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_clean_zeros
|
||||
implicit none
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_c_coo_sparse_mat) :: tmpcoo
|
||||
|
||||
call a%mv_to_coo(tmpcoo,info)
|
||||
if (info == 0) call tmpcoo%clean_zeros(info)
|
||||
if (info == 0) call a%mv_from_coo(tmpcoo,info)
|
||||
|
||||
end subroutine psb_c_base_clean_zeros
|
||||
|
||||
|
||||
subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_error_mod
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_csput_a
|
||||
|
||||
@@ -329,6 +329,31 @@ subroutine psb_c_coo_trim(a)
|
||||
|
||||
end subroutine psb_c_coo_trim
|
||||
|
||||
subroutine psb_c_coo_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_clean_zeros
|
||||
implicit none
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i,j,k, nzin
|
||||
|
||||
info = 0
|
||||
nzin = a%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nzin
|
||||
if (a%val(i) /= czero) then
|
||||
j = j + 1
|
||||
a%val(j) = a%val(i)
|
||||
a%ia(j) = a%ia(i)
|
||||
a%ja(j) = a%ja(i)
|
||||
end if
|
||||
end do
|
||||
call a%set_nzeros(j)
|
||||
call a%trim()
|
||||
end subroutine psb_c_coo_clean_zeros
|
||||
|
||||
|
||||
|
||||
subroutine psb_c_coo_allocate_mnnz(m,n,a,nz)
|
||||
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_allocate_mnnz
|
||||
|
||||
@@ -318,6 +318,22 @@ subroutine psb_d_base_mv_from_fmt(a,b,info)
|
||||
|
||||
end subroutine psb_d_base_mv_from_fmt
|
||||
|
||||
subroutine psb_d_base_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_clean_zeros
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_d_coo_sparse_mat) :: tmpcoo
|
||||
|
||||
call a%mv_to_coo(tmpcoo,info)
|
||||
if (info == 0) call tmpcoo%clean_zeros(info)
|
||||
if (info == 0) call a%mv_from_coo(tmpcoo,info)
|
||||
|
||||
end subroutine psb_d_base_clean_zeros
|
||||
|
||||
|
||||
subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_error_mod
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput_a
|
||||
|
||||
@@ -329,6 +329,31 @@ subroutine psb_d_coo_trim(a)
|
||||
|
||||
end subroutine psb_d_coo_trim
|
||||
|
||||
subroutine psb_d_coo_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_clean_zeros
|
||||
implicit none
|
||||
class(psb_d_coo_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i,j,k, nzin
|
||||
|
||||
info = 0
|
||||
nzin = a%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nzin
|
||||
if (a%val(i) /= dzero) then
|
||||
j = j + 1
|
||||
a%val(j) = a%val(i)
|
||||
a%ia(j) = a%ia(i)
|
||||
a%ja(j) = a%ja(i)
|
||||
end if
|
||||
end do
|
||||
call a%set_nzeros(j)
|
||||
call a%trim()
|
||||
end subroutine psb_d_coo_clean_zeros
|
||||
|
||||
|
||||
|
||||
subroutine psb_d_coo_allocate_mnnz(m,n,a,nz)
|
||||
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_allocate_mnnz
|
||||
|
||||
@@ -318,6 +318,22 @@ subroutine psb_s_base_mv_from_fmt(a,b,info)
|
||||
|
||||
end subroutine psb_s_base_mv_from_fmt
|
||||
|
||||
subroutine psb_s_base_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_clean_zeros
|
||||
implicit none
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_s_coo_sparse_mat) :: tmpcoo
|
||||
|
||||
call a%mv_to_coo(tmpcoo,info)
|
||||
if (info == 0) call tmpcoo%clean_zeros(info)
|
||||
if (info == 0) call a%mv_from_coo(tmpcoo,info)
|
||||
|
||||
end subroutine psb_s_base_clean_zeros
|
||||
|
||||
|
||||
subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_error_mod
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_csput_a
|
||||
|
||||
@@ -329,6 +329,31 @@ subroutine psb_s_coo_trim(a)
|
||||
|
||||
end subroutine psb_s_coo_trim
|
||||
|
||||
subroutine psb_s_coo_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_clean_zeros
|
||||
implicit none
|
||||
class(psb_s_coo_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i,j,k, nzin
|
||||
|
||||
info = 0
|
||||
nzin = a%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nzin
|
||||
if (a%val(i) /= szero) then
|
||||
j = j + 1
|
||||
a%val(j) = a%val(i)
|
||||
a%ia(j) = a%ia(i)
|
||||
a%ja(j) = a%ja(i)
|
||||
end if
|
||||
end do
|
||||
call a%set_nzeros(j)
|
||||
call a%trim()
|
||||
end subroutine psb_s_coo_clean_zeros
|
||||
|
||||
|
||||
|
||||
subroutine psb_s_coo_allocate_mnnz(m,n,a,nz)
|
||||
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_allocate_mnnz
|
||||
|
||||
@@ -318,6 +318,22 @@ subroutine psb_z_base_mv_from_fmt(a,b,info)
|
||||
|
||||
end subroutine psb_z_base_mv_from_fmt
|
||||
|
||||
subroutine psb_z_base_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_clean_zeros
|
||||
implicit none
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_z_coo_sparse_mat) :: tmpcoo
|
||||
|
||||
call a%mv_to_coo(tmpcoo,info)
|
||||
if (info == 0) call tmpcoo%clean_zeros(info)
|
||||
if (info == 0) call a%mv_from_coo(tmpcoo,info)
|
||||
|
||||
end subroutine psb_z_base_clean_zeros
|
||||
|
||||
|
||||
subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_error_mod
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_csput_a
|
||||
|
||||
@@ -329,6 +329,31 @@ subroutine psb_z_coo_trim(a)
|
||||
|
||||
end subroutine psb_z_coo_trim
|
||||
|
||||
subroutine psb_z_coo_clean_zeros(a, info)
|
||||
use psb_error_mod
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_clean_zeros
|
||||
implicit none
|
||||
class(psb_z_coo_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i,j,k, nzin
|
||||
|
||||
info = 0
|
||||
nzin = a%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nzin
|
||||
if (a%val(i) /= zzero) then
|
||||
j = j + 1
|
||||
a%val(j) = a%val(i)
|
||||
a%ia(j) = a%ia(i)
|
||||
a%ja(j) = a%ja(i)
|
||||
end if
|
||||
end do
|
||||
call a%set_nzeros(j)
|
||||
call a%trim()
|
||||
end subroutine psb_z_coo_clean_zeros
|
||||
|
||||
|
||||
|
||||
subroutine psb_z_coo_allocate_mnnz(m,n,a,nz)
|
||||
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_allocate_mnnz
|
||||
|
||||
Reference in New Issue
Block a user