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

New clip "in place" method

Browse Source
pizdaint-runs
Salvatore Filippone 5 years ago
parent 77542b9023
commit e2653b1c60
8 changed files with 480 additions and 12 deletions
Show Stats Download Patch File Download Diff File

28
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -145,8 +145,9 @@ module psb_c_mat_mod
procedure, pass(a) :: tril => psb_c_tril
procedure, pass(a) :: triu => psb_c_triu
procedure, pass(a) :: m_csclip => psb_c_csclip
procedure, pass(a) :: m_csclip_ip => psb_c_csclip_ip
procedure, pass(a) :: b_csclip => psb_c_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_c_clean_zeros
procedure, pass(a) :: reall => psb_c_reallocate_nz
procedure, pass(a) :: get_neigh => psb_c_get_neigh
@ -337,8 +338,9 @@ module psb_c_mat_mod
procedure, pass(a) :: tril => psb_lc_tril
procedure, pass(a) :: triu => psb_lc_triu
procedure, pass(a) :: m_csclip => psb_lc_csclip
procedure, pass(a) :: m_csclip_ip => psb_lc_csclip_ip
procedure, pass(a) :: b_csclip => psb_lc_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_lc_clean_zeros
procedure, pass(a) :: reall => psb_lc_reallocate_nz
procedure, pass(a) :: get_neigh => psb_lc_get_neigh
@ -734,6 +736,17 @@ module psb_c_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_csclip
end interface
interface
subroutine psb_c_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_csclip_ip
end interface
interface
subroutine psb_c_b_csclip(a,b,info,&
@ -1462,6 +1475,17 @@ module psb_c_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csclip
end interface
interface
subroutine psb_lc_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csclip_ip
end interface
interface
subroutine psb_lc_b_csclip(a,b,info,&

28
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -145,8 +145,9 @@ module psb_d_mat_mod
procedure, pass(a) :: tril => psb_d_tril
procedure, pass(a) :: triu => psb_d_triu
procedure, pass(a) :: m_csclip => psb_d_csclip
procedure, pass(a) :: m_csclip_ip => psb_d_csclip_ip
procedure, pass(a) :: b_csclip => psb_d_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_d_clean_zeros
procedure, pass(a) :: reall => psb_d_reallocate_nz
procedure, pass(a) :: get_neigh => psb_d_get_neigh
@ -337,8 +338,9 @@ module psb_d_mat_mod
procedure, pass(a) :: tril => psb_ld_tril
procedure, pass(a) :: triu => psb_ld_triu
procedure, pass(a) :: m_csclip => psb_ld_csclip
procedure, pass(a) :: m_csclip_ip => psb_ld_csclip_ip
procedure, pass(a) :: b_csclip => psb_ld_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_ld_clean_zeros
procedure, pass(a) :: reall => psb_ld_reallocate_nz
procedure, pass(a) :: get_neigh => psb_ld_get_neigh
@ -734,6 +736,17 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csclip
end interface
interface
subroutine psb_d_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csclip_ip
end interface
interface
subroutine psb_d_b_csclip(a,b,info,&
@ -1462,6 +1475,17 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csclip
end interface
interface
subroutine psb_ld_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csclip_ip
end interface
interface
subroutine psb_ld_b_csclip(a,b,info,&

28
base/modules/serial/psb_s_mat_mod.F90
Unescape Escape View File

@ -145,8 +145,9 @@ module psb_s_mat_mod
procedure, pass(a) :: tril => psb_s_tril
procedure, pass(a) :: triu => psb_s_triu
procedure, pass(a) :: m_csclip => psb_s_csclip
procedure, pass(a) :: m_csclip_ip => psb_s_csclip_ip
procedure, pass(a) :: b_csclip => psb_s_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_s_clean_zeros
procedure, pass(a) :: reall => psb_s_reallocate_nz
procedure, pass(a) :: get_neigh => psb_s_get_neigh
@ -337,8 +338,9 @@ module psb_s_mat_mod
procedure, pass(a) :: tril => psb_ls_tril
procedure, pass(a) :: triu => psb_ls_triu
procedure, pass(a) :: m_csclip => psb_ls_csclip
procedure, pass(a) :: m_csclip_ip => psb_ls_csclip_ip
procedure, pass(a) :: b_csclip => psb_ls_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_ls_clean_zeros
procedure, pass(a) :: reall => psb_ls_reallocate_nz
procedure, pass(a) :: get_neigh => psb_ls_get_neigh
@ -734,6 +736,17 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csclip
end interface
interface
subroutine psb_s_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csclip_ip
end interface
interface
subroutine psb_s_b_csclip(a,b,info,&
@ -1462,6 +1475,17 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csclip
end interface
interface
subroutine psb_ls_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csclip_ip
end interface
interface
subroutine psb_ls_b_csclip(a,b,info,&

28
base/modules/serial/psb_z_mat_mod.F90
Unescape Escape View File

@ -145,8 +145,9 @@ module psb_z_mat_mod
procedure, pass(a) :: tril => psb_z_tril
procedure, pass(a) :: triu => psb_z_triu
procedure, pass(a) :: m_csclip => psb_z_csclip
procedure, pass(a) :: m_csclip_ip => psb_z_csclip_ip
procedure, pass(a) :: b_csclip => psb_z_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_z_clean_zeros
procedure, pass(a) :: reall => psb_z_reallocate_nz
procedure, pass(a) :: get_neigh => psb_z_get_neigh
@ -337,8 +338,9 @@ module psb_z_mat_mod
procedure, pass(a) :: tril => psb_lz_tril
procedure, pass(a) :: triu => psb_lz_triu
procedure, pass(a) :: m_csclip => psb_lz_csclip
procedure, pass(a) :: m_csclip_ip => psb_lz_csclip_ip
procedure, pass(a) :: b_csclip => psb_lz_b_csclip
generic, public :: csclip => b_csclip, m_csclip
generic, public :: csclip => b_csclip, m_csclip, m_csclip_ip
procedure, pass(a) :: clean_zeros => psb_lz_clean_zeros
procedure, pass(a) :: reall => psb_lz_reallocate_nz
procedure, pass(a) :: get_neigh => psb_lz_get_neigh
@ -734,6 +736,17 @@ module psb_z_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_csclip
end interface
interface
subroutine psb_z_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_csclip_ip
end interface
interface
subroutine psb_z_b_csclip(a,b,info,&
@ -1462,6 +1475,17 @@ module psb_z_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csclip
end interface
interface
subroutine psb_lz_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csclip_ip
end interface
interface
subroutine psb_lz_b_csclip(a,b,info,&

95
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -1047,7 +1047,6 @@ subroutine psb_c_triu(a,u,info,diag,imin,imax,&
end subroutine psb_c_triu
subroutine psb_c_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
@ -1098,6 +1097,53 @@ subroutine psb_c_csclip(a,b,info,&
end subroutine psb_c_csclip
subroutine psb_c_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod
use psb_c_mat_mod, psb_protect_name => psb_c_csclip_ip
implicit none
class(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_csclip_ip
subroutine psb_c_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
@ -3705,6 +3751,53 @@ subroutine psb_lc_csclip(a,b,info,&
end subroutine psb_lc_csclip
subroutine psb_lc_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod
use psb_c_mat_mod, psb_protect_name => psb_lc_csclip_ip
implicit none
class(psb_lcspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csclip_ip
subroutine psb_lc_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)

95
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -1047,7 +1047,6 @@ subroutine psb_d_triu(a,u,info,diag,imin,imax,&
end subroutine psb_d_triu
subroutine psb_d_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
@ -1098,6 +1097,53 @@ subroutine psb_d_csclip(a,b,info,&
end subroutine psb_d_csclip
subroutine psb_d_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod
use psb_d_mat_mod, psb_protect_name => psb_d_csclip_ip
implicit none
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_csclip_ip
subroutine psb_d_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
@ -3705,6 +3751,53 @@ subroutine psb_ld_csclip(a,b,info,&
end subroutine psb_ld_csclip
subroutine psb_ld_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod
use psb_d_mat_mod, psb_protect_name => psb_ld_csclip_ip
implicit none
class(psb_ldspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csclip_ip
subroutine psb_ld_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)

95
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -1047,7 +1047,6 @@ subroutine psb_s_triu(a,u,info,diag,imin,imax,&
end subroutine psb_s_triu
subroutine psb_s_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
@ -1098,6 +1097,53 @@ subroutine psb_s_csclip(a,b,info,&
end subroutine psb_s_csclip
subroutine psb_s_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod
use psb_s_mat_mod, psb_protect_name => psb_s_csclip_ip
implicit none
class(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_csclip_ip
subroutine psb_s_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
@ -3705,6 +3751,53 @@ subroutine psb_ls_csclip(a,b,info,&
end subroutine psb_ls_csclip
subroutine psb_ls_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod
use psb_s_mat_mod, psb_protect_name => psb_ls_csclip_ip
implicit none
class(psb_lsspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csclip_ip
subroutine psb_ls_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)

95
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -1047,7 +1047,6 @@ subroutine psb_z_triu(a,u,info,diag,imin,imax,&
end subroutine psb_z_triu
subroutine psb_z_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
@ -1098,6 +1097,53 @@ subroutine psb_z_csclip(a,b,info,&
end subroutine psb_z_csclip
subroutine psb_z_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod
use psb_z_mat_mod, psb_protect_name => psb_z_csclip_ip
implicit none
class(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_csclip_ip
subroutine psb_z_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
@ -3705,6 +3751,53 @@ subroutine psb_lz_csclip(a,b,info,&
end subroutine psb_lz_csclip
subroutine psb_lz_csclip_ip(a,info,&
& imin,imax,jmin,jmax,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod
use psb_z_mat_mod, psb_protect_name => psb_lz_csclip_ip
implicit none
class(psb_lzspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csclip'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat), allocatable :: acoo
info = psb_success_
call psb_erractionsave(err_act)
if (a%is_null()) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == psb_success_) then
call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call a%free()
if (info == psb_success_) call move_alloc(acoo,a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csclip_ip
subroutine psb_lz_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)

Write Preview
Loading…
Cancel
Save