diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index 2e2c6a91..3c608a64 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -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,& diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index c889c2a3..4964587e 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -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,& diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index 96e39e9d..20f804a7 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -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,& diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index 56d26761..a73062f1 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -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,& diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index c2f1e67c..60f0fd3d 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -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) diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 0ad1edc6..49d66499 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -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) diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index ee8bc40d..b05bd9cb 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -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) diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 10e69e3e..8eac4f8f 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -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)