From 4f8acf331ab1a57c0799f25b1c35ee8c23152f91 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 13 Sep 2018 14:30:35 +0100 Subject: [PATCH 1/2] Fix bounds computation in set_vect. Bug report by Alexandre Silva Lopes --- base/modules/serial/psb_c_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_d_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_i_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_l_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_s_base_vect_mod.f90 | 4 ++-- base/modules/serial/psb_z_base_vect_mod.f90 | 4 ++-- 6 files changed, 12 insertions(+), 12 deletions(-) diff --git a/base/modules/serial/psb_c_base_vect_mod.f90 b/base/modules/serial/psb_c_base_vect_mod.f90 index 44adceeb..5ec82814 100644 --- a/base/modules/serial/psb_c_base_vect_mod.f90 +++ b/base/modules/serial/psb_c_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_d_base_vect_mod.f90 b/base/modules/serial/psb_d_base_vect_mod.f90 index 460b7c78..7645f178 100644 --- a/base/modules/serial/psb_d_base_vect_mod.f90 +++ b/base/modules/serial/psb_d_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_i_base_vect_mod.f90 b/base/modules/serial/psb_i_base_vect_mod.f90 index 8d6f2cc5..a6da896b 100644 --- a/base/modules/serial/psb_i_base_vect_mod.f90 +++ b/base/modules/serial/psb_i_base_vect_mod.f90 @@ -762,9 +762,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_l_base_vect_mod.f90 b/base/modules/serial/psb_l_base_vect_mod.f90 index 84450a17..c379242f 100644 --- a/base/modules/serial/psb_l_base_vect_mod.f90 +++ b/base/modules/serial/psb_l_base_vect_mod.f90 @@ -763,9 +763,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_s_base_vect_mod.f90 b/base/modules/serial/psb_s_base_vect_mod.f90 index e3002b17..5496ad18 100644 --- a/base/modules/serial/psb_s_base_vect_mod.f90 +++ b/base/modules/serial/psb_s_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then diff --git a/base/modules/serial/psb_z_base_vect_mod.f90 b/base/modules/serial/psb_z_base_vect_mod.f90 index c0c41cc9..59660dde 100644 --- a/base/modules/serial/psb_z_base_vect_mod.f90 +++ b/base/modules/serial/psb_z_base_vect_mod.f90 @@ -794,9 +794,9 @@ contains integer(psb_ipk_) :: info, first_, last_, nr - first_=1 - last_=min(psb_size(x%v),size(val)) + first_ = 1 if (present(first)) first_ = max(1,first) + last_ = min(psb_size(x%v),first_+size(val)-1) if (present(last)) last_ = min(last,last_) if (allocated(x%v)) then From 27d74bc6cca828ced96abdaa597bde8096af5459 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 21 Oct 2018 20:32:10 +0100 Subject: [PATCH 2/2] Merged development branch --- base/modules/serial/psb_c_base_mat_mod.f90 | 12 +- base/modules/serial/psb_c_base_vect_mod.f90 | 11 +- base/modules/serial/psb_c_csc_mat_mod.f90 | 10 +- base/modules/serial/psb_c_csr_mat_mod.f90 | 38 +----- base/modules/serial/psb_c_vect_mod.F90 | 5 +- base/modules/serial/psb_d_base_mat_mod.f90 | 12 +- base/modules/serial/psb_d_base_vect_mod.f90 | 11 +- base/modules/serial/psb_d_csc_mat_mod.f90 | 10 +- base/modules/serial/psb_d_csr_mat_mod.f90 | 38 +----- base/modules/serial/psb_d_vect_mod.F90 | 5 +- base/modules/serial/psb_i_base_vect_mod.f90 | 11 +- base/modules/serial/psb_i_vect_mod.F90 | 5 +- base/modules/serial/psb_l_base_vect_mod.f90 | 11 +- base/modules/serial/psb_l_vect_mod.F90 | 5 +- base/modules/serial/psb_s_base_mat_mod.f90 | 12 +- base/modules/serial/psb_s_base_vect_mod.f90 | 11 +- base/modules/serial/psb_s_csc_mat_mod.f90 | 10 +- base/modules/serial/psb_s_csr_mat_mod.f90 | 38 +----- base/modules/serial/psb_s_vect_mod.F90 | 5 +- base/modules/serial/psb_z_base_mat_mod.f90 | 12 +- base/modules/serial/psb_z_base_vect_mod.f90 | 11 +- base/modules/serial/psb_z_csc_mat_mod.f90 | 10 +- base/modules/serial/psb_z_csr_mat_mod.f90 | 38 +----- base/modules/serial/psb_z_vect_mod.F90 | 5 +- base/serial/impl/psb_c_base_mat_impl.F90 | 12 +- base/serial/impl/psb_c_coo_impl.f90 | 62 +++++---- base/serial/impl/psb_c_csc_impl.f90 | 112 +++++++-------- base/serial/impl/psb_c_csr_impl.f90 | 144 +++----------------- base/serial/impl/psb_c_mat_impl.F90 | 6 +- base/serial/impl/psb_d_base_mat_impl.F90 | 12 +- base/serial/impl/psb_d_coo_impl.f90 | 62 +++++---- base/serial/impl/psb_d_csc_impl.f90 | 112 +++++++-------- base/serial/impl/psb_d_csr_impl.f90 | 144 +++----------------- base/serial/impl/psb_d_mat_impl.F90 | 6 +- base/serial/impl/psb_s_base_mat_impl.F90 | 12 +- base/serial/impl/psb_s_coo_impl.f90 | 62 +++++---- base/serial/impl/psb_s_csc_impl.f90 | 112 +++++++-------- base/serial/impl/psb_s_csr_impl.f90 | 144 +++----------------- base/serial/impl/psb_s_mat_impl.F90 | 6 +- base/serial/impl/psb_z_base_mat_impl.F90 | 12 +- base/serial/impl/psb_z_coo_impl.f90 | 62 +++++---- base/serial/impl/psb_z_csc_impl.f90 | 112 +++++++-------- base/serial/impl/psb_z_csr_impl.f90 | 144 +++----------------- base/serial/impl/psb_z_mat_impl.F90 | 6 +- base/tools/psb_csphalo.F90 | 26 ++-- base/tools/psb_dsphalo.F90 | 26 ++-- base/tools/psb_ssphalo.F90 | 26 ++-- base/tools/psb_zsphalo.F90 | 26 ++-- cbind/prec/psb_cprec_cbind_mod.f90 | 6 +- cbind/prec/psb_dprec_cbind_mod.f90 | 6 +- cbind/prec/psb_sprec_cbind_mod.f90 | 6 +- cbind/prec/psb_zprec_cbind_mod.f90 | 6 +- prec/impl/psb_cprecinit.f90 | 7 +- prec/impl/psb_dprecinit.f90 | 7 +- prec/impl/psb_sprecinit.f90 | 7 +- prec/impl/psb_zprecinit.f90 | 7 +- prec/psb_c_prec_type.f90 | 4 +- prec/psb_d_prec_type.f90 | 4 +- prec/psb_s_prec_type.f90 | 4 +- prec/psb_z_prec_type.f90 | 4 +- test/fileread/psb_cf_sample.f90 | 2 +- test/fileread/psb_df_sample.f90 | 2 +- test/fileread/psb_sf_sample.f90 | 2 +- test/fileread/psb_zf_sample.f90 | 2 +- test/pargen/psb_d_pde2d.f90 | 4 +- test/pargen/psb_d_pde3d.f90 | 4 +- test/pargen/psb_s_pde2d.f90 | 4 +- test/pargen/psb_s_pde3d.f90 | 4 +- 68 files changed, 702 insertions(+), 1174 deletions(-) diff --git a/base/modules/serial/psb_c_base_mat_mod.f90 b/base/modules/serial/psb_c_base_mat_mod.f90 index 52197678..3063713c 100644 --- a/base/modules/serial/psb_c_base_mat_mod.f90 +++ b/base/modules/serial/psb_c_base_mat_mod.f90 @@ -511,7 +511,7 @@ module psb_c_base_mat_mod ! interface subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_c_base_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -522,7 +522,7 @@ module psb_c_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_c_base_csgetrow end interface @@ -550,7 +550,7 @@ module psb_c_base_mat_mod ! interface subroutine psb_c_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_c_base_sparse_mat), intent(in) :: a class(psb_c_coo_sparse_mat), intent(inout) :: b @@ -559,7 +559,7 @@ module psb_c_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_c_base_csgetblk end interface @@ -1910,7 +1910,7 @@ module psb_c_base_mat_mod !! \see psb_c_base_mat_mod::psb_c_base_csgetrow interface subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_c_coo_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -1921,7 +1921,7 @@ module psb_c_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_c_coo_csgetrow end interface diff --git a/base/modules/serial/psb_c_base_vect_mod.f90 b/base/modules/serial/psb_c_base_vect_mod.f90 index 5ec82814..50327c1c 100644 --- a/base/modules/serial/psb_c_base_vect_mod.f90 +++ b/base/modules/serial/psb_c_base_vect_mod.f90 @@ -738,19 +738,24 @@ contains !! \brief Extract a copy of the contents !! ! - function c_base_get_vect(x) result(res) + function c_base_get_vect(x,n) result(res) class(psb_c_base_vect_type), intent(inout) :: x complex(psb_spk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n + ! Local variables + integer(psb_ipk_) :: isz if (.not.allocated(x%v)) return if (.not.x%is_host()) call x%sync() - allocate(res(x%get_nrows()),stat=info) + isz = x%get_nrows() + if (present(n)) isz = max(0,min(isz,n)) + allocate(res(isz),stat=info) if (info /= 0) then call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect') return end if - res(:) = x%v(:) + res(1:isz) = x%v(1:isz) end function c_base_get_vect ! diff --git a/base/modules/serial/psb_c_csc_mat_mod.f90 b/base/modules/serial/psb_c_csc_mat_mod.f90 index 6c5cd61f..d5718de7 100644 --- a/base/modules/serial/psb_c_csc_mat_mod.f90 +++ b/base/modules/serial/psb_c_csc_mat_mod.f90 @@ -368,8 +368,8 @@ module psb_c_csc_mat_mod !! \see psb_c_base_mat_mod::psb_c_base_csgetrow interface subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - import + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_ipk_, psb_c_csc_sparse_mat, psb_spk_ class(psb_c_csc_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax integer(psb_ipk_), intent(out) :: nz @@ -379,7 +379,7 @@ module psb_c_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_c_csc_csgetrow end interface @@ -387,7 +387,7 @@ module psb_c_csc_mat_mod !! \see psb_c_base_mat_mod::psb_c_base_csgetblk interface subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_c_csc_sparse_mat), intent(in) :: a class(psb_c_coo_sparse_mat), intent(inout) :: b @@ -396,7 +396,7 @@ module psb_c_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_c_csc_csgetblk end interface diff --git a/base/modules/serial/psb_c_csr_mat_mod.f90 b/base/modules/serial/psb_c_csr_mat_mod.f90 index 222b46a4..43b0c224 100644 --- a/base/modules/serial/psb_c_csr_mat_mod.f90 +++ b/base/modules/serial/psb_c_csr_mat_mod.f90 @@ -405,7 +405,7 @@ module psb_c_csr_mat_mod !! \see psb_c_base_mat_mod::psb_c_base_csgetrow interface subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_c_csr_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -416,27 +416,10 @@ module psb_c_csr_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_c_csr_csgetrow end interface - !> \memberof psb_c_csr_sparse_mat - !! \see psb_c_base_mat_mod::psb_c_base_csgetblk - interface - subroutine psb_c_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_c_csr_sparse_mat), intent(in) :: a - class(psb_c_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_c_csr_csgetblk - end interface - !> \memberof psb_c_csr_sparse_mat !! \see psb_c_base_mat_mod::psb_c_base_cssv interface @@ -954,23 +937,6 @@ module psb_c_csr_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_lc_csr_csgetrow end interface - - !> \memberof psb_lc_csr_sparse_mat - !! \see psb_lc_base_mat_mod::psb_lc_base_csgetblk - interface - subroutine psb_lc_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_lc_csr_sparse_mat), intent(in) :: a - class(psb_lc_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_lc_csr_csgetblk - end interface !> \memberof psb_lc_csr_sparse_mat !! \see psb_lc_base_mat_mod::psb_lc_base_get_diag diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index e93ec8da..6c98e4e9 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -250,13 +250,14 @@ contains end subroutine c_vect_bld_en - function c_vect_get_vect(x) result(res) + function c_vect_get_vect(x,n) result(res) class(psb_c_vect_type), intent(inout) :: x complex(psb_spk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n if (allocated(x%v)) then - res = x%v%get_vect() + res = x%v%get_vect(n) end if end function c_vect_get_vect diff --git a/base/modules/serial/psb_d_base_mat_mod.f90 b/base/modules/serial/psb_d_base_mat_mod.f90 index 64b20aee..19bc1d6f 100644 --- a/base/modules/serial/psb_d_base_mat_mod.f90 +++ b/base/modules/serial/psb_d_base_mat_mod.f90 @@ -511,7 +511,7 @@ module psb_d_base_mat_mod ! interface subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_d_base_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -522,7 +522,7 @@ module psb_d_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_d_base_csgetrow end interface @@ -550,7 +550,7 @@ module psb_d_base_mat_mod ! interface subroutine psb_d_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_d_base_sparse_mat), intent(in) :: a class(psb_d_coo_sparse_mat), intent(inout) :: b @@ -559,7 +559,7 @@ module psb_d_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_d_base_csgetblk end interface @@ -1910,7 +1910,7 @@ module psb_d_base_mat_mod !! \see psb_d_base_mat_mod::psb_d_base_csgetrow interface subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_d_coo_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -1921,7 +1921,7 @@ module psb_d_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_d_coo_csgetrow end interface diff --git a/base/modules/serial/psb_d_base_vect_mod.f90 b/base/modules/serial/psb_d_base_vect_mod.f90 index 7645f178..3183629d 100644 --- a/base/modules/serial/psb_d_base_vect_mod.f90 +++ b/base/modules/serial/psb_d_base_vect_mod.f90 @@ -738,19 +738,24 @@ contains !! \brief Extract a copy of the contents !! ! - function d_base_get_vect(x) result(res) + function d_base_get_vect(x,n) result(res) class(psb_d_base_vect_type), intent(inout) :: x real(psb_dpk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n + ! Local variables + integer(psb_ipk_) :: isz if (.not.allocated(x%v)) return if (.not.x%is_host()) call x%sync() - allocate(res(x%get_nrows()),stat=info) + isz = x%get_nrows() + if (present(n)) isz = max(0,min(isz,n)) + allocate(res(isz),stat=info) if (info /= 0) then call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect') return end if - res(:) = x%v(:) + res(1:isz) = x%v(1:isz) end function d_base_get_vect ! diff --git a/base/modules/serial/psb_d_csc_mat_mod.f90 b/base/modules/serial/psb_d_csc_mat_mod.f90 index f494bc3f..8577ba31 100644 --- a/base/modules/serial/psb_d_csc_mat_mod.f90 +++ b/base/modules/serial/psb_d_csc_mat_mod.f90 @@ -368,8 +368,8 @@ module psb_d_csc_mat_mod !! \see psb_d_base_mat_mod::psb_d_base_csgetrow interface subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - import + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_ class(psb_d_csc_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax integer(psb_ipk_), intent(out) :: nz @@ -379,7 +379,7 @@ module psb_d_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_d_csc_csgetrow end interface @@ -387,7 +387,7 @@ module psb_d_csc_mat_mod !! \see psb_d_base_mat_mod::psb_d_base_csgetblk interface subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_d_csc_sparse_mat), intent(in) :: a class(psb_d_coo_sparse_mat), intent(inout) :: b @@ -396,7 +396,7 @@ module psb_d_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_d_csc_csgetblk end interface diff --git a/base/modules/serial/psb_d_csr_mat_mod.f90 b/base/modules/serial/psb_d_csr_mat_mod.f90 index c80246b7..7dd197de 100644 --- a/base/modules/serial/psb_d_csr_mat_mod.f90 +++ b/base/modules/serial/psb_d_csr_mat_mod.f90 @@ -405,7 +405,7 @@ module psb_d_csr_mat_mod !! \see psb_d_base_mat_mod::psb_d_base_csgetrow interface subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_d_csr_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -416,27 +416,10 @@ module psb_d_csr_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_d_csr_csgetrow end interface - !> \memberof psb_d_csr_sparse_mat - !! \see psb_d_base_mat_mod::psb_d_base_csgetblk - interface - subroutine psb_d_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_d_csr_sparse_mat), intent(in) :: a - class(psb_d_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_d_csr_csgetblk - end interface - !> \memberof psb_d_csr_sparse_mat !! \see psb_d_base_mat_mod::psb_d_base_cssv interface @@ -954,23 +937,6 @@ module psb_d_csr_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_ld_csr_csgetrow end interface - - !> \memberof psb_ld_csr_sparse_mat - !! \see psb_ld_base_mat_mod::psb_ld_base_csgetblk - interface - subroutine psb_ld_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_ld_csr_sparse_mat), intent(in) :: a - class(psb_ld_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_ld_csr_csgetblk - end interface !> \memberof psb_ld_csr_sparse_mat !! \see psb_ld_base_mat_mod::psb_ld_base_get_diag diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index d3d50403..36699651 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -250,13 +250,14 @@ contains end subroutine d_vect_bld_en - function d_vect_get_vect(x) result(res) + function d_vect_get_vect(x,n) result(res) class(psb_d_vect_type), intent(inout) :: x real(psb_dpk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n if (allocated(x%v)) then - res = x%v%get_vect() + res = x%v%get_vect(n) end if end function d_vect_get_vect diff --git a/base/modules/serial/psb_i_base_vect_mod.f90 b/base/modules/serial/psb_i_base_vect_mod.f90 index a6da896b..3d4fd861 100644 --- a/base/modules/serial/psb_i_base_vect_mod.f90 +++ b/base/modules/serial/psb_i_base_vect_mod.f90 @@ -706,19 +706,24 @@ contains !! \brief Extract a copy of the contents !! ! - function i_base_get_vect(x) result(res) + function i_base_get_vect(x,n) result(res) class(psb_i_base_vect_type), intent(inout) :: x integer(psb_ipk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n + ! Local variables + integer(psb_ipk_) :: isz if (.not.allocated(x%v)) return if (.not.x%is_host()) call x%sync() - allocate(res(x%get_nrows()),stat=info) + isz = x%get_nrows() + if (present(n)) isz = max(0,min(isz,n)) + allocate(res(isz),stat=info) if (info /= 0) then call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect') return end if - res(:) = x%v(:) + res(1:isz) = x%v(1:isz) end function i_base_get_vect ! diff --git a/base/modules/serial/psb_i_vect_mod.F90 b/base/modules/serial/psb_i_vect_mod.F90 index 81f104e2..fce7f2b2 100644 --- a/base/modules/serial/psb_i_vect_mod.F90 +++ b/base/modules/serial/psb_i_vect_mod.F90 @@ -223,13 +223,14 @@ contains end subroutine i_vect_bld_en - function i_vect_get_vect(x) result(res) + function i_vect_get_vect(x,n) result(res) class(psb_i_vect_type), intent(inout) :: x integer(psb_ipk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n if (allocated(x%v)) then - res = x%v%get_vect() + res = x%v%get_vect(n) end if end function i_vect_get_vect diff --git a/base/modules/serial/psb_l_base_vect_mod.f90 b/base/modules/serial/psb_l_base_vect_mod.f90 index c379242f..8b22bbc8 100644 --- a/base/modules/serial/psb_l_base_vect_mod.f90 +++ b/base/modules/serial/psb_l_base_vect_mod.f90 @@ -707,19 +707,24 @@ contains !! \brief Extract a copy of the contents !! ! - function l_base_get_vect(x) result(res) + function l_base_get_vect(x,n) result(res) class(psb_l_base_vect_type), intent(inout) :: x integer(psb_lpk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n + ! Local variables + integer(psb_ipk_) :: isz if (.not.allocated(x%v)) return if (.not.x%is_host()) call x%sync() - allocate(res(x%get_nrows()),stat=info) + isz = x%get_nrows() + if (present(n)) isz = max(0,min(isz,n)) + allocate(res(isz),stat=info) if (info /= 0) then call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect') return end if - res(:) = x%v(:) + res(1:isz) = x%v(1:isz) end function l_base_get_vect ! diff --git a/base/modules/serial/psb_l_vect_mod.F90 b/base/modules/serial/psb_l_vect_mod.F90 index 8c3ff882..0815619d 100644 --- a/base/modules/serial/psb_l_vect_mod.F90 +++ b/base/modules/serial/psb_l_vect_mod.F90 @@ -224,13 +224,14 @@ contains end subroutine l_vect_bld_en - function l_vect_get_vect(x) result(res) + function l_vect_get_vect(x,n) result(res) class(psb_l_vect_type), intent(inout) :: x integer(psb_lpk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n if (allocated(x%v)) then - res = x%v%get_vect() + res = x%v%get_vect(n) end if end function l_vect_get_vect diff --git a/base/modules/serial/psb_s_base_mat_mod.f90 b/base/modules/serial/psb_s_base_mat_mod.f90 index 7762ca9c..52189abc 100644 --- a/base/modules/serial/psb_s_base_mat_mod.f90 +++ b/base/modules/serial/psb_s_base_mat_mod.f90 @@ -511,7 +511,7 @@ module psb_s_base_mat_mod ! interface subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_s_base_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -522,7 +522,7 @@ module psb_s_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_s_base_csgetrow end interface @@ -550,7 +550,7 @@ module psb_s_base_mat_mod ! interface subroutine psb_s_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_s_base_sparse_mat), intent(in) :: a class(psb_s_coo_sparse_mat), intent(inout) :: b @@ -559,7 +559,7 @@ module psb_s_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_s_base_csgetblk end interface @@ -1910,7 +1910,7 @@ module psb_s_base_mat_mod !! \see psb_s_base_mat_mod::psb_s_base_csgetrow interface subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_s_coo_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -1921,7 +1921,7 @@ module psb_s_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_s_coo_csgetrow end interface diff --git a/base/modules/serial/psb_s_base_vect_mod.f90 b/base/modules/serial/psb_s_base_vect_mod.f90 index 5496ad18..f2932684 100644 --- a/base/modules/serial/psb_s_base_vect_mod.f90 +++ b/base/modules/serial/psb_s_base_vect_mod.f90 @@ -738,19 +738,24 @@ contains !! \brief Extract a copy of the contents !! ! - function s_base_get_vect(x) result(res) + function s_base_get_vect(x,n) result(res) class(psb_s_base_vect_type), intent(inout) :: x real(psb_spk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n + ! Local variables + integer(psb_ipk_) :: isz if (.not.allocated(x%v)) return if (.not.x%is_host()) call x%sync() - allocate(res(x%get_nrows()),stat=info) + isz = x%get_nrows() + if (present(n)) isz = max(0,min(isz,n)) + allocate(res(isz),stat=info) if (info /= 0) then call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect') return end if - res(:) = x%v(:) + res(1:isz) = x%v(1:isz) end function s_base_get_vect ! diff --git a/base/modules/serial/psb_s_csc_mat_mod.f90 b/base/modules/serial/psb_s_csc_mat_mod.f90 index 2bf812ec..1d248c1d 100644 --- a/base/modules/serial/psb_s_csc_mat_mod.f90 +++ b/base/modules/serial/psb_s_csc_mat_mod.f90 @@ -368,8 +368,8 @@ module psb_s_csc_mat_mod !! \see psb_s_base_mat_mod::psb_s_base_csgetrow interface subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - import + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_ipk_, psb_s_csc_sparse_mat, psb_spk_ class(psb_s_csc_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax integer(psb_ipk_), intent(out) :: nz @@ -379,7 +379,7 @@ module psb_s_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_s_csc_csgetrow end interface @@ -387,7 +387,7 @@ module psb_s_csc_mat_mod !! \see psb_s_base_mat_mod::psb_s_base_csgetblk interface subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_s_csc_sparse_mat), intent(in) :: a class(psb_s_coo_sparse_mat), intent(inout) :: b @@ -396,7 +396,7 @@ module psb_s_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_s_csc_csgetblk end interface diff --git a/base/modules/serial/psb_s_csr_mat_mod.f90 b/base/modules/serial/psb_s_csr_mat_mod.f90 index 00dc1dfc..fb9e4139 100644 --- a/base/modules/serial/psb_s_csr_mat_mod.f90 +++ b/base/modules/serial/psb_s_csr_mat_mod.f90 @@ -405,7 +405,7 @@ module psb_s_csr_mat_mod !! \see psb_s_base_mat_mod::psb_s_base_csgetrow interface subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_s_csr_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -416,27 +416,10 @@ module psb_s_csr_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_s_csr_csgetrow end interface - !> \memberof psb_s_csr_sparse_mat - !! \see psb_s_base_mat_mod::psb_s_base_csgetblk - interface - subroutine psb_s_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_s_csr_sparse_mat), intent(in) :: a - class(psb_s_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_s_csr_csgetblk - end interface - !> \memberof psb_s_csr_sparse_mat !! \see psb_s_base_mat_mod::psb_s_base_cssv interface @@ -954,23 +937,6 @@ module psb_s_csr_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_ls_csr_csgetrow end interface - - !> \memberof psb_ls_csr_sparse_mat - !! \see psb_ls_base_mat_mod::psb_ls_base_csgetblk - interface - subroutine psb_ls_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_ls_csr_sparse_mat), intent(in) :: a - class(psb_ls_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_ls_csr_csgetblk - end interface !> \memberof psb_ls_csr_sparse_mat !! \see psb_ls_base_mat_mod::psb_ls_base_get_diag diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index 79e73a00..72a57c04 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -250,13 +250,14 @@ contains end subroutine s_vect_bld_en - function s_vect_get_vect(x) result(res) + function s_vect_get_vect(x,n) result(res) class(psb_s_vect_type), intent(inout) :: x real(psb_spk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n if (allocated(x%v)) then - res = x%v%get_vect() + res = x%v%get_vect(n) end if end function s_vect_get_vect diff --git a/base/modules/serial/psb_z_base_mat_mod.f90 b/base/modules/serial/psb_z_base_mat_mod.f90 index b86f8a3c..f09b15f9 100644 --- a/base/modules/serial/psb_z_base_mat_mod.f90 +++ b/base/modules/serial/psb_z_base_mat_mod.f90 @@ -511,7 +511,7 @@ module psb_z_base_mat_mod ! interface subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_z_base_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -522,7 +522,7 @@ module psb_z_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_z_base_csgetrow end interface @@ -550,7 +550,7 @@ module psb_z_base_mat_mod ! interface subroutine psb_z_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_z_base_sparse_mat), intent(in) :: a class(psb_z_coo_sparse_mat), intent(inout) :: b @@ -559,7 +559,7 @@ module psb_z_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_z_base_csgetblk end interface @@ -1910,7 +1910,7 @@ module psb_z_base_mat_mod !! \see psb_z_base_mat_mod::psb_z_base_csgetrow interface subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_z_coo_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -1921,7 +1921,7 @@ module psb_z_base_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_z_coo_csgetrow end interface diff --git a/base/modules/serial/psb_z_base_vect_mod.f90 b/base/modules/serial/psb_z_base_vect_mod.f90 index 59660dde..faebc7ab 100644 --- a/base/modules/serial/psb_z_base_vect_mod.f90 +++ b/base/modules/serial/psb_z_base_vect_mod.f90 @@ -738,19 +738,24 @@ contains !! \brief Extract a copy of the contents !! ! - function z_base_get_vect(x) result(res) + function z_base_get_vect(x,n) result(res) class(psb_z_base_vect_type), intent(inout) :: x complex(psb_dpk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n + ! Local variables + integer(psb_ipk_) :: isz if (.not.allocated(x%v)) return if (.not.x%is_host()) call x%sync() - allocate(res(x%get_nrows()),stat=info) + isz = x%get_nrows() + if (present(n)) isz = max(0,min(isz,n)) + allocate(res(isz),stat=info) if (info /= 0) then call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect') return end if - res(:) = x%v(:) + res(1:isz) = x%v(1:isz) end function z_base_get_vect ! diff --git a/base/modules/serial/psb_z_csc_mat_mod.f90 b/base/modules/serial/psb_z_csc_mat_mod.f90 index cbbc3948..19fb0b23 100644 --- a/base/modules/serial/psb_z_csc_mat_mod.f90 +++ b/base/modules/serial/psb_z_csc_mat_mod.f90 @@ -368,8 +368,8 @@ module psb_z_csc_mat_mod !! \see psb_z_base_mat_mod::psb_z_base_csgetrow interface subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - import + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_ipk_, psb_z_csc_sparse_mat, psb_dpk_ class(psb_z_csc_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax integer(psb_ipk_), intent(out) :: nz @@ -379,7 +379,7 @@ module psb_z_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_z_csc_csgetrow end interface @@ -387,7 +387,7 @@ module psb_z_csc_mat_mod !! \see psb_z_base_mat_mod::psb_z_base_csgetblk interface subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) import class(psb_z_csc_sparse_mat), intent(in) :: a class(psb_z_coo_sparse_mat), intent(inout) :: b @@ -396,7 +396,7 @@ module psb_z_csc_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_z_csc_csgetblk end interface diff --git a/base/modules/serial/psb_z_csr_mat_mod.f90 b/base/modules/serial/psb_z_csr_mat_mod.f90 index 28b7d37b..975ff9c9 100644 --- a/base/modules/serial/psb_z_csr_mat_mod.f90 +++ b/base/modules/serial/psb_z_csr_mat_mod.f90 @@ -405,7 +405,7 @@ module psb_z_csr_mat_mod !! \see psb_z_base_mat_mod::psb_z_base_csgetrow interface subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) import class(psb_z_csr_sparse_mat), intent(in) :: a integer(psb_ipk_), intent(in) :: imin,imax @@ -416,27 +416,10 @@ module psb_z_csr_mat_mod logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz end subroutine psb_z_csr_csgetrow end interface - !> \memberof psb_z_csr_sparse_mat - !! \see psb_z_base_mat_mod::psb_z_base_csgetblk - interface - subroutine psb_z_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_z_csr_sparse_mat), intent(in) :: a - class(psb_z_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_z_csr_csgetblk - end interface - !> \memberof psb_z_csr_sparse_mat !! \see psb_z_base_mat_mod::psb_z_base_cssv interface @@ -954,23 +937,6 @@ module psb_z_csr_mat_mod logical, intent(in), optional :: rscale,cscale end subroutine psb_lz_csr_csgetrow end interface - - !> \memberof psb_lz_csr_sparse_mat - !! \see psb_lz_base_mat_mod::psb_lz_base_csgetblk - interface - subroutine psb_lz_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - import - class(psb_lz_csr_sparse_mat), intent(in) :: a - class(psb_lz_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_lz_csr_csgetblk - end interface !> \memberof psb_lz_csr_sparse_mat !! \see psb_lz_base_mat_mod::psb_lz_base_get_diag diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index c41fb037..6d91a8bf 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -250,13 +250,14 @@ contains end subroutine z_vect_bld_en - function z_vect_get_vect(x) result(res) + function z_vect_get_vect(x,n) result(res) class(psb_z_vect_type), intent(inout) :: x complex(psb_dpk_), allocatable :: res(:) integer(psb_ipk_) :: info + integer(psb_ipk_), optional :: n if (allocated(x%v)) then - res = x%v%get_vect() + res = x%v%get_vect(n) end if end function z_vect_get_vect diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index 55acd550..e8cb8dfc 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -396,7 +396,7 @@ subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_c_base_csput_v subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -412,7 +412,7 @@ subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -428,15 +428,13 @@ subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& end subroutine psb_c_base_csgetrow - - ! ! Here we have the base implementation of getblk and clip: ! this is just based on the getrow. ! If performance is critical it can be overridden. ! subroutine psb_c_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -450,7 +448,7 @@ subroutine psb_c_base_csgetblk(imin,imax,a,b,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csget' integer(psb_ipk_) :: jmin_, jmax_ @@ -510,7 +508,7 @@ subroutine psb_c_base_csgetblk(imin,imax,a,b,info,& call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) + & nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index b37c4fee..c2b27cc8 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -2223,7 +2223,7 @@ end subroutine psb_c_coo_csgetptn ! The output is guaranteed to be sorted ! subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2240,9 +2240,9 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2284,13 +2284,18 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2315,7 +2320,7 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2331,7 +2336,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) complex(psb_spk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append,chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd @@ -2415,11 +2420,13 @@ contains nzt = jp - ip +1 nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then do i=ip,jp if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then @@ -2451,11 +2458,13 @@ contains nrd = max(a%get_nrows(),1) nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1) - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then k = 0 do i=1, a%get_nzeros() @@ -2464,10 +2473,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = iren(a%ia(i)) @@ -2482,11 +2493,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = (a%ia(i)) diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 549fd98e..ed80519d 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -1686,7 +1686,7 @@ end subroutine psb_c_csc_csgetptn subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -1704,7 +1704,7 @@ subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i @@ -2557,60 +2557,60 @@ end subroutine psb_c_csc_reallocate_nz -subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csgetblk - implicit none - - class(psb_c_csc_sparse_mat), intent(in) :: a - class(psb_c_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_c_csc_csgetblk +!!$subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ ! Output is always in COO format +!!$ use psb_error_mod +!!$ use psb_const_mod +!!$ use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csgetblk +!!$ implicit none +!!$ +!!$ class(psb_c_csc_sparse_mat), intent(in) :: a +!!$ class(psb_c_coo_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(in) :: imin,imax +!!$ integer(psb_ipk_),intent(out) :: info +!!$ logical, intent(in), optional :: append +!!$ integer(psb_ipk_), intent(in), optional :: iren(:) +!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax +!!$ logical, intent(in), optional :: rscale,cscale +!!$ integer(psb_ipk_) :: err_act, nzin, nzout +!!$ integer(psb_ipk_) :: ierr(5) +!!$ character(len=20) :: name='csget' +!!$ logical :: append_ +!!$ logical, parameter :: debug=.false. +!!$ +!!$ call psb_erractionsave(err_act) +!!$ info = psb_success_ +!!$ +!!$ if (present(append)) then +!!$ append_ = append +!!$ else +!!$ append_ = .false. +!!$ endif +!!$ if (append_) then +!!$ nzin = a%get_nzeros() +!!$ else +!!$ nzin = 0 +!!$ endif +!!$ +!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& +!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, & +!!$ & nzin=nzin, rscale=rscale, cscale=cscale) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call b%set_nzeros(nzin+nzout) +!!$ call b%fix(info) +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call psb_erractionrestore(err_act) +!!$ return +!!$ +!!$9999 call psb_error_handler(err_act) +!!$ +!!$ return +!!$ +!!$end subroutine psb_c_csc_csgetblk subroutine psb_c_csc_reinit(a,clear) use psb_error_mod diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index aed54121..66ca5f75 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1993,7 +1993,7 @@ end subroutine psb_c_csr_csgetptn subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2011,9 +2011,9 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2056,13 +2056,18 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2087,7 +2092,7 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2102,7 +2107,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) complex(psb_spk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append, chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd @@ -2135,11 +2140,13 @@ contains nzt = (a%irp(lrw+1)-a%irp(irw)) nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + + if (info /= psb_success_) return + end if if (present(iren)) then do i=irw, lrw @@ -2171,59 +2178,6 @@ contains end subroutine psb_c_csr_csgetrow -subroutine psb_c_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_csgetblk - implicit none - - class(psb_c_csr_sparse_mat), intent(in) :: a - class(psb_c_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_c_csr_csgetblk ! ! CSR implementation of tril/triu @@ -2245,8 +2199,6 @@ subroutine psb_c_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - complex(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -2401,8 +2353,6 @@ subroutine psb_c_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - complex(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ @@ -4397,60 +4347,6 @@ contains end subroutine psb_lc_csr_csgetrow -subroutine psb_lc_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_csgetblk - implicit none - - class(psb_lc_csr_sparse_mat), intent(in) :: a - class(psb_lc_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_lpk_) :: nzin, nzout - integer(psb_ipk_) :: err_act - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_lc_csr_csgetblk ! ! CSR implementation of tril/triu @@ -4473,8 +4369,6 @@ subroutine psb_lc_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - complex(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -4630,8 +4524,6 @@ subroutine psb_lc_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - complex(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index f3c5040f..08532e12 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -791,7 +791,7 @@ end subroutine psb_c_csgetptn subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -808,7 +808,7 @@ subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' @@ -824,7 +824,7 @@ subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call a%a%csget(imin,imax,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index 21470d9a..332c1a7b 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -396,7 +396,7 @@ subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_d_base_csput_v subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -412,7 +412,7 @@ subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -428,15 +428,13 @@ subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& end subroutine psb_d_base_csgetrow - - ! ! Here we have the base implementation of getblk and clip: ! this is just based on the getrow. ! If performance is critical it can be overridden. ! subroutine psb_d_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -450,7 +448,7 @@ subroutine psb_d_base_csgetblk(imin,imax,a,b,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csget' integer(psb_ipk_) :: jmin_, jmax_ @@ -510,7 +508,7 @@ subroutine psb_d_base_csgetblk(imin,imax,a,b,info,& call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) + & nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 860eaebc..27f22219 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -2223,7 +2223,7 @@ end subroutine psb_d_coo_csgetptn ! The output is guaranteed to be sorted ! subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2240,9 +2240,9 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2284,13 +2284,18 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2315,7 +2320,7 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2331,7 +2336,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) real(psb_dpk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append,chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd @@ -2415,11 +2420,13 @@ contains nzt = jp - ip +1 nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then do i=ip,jp if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then @@ -2451,11 +2458,13 @@ contains nrd = max(a%get_nrows(),1) nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1) - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then k = 0 do i=1, a%get_nzeros() @@ -2464,10 +2473,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = iren(a%ia(i)) @@ -2482,11 +2493,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = (a%ia(i)) diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index 72c1314d..c70868b1 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -1686,7 +1686,7 @@ end subroutine psb_d_csc_csgetptn subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -1704,7 +1704,7 @@ subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i @@ -2557,60 +2557,60 @@ end subroutine psb_d_csc_reallocate_nz -subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csgetblk - implicit none - - class(psb_d_csc_sparse_mat), intent(in) :: a - class(psb_d_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_d_csc_csgetblk +!!$subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ ! Output is always in COO format +!!$ use psb_error_mod +!!$ use psb_const_mod +!!$ use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csgetblk +!!$ implicit none +!!$ +!!$ class(psb_d_csc_sparse_mat), intent(in) :: a +!!$ class(psb_d_coo_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(in) :: imin,imax +!!$ integer(psb_ipk_),intent(out) :: info +!!$ logical, intent(in), optional :: append +!!$ integer(psb_ipk_), intent(in), optional :: iren(:) +!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax +!!$ logical, intent(in), optional :: rscale,cscale +!!$ integer(psb_ipk_) :: err_act, nzin, nzout +!!$ integer(psb_ipk_) :: ierr(5) +!!$ character(len=20) :: name='csget' +!!$ logical :: append_ +!!$ logical, parameter :: debug=.false. +!!$ +!!$ call psb_erractionsave(err_act) +!!$ info = psb_success_ +!!$ +!!$ if (present(append)) then +!!$ append_ = append +!!$ else +!!$ append_ = .false. +!!$ endif +!!$ if (append_) then +!!$ nzin = a%get_nzeros() +!!$ else +!!$ nzin = 0 +!!$ endif +!!$ +!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& +!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, & +!!$ & nzin=nzin, rscale=rscale, cscale=cscale) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call b%set_nzeros(nzin+nzout) +!!$ call b%fix(info) +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call psb_erractionrestore(err_act) +!!$ return +!!$ +!!$9999 call psb_error_handler(err_act) +!!$ +!!$ return +!!$ +!!$end subroutine psb_d_csc_csgetblk subroutine psb_d_csc_reinit(a,clear) use psb_error_mod diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 71f1438f..8edbf43c 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1993,7 +1993,7 @@ end subroutine psb_d_csr_csgetptn subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2011,9 +2011,9 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2056,13 +2056,18 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2087,7 +2092,7 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2102,7 +2107,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) real(psb_dpk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append, chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd @@ -2135,11 +2140,13 @@ contains nzt = (a%irp(lrw+1)-a%irp(irw)) nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + + if (info /= psb_success_) return + end if if (present(iren)) then do i=irw, lrw @@ -2171,59 +2178,6 @@ contains end subroutine psb_d_csr_csgetrow -subroutine psb_d_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csgetblk - implicit none - - class(psb_d_csr_sparse_mat), intent(in) :: a - class(psb_d_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_d_csr_csgetblk ! ! CSR implementation of tril/triu @@ -2245,8 +2199,6 @@ subroutine psb_d_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - real(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -2401,8 +2353,6 @@ subroutine psb_d_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - real(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ @@ -4397,60 +4347,6 @@ contains end subroutine psb_ld_csr_csgetrow -subroutine psb_ld_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_csgetblk - implicit none - - class(psb_ld_csr_sparse_mat), intent(in) :: a - class(psb_ld_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_lpk_) :: nzin, nzout - integer(psb_ipk_) :: err_act - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_ld_csr_csgetblk ! ! CSR implementation of tril/triu @@ -4473,8 +4369,6 @@ subroutine psb_ld_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - real(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -4630,8 +4524,6 @@ subroutine psb_ld_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - real(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 0a259115..a2f960ad 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -791,7 +791,7 @@ end subroutine psb_d_csgetptn subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -808,7 +808,7 @@ subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' @@ -824,7 +824,7 @@ subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call a%a%csget(imin,imax,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index 3f52bdad..48733b74 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -396,7 +396,7 @@ subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_s_base_csput_v subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -412,7 +412,7 @@ subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -428,15 +428,13 @@ subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& end subroutine psb_s_base_csgetrow - - ! ! Here we have the base implementation of getblk and clip: ! this is just based on the getrow. ! If performance is critical it can be overridden. ! subroutine psb_s_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -450,7 +448,7 @@ subroutine psb_s_base_csgetblk(imin,imax,a,b,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csget' integer(psb_ipk_) :: jmin_, jmax_ @@ -510,7 +508,7 @@ subroutine psb_s_base_csgetblk(imin,imax,a,b,info,& call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) + & nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 6063cb32..849cc744 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -2223,7 +2223,7 @@ end subroutine psb_s_coo_csgetptn ! The output is guaranteed to be sorted ! subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2240,9 +2240,9 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2284,13 +2284,18 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2315,7 +2320,7 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2331,7 +2336,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) real(psb_spk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append,chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd @@ -2415,11 +2420,13 @@ contains nzt = jp - ip +1 nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then do i=ip,jp if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then @@ -2451,11 +2458,13 @@ contains nrd = max(a%get_nrows(),1) nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1) - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then k = 0 do i=1, a%get_nzeros() @@ -2464,10 +2473,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = iren(a%ia(i)) @@ -2482,11 +2493,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = (a%ia(i)) diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index 61d4ac05..5f313792 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -1686,7 +1686,7 @@ end subroutine psb_s_csc_csgetptn subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -1704,7 +1704,7 @@ subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i @@ -2557,60 +2557,60 @@ end subroutine psb_s_csc_reallocate_nz -subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csgetblk - implicit none - - class(psb_s_csc_sparse_mat), intent(in) :: a - class(psb_s_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_s_csc_csgetblk +!!$subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ ! Output is always in COO format +!!$ use psb_error_mod +!!$ use psb_const_mod +!!$ use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csgetblk +!!$ implicit none +!!$ +!!$ class(psb_s_csc_sparse_mat), intent(in) :: a +!!$ class(psb_s_coo_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(in) :: imin,imax +!!$ integer(psb_ipk_),intent(out) :: info +!!$ logical, intent(in), optional :: append +!!$ integer(psb_ipk_), intent(in), optional :: iren(:) +!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax +!!$ logical, intent(in), optional :: rscale,cscale +!!$ integer(psb_ipk_) :: err_act, nzin, nzout +!!$ integer(psb_ipk_) :: ierr(5) +!!$ character(len=20) :: name='csget' +!!$ logical :: append_ +!!$ logical, parameter :: debug=.false. +!!$ +!!$ call psb_erractionsave(err_act) +!!$ info = psb_success_ +!!$ +!!$ if (present(append)) then +!!$ append_ = append +!!$ else +!!$ append_ = .false. +!!$ endif +!!$ if (append_) then +!!$ nzin = a%get_nzeros() +!!$ else +!!$ nzin = 0 +!!$ endif +!!$ +!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& +!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, & +!!$ & nzin=nzin, rscale=rscale, cscale=cscale) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call b%set_nzeros(nzin+nzout) +!!$ call b%fix(info) +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call psb_erractionrestore(err_act) +!!$ return +!!$ +!!$9999 call psb_error_handler(err_act) +!!$ +!!$ return +!!$ +!!$end subroutine psb_s_csc_csgetblk subroutine psb_s_csc_reinit(a,clear) use psb_error_mod diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 61de56d2..8ed54ae9 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -1993,7 +1993,7 @@ end subroutine psb_s_csr_csgetptn subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2011,9 +2011,9 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2056,13 +2056,18 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2087,7 +2092,7 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2102,7 +2107,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) real(psb_spk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append, chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd @@ -2135,11 +2140,13 @@ contains nzt = (a%irp(lrw+1)-a%irp(irw)) nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + + if (info /= psb_success_) return + end if if (present(iren)) then do i=irw, lrw @@ -2171,59 +2178,6 @@ contains end subroutine psb_s_csr_csgetrow -subroutine psb_s_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_csgetblk - implicit none - - class(psb_s_csr_sparse_mat), intent(in) :: a - class(psb_s_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_s_csr_csgetblk ! ! CSR implementation of tril/triu @@ -2245,8 +2199,6 @@ subroutine psb_s_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - real(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -2401,8 +2353,6 @@ subroutine psb_s_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - real(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ @@ -4397,60 +4347,6 @@ contains end subroutine psb_ls_csr_csgetrow -subroutine psb_ls_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_csgetblk - implicit none - - class(psb_ls_csr_sparse_mat), intent(in) :: a - class(psb_ls_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_lpk_) :: nzin, nzout - integer(psb_ipk_) :: err_act - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_ls_csr_csgetblk ! ! CSR implementation of tril/triu @@ -4473,8 +4369,6 @@ subroutine psb_ls_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - real(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -4630,8 +4524,6 @@ subroutine psb_ls_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - real(psb_spk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 5977e991..64e8bbc4 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -791,7 +791,7 @@ end subroutine psb_s_csgetptn subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -808,7 +808,7 @@ subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' @@ -824,7 +824,7 @@ subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call a%a%csget(imin,imax,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index 8fdd5ba5..ed77f84c 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -396,7 +396,7 @@ subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_z_base_csput_v subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -412,7 +412,7 @@ subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -428,15 +428,13 @@ subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,& end subroutine psb_z_base_csgetrow - - ! ! Here we have the base implementation of getblk and clip: ! this is just based on the getrow. ! If performance is critical it can be overridden. ! subroutine psb_z_base_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) + & jmin,jmax,iren,append,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -450,7 +448,7 @@ subroutine psb_z_base_csgetblk(imin,imax,a,b,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csget' integer(psb_ipk_) :: jmin_, jmax_ @@ -510,7 +508,7 @@ subroutine psb_z_base_csgetblk(imin,imax,a,b,info,& call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) + & nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 9b4d74a9..db42931c 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -2223,7 +2223,7 @@ end subroutine psb_z_coo_csgetptn ! The output is guaranteed to be sorted ! subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2240,9 +2240,9 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2284,13 +2284,18 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2315,7 +2320,7 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2331,7 +2336,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) complex(psb_dpk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append,chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd @@ -2415,11 +2420,13 @@ contains nzt = jp - ip +1 nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then do i=ip,jp if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then @@ -2451,11 +2458,13 @@ contains nrd = max(a%get_nrows(),1) nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1) - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if + if (present(iren)) then k = 0 do i=1, a%get_nzeros() @@ -2464,10 +2473,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = iren(a%ia(i)) @@ -2482,11 +2493,12 @@ contains k = k + 1 if (k > nzt) then nzt = k + nzt - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - if (info /= psb_success_) return - + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + if (info /= psb_success_) return + end if end if val(nzin_+k) = a%val(i) ia(nzin_+k) = (a%ia(i)) diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 399f7808..29c3e392 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -1686,7 +1686,7 @@ end subroutine psb_z_csc_csgetptn subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -1704,7 +1704,7 @@ subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i @@ -2557,60 +2557,60 @@ end subroutine psb_z_csc_reallocate_nz -subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csgetblk - implicit none - - class(psb_z_csc_sparse_mat), intent(in) :: a - class(psb_z_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_z_csc_csgetblk +!!$subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ ! Output is always in COO format +!!$ use psb_error_mod +!!$ use psb_const_mod +!!$ use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csgetblk +!!$ implicit none +!!$ +!!$ class(psb_z_csc_sparse_mat), intent(in) :: a +!!$ class(psb_z_coo_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(in) :: imin,imax +!!$ integer(psb_ipk_),intent(out) :: info +!!$ logical, intent(in), optional :: append +!!$ integer(psb_ipk_), intent(in), optional :: iren(:) +!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax +!!$ logical, intent(in), optional :: rscale,cscale +!!$ integer(psb_ipk_) :: err_act, nzin, nzout +!!$ integer(psb_ipk_) :: ierr(5) +!!$ character(len=20) :: name='csget' +!!$ logical :: append_ +!!$ logical, parameter :: debug=.false. +!!$ +!!$ call psb_erractionsave(err_act) +!!$ info = psb_success_ +!!$ +!!$ if (present(append)) then +!!$ append_ = append +!!$ else +!!$ append_ = .false. +!!$ endif +!!$ if (append_) then +!!$ nzin = a%get_nzeros() +!!$ else +!!$ nzin = 0 +!!$ endif +!!$ +!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& +!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, & +!!$ & nzin=nzin, rscale=rscale, cscale=cscale) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call b%set_nzeros(nzin+nzout) +!!$ call b%fix(info) +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ call psb_erractionrestore(err_act) +!!$ return +!!$ +!!$9999 call psb_error_handler(err_act) +!!$ +!!$ return +!!$ +!!$end subroutine psb_z_csc_csgetblk subroutine psb_z_csc_reinit(a,clear) use psb_error_mod diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index ec688ad1..808a407a 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1993,7 +1993,7 @@ end subroutine psb_z_csr_csgetptn subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -2011,9 +2011,9 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz - logical :: append_, rscale_, cscale_ + logical :: append_, rscale_, cscale_, chksz_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2056,13 +2056,18 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& else cscale_ = .false. endif + if (present(chksz)) then + chksz_ = chksz + else + chksz_ = .true. + endif if ((rscale_.or.cscale_).and.(present(iren))) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='iren (rscale.or.cscale)') goto 9999 end if - call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,& + call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,& & iren) if (rscale_) then @@ -2087,7 +2092,7 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& contains - subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,& + subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,& & iren) use psb_const_mod @@ -2102,7 +2107,7 @@ contains integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) complex(psb_dpk_), allocatable, intent(inout) :: val(:) integer(psb_ipk_), intent(in) :: nzin - logical, intent(in) :: append + logical, intent(in) :: append, chksz integer(psb_ipk_) :: info integer(psb_ipk_), optional :: iren(:) integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd @@ -2135,11 +2140,13 @@ contains nzt = (a%irp(lrw+1)-a%irp(irw)) nz = 0 - call psb_ensure_size(nzin_+nzt,ia,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) - if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) - - if (info /= psb_success_) return + if (chksz) then + call psb_ensure_size(nzin_+nzt,ia,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info) + if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info) + + if (info /= psb_success_) return + end if if (present(iren)) then do i=irw, lrw @@ -2171,59 +2178,6 @@ contains end subroutine psb_z_csr_csgetrow -subroutine psb_z_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_csgetblk - implicit none - - class(psb_z_csr_sparse_mat), intent(in) :: a - class(psb_z_coo_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_ipk_), intent(in), optional :: iren(:) - integer(psb_ipk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_ipk_) :: err_act, nzin, nzout - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_z_csr_csgetblk ! ! CSR implementation of tril/triu @@ -2245,8 +2199,6 @@ subroutine psb_z_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - complex(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -2401,8 +2353,6 @@ subroutine psb_z_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_ipk_), allocatable :: ia(:), ja(:) - complex(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ @@ -4397,60 +4347,6 @@ contains end subroutine psb_lz_csr_csgetrow -subroutine psb_lz_csr_csgetblk(imin,imax,a,b,info,& - & jmin,jmax,iren,append,rscale,cscale) - ! Output is always in COO format - use psb_error_mod - use psb_const_mod - use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_csgetblk - implicit none - - class(psb_lz_csr_sparse_mat), intent(in) :: a - class(psb_lz_coo_sparse_mat), intent(inout) :: b - integer(psb_lpk_), intent(in) :: imin,imax - integer(psb_ipk_),intent(out) :: info - logical, intent(in), optional :: append - integer(psb_lpk_), intent(in), optional :: iren(:) - integer(psb_lpk_), intent(in), optional :: jmin,jmax - logical, intent(in), optional :: rscale,cscale - integer(psb_lpk_) :: nzin, nzout - integer(psb_ipk_) :: err_act - character(len=20) :: name='csget' - logical :: append_ - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(append)) then - append_ = append - else - append_ = .false. - endif - if (append_) then - nzin = a%get_nzeros() - else - nzin = 0 - endif - - call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,& - & jmin=jmin, jmax=jmax, iren=iren, append=append_, & - & nzin=nzin, rscale=rscale, cscale=cscale) - - if (info /= psb_success_) goto 9999 - - call b%set_nzeros(nzin+nzout) - call b%fix(info) - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine psb_lz_csr_csgetblk ! ! CSR implementation of tril/triu @@ -4473,8 +4369,6 @@ subroutine psb_lz_csr_tril(a,l,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - complex(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='tril' logical :: rscale_, cscale_ @@ -4630,8 +4524,6 @@ subroutine psb_lz_csr_triu(a,u,info,& integer(psb_ipk_) :: err_act integer(psb_lpk_) :: nzin, nzout, i, j, k integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz - integer(psb_lpk_), allocatable :: ia(:), ja(:) - complex(psb_dpk_), allocatable :: val(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='triu' logical :: rscale_, cscale_ diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 7f5dcc7f..9a80c2ef 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -791,7 +791,7 @@ end subroutine psb_z_csgetptn subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) ! Output is always in COO format use psb_error_mod use psb_const_mod @@ -808,7 +808,7 @@ subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical, intent(in), optional :: append integer(psb_ipk_), intent(in), optional :: iren(:) integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin - logical, intent(in), optional :: rscale,cscale + logical, intent(in), optional :: rscale,cscale,chksz integer(psb_ipk_) :: err_act character(len=20) :: name='csget' @@ -824,7 +824,7 @@ subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call a%a%csget(imin,imax,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index c8f6377c..f8008bf8 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -209,8 +209,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -618,8 +617,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -650,6 +648,11 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if if (info /= psb_success_) then info=psb_err_from_subroutine_; ch_err='psb_sp_reall' @@ -676,8 +679,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & append=.true.,nzin=tot_elem) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_sp_getrow' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_sp_getrow') goto 9999 end if tot_elem=tot_elem+n_elem @@ -691,8 +693,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_loc_to_glob' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_loc_to_glob') goto 9999 end if @@ -705,8 +706,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoallv') goto 9999 end if @@ -717,8 +717,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psbglob_to_loc' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psbglob_to_loc') goto 9999 end if @@ -770,8 +769,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_spcnv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_spcnv') goto 9999 end if diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 18fce4e9..c2aa2538 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -209,8 +209,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -618,8 +617,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -650,6 +648,11 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if if (info /= psb_success_) then info=psb_err_from_subroutine_; ch_err='psb_sp_reall' @@ -676,8 +679,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & append=.true.,nzin=tot_elem) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_sp_getrow' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_sp_getrow') goto 9999 end if tot_elem=tot_elem+n_elem @@ -691,8 +693,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_loc_to_glob' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_loc_to_glob') goto 9999 end if @@ -705,8 +706,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoallv') goto 9999 end if @@ -717,8 +717,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psbglob_to_loc' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psbglob_to_loc') goto 9999 end if @@ -770,8 +769,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_spcnv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_spcnv') goto 9999 end if diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index 23b6e6ec..8534a838 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -209,8 +209,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -618,8 +617,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -650,6 +648,11 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if if (info /= psb_success_) then info=psb_err_from_subroutine_; ch_err='psb_sp_reall' @@ -676,8 +679,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & append=.true.,nzin=tot_elem) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_sp_getrow' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_sp_getrow') goto 9999 end if tot_elem=tot_elem+n_elem @@ -691,8 +693,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_loc_to_glob' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_loc_to_glob') goto 9999 end if @@ -705,8 +706,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoallv') goto 9999 end if @@ -717,8 +717,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psbglob_to_loc' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psbglob_to_loc') goto 9999 end if @@ -770,8 +769,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_spcnv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_spcnv') goto 9999 end if diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 25f2c180..e17d30a5 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -209,8 +209,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -618,8 +617,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if @@ -650,6 +648,11 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info) if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='ensure_size') + goto 9999 + end if if (info /= psb_success_) then info=psb_err_from_subroutine_; ch_err='psb_sp_reall' @@ -676,8 +679,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & append=.true.,nzin=tot_elem) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_sp_getrow' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_sp_getrow') goto 9999 end if tot_elem=tot_elem+n_elem @@ -691,8 +693,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_loc_to_glob' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_loc_to_glob') goto 9999 end if @@ -705,8 +706,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoallv') goto 9999 end if @@ -717,8 +717,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psbglob_to_loc' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psbglob_to_loc') goto 9999 end if @@ -770,8 +769,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='psb_spcnv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_spcnv') goto 9999 end if diff --git a/cbind/prec/psb_cprec_cbind_mod.f90 b/cbind/prec/psb_cprec_cbind_mod.f90 index a97d8870..c9304c66 100644 --- a/cbind/prec/psb_cprec_cbind_mod.f90 +++ b/cbind/prec/psb_cprec_cbind_mod.f90 @@ -13,12 +13,14 @@ module psb_cprec_cbind_mod contains - function psb_c_cprecinit(ph,ptype) bind(c) result(res) + function psb_c_cprecinit(ictxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk) :: res + integer(psb_c_ipk), value :: ictxt + type(psb_c_cprec) :: ph character(c_char) :: ptype(*) type(psb_cprec_type), pointer :: precp @@ -36,7 +38,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(precp,fptype,info) + call psb_precinit(ictxt,precp,fptype,info) res = min(0,info) return diff --git a/cbind/prec/psb_dprec_cbind_mod.f90 b/cbind/prec/psb_dprec_cbind_mod.f90 index 1ac63b54..2ea6c9fc 100644 --- a/cbind/prec/psb_dprec_cbind_mod.f90 +++ b/cbind/prec/psb_dprec_cbind_mod.f90 @@ -13,12 +13,14 @@ module psb_dprec_cbind_mod contains - function psb_c_dprecinit(ph,ptype) bind(c) result(res) + function psb_c_dprecinit(ictxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk) :: res + integer(psb_c_ipk), value :: ictxt + type(psb_c_dprec) :: ph character(c_char) :: ptype(*) type(psb_dprec_type), pointer :: precp @@ -36,7 +38,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(precp,fptype,info) + call psb_precinit(ictxt,precp,fptype,info) res = min(0,info) return diff --git a/cbind/prec/psb_sprec_cbind_mod.f90 b/cbind/prec/psb_sprec_cbind_mod.f90 index 0a311e8d..87eedbfd 100644 --- a/cbind/prec/psb_sprec_cbind_mod.f90 +++ b/cbind/prec/psb_sprec_cbind_mod.f90 @@ -13,12 +13,14 @@ module psb_sprec_cbind_mod contains - function psb_c_sprecinit(ph,ptype) bind(c) result(res) + function psb_c_sprecinit(ictxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk) :: res + integer(psb_c_ipk), value :: ictxt + type(psb_c_sprec) :: ph character(c_char) :: ptype(*) type(psb_sprec_type), pointer :: precp @@ -36,7 +38,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(precp,fptype,info) + call psb_precinit(ictxt,precp,fptype,info) res = min(0,info) return diff --git a/cbind/prec/psb_zprec_cbind_mod.f90 b/cbind/prec/psb_zprec_cbind_mod.f90 index 971526ea..b2bdcbe6 100644 --- a/cbind/prec/psb_zprec_cbind_mod.f90 +++ b/cbind/prec/psb_zprec_cbind_mod.f90 @@ -13,12 +13,14 @@ module psb_zprec_cbind_mod contains - function psb_c_zprecinit(ph,ptype) bind(c) result(res) + function psb_c_zprecinit(ictxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk) :: res + integer(psb_c_ipk), value :: ictxt + type(psb_c_zprec) :: ph character(c_char) :: ptype(*) type(psb_zprec_type), pointer :: precp @@ -36,7 +38,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(precp,fptype,info) + call psb_precinit(ictxt,precp,fptype,info) res = min(0,info) return diff --git a/prec/impl/psb_cprecinit.f90 b/prec/impl/psb_cprecinit.f90 index 6a757e39..7f6da35f 100644 --- a/prec/impl/psb_cprecinit.f90 +++ b/prec/impl/psb_cprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_cprecinit(p,ptype,info) +subroutine psb_cprecinit(ictxt,p,ptype,info) use psb_base_mod use psb_c_prec_type, psb_protect_name => psb_cprecinit @@ -37,7 +37,8 @@ subroutine psb_cprecinit(p,ptype,info) use psb_c_diagprec, only : psb_c_diag_prec_type use psb_c_bjacprec, only : psb_c_bjac_prec_type implicit none - class(psb_cprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: ictxt + class(psb_cprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -49,6 +50,8 @@ subroutine psb_cprecinit(p,ptype,info) if (info /= psb_success_) return end if + p%ictxt = ictxt + select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/impl/psb_dprecinit.f90 b/prec/impl/psb_dprecinit.f90 index b5bee7ab..70f7c05a 100644 --- a/prec/impl/psb_dprecinit.f90 +++ b/prec/impl/psb_dprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_dprecinit(p,ptype,info) +subroutine psb_dprecinit(ictxt,p,ptype,info) use psb_base_mod use psb_d_prec_type, psb_protect_name => psb_dprecinit @@ -37,7 +37,8 @@ subroutine psb_dprecinit(p,ptype,info) use psb_d_diagprec, only : psb_d_diag_prec_type use psb_d_bjacprec, only : psb_d_bjac_prec_type implicit none - class(psb_dprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: ictxt + class(psb_dprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -49,6 +50,8 @@ subroutine psb_dprecinit(p,ptype,info) if (info /= psb_success_) return end if + p%ictxt = ictxt + select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/impl/psb_sprecinit.f90 b/prec/impl/psb_sprecinit.f90 index 54897772..46ab547a 100644 --- a/prec/impl/psb_sprecinit.f90 +++ b/prec/impl/psb_sprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_sprecinit(p,ptype,info) +subroutine psb_sprecinit(ictxt,p,ptype,info) use psb_base_mod use psb_s_prec_type, psb_protect_name => psb_sprecinit @@ -37,7 +37,8 @@ subroutine psb_sprecinit(p,ptype,info) use psb_s_diagprec, only : psb_s_diag_prec_type use psb_s_bjacprec, only : psb_s_bjac_prec_type implicit none - class(psb_sprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: ictxt + class(psb_sprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -49,6 +50,8 @@ subroutine psb_sprecinit(p,ptype,info) if (info /= psb_success_) return end if + p%ictxt = ictxt + select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/impl/psb_zprecinit.f90 b/prec/impl/psb_zprecinit.f90 index 40ecb78e..200e36dd 100644 --- a/prec/impl/psb_zprecinit.f90 +++ b/prec/impl/psb_zprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_zprecinit(p,ptype,info) +subroutine psb_zprecinit(ictxt,p,ptype,info) use psb_base_mod use psb_z_prec_type, psb_protect_name => psb_zprecinit @@ -37,7 +37,8 @@ subroutine psb_zprecinit(p,ptype,info) use psb_z_diagprec, only : psb_z_diag_prec_type use psb_z_bjacprec, only : psb_z_bjac_prec_type implicit none - class(psb_zprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: ictxt + class(psb_zprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -49,6 +50,8 @@ subroutine psb_zprecinit(p,ptype,info) if (info /= psb_success_) return end if + p%ictxt = ictxt + select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 99225d5e..5e341e1c 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -39,6 +39,7 @@ module psb_c_prec_type use psb_c_base_prec_mod type psb_cprec_type + integer(psb_ipk_) :: ictxt class(psb_c_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_c_apply1_vect @@ -60,9 +61,10 @@ module psb_c_prec_type end interface interface psb_precinit - subroutine psb_cprecinit(prec,ptype,info) + subroutine psb_cprecinit(ictxt,prec,ptype,info) import :: psb_ipk_, psb_cprec_type implicit none + integer(psb_ipk_), intent(in) :: ictxt class(psb_cprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index 16afd958..f420d282 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -39,6 +39,7 @@ module psb_d_prec_type use psb_d_base_prec_mod type psb_dprec_type + integer(psb_ipk_) :: ictxt class(psb_d_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_d_apply1_vect @@ -60,9 +61,10 @@ module psb_d_prec_type end interface interface psb_precinit - subroutine psb_dprecinit(prec,ptype,info) + subroutine psb_dprecinit(ictxt,prec,ptype,info) import :: psb_ipk_, psb_dprec_type implicit none + integer(psb_ipk_), intent(in) :: ictxt class(psb_dprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index 808eaf03..4eb157c6 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -39,6 +39,7 @@ module psb_s_prec_type use psb_s_base_prec_mod type psb_sprec_type + integer(psb_ipk_) :: ictxt class(psb_s_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_s_apply1_vect @@ -60,9 +61,10 @@ module psb_s_prec_type end interface interface psb_precinit - subroutine psb_sprecinit(prec,ptype,info) + subroutine psb_sprecinit(ictxt,prec,ptype,info) import :: psb_ipk_, psb_sprec_type implicit none + integer(psb_ipk_), intent(in) :: ictxt class(psb_sprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index e4702ef0..15a53fe4 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -39,6 +39,7 @@ module psb_z_prec_type use psb_z_base_prec_mod type psb_zprec_type + integer(psb_ipk_) :: ictxt class(psb_z_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_z_apply1_vect @@ -60,9 +61,10 @@ module psb_z_prec_type end interface interface psb_precinit - subroutine psb_zprecinit(prec,ptype,info) + subroutine psb_zprecinit(ictxt,prec,ptype,info) import :: psb_ipk_, psb_zprec_type implicit none + integer(psb_ipk_), intent(in) :: ictxt class(psb_zprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index f96db3a6..93957db8 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -213,7 +213,7 @@ program psb_cf_sample ! - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) ! building the preconditioner t1 = psb_wtime() diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index 45f675bc..8dd33fea 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -213,7 +213,7 @@ program psb_df_sample ! - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) ! building the preconditioner t1 = psb_wtime() diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index 35d212aa..591e78c5 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -213,7 +213,7 @@ program psb_sf_sample ! - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) ! building the preconditioner t1 = psb_wtime() diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index 36101aa2..40c5a0a2 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -213,7 +213,7 @@ program psb_zf_sample ! - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) ! building the preconditioner t1 = psb_wtime() diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index c1f6d93b..d1ec686e 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -613,7 +613,7 @@ program psb_d_pde2d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -638,7 +638,7 @@ program psb_d_pde2d if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd call psb_barrier(ictxt) t1 = psb_wtime() - eps = 1.d-9 + eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index a78ec3b6..e78b9825 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -654,7 +654,7 @@ program psb_d_pde3d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -679,7 +679,7 @@ program psb_d_pde3d if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd call psb_barrier(ictxt) t1 = psb_wtime() - eps = 1.d-9 + eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index 571e36c2..048a7a58 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -613,7 +613,7 @@ program psb_s_pde2d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -638,7 +638,7 @@ program psb_s_pde2d if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd call psb_barrier(ictxt) t1 = psb_wtime() - eps = 1.d-9 + eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index 2161ae7d..6eb47872 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -654,7 +654,7 @@ program psb_s_pde3d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ptype,info) + call prec%init(ictxt,ptype,info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -679,7 +679,7 @@ program psb_s_pde3d if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd call psb_barrier(ictxt) t1 = psb_wtime() - eps = 1.d-9 + eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)