fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Modify clean_zeros and have it only at base%

Browse Source
repackage
sfilippone 3 weeks ago
parent 66a9d5e50a
commit 4e71fa971c
20 changed files with 688 additions and 684 deletions
Show Stats Download Patch File Download Diff File

52
base/modules/serial/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -87,7 +87,7 @@ module psb_c_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_c_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_c_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_c_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_c_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_c_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_c_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_c_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_c_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_c_csc_csput_a procedure, pass(a) :: csput_a => psb_c_csc_csput_a
procedure, pass(a) :: get_diag => psb_c_csc_get_diag procedure, pass(a) :: get_diag => psb_c_csc_get_diag
procedure, pass(a) :: csgetptn => psb_c_csc_csgetptn procedure, pass(a) :: csgetptn => psb_c_csc_csgetptn
@ -143,7 +143,7 @@ module psb_c_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_lc_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_lc_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_lc_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_lc_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_lc_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_lc_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_lc_csc_csput_a procedure, pass(a) :: csput_a => psb_lc_csc_csput_a
procedure, pass(a) :: get_diag => psb_lc_csc_get_diag procedure, pass(a) :: get_diag => psb_lc_csc_get_diag
procedure, pass(a) :: csgetptn => psb_lc_csc_csgetptn procedure, pass(a) :: csgetptn => psb_lc_csc_csgetptn
@ -313,18 +313,18 @@ module psb_c_csc_mat_mod
end subroutine psb_c_mv_csc_from_fmt end subroutine psb_c_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_c_csc_sparse_mat !!$ !! \memberof psb_c_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_clean_zeros !!$ !! \see psb_c_base_mat_mod::psb_c_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_c_csc_clean_zeros(a, info) !!$ subroutine psb_c_csc_clean_zeros(a, info)
import !!$ import
class(psb_c_csc_sparse_mat), intent(inout) :: a !!$ class(psb_c_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_csc_clean_zeros !!$ end subroutine psb_c_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_c_csc_sparse_mat !> \memberof psb_c_csc_sparse_mat
@ -717,18 +717,18 @@ module psb_c_csc_mat_mod
end subroutine psb_lc_mv_csc_from_fmt end subroutine psb_lc_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_lc_csc_sparse_mat !!$ !! \memberof psb_lc_csc_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_clean_zeros !!$ !! \see psb_lc_base_mat_mod::psb_lc_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_lc_csc_clean_zeros(a, info) !!$ subroutine psb_lc_csc_clean_zeros(a, info)
import !!$ import
class(psb_lc_csc_sparse_mat), intent(inout) :: a !!$ class(psb_lc_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csc_clean_zeros !!$ end subroutine psb_lc_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_lc_csc_sparse_mat !> \memberof psb_lc_csc_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_from !! \see psb_lc_base_mat_mod::psb_lc_base_cp_from

50
base/modules/serial/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -91,7 +91,7 @@ module psb_c_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_c_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_c_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_c_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_c_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_c_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_c_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_c_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_c_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_c_csr_csput_a procedure, pass(a) :: csput_a => psb_c_csr_csput_a
procedure, pass(a) :: get_diag => psb_c_csr_get_diag procedure, pass(a) :: get_diag => psb_c_csr_get_diag
procedure, pass(a) :: csgetptn => psb_c_csr_csgetptn procedure, pass(a) :: csgetptn => psb_c_csr_csgetptn
@ -261,18 +261,18 @@ module psb_c_csr_mat_mod
end subroutine psb_c_csr_triu end subroutine psb_c_csr_triu
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_c_csr_sparse_mat !!$ !! \memberof psb_c_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_clean_zeros !!$ !! \see psb_c_base_mat_mod::psb_c_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_c_csr_clean_zeros(a, info) !!$ subroutine psb_c_csr_clean_zeros(a, info)
import !!$ import
class(psb_c_csr_sparse_mat), intent(inout) :: a !!$ class(psb_c_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_csr_clean_zeros !!$ end subroutine psb_c_csr_clean_zeros
end interface !!$ end interface
!> \memberof psb_c_csr_sparse_mat !> \memberof psb_c_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_cp_to_coo !! \see psb_c_base_mat_mod::psb_c_base_cp_to_coo
@ -716,7 +716,7 @@ module psb_c_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_lc_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_lc_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_lc_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_lc_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_lc_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_lc_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_lc_csr_csput_a procedure, pass(a) :: csput_a => psb_lc_csr_csput_a
procedure, pass(a) :: get_diag => psb_lc_csr_get_diag procedure, pass(a) :: get_diag => psb_lc_csr_get_diag
procedure, pass(a) :: csgetptn => psb_lc_csr_csgetptn procedure, pass(a) :: csgetptn => psb_lc_csr_csgetptn
@ -895,17 +895,17 @@ module psb_c_csr_mat_mod
end interface end interface
! !
!> !!$ !>
!! \memberof psb_lc_csr_sparse_mat !!$ !! \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_clean_zeros !!$ !! \see psb_lc_base_mat_mod::psb_lc_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_lc_csr_clean_zeros(a, info) !!$ subroutine psb_lc_csr_clean_zeros(a, info)
import !!$ import
class(psb_lc_csr_sparse_mat), intent(inout) :: a !!$ class(psb_lc_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csr_clean_zeros !!$ end subroutine psb_lc_csr_clean_zeros
end interface !!$ end interface

52
base/modules/serial/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -87,7 +87,7 @@ module psb_d_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_d_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_d_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_d_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_d_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_d_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_d_csc_csput_a procedure, pass(a) :: csput_a => psb_d_csc_csput_a
procedure, pass(a) :: get_diag => psb_d_csc_get_diag procedure, pass(a) :: get_diag => psb_d_csc_get_diag
procedure, pass(a) :: csgetptn => psb_d_csc_csgetptn procedure, pass(a) :: csgetptn => psb_d_csc_csgetptn
@ -143,7 +143,7 @@ module psb_d_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_ld_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_ld_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_ld_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_ld_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_ld_csc_csput_a procedure, pass(a) :: csput_a => psb_ld_csc_csput_a
procedure, pass(a) :: get_diag => psb_ld_csc_get_diag procedure, pass(a) :: get_diag => psb_ld_csc_get_diag
procedure, pass(a) :: csgetptn => psb_ld_csc_csgetptn procedure, pass(a) :: csgetptn => psb_ld_csc_csgetptn
@ -313,18 +313,18 @@ module psb_d_csc_mat_mod
end subroutine psb_d_mv_csc_from_fmt end subroutine psb_d_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_d_csc_sparse_mat !!$ !! \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_clean_zeros !!$ !! \see psb_d_base_mat_mod::psb_d_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_d_csc_clean_zeros(a, info) !!$ subroutine psb_d_csc_clean_zeros(a, info)
import !!$ import
class(psb_d_csc_sparse_mat), intent(inout) :: a !!$ class(psb_d_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_csc_clean_zeros !!$ end subroutine psb_d_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_d_csc_sparse_mat !> \memberof psb_d_csc_sparse_mat
@ -717,18 +717,18 @@ module psb_d_csc_mat_mod
end subroutine psb_ld_mv_csc_from_fmt end subroutine psb_ld_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_ld_csc_sparse_mat !!$ !! \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_clean_zeros !!$ !! \see psb_ld_base_mat_mod::psb_ld_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_ld_csc_clean_zeros(a, info) !!$ subroutine psb_ld_csc_clean_zeros(a, info)
import !!$ import
class(psb_ld_csc_sparse_mat), intent(inout) :: a !!$ class(psb_ld_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csc_clean_zeros !!$ end subroutine psb_ld_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_ld_csc_sparse_mat !> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from !! \see psb_ld_base_mat_mod::psb_ld_base_cp_from

50
base/modules/serial/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -91,7 +91,7 @@ module psb_d_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_d_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_d_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_d_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_d_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_d_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_d_csr_csput_a procedure, pass(a) :: csput_a => psb_d_csr_csput_a
procedure, pass(a) :: get_diag => psb_d_csr_get_diag procedure, pass(a) :: get_diag => psb_d_csr_get_diag
procedure, pass(a) :: csgetptn => psb_d_csr_csgetptn procedure, pass(a) :: csgetptn => psb_d_csr_csgetptn
@ -261,18 +261,18 @@ module psb_d_csr_mat_mod
end subroutine psb_d_csr_triu end subroutine psb_d_csr_triu
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_d_csr_sparse_mat !!$ !! \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_clean_zeros !!$ !! \see psb_d_base_mat_mod::psb_d_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_d_csr_clean_zeros(a, info) !!$ subroutine psb_d_csr_clean_zeros(a, info)
import !!$ import
class(psb_d_csr_sparse_mat), intent(inout) :: a !!$ class(psb_d_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_csr_clean_zeros !!$ end subroutine psb_d_csr_clean_zeros
end interface !!$ end interface
!> \memberof psb_d_csr_sparse_mat !> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_to_coo !! \see psb_d_base_mat_mod::psb_d_base_cp_to_coo
@ -716,7 +716,7 @@ module psb_d_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_ld_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_ld_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_ld_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_ld_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_ld_csr_csput_a procedure, pass(a) :: csput_a => psb_ld_csr_csput_a
procedure, pass(a) :: get_diag => psb_ld_csr_get_diag procedure, pass(a) :: get_diag => psb_ld_csr_get_diag
procedure, pass(a) :: csgetptn => psb_ld_csr_csgetptn procedure, pass(a) :: csgetptn => psb_ld_csr_csgetptn
@ -895,17 +895,17 @@ module psb_d_csr_mat_mod
end interface end interface
! !
!> !!$ !>
!! \memberof psb_ld_csr_sparse_mat !!$ !! \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_clean_zeros !!$ !! \see psb_ld_base_mat_mod::psb_ld_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_ld_csr_clean_zeros(a, info) !!$ subroutine psb_ld_csr_clean_zeros(a, info)
import !!$ import
class(psb_ld_csr_sparse_mat), intent(inout) :: a !!$ class(psb_ld_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_clean_zeros !!$ end subroutine psb_ld_csr_clean_zeros
end interface !!$ end interface

52
base/modules/serial/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -87,7 +87,7 @@ module psb_s_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_s_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_s_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_s_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_s_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_s_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_s_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_s_csc_csput_a procedure, pass(a) :: csput_a => psb_s_csc_csput_a
procedure, pass(a) :: get_diag => psb_s_csc_get_diag procedure, pass(a) :: get_diag => psb_s_csc_get_diag
procedure, pass(a) :: csgetptn => psb_s_csc_csgetptn procedure, pass(a) :: csgetptn => psb_s_csc_csgetptn
@ -143,7 +143,7 @@ module psb_s_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_ls_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_ls_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_ls_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_ls_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_ls_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_ls_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_ls_csc_csput_a procedure, pass(a) :: csput_a => psb_ls_csc_csput_a
procedure, pass(a) :: get_diag => psb_ls_csc_get_diag procedure, pass(a) :: get_diag => psb_ls_csc_get_diag
procedure, pass(a) :: csgetptn => psb_ls_csc_csgetptn procedure, pass(a) :: csgetptn => psb_ls_csc_csgetptn
@ -313,18 +313,18 @@ module psb_s_csc_mat_mod
end subroutine psb_s_mv_csc_from_fmt end subroutine psb_s_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_s_csc_sparse_mat !!$ !! \memberof psb_s_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_clean_zeros !!$ !! \see psb_s_base_mat_mod::psb_s_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_s_csc_clean_zeros(a, info) !!$ subroutine psb_s_csc_clean_zeros(a, info)
import !!$ import
class(psb_s_csc_sparse_mat), intent(inout) :: a !!$ class(psb_s_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_csc_clean_zeros !!$ end subroutine psb_s_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_s_csc_sparse_mat !> \memberof psb_s_csc_sparse_mat
@ -717,18 +717,18 @@ module psb_s_csc_mat_mod
end subroutine psb_ls_mv_csc_from_fmt end subroutine psb_ls_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_ls_csc_sparse_mat !!$ !! \memberof psb_ls_csc_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_clean_zeros !!$ !! \see psb_ls_base_mat_mod::psb_ls_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_ls_csc_clean_zeros(a, info) !!$ subroutine psb_ls_csc_clean_zeros(a, info)
import !!$ import
class(psb_ls_csc_sparse_mat), intent(inout) :: a !!$ class(psb_ls_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csc_clean_zeros !!$ end subroutine psb_ls_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_ls_csc_sparse_mat !> \memberof psb_ls_csc_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_from !! \see psb_ls_base_mat_mod::psb_ls_base_cp_from

50
base/modules/serial/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -91,7 +91,7 @@ module psb_s_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_s_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_s_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_s_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_s_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_s_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_s_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_s_csr_csput_a procedure, pass(a) :: csput_a => psb_s_csr_csput_a
procedure, pass(a) :: get_diag => psb_s_csr_get_diag procedure, pass(a) :: get_diag => psb_s_csr_get_diag
procedure, pass(a) :: csgetptn => psb_s_csr_csgetptn procedure, pass(a) :: csgetptn => psb_s_csr_csgetptn
@ -261,18 +261,18 @@ module psb_s_csr_mat_mod
end subroutine psb_s_csr_triu end subroutine psb_s_csr_triu
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_s_csr_sparse_mat !!$ !! \memberof psb_s_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_clean_zeros !!$ !! \see psb_s_base_mat_mod::psb_s_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_s_csr_clean_zeros(a, info) !!$ subroutine psb_s_csr_clean_zeros(a, info)
import !!$ import
class(psb_s_csr_sparse_mat), intent(inout) :: a !!$ class(psb_s_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_csr_clean_zeros !!$ end subroutine psb_s_csr_clean_zeros
end interface !!$ end interface
!> \memberof psb_s_csr_sparse_mat !> \memberof psb_s_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_cp_to_coo !! \see psb_s_base_mat_mod::psb_s_base_cp_to_coo
@ -716,7 +716,7 @@ module psb_s_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_ls_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_ls_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_ls_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_ls_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_ls_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_ls_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_ls_csr_csput_a procedure, pass(a) :: csput_a => psb_ls_csr_csput_a
procedure, pass(a) :: get_diag => psb_ls_csr_get_diag procedure, pass(a) :: get_diag => psb_ls_csr_get_diag
procedure, pass(a) :: csgetptn => psb_ls_csr_csgetptn procedure, pass(a) :: csgetptn => psb_ls_csr_csgetptn
@ -895,17 +895,17 @@ module psb_s_csr_mat_mod
end interface end interface
! !
!> !!$ !>
!! \memberof psb_ls_csr_sparse_mat !!$ !! \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_clean_zeros !!$ !! \see psb_ls_base_mat_mod::psb_ls_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_ls_csr_clean_zeros(a, info) !!$ subroutine psb_ls_csr_clean_zeros(a, info)
import !!$ import
class(psb_ls_csr_sparse_mat), intent(inout) :: a !!$ class(psb_ls_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csr_clean_zeros !!$ end subroutine psb_ls_csr_clean_zeros
end interface !!$ end interface

52
base/modules/serial/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -87,7 +87,7 @@ module psb_z_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_z_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_z_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_z_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_z_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_z_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_z_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_z_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_z_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_z_csc_csput_a procedure, pass(a) :: csput_a => psb_z_csc_csput_a
procedure, pass(a) :: get_diag => psb_z_csc_get_diag procedure, pass(a) :: get_diag => psb_z_csc_get_diag
procedure, pass(a) :: csgetptn => psb_z_csc_csgetptn procedure, pass(a) :: csgetptn => psb_z_csc_csgetptn
@ -143,7 +143,7 @@ module psb_z_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_lz_mv_csc_from_coo procedure, pass(a) :: mv_from_coo => psb_lz_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_mv_csc_to_fmt procedure, pass(a) :: mv_to_fmt => psb_lz_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_mv_csc_from_fmt procedure, pass(a) :: mv_from_fmt => psb_lz_mv_csc_from_fmt
procedure, pass(a) :: clean_zeros => psb_lz_csc_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_lz_csc_clean_zeros
procedure, pass(a) :: csput_a => psb_lz_csc_csput_a procedure, pass(a) :: csput_a => psb_lz_csc_csput_a
procedure, pass(a) :: get_diag => psb_lz_csc_get_diag procedure, pass(a) :: get_diag => psb_lz_csc_get_diag
procedure, pass(a) :: csgetptn => psb_lz_csc_csgetptn procedure, pass(a) :: csgetptn => psb_lz_csc_csgetptn
@ -313,18 +313,18 @@ module psb_z_csc_mat_mod
end subroutine psb_z_mv_csc_from_fmt end subroutine psb_z_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_z_csc_sparse_mat !!$ !! \memberof psb_z_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_clean_zeros !!$ !! \see psb_z_base_mat_mod::psb_z_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_z_csc_clean_zeros(a, info) !!$ subroutine psb_z_csc_clean_zeros(a, info)
import !!$ import
class(psb_z_csc_sparse_mat), intent(inout) :: a !!$ class(psb_z_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_csc_clean_zeros !!$ end subroutine psb_z_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_z_csc_sparse_mat !> \memberof psb_z_csc_sparse_mat
@ -717,18 +717,18 @@ module psb_z_csc_mat_mod
end subroutine psb_lz_mv_csc_from_fmt end subroutine psb_lz_mv_csc_from_fmt
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_lz_csc_sparse_mat !!$ !! \memberof psb_lz_csc_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros !!$ !! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_lz_csc_clean_zeros(a, info) !!$ subroutine psb_lz_csc_clean_zeros(a, info)
import !!$ import
class(psb_lz_csc_sparse_mat), intent(inout) :: a !!$ class(psb_lz_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csc_clean_zeros !!$ end subroutine psb_lz_csc_clean_zeros
end interface !!$ end interface
!> \memberof psb_lz_csc_sparse_mat !> \memberof psb_lz_csc_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_from !! \see psb_lz_base_mat_mod::psb_lz_base_cp_from

50
base/modules/serial/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -91,7 +91,7 @@ module psb_z_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_z_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_z_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_z_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_z_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_z_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_z_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_z_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_z_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_z_csr_csput_a procedure, pass(a) :: csput_a => psb_z_csr_csput_a
procedure, pass(a) :: get_diag => psb_z_csr_get_diag procedure, pass(a) :: get_diag => psb_z_csr_get_diag
procedure, pass(a) :: csgetptn => psb_z_csr_csgetptn procedure, pass(a) :: csgetptn => psb_z_csr_csgetptn
@ -261,18 +261,18 @@ module psb_z_csr_mat_mod
end subroutine psb_z_csr_triu end subroutine psb_z_csr_triu
end interface end interface
! !!$ !
!> !!$ !>
!! \memberof psb_z_csr_sparse_mat !!$ !! \memberof psb_z_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_clean_zeros !!$ !! \see psb_z_base_mat_mod::psb_z_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_z_csr_clean_zeros(a, info) !!$ subroutine psb_z_csr_clean_zeros(a, info)
import !!$ import
class(psb_z_csr_sparse_mat), intent(inout) :: a !!$ class(psb_z_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_csr_clean_zeros !!$ end subroutine psb_z_csr_clean_zeros
end interface !!$ end interface
!> \memberof psb_z_csr_sparse_mat !> \memberof psb_z_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_cp_to_coo !! \see psb_z_base_mat_mod::psb_z_base_cp_to_coo
@ -716,7 +716,7 @@ module psb_z_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_lz_mv_csr_from_coo procedure, pass(a) :: mv_from_coo => psb_lz_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_mv_csr_to_fmt procedure, pass(a) :: mv_to_fmt => psb_lz_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_mv_csr_from_fmt procedure, pass(a) :: mv_from_fmt => psb_lz_mv_csr_from_fmt
procedure, pass(a) :: clean_zeros => psb_lz_csr_clean_zeros ! procedure, pass(a) :: clean_zeros => psb_lz_csr_clean_zeros
procedure, pass(a) :: csput_a => psb_lz_csr_csput_a procedure, pass(a) :: csput_a => psb_lz_csr_csput_a
procedure, pass(a) :: get_diag => psb_lz_csr_get_diag procedure, pass(a) :: get_diag => psb_lz_csr_get_diag
procedure, pass(a) :: csgetptn => psb_lz_csr_csgetptn procedure, pass(a) :: csgetptn => psb_lz_csr_csgetptn
@ -895,17 +895,17 @@ module psb_z_csr_mat_mod
end interface end interface
! !
!> !!$ !>
!! \memberof psb_lz_csr_sparse_mat !!$ !! \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros !!$ !! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros
! !!$ !
interface !!$ interface
subroutine psb_lz_csr_clean_zeros(a, info) !!$ subroutine psb_lz_csr_clean_zeros(a, info)
import !!$ import
class(psb_lz_csr_sparse_mat), intent(inout) :: a !!$ class(psb_lz_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csr_clean_zeros !!$ end subroutine psb_lz_csr_clean_zeros
end interface !!$ end interface

1
base/serial/impl/psb_c_coo_impl.F90
Unescape Escape View File

@ -609,6 +609,7 @@ subroutine psb_c_coo_clean_zeros(a, info)
end if end if
end do end do
call a%set_nzeros(j) call a%set_nzeros(j)
call a%fix(info)
call a%trim() call a%trim()
end subroutine psb_c_coo_clean_zeros end subroutine psb_c_coo_clean_zeros

120
base/serial/impl/psb_c_csc_impl.F90
Unescape Escape View File

@ -2403,36 +2403,36 @@ subroutine psb_c_mv_csc_from_fmt(a,b,info)
end subroutine psb_c_mv_csc_from_fmt end subroutine psb_c_mv_csc_from_fmt
subroutine psb_c_csc_clean_zeros(a, info) !!$subroutine psb_c_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_clean_zeros !!$ use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_clean_zeros
implicit none !!$ implicit none
class(psb_c_csc_sparse_mat), intent(inout) :: a !!$ class(psb_c_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nc !!$ integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:) !!$ integer(psb_ipk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= czero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= czero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_c_csc_clean_zeros !!$end subroutine psb_c_csc_clean_zeros
subroutine psb_c_cp_csc_from_fmt(a,b,info) subroutine psb_c_cp_csc_from_fmt(a,b,info)
use psb_const_mod use psb_const_mod
@ -4305,36 +4305,36 @@ subroutine psb_lc_cp_csc_from_fmt(a,b,info)
end subroutine psb_lc_cp_csc_from_fmt end subroutine psb_lc_cp_csc_from_fmt
subroutine psb_lc_csc_clean_zeros(a, info) !!$subroutine psb_lc_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_clean_zeros !!$ use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_clean_zeros
implicit none !!$ implicit none
class(psb_lc_csc_sparse_mat), intent(inout) :: a !!$ class(psb_lc_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nc !!$ integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:) !!$ integer(psb_lpk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= czero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= czero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_lc_csc_clean_zeros !!$end subroutine psb_lc_csc_clean_zeros
subroutine psb_lc_csc_mold(a,b,info) subroutine psb_lc_csc_mold(a,b,info)

120
base/serial/impl/psb_c_csr_impl.F90
Unescape Escape View File

@ -3624,36 +3624,36 @@ subroutine psb_c_cp_csr_from_fmt(a,b,info)
end select end select
end subroutine psb_c_cp_csr_from_fmt end subroutine psb_c_cp_csr_from_fmt
subroutine psb_c_csr_clean_zeros(a, info) !!$subroutine psb_c_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_clean_zeros !!$ use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_clean_zeros
implicit none !!$ implicit none
class(psb_c_csr_sparse_mat), intent(inout) :: a !!$ class(psb_c_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nr !!$ integer(psb_ipk_) :: i, j, k, nr
integer(psb_ipk_), allocatable :: ilrp(:) !!$ integer(psb_ipk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= czero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= czero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_c_csr_clean_zeros !!$end subroutine psb_c_csr_clean_zeros
#if defined(OPENMP) #if defined(OPENMP)
subroutine psb_ccsrspspmm(a,b,c,info) 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 end subroutine psb_lc_cp_csr_from_fmt
subroutine psb_lc_csr_clean_zeros(a, info) !!$subroutine psb_lc_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_clean_zeros !!$ use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_clean_zeros
implicit none !!$ implicit none
class(psb_lc_csr_sparse_mat), intent(inout) :: a !!$ class(psb_lc_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nr !!$ integer(psb_lpk_) :: i, j, k, nr
integer(psb_lpk_), allocatable :: ilrp(:) !!$ integer(psb_lpk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= czero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= czero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_lc_csr_clean_zeros !!$end subroutine psb_lc_csr_clean_zeros
subroutine psb_lccsrspspmm(a,b,c,info) subroutine psb_lccsrspspmm(a,b,c,info)
use psb_c_mat_mod use psb_c_mat_mod

1
base/serial/impl/psb_d_coo_impl.F90
Unescape Escape View File

@ -609,6 +609,7 @@ subroutine psb_d_coo_clean_zeros(a, info)
end if end if
end do end do
call a%set_nzeros(j) call a%set_nzeros(j)
call a%fix(info)
call a%trim() call a%trim()
end subroutine psb_d_coo_clean_zeros end subroutine psb_d_coo_clean_zeros

120
base/serial/impl/psb_d_csc_impl.F90
Unescape Escape View File

@ -2403,36 +2403,36 @@ subroutine psb_d_mv_csc_from_fmt(a,b,info)
end subroutine psb_d_mv_csc_from_fmt end subroutine psb_d_mv_csc_from_fmt
subroutine psb_d_csc_clean_zeros(a, info) !!$subroutine psb_d_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_clean_zeros !!$ use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_clean_zeros
implicit none !!$ implicit none
class(psb_d_csc_sparse_mat), intent(inout) :: a !!$ class(psb_d_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nc !!$ integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:) !!$ integer(psb_ipk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= dzero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= dzero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_d_csc_clean_zeros !!$end subroutine psb_d_csc_clean_zeros
subroutine psb_d_cp_csc_from_fmt(a,b,info) subroutine psb_d_cp_csc_from_fmt(a,b,info)
use psb_const_mod use psb_const_mod
@ -4305,36 +4305,36 @@ subroutine psb_ld_cp_csc_from_fmt(a,b,info)
end subroutine psb_ld_cp_csc_from_fmt end subroutine psb_ld_cp_csc_from_fmt
subroutine psb_ld_csc_clean_zeros(a, info) !!$subroutine psb_ld_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_clean_zeros !!$ use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_clean_zeros
implicit none !!$ implicit none
class(psb_ld_csc_sparse_mat), intent(inout) :: a !!$ class(psb_ld_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nc !!$ integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:) !!$ integer(psb_lpk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= dzero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= dzero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_ld_csc_clean_zeros !!$end subroutine psb_ld_csc_clean_zeros
subroutine psb_ld_csc_mold(a,b,info) subroutine psb_ld_csc_mold(a,b,info)

120
base/serial/impl/psb_d_csr_impl.F90
Unescape Escape View File

@ -3624,36 +3624,36 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info)
end select end select
end subroutine psb_d_cp_csr_from_fmt end subroutine psb_d_cp_csr_from_fmt
subroutine psb_d_csr_clean_zeros(a, info) !!$subroutine psb_d_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_clean_zeros !!$ use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_clean_zeros
implicit none !!$ implicit none
class(psb_d_csr_sparse_mat), intent(inout) :: a !!$ class(psb_d_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nr !!$ integer(psb_ipk_) :: i, j, k, nr
integer(psb_ipk_), allocatable :: ilrp(:) !!$ integer(psb_ipk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= dzero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= dzero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_d_csr_clean_zeros !!$end subroutine psb_d_csr_clean_zeros
#if defined(OPENMP) #if defined(OPENMP)
subroutine psb_dcsrspspmm(a,b,c,info) subroutine psb_dcsrspspmm(a,b,c,info)
@ -6544,36 +6544,36 @@ subroutine psb_ld_cp_csr_from_fmt(a,b,info)
end subroutine psb_ld_cp_csr_from_fmt end subroutine psb_ld_cp_csr_from_fmt
subroutine psb_ld_csr_clean_zeros(a, info) !!$subroutine psb_ld_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_clean_zeros !!$ use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_clean_zeros
implicit none !!$ implicit none
class(psb_ld_csr_sparse_mat), intent(inout) :: a !!$ class(psb_ld_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nr !!$ integer(psb_lpk_) :: i, j, k, nr
integer(psb_lpk_), allocatable :: ilrp(:) !!$ integer(psb_lpk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= dzero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= dzero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_ld_csr_clean_zeros !!$end subroutine psb_ld_csr_clean_zeros
subroutine psb_ldcsrspspmm(a,b,c,info) subroutine psb_ldcsrspspmm(a,b,c,info)
use psb_d_mat_mod use psb_d_mat_mod

1
base/serial/impl/psb_s_coo_impl.F90
Unescape Escape View File

@ -609,6 +609,7 @@ subroutine psb_s_coo_clean_zeros(a, info)
end if end if
end do end do
call a%set_nzeros(j) call a%set_nzeros(j)
call a%fix(info)
call a%trim() call a%trim()
end subroutine psb_s_coo_clean_zeros end subroutine psb_s_coo_clean_zeros

120
base/serial/impl/psb_s_csc_impl.F90
Unescape Escape View File

@ -2403,36 +2403,36 @@ subroutine psb_s_mv_csc_from_fmt(a,b,info)
end subroutine psb_s_mv_csc_from_fmt end subroutine psb_s_mv_csc_from_fmt
subroutine psb_s_csc_clean_zeros(a, info) !!$subroutine psb_s_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_clean_zeros !!$ use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_clean_zeros
implicit none !!$ implicit none
class(psb_s_csc_sparse_mat), intent(inout) :: a !!$ class(psb_s_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nc !!$ integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:) !!$ integer(psb_ipk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= szero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= szero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_s_csc_clean_zeros !!$end subroutine psb_s_csc_clean_zeros
subroutine psb_s_cp_csc_from_fmt(a,b,info) subroutine psb_s_cp_csc_from_fmt(a,b,info)
use psb_const_mod use psb_const_mod
@ -4305,36 +4305,36 @@ subroutine psb_ls_cp_csc_from_fmt(a,b,info)
end subroutine psb_ls_cp_csc_from_fmt end subroutine psb_ls_cp_csc_from_fmt
subroutine psb_ls_csc_clean_zeros(a, info) !!$subroutine psb_ls_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_clean_zeros !!$ use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_clean_zeros
implicit none !!$ implicit none
class(psb_ls_csc_sparse_mat), intent(inout) :: a !!$ class(psb_ls_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nc !!$ integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:) !!$ integer(psb_lpk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= szero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= szero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_ls_csc_clean_zeros !!$end subroutine psb_ls_csc_clean_zeros
subroutine psb_ls_csc_mold(a,b,info) subroutine psb_ls_csc_mold(a,b,info)

120
base/serial/impl/psb_s_csr_impl.F90
Unescape Escape View File

@ -3624,36 +3624,36 @@ subroutine psb_s_cp_csr_from_fmt(a,b,info)
end select end select
end subroutine psb_s_cp_csr_from_fmt end subroutine psb_s_cp_csr_from_fmt
subroutine psb_s_csr_clean_zeros(a, info) !!$subroutine psb_s_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_clean_zeros !!$ use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_clean_zeros
implicit none !!$ implicit none
class(psb_s_csr_sparse_mat), intent(inout) :: a !!$ class(psb_s_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nr !!$ integer(psb_ipk_) :: i, j, k, nr
integer(psb_ipk_), allocatable :: ilrp(:) !!$ integer(psb_ipk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= szero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= szero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_s_csr_clean_zeros !!$end subroutine psb_s_csr_clean_zeros
#if defined(OPENMP) #if defined(OPENMP)
subroutine psb_scsrspspmm(a,b,c,info) subroutine psb_scsrspspmm(a,b,c,info)
@ -6544,36 +6544,36 @@ subroutine psb_ls_cp_csr_from_fmt(a,b,info)
end subroutine psb_ls_cp_csr_from_fmt end subroutine psb_ls_cp_csr_from_fmt
subroutine psb_ls_csr_clean_zeros(a, info) !!$subroutine psb_ls_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_clean_zeros !!$ use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_clean_zeros
implicit none !!$ implicit none
class(psb_ls_csr_sparse_mat), intent(inout) :: a !!$ class(psb_ls_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nr !!$ integer(psb_lpk_) :: i, j, k, nr
integer(psb_lpk_), allocatable :: ilrp(:) !!$ integer(psb_lpk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= szero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= szero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_ls_csr_clean_zeros !!$end subroutine psb_ls_csr_clean_zeros
subroutine psb_lscsrspspmm(a,b,c,info) subroutine psb_lscsrspspmm(a,b,c,info)
use psb_s_mat_mod use psb_s_mat_mod

1
base/serial/impl/psb_z_coo_impl.F90
Unescape Escape View File

@ -609,6 +609,7 @@ subroutine psb_z_coo_clean_zeros(a, info)
end if end if
end do end do
call a%set_nzeros(j) call a%set_nzeros(j)
call a%fix(info)
call a%trim() call a%trim()
end subroutine psb_z_coo_clean_zeros end subroutine psb_z_coo_clean_zeros

120
base/serial/impl/psb_z_csc_impl.F90
Unescape Escape View File

@ -2403,36 +2403,36 @@ subroutine psb_z_mv_csc_from_fmt(a,b,info)
end subroutine psb_z_mv_csc_from_fmt end subroutine psb_z_mv_csc_from_fmt
subroutine psb_z_csc_clean_zeros(a, info) !!$subroutine psb_z_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_clean_zeros !!$ use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_clean_zeros
implicit none !!$ implicit none
class(psb_z_csc_sparse_mat), intent(inout) :: a !!$ class(psb_z_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nc !!$ integer(psb_ipk_) :: i, j, k, nc
integer(psb_ipk_), allocatable :: ilcp(:) !!$ integer(psb_ipk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= zzero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= zzero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_z_csc_clean_zeros !!$end subroutine psb_z_csc_clean_zeros
subroutine psb_z_cp_csc_from_fmt(a,b,info) subroutine psb_z_cp_csc_from_fmt(a,b,info)
use psb_const_mod use psb_const_mod
@ -4305,36 +4305,36 @@ subroutine psb_lz_cp_csc_from_fmt(a,b,info)
end subroutine psb_lz_cp_csc_from_fmt end subroutine psb_lz_cp_csc_from_fmt
subroutine psb_lz_csc_clean_zeros(a, info) !!$subroutine psb_lz_csc_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_clean_zeros !!$ use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_clean_zeros
implicit none !!$ implicit none
class(psb_lz_csc_sparse_mat), intent(inout) :: a !!$ class(psb_lz_csc_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nc !!$ integer(psb_lpk_) :: i, j, k, nc
integer(psb_lpk_), allocatable :: ilcp(:) !!$ integer(psb_lpk_), allocatable :: ilcp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nc = a%get_ncols() !!$ nc = a%get_ncols()
ilcp = a%icp !!$ ilcp = a%icp
a%icp(1) = 1 !!$ a%icp(1) = 1
j = a%icp(1) !!$ j = a%icp(1)
do i=1, nc !!$ do i=1, nc
do k = ilcp(i), ilcp(i+1) -1 !!$ do k = ilcp(i), ilcp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= zzero).or.(i == a%ia(k))) then !!$ if ((a%val(k) /= zzero).or.(i == a%ia(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ia(j) = a%ia(k) !!$ a%ia(j) = a%ia(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%icp(i+1) = j !!$ a%icp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_lz_csc_clean_zeros !!$end subroutine psb_lz_csc_clean_zeros
subroutine psb_lz_csc_mold(a,b,info) subroutine psb_lz_csc_mold(a,b,info)

120
base/serial/impl/psb_z_csr_impl.F90
Unescape Escape View File

@ -3624,36 +3624,36 @@ subroutine psb_z_cp_csr_from_fmt(a,b,info)
end select end select
end subroutine psb_z_cp_csr_from_fmt end subroutine psb_z_cp_csr_from_fmt
subroutine psb_z_csr_clean_zeros(a, info) !!$subroutine psb_z_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_clean_zeros !!$ use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_clean_zeros
implicit none !!$ implicit none
class(psb_z_csr_sparse_mat), intent(inout) :: a !!$ class(psb_z_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_ipk_) :: i, j, k, nr !!$ integer(psb_ipk_) :: i, j, k, nr
integer(psb_ipk_), allocatable :: ilrp(:) !!$ integer(psb_ipk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= zzero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= zzero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_z_csr_clean_zeros !!$end subroutine psb_z_csr_clean_zeros
#if defined(OPENMP) #if defined(OPENMP)
subroutine psb_zcsrspspmm(a,b,c,info) subroutine psb_zcsrspspmm(a,b,c,info)
@ -6544,36 +6544,36 @@ subroutine psb_lz_cp_csr_from_fmt(a,b,info)
end subroutine psb_lz_cp_csr_from_fmt end subroutine psb_lz_cp_csr_from_fmt
subroutine psb_lz_csr_clean_zeros(a, info) !!$subroutine psb_lz_csr_clean_zeros(a, info)
use psb_error_mod !!$ use psb_error_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_clean_zeros !!$ use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_clean_zeros
implicit none !!$ implicit none
class(psb_lz_csr_sparse_mat), intent(inout) :: a !!$ class(psb_lz_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info !!$ integer(psb_ipk_), intent(out) :: info
! !!$ !
integer(psb_lpk_) :: i, j, k, nr !!$ integer(psb_lpk_) :: i, j, k, nr
integer(psb_lpk_), allocatable :: ilrp(:) !!$ integer(psb_lpk_), allocatable :: ilrp(:)
!!$
info = 0 !!$ info = 0
call a%sync() !!$ call a%sync()
nr = a%get_nrows() !!$ nr = a%get_nrows()
ilrp = a%irp !!$ ilrp = a%irp
a%irp(1) = 1 !!$ a%irp(1) = 1
j = a%irp(1) !!$ j = a%irp(1)
do i=1, nr !!$ do i=1, nr
do k = ilrp(i), ilrp(i+1) -1 !!$ do k = ilrp(i), ilrp(i+1) -1
! Always keep the diagonal, even if numerically zero !!$ ! Always keep the diagonal, even if numerically zero
if ((a%val(k) /= zzero).or.(i == a%ja(k))) then !!$ if ((a%val(k) /= zzero).or.(i == a%ja(k))) then
a%val(j) = a%val(k) !!$ a%val(j) = a%val(k)
a%ja(j) = a%ja(k) !!$ a%ja(j) = a%ja(k)
j = j + 1 !!$ j = j + 1
end if !!$ end if
end do !!$ end do
a%irp(i+1) = j !!$ a%irp(i+1) = j
end do !!$ end do
call a%trim() !!$ call a%trim()
call a%set_host() !!$ call a%set_host()
end subroutine psb_lz_csr_clean_zeros !!$end subroutine psb_lz_csr_clean_zeros
subroutine psb_lzcsrspspmm(a,b,c,info) subroutine psb_lzcsrspspmm(a,b,c,info)
use psb_z_mat_mod use psb_z_mat_mod

Write Preview
Loading…
Cancel
Save