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.
psblas-3.4-maint
Salvatore Filippone 9 years ago
parent 337ee6b4c5
commit faafed5455

@ -42,7 +42,7 @@ module psb_c_base_mat_mod
!! The psb_c_base_sparse_mat type, extending psb_base_sparse_mat, !! The psb_c_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level complex(psb_spk_) sparse matrix object. !! defines a middle level complex(psb_spk_) sparse matrix object.
!! This class object itself does not have any additional members !! This class object itself does not have any additional members
!! with respect to those of the base class. No methods can be fully !! with respect to those of the base class. Most methods cannot be fully
!! implemented at this level, but we can define the interface for the !! implemented at this level, but we can define the interface for the
!! computational methods requiring the knowledge of the underlying !! computational methods requiring the knowledge of the underlying
!! field, such as the matrix-vector product; this interface is defined, !! field, such as the matrix-vector product; this interface is defined,
@ -78,6 +78,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: mold => psb_c_base_mold procedure, pass(a) :: mold => psb_c_base_mold
procedure, pass(a) :: clone => psb_c_base_clone procedure, pass(a) :: clone => psb_c_base_clone
procedure, pass(a) :: make_nonunit => psb_c_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_c_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_c_base_clean_zeros
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -165,6 +166,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: get_nz_row => psb_c_coo_get_nz_row procedure, pass(a) :: get_nz_row => psb_c_coo_get_nz_row
procedure, pass(a) :: fix => psb_c_fix_coo procedure, pass(a) :: fix => psb_c_fix_coo
procedure, pass(a) :: trim => psb_c_coo_trim procedure, pass(a) :: trim => psb_c_coo_trim
procedure, pass(a) :: clean_zeros => psb_c_coo_clean_zeros
procedure, pass(a) :: print => psb_c_coo_print procedure, pass(a) :: print => psb_c_coo_print
procedure, pass(a) :: free => c_coo_free procedure, pass(a) :: free => c_coo_free
procedure, pass(a) :: mold => psb_c_coo_mold procedure, pass(a) :: mold => psb_c_coo_mold
@ -701,6 +703,18 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_from_fmt end subroutine psb_c_base_mv_from_fmt
end interface end interface
!
!>
!! \memberof psb_c_base_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_clean_zeros
!
interface
subroutine psb_c_base_clean_zeros(a, info)
import :: psb_ipk_, psb_c_base_sparse_mat
class(psb_c_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_clean_zeros
end interface
! !
!> Function transp: !> Function transp:
@ -1239,6 +1253,18 @@ module psb_c_base_mat_mod
class(psb_c_coo_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(inout) :: a
end subroutine psb_c_coo_trim end subroutine psb_c_coo_trim
end interface end interface
!
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_clean_zeros
!
interface
subroutine psb_c_coo_clean_zeros(a,info)
import :: psb_ipk_, psb_c_coo_sparse_mat
class(psb_c_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_clean_zeros
end interface
! !
!> !>

@ -133,6 +133,7 @@ module psb_c_mat_mod
procedure, pass(a) :: m_csclip => psb_c_csclip procedure, pass(a) :: m_csclip => psb_c_csclip
procedure, pass(a) :: b_csclip => psb_c_b_csclip procedure, pass(a) :: b_csclip => psb_c_b_csclip
generic, public :: csclip => b_csclip, m_csclip generic, public :: csclip => b_csclip, m_csclip
procedure, pass(a) :: clean_zeros => psb_c_clean_zeros
procedure, pass(a) :: reall => psb_c_reallocate_nz procedure, pass(a) :: reall => psb_c_reallocate_nz
procedure, pass(a) :: get_neigh => psb_c_get_neigh procedure, pass(a) :: get_neigh => psb_c_get_neigh
procedure, pass(a) :: reinit => psb_c_reinit procedure, pass(a) :: reinit => psb_c_reinit
@ -1279,7 +1280,15 @@ contains
end function psb_c_get_nz_row end function psb_c_get_nz_row
subroutine psb_c_clean_zeros(a,info)
implicit none
integer(psb_ipk_), intent(out) :: info
class(psb_cspmat_type), intent(inout) :: a
info = 0
if (allocated(a%a)) call a%a%clean_zeros(info)
end subroutine psb_c_clean_zeros
end module psb_c_mat_mod end module psb_c_mat_mod

@ -42,7 +42,7 @@ module psb_d_base_mat_mod
!! The psb_d_base_sparse_mat type, extending psb_base_sparse_mat, !! The psb_d_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level real(psb_dpk_) sparse matrix object. !! defines a middle level real(psb_dpk_) sparse matrix object.
!! This class object itself does not have any additional members !! This class object itself does not have any additional members
!! with respect to those of the base class. No methods can be fully !! with respect to those of the base class. Most methods cannot be fully
!! implemented at this level, but we can define the interface for the !! implemented at this level, but we can define the interface for the
!! computational methods requiring the knowledge of the underlying !! computational methods requiring the knowledge of the underlying
!! field, such as the matrix-vector product; this interface is defined, !! field, such as the matrix-vector product; this interface is defined,
@ -78,6 +78,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mold => psb_d_base_mold procedure, pass(a) :: mold => psb_d_base_mold
procedure, pass(a) :: clone => psb_d_base_clone procedure, pass(a) :: clone => psb_d_base_clone
procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_d_base_clean_zeros
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -165,6 +166,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: get_nz_row => psb_d_coo_get_nz_row procedure, pass(a) :: get_nz_row => psb_d_coo_get_nz_row
procedure, pass(a) :: fix => psb_d_fix_coo procedure, pass(a) :: fix => psb_d_fix_coo
procedure, pass(a) :: trim => psb_d_coo_trim procedure, pass(a) :: trim => psb_d_coo_trim
procedure, pass(a) :: clean_zeros => psb_d_coo_clean_zeros
procedure, pass(a) :: print => psb_d_coo_print procedure, pass(a) :: print => psb_d_coo_print
procedure, pass(a) :: free => d_coo_free procedure, pass(a) :: free => d_coo_free
procedure, pass(a) :: mold => psb_d_coo_mold procedure, pass(a) :: mold => psb_d_coo_mold
@ -701,6 +703,18 @@ module psb_d_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_from_fmt end subroutine psb_d_base_mv_from_fmt
end interface end interface
!
!>
!! \memberof psb_d_base_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_clean_zeros
!
interface
subroutine psb_d_base_clean_zeros(a, info)
import :: psb_ipk_, psb_d_base_sparse_mat
class(psb_d_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_clean_zeros
end interface
! !
!> Function transp: !> Function transp:
@ -1239,6 +1253,18 @@ module psb_d_base_mat_mod
class(psb_d_coo_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(inout) :: a
end subroutine psb_d_coo_trim end subroutine psb_d_coo_trim
end interface end interface
!
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_clean_zeros
!
interface
subroutine psb_d_coo_clean_zeros(a,info)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_clean_zeros
end interface
! !
!> !>

@ -133,6 +133,7 @@ module psb_d_mat_mod
procedure, pass(a) :: m_csclip => psb_d_csclip procedure, pass(a) :: m_csclip => psb_d_csclip
procedure, pass(a) :: b_csclip => psb_d_b_csclip procedure, pass(a) :: b_csclip => psb_d_b_csclip
generic, public :: csclip => b_csclip, m_csclip generic, public :: csclip => b_csclip, m_csclip
procedure, pass(a) :: clean_zeros => psb_d_clean_zeros
procedure, pass(a) :: reall => psb_d_reallocate_nz procedure, pass(a) :: reall => psb_d_reallocate_nz
procedure, pass(a) :: get_neigh => psb_d_get_neigh procedure, pass(a) :: get_neigh => psb_d_get_neigh
procedure, pass(a) :: reinit => psb_d_reinit procedure, pass(a) :: reinit => psb_d_reinit
@ -1279,7 +1280,15 @@ contains
end function psb_d_get_nz_row end function psb_d_get_nz_row
subroutine psb_d_clean_zeros(a,info)
implicit none
integer(psb_ipk_), intent(out) :: info
class(psb_dspmat_type), intent(inout) :: a
info = 0
if (allocated(a%a)) call a%a%clean_zeros(info)
end subroutine psb_d_clean_zeros
end module psb_d_mat_mod end module psb_d_mat_mod

@ -42,7 +42,7 @@ module psb_s_base_mat_mod
!! The psb_s_base_sparse_mat type, extending psb_base_sparse_mat, !! The psb_s_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level real(psb_spk_) sparse matrix object. !! defines a middle level real(psb_spk_) sparse matrix object.
!! This class object itself does not have any additional members !! This class object itself does not have any additional members
!! with respect to those of the base class. No methods can be fully !! with respect to those of the base class. Most methods cannot be fully
!! implemented at this level, but we can define the interface for the !! implemented at this level, but we can define the interface for the
!! computational methods requiring the knowledge of the underlying !! computational methods requiring the knowledge of the underlying
!! field, such as the matrix-vector product; this interface is defined, !! field, such as the matrix-vector product; this interface is defined,
@ -78,6 +78,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: mold => psb_s_base_mold procedure, pass(a) :: mold => psb_s_base_mold
procedure, pass(a) :: clone => psb_s_base_clone procedure, pass(a) :: clone => psb_s_base_clone
procedure, pass(a) :: make_nonunit => psb_s_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_s_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_s_base_clean_zeros
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -165,6 +166,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: get_nz_row => psb_s_coo_get_nz_row procedure, pass(a) :: get_nz_row => psb_s_coo_get_nz_row
procedure, pass(a) :: fix => psb_s_fix_coo procedure, pass(a) :: fix => psb_s_fix_coo
procedure, pass(a) :: trim => psb_s_coo_trim procedure, pass(a) :: trim => psb_s_coo_trim
procedure, pass(a) :: clean_zeros => psb_s_coo_clean_zeros
procedure, pass(a) :: print => psb_s_coo_print procedure, pass(a) :: print => psb_s_coo_print
procedure, pass(a) :: free => s_coo_free procedure, pass(a) :: free => s_coo_free
procedure, pass(a) :: mold => psb_s_coo_mold procedure, pass(a) :: mold => psb_s_coo_mold
@ -701,6 +703,18 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_from_fmt end subroutine psb_s_base_mv_from_fmt
end interface end interface
!
!>
!! \memberof psb_s_base_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_clean_zeros
!
interface
subroutine psb_s_base_clean_zeros(a, info)
import :: psb_ipk_, psb_s_base_sparse_mat
class(psb_s_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_clean_zeros
end interface
! !
!> Function transp: !> Function transp:
@ -1239,6 +1253,18 @@ module psb_s_base_mat_mod
class(psb_s_coo_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(inout) :: a
end subroutine psb_s_coo_trim end subroutine psb_s_coo_trim
end interface end interface
!
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_clean_zeros
!
interface
subroutine psb_s_coo_clean_zeros(a,info)
import :: psb_ipk_, psb_s_coo_sparse_mat
class(psb_s_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_clean_zeros
end interface
! !
!> !>

@ -133,6 +133,7 @@ module psb_s_mat_mod
procedure, pass(a) :: m_csclip => psb_s_csclip procedure, pass(a) :: m_csclip => psb_s_csclip
procedure, pass(a) :: b_csclip => psb_s_b_csclip procedure, pass(a) :: b_csclip => psb_s_b_csclip
generic, public :: csclip => b_csclip, m_csclip generic, public :: csclip => b_csclip, m_csclip
procedure, pass(a) :: clean_zeros => psb_s_clean_zeros
procedure, pass(a) :: reall => psb_s_reallocate_nz procedure, pass(a) :: reall => psb_s_reallocate_nz
procedure, pass(a) :: get_neigh => psb_s_get_neigh procedure, pass(a) :: get_neigh => psb_s_get_neigh
procedure, pass(a) :: reinit => psb_s_reinit procedure, pass(a) :: reinit => psb_s_reinit
@ -1279,7 +1280,15 @@ contains
end function psb_s_get_nz_row end function psb_s_get_nz_row
subroutine psb_s_clean_zeros(a,info)
implicit none
integer(psb_ipk_), intent(out) :: info
class(psb_sspmat_type), intent(inout) :: a
info = 0
if (allocated(a%a)) call a%a%clean_zeros(info)
end subroutine psb_s_clean_zeros
end module psb_s_mat_mod end module psb_s_mat_mod

@ -42,7 +42,7 @@ module psb_z_base_mat_mod
!! The psb_z_base_sparse_mat type, extending psb_base_sparse_mat, !! The psb_z_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level complex(psb_dpk_) sparse matrix object. !! defines a middle level complex(psb_dpk_) sparse matrix object.
!! This class object itself does not have any additional members !! This class object itself does not have any additional members
!! with respect to those of the base class. No methods can be fully !! with respect to those of the base class. Most methods cannot be fully
!! implemented at this level, but we can define the interface for the !! implemented at this level, but we can define the interface for the
!! computational methods requiring the knowledge of the underlying !! computational methods requiring the knowledge of the underlying
!! field, such as the matrix-vector product; this interface is defined, !! field, such as the matrix-vector product; this interface is defined,
@ -78,6 +78,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: mold => psb_z_base_mold procedure, pass(a) :: mold => psb_z_base_mold
procedure, pass(a) :: clone => psb_z_base_clone procedure, pass(a) :: clone => psb_z_base_clone
procedure, pass(a) :: make_nonunit => psb_z_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_z_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_z_base_clean_zeros
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -165,6 +166,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: get_nz_row => psb_z_coo_get_nz_row procedure, pass(a) :: get_nz_row => psb_z_coo_get_nz_row
procedure, pass(a) :: fix => psb_z_fix_coo procedure, pass(a) :: fix => psb_z_fix_coo
procedure, pass(a) :: trim => psb_z_coo_trim procedure, pass(a) :: trim => psb_z_coo_trim
procedure, pass(a) :: clean_zeros => psb_z_coo_clean_zeros
procedure, pass(a) :: print => psb_z_coo_print procedure, pass(a) :: print => psb_z_coo_print
procedure, pass(a) :: free => z_coo_free procedure, pass(a) :: free => z_coo_free
procedure, pass(a) :: mold => psb_z_coo_mold procedure, pass(a) :: mold => psb_z_coo_mold
@ -701,6 +703,18 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_from_fmt end subroutine psb_z_base_mv_from_fmt
end interface end interface
!
!>
!! \memberof psb_z_base_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_clean_zeros
!
interface
subroutine psb_z_base_clean_zeros(a, info)
import :: psb_ipk_, psb_z_base_sparse_mat
class(psb_z_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_clean_zeros
end interface
! !
!> Function transp: !> Function transp:
@ -1239,6 +1253,18 @@ module psb_z_base_mat_mod
class(psb_z_coo_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(inout) :: a
end subroutine psb_z_coo_trim end subroutine psb_z_coo_trim
end interface end interface
!
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_clean_zeros
!
interface
subroutine psb_z_coo_clean_zeros(a,info)
import :: psb_ipk_, psb_z_coo_sparse_mat
class(psb_z_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_clean_zeros
end interface
! !
!> !>

@ -133,6 +133,7 @@ module psb_z_mat_mod
procedure, pass(a) :: m_csclip => psb_z_csclip procedure, pass(a) :: m_csclip => psb_z_csclip
procedure, pass(a) :: b_csclip => psb_z_b_csclip procedure, pass(a) :: b_csclip => psb_z_b_csclip
generic, public :: csclip => b_csclip, m_csclip generic, public :: csclip => b_csclip, m_csclip
procedure, pass(a) :: clean_zeros => psb_z_clean_zeros
procedure, pass(a) :: reall => psb_z_reallocate_nz procedure, pass(a) :: reall => psb_z_reallocate_nz
procedure, pass(a) :: get_neigh => psb_z_get_neigh procedure, pass(a) :: get_neigh => psb_z_get_neigh
procedure, pass(a) :: reinit => psb_z_reinit procedure, pass(a) :: reinit => psb_z_reinit
@ -1279,7 +1280,15 @@ contains
end function psb_z_get_nz_row end function psb_z_get_nz_row
subroutine psb_z_clean_zeros(a,info)
implicit none
integer(psb_ipk_), intent(out) :: info
class(psb_zspmat_type), intent(inout) :: a
info = 0
if (allocated(a%a)) call a%a%clean_zeros(info)
end subroutine psb_z_clean_zeros
end module psb_z_mat_mod end module psb_z_mat_mod

@ -318,6 +318,22 @@ subroutine psb_c_base_mv_from_fmt(a,b,info)
end subroutine psb_c_base_mv_from_fmt 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) subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod use psb_error_mod
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_csput_a 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 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) subroutine psb_c_coo_allocate_mnnz(m,n,a,nz)
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_allocate_mnnz 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 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) subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod use psb_error_mod
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput_a 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 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) subroutine psb_d_coo_allocate_mnnz(m,n,a,nz)
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_allocate_mnnz 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 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) subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod use psb_error_mod
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_csput_a 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 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) subroutine psb_s_coo_allocate_mnnz(m,n,a,nz)
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_allocate_mnnz 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 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) subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod use psb_error_mod
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_csput_a 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 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) subroutine psb_z_coo_allocate_mnnz(m,n,a,nz)
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_allocate_mnnz use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_allocate_mnnz

Loading…
Cancel
Save