diff --git a/base/modules/serial/psb_c_base_mat_mod.f90 b/base/modules/serial/psb_c_base_mat_mod.f90 index 3063713c..191bffc1 100644 --- a/base/modules/serial/psb_c_base_mat_mod.f90 +++ b/base/modules/serial/psb_c_base_mat_mod.f90 @@ -455,25 +455,23 @@ module psb_c_base_mat_mod !! ! interface - subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_c_base_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_base_csput_a end interface interface - subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_vect_type), intent(inout) :: val class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_base_csput_v end interface @@ -1875,14 +1873,13 @@ module psb_c_base_mat_mod !! ! interface - subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_c_coo_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_coo_csput_a end interface @@ -2137,25 +2134,23 @@ module psb_c_base_mat_mod !! ! interface - subroutine psb_lc_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lc_base_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_base_csput_a end interface interface - subroutine psb_lc_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lc_base_sparse_mat), intent(inout) :: a class(psb_c_base_vect_type), intent(inout) :: val class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_base_csput_v end interface @@ -3345,14 +3340,13 @@ module psb_c_base_mat_mod !! ! interface - subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lc_coo_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_coo_csput_a end interface diff --git a/base/modules/serial/psb_c_csc_mat_mod.f90 b/base/modules/serial/psb_c_csc_mat_mod.f90 index d5718de7..47256546 100644 --- a/base/modules/serial/psb_c_csc_mat_mod.f90 +++ b/base/modules/serial/psb_c_csc_mat_mod.f90 @@ -335,14 +335,13 @@ module psb_c_csc_mat_mod !> \memberof psb_c_csc_sparse_mat !! \see psb_c_base_mat_mod::psb_c_base_csput_a interface - subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_c_csc_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_csc_csput_a end interface @@ -727,14 +726,13 @@ module psb_c_csc_mat_mod !> \memberof psb_lc_csc_sparse_mat !! \see psb_lc_base_mat_mod::psb_lc_base_csput_a interface - subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lc_csc_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_csc_csput_a 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 43b0c224..9d72a770 100644 --- a/base/modules/serial/psb_c_csr_mat_mod.f90 +++ b/base/modules/serial/psb_c_csr_mat_mod.f90 @@ -372,14 +372,13 @@ module psb_c_csr_mat_mod !> \memberof psb_c_csr_sparse_mat !! \see psb_c_base_mat_mod::psb_c_base_csput_a interface - subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_c_csr_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_csr_csput_a end interface @@ -890,14 +889,13 @@ module psb_c_csr_mat_mod !> \memberof psb_lc_csr_sparse_mat !! \see psb_lc_base_mat_mod::psb_lc_base_csput_a interface - subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lc_csr_sparse_mat), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_csr_csput_a end interface diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index e07eb667..f10c9640 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -598,19 +598,18 @@ module psb_c_mat_mod end interface interface - subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_ class(psb_cspmat_type), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_csput_a end interface interface - subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_c_vect_mod, only : psb_c_vect_type use psb_i_vect_mod, only : psb_i_vect_type import :: psb_ipk_, psb_lpk_, psb_cspmat_type @@ -619,7 +618,6 @@ module psb_c_mat_mod type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_c_csput_v end interface @@ -1306,19 +1304,18 @@ module psb_c_mat_mod end interface interface - subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_ class(psb_lcspmat_type), intent(inout) :: a complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_csput_a end interface interface - subroutine psb_lc_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lc_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_c_vect_mod, only : psb_c_vect_type use psb_l_vect_mod, only : psb_l_vect_type import :: psb_ipk_, psb_lpk_, psb_lcspmat_type @@ -1327,7 +1324,6 @@ module psb_c_mat_mod type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lc_csput_v end interface diff --git a/base/modules/serial/psb_d_base_mat_mod.f90 b/base/modules/serial/psb_d_base_mat_mod.f90 index 19bc1d6f..5e2442be 100644 --- a/base/modules/serial/psb_d_base_mat_mod.f90 +++ b/base/modules/serial/psb_d_base_mat_mod.f90 @@ -455,25 +455,23 @@ module psb_d_base_mat_mod !! ! interface - subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_d_base_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_base_csput_a end interface interface - subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_vect_type), intent(inout) :: val class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_base_csput_v end interface @@ -1875,14 +1873,13 @@ module psb_d_base_mat_mod !! ! interface - subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_d_coo_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_coo_csput_a end interface @@ -2137,25 +2134,23 @@ module psb_d_base_mat_mod !! ! interface - subroutine psb_ld_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ld_base_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_base_csput_a end interface interface - subroutine psb_ld_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ld_base_sparse_mat), intent(inout) :: a class(psb_d_base_vect_type), intent(inout) :: val class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_base_csput_v end interface @@ -3345,14 +3340,13 @@ module psb_d_base_mat_mod !! ! interface - subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ld_coo_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_coo_csput_a end interface diff --git a/base/modules/serial/psb_d_csc_mat_mod.f90 b/base/modules/serial/psb_d_csc_mat_mod.f90 index 8577ba31..8d67e09a 100644 --- a/base/modules/serial/psb_d_csc_mat_mod.f90 +++ b/base/modules/serial/psb_d_csc_mat_mod.f90 @@ -335,14 +335,13 @@ module psb_d_csc_mat_mod !> \memberof psb_d_csc_sparse_mat !! \see psb_d_base_mat_mod::psb_d_base_csput_a interface - subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_d_csc_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_csc_csput_a end interface @@ -727,14 +726,13 @@ module psb_d_csc_mat_mod !> \memberof psb_ld_csc_sparse_mat !! \see psb_ld_base_mat_mod::psb_ld_base_csput_a interface - subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ld_csc_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_csc_csput_a 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 7dd197de..ce4b3e7c 100644 --- a/base/modules/serial/psb_d_csr_mat_mod.f90 +++ b/base/modules/serial/psb_d_csr_mat_mod.f90 @@ -372,14 +372,13 @@ module psb_d_csr_mat_mod !> \memberof psb_d_csr_sparse_mat !! \see psb_d_base_mat_mod::psb_d_base_csput_a interface - subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_d_csr_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_csr_csput_a end interface @@ -890,14 +889,13 @@ module psb_d_csr_mat_mod !> \memberof psb_ld_csr_sparse_mat !! \see psb_ld_base_mat_mod::psb_ld_base_csput_a interface - subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ld_csr_sparse_mat), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_csr_csput_a end interface diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index bd24197c..767ac251 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -598,19 +598,18 @@ module psb_d_mat_mod end interface interface - subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_ class(psb_dspmat_type), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_csput_a end interface interface - subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_d_vect_mod, only : psb_d_vect_type use psb_i_vect_mod, only : psb_i_vect_type import :: psb_ipk_, psb_lpk_, psb_dspmat_type @@ -619,7 +618,6 @@ module psb_d_mat_mod type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_d_csput_v end interface @@ -1306,19 +1304,18 @@ module psb_d_mat_mod end interface interface - subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_ class(psb_ldspmat_type), intent(inout) :: a real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_csput_a end interface interface - subroutine psb_ld_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ld_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_d_vect_mod, only : psb_d_vect_type use psb_l_vect_mod, only : psb_l_vect_type import :: psb_ipk_, psb_lpk_, psb_ldspmat_type @@ -1327,7 +1324,6 @@ module psb_d_mat_mod type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ld_csput_v end interface diff --git a/base/modules/serial/psb_s_base_mat_mod.f90 b/base/modules/serial/psb_s_base_mat_mod.f90 index 52189abc..3dbfe62e 100644 --- a/base/modules/serial/psb_s_base_mat_mod.f90 +++ b/base/modules/serial/psb_s_base_mat_mod.f90 @@ -455,25 +455,23 @@ module psb_s_base_mat_mod !! ! interface - subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_s_base_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_base_csput_a end interface interface - subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_vect_type), intent(inout) :: val class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_base_csput_v end interface @@ -1875,14 +1873,13 @@ module psb_s_base_mat_mod !! ! interface - subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_s_coo_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_coo_csput_a end interface @@ -2137,25 +2134,23 @@ module psb_s_base_mat_mod !! ! interface - subroutine psb_ls_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ls_base_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_base_csput_a end interface interface - subroutine psb_ls_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ls_base_sparse_mat), intent(inout) :: a class(psb_s_base_vect_type), intent(inout) :: val class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_base_csput_v end interface @@ -3345,14 +3340,13 @@ module psb_s_base_mat_mod !! ! interface - subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ls_coo_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_coo_csput_a end interface diff --git a/base/modules/serial/psb_s_csc_mat_mod.f90 b/base/modules/serial/psb_s_csc_mat_mod.f90 index 1d248c1d..188950d2 100644 --- a/base/modules/serial/psb_s_csc_mat_mod.f90 +++ b/base/modules/serial/psb_s_csc_mat_mod.f90 @@ -335,14 +335,13 @@ module psb_s_csc_mat_mod !> \memberof psb_s_csc_sparse_mat !! \see psb_s_base_mat_mod::psb_s_base_csput_a interface - subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_s_csc_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_csc_csput_a end interface @@ -727,14 +726,13 @@ module psb_s_csc_mat_mod !> \memberof psb_ls_csc_sparse_mat !! \see psb_ls_base_mat_mod::psb_ls_base_csput_a interface - subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ls_csc_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_csc_csput_a 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 fb9e4139..e21a8476 100644 --- a/base/modules/serial/psb_s_csr_mat_mod.f90 +++ b/base/modules/serial/psb_s_csr_mat_mod.f90 @@ -372,14 +372,13 @@ module psb_s_csr_mat_mod !> \memberof psb_s_csr_sparse_mat !! \see psb_s_base_mat_mod::psb_s_base_csput_a interface - subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_s_csr_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_csr_csput_a end interface @@ -890,14 +889,13 @@ module psb_s_csr_mat_mod !> \memberof psb_ls_csr_sparse_mat !! \see psb_ls_base_mat_mod::psb_ls_base_csput_a interface - subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_ls_csr_sparse_mat), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_csr_csput_a end interface diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index 7e68e8a6..46c3e4ac 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -598,19 +598,18 @@ module psb_s_mat_mod end interface interface - subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_ class(psb_sspmat_type), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_csput_a end interface interface - subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_s_vect_mod, only : psb_s_vect_type use psb_i_vect_mod, only : psb_i_vect_type import :: psb_ipk_, psb_lpk_, psb_sspmat_type @@ -619,7 +618,6 @@ module psb_s_mat_mod type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_s_csput_v end interface @@ -1306,19 +1304,18 @@ module psb_s_mat_mod end interface interface - subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_ class(psb_lsspmat_type), intent(inout) :: a real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_csput_a end interface interface - subroutine psb_ls_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_ls_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_s_vect_mod, only : psb_s_vect_type use psb_l_vect_mod, only : psb_l_vect_type import :: psb_ipk_, psb_lpk_, psb_lsspmat_type @@ -1327,7 +1324,6 @@ module psb_s_mat_mod type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_ls_csput_v end interface diff --git a/base/modules/serial/psb_z_base_mat_mod.f90 b/base/modules/serial/psb_z_base_mat_mod.f90 index f09b15f9..e97eb381 100644 --- a/base/modules/serial/psb_z_base_mat_mod.f90 +++ b/base/modules/serial/psb_z_base_mat_mod.f90 @@ -455,25 +455,23 @@ module psb_z_base_mat_mod !! ! interface - subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_z_base_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_base_csput_a end interface interface - subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_vect_type), intent(inout) :: val class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_base_csput_v end interface @@ -1875,14 +1873,13 @@ module psb_z_base_mat_mod !! ! interface - subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_z_coo_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_coo_csput_a end interface @@ -2137,25 +2134,23 @@ module psb_z_base_mat_mod !! ! interface - subroutine psb_lz_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lz_base_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_base_csput_a end interface interface - subroutine psb_lz_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lz_base_sparse_mat), intent(inout) :: a class(psb_z_base_vect_type), intent(inout) :: val class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_base_csput_v end interface @@ -3345,14 +3340,13 @@ module psb_z_base_mat_mod !! ! interface - subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lz_coo_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_coo_csput_a end interface diff --git a/base/modules/serial/psb_z_csc_mat_mod.f90 b/base/modules/serial/psb_z_csc_mat_mod.f90 index 19fb0b23..1f378036 100644 --- a/base/modules/serial/psb_z_csc_mat_mod.f90 +++ b/base/modules/serial/psb_z_csc_mat_mod.f90 @@ -335,14 +335,13 @@ module psb_z_csc_mat_mod !> \memberof psb_z_csc_sparse_mat !! \see psb_z_base_mat_mod::psb_z_base_csput_a interface - subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_z_csc_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_csc_csput_a end interface @@ -727,14 +726,13 @@ module psb_z_csc_mat_mod !> \memberof psb_lz_csc_sparse_mat !! \see psb_lz_base_mat_mod::psb_lz_base_csput_a interface - subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lz_csc_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_csc_csput_a 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 975ff9c9..9a9cdd26 100644 --- a/base/modules/serial/psb_z_csr_mat_mod.f90 +++ b/base/modules/serial/psb_z_csr_mat_mod.f90 @@ -372,14 +372,13 @@ module psb_z_csr_mat_mod !> \memberof psb_z_csr_sparse_mat !! \see psb_z_base_mat_mod::psb_z_base_csput_a interface - subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_z_csr_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_csr_csput_a end interface @@ -890,14 +889,13 @@ module psb_z_csr_mat_mod !> \memberof psb_lz_csr_sparse_mat !! \see psb_lz_base_mat_mod::psb_lz_base_csput_a interface - subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import class(psb_lz_csr_sparse_mat), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),& & imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_csr_csput_a end interface diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index 6fc5bfe2..e2e96301 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -598,19 +598,18 @@ module psb_z_mat_mod end interface interface - subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_ class(psb_zspmat_type), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_csput_a end interface interface - subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_z_vect_mod, only : psb_z_vect_type use psb_i_vect_mod, only : psb_i_vect_type import :: psb_ipk_, psb_lpk_, psb_zspmat_type @@ -619,7 +618,6 @@ module psb_z_mat_mod type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) end subroutine psb_z_csput_v end interface @@ -1306,19 +1304,18 @@ module psb_z_mat_mod end interface interface - subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_ class(psb_lzspmat_type), intent(inout) :: a complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_csput_a end interface interface - subroutine psb_lz_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) + subroutine psb_lz_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_z_vect_mod, only : psb_z_vect_type use psb_l_vect_mod, only : psb_l_vect_type import :: psb_ipk_, psb_lpk_, psb_lzspmat_type @@ -1327,7 +1324,6 @@ module psb_z_mat_mod type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) end subroutine psb_lz_csput_v end interface diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index e8cb8dfc..879638bf 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -326,7 +326,7 @@ subroutine psb_c_base_clean_zeros(a, info) end subroutine psb_c_base_clean_zeros -subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_c_base_mat_mod, psb_protect_name => psb_c_base_csput_a implicit none @@ -334,7 +334,6 @@ subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -351,7 +350,7 @@ subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_c_base_csput_a -subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_c_base_mat_mod, psb_protect_name => psb_c_base_csput_v use psb_c_base_vect_mod @@ -361,7 +360,6 @@ subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csput_v' @@ -377,7 +375,7 @@ subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -2625,7 +2623,7 @@ subroutine psb_lc_base_clean_zeros(a, info) end subroutine psb_lc_base_clean_zeros -subroutine psb_lc_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_csput_a implicit none @@ -2633,7 +2631,6 @@ subroutine psb_lc_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -2650,7 +2647,7 @@ subroutine psb_lc_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_lc_base_csput_a -subroutine psb_lc_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_csput_v use psb_c_base_vect_mod @@ -2660,7 +2657,6 @@ subroutine psb_lc_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: nzin, nzout integer(psb_ipk_) :: err_act @@ -2677,7 +2673,7 @@ subroutine psb_lc_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index c2b27cc8..dd34b4e1 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -2515,7 +2515,7 @@ contains end subroutine psb_c_coo_csgetrow -subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -2526,7 +2526,6 @@ subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -2579,7 +2578,7 @@ subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -2589,7 +2588,7 @@ subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call c_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2619,7 +2618,7 @@ subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -2628,46 +2627,25 @@ contains complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: i,ir,ic,ng + integer(psb_ipk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine c_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2679,9 +2657,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nc,nnz,dupl,ng, nr + & i1,i2,nc,nnz,dupl,nr integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='c_coo_srch_upd' @@ -2703,188 +2680,88 @@ contains nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine c_coo_srch_upd @@ -5521,7 +5398,7 @@ contains end subroutine psb_lc_coo_csgetrow -subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -5532,7 +5409,6 @@ subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -5586,7 +5462,7 @@ subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -5596,7 +5472,7 @@ subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call lc_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -5626,7 +5502,7 @@ subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -5635,46 +5511,25 @@ contains complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) - integer(psb_lpk_) :: i,ir,ic,ng + integer(psb_lpk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine lc_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -5686,9 +5541,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nnz,dupl,ng, nr + & i1,i2,nnz,dupl, nr integer(psb_ipk_) :: debug_level, debug_unit, innz, nc character(len=20) :: name='lc_coo_srch_upd' @@ -5709,188 +5563,88 @@ contains nr = a%get_nrows() innz = nnz - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine lc_coo_srch_upd diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index ed80519d..179c60a0 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -1880,7 +1880,7 @@ end subroutine psb_c_csc_csgetrow -subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csput_a @@ -1890,8 +1890,6 @@ subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -1941,7 +1939,7 @@ subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_c_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -1973,7 +1971,7 @@ subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_c_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -1986,9 +1984,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='c_csc_srch_upd' @@ -2009,138 +2006,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_c_csc_srch_upd @@ -3783,7 +3705,7 @@ end subroutine psb_lc_csc_csgetrow -subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_csput_a @@ -3793,7 +3715,6 @@ subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, debug_level, debug_unit, ierr(5) @@ -3843,7 +3764,7 @@ subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_lc_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -3875,7 +3796,7 @@ subroutine psb_lc_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_lc_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -3888,9 +3809,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit, inr character(len=20) :: name='lc_csc_srch_upd' @@ -3911,138 +3831,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_lc_csc_srch_upd diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 66ca5f75..9afc3c59 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -2490,7 +2490,7 @@ subroutine psb_c_csr_triu(a,u,info,& end subroutine psb_c_csr_triu -subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_csput_a @@ -2500,8 +2500,6 @@ subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act character(len=20) :: name='c_csr_csput_a' @@ -2547,7 +2545,7 @@ subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_c_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2579,7 +2577,7 @@ subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_c_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2592,9 +2590,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng + & i1,i2,nr,nc,nnz,dupl integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='c_csr_srch_upd' @@ -2615,136 +2612,62 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then + if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_c_csr_srch_upd @@ -4661,7 +4584,7 @@ subroutine psb_lc_csr_triu(a,u,info,& end subroutine psb_lc_csr_triu -subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_csput_a @@ -4671,7 +4594,6 @@ subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -4719,7 +4641,7 @@ subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_lc_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -4751,7 +4673,7 @@ subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_lc_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -4764,9 +4686,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,ng + & i1,i2,nr,nc,nnz integer(psb_ipk_) :: debug_level, debug_unit,dupl, inc character(len=20) :: name='lc_csr_srch_upd' @@ -4787,138 +4708,63 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ir > 0).and.(ir <= nr)) then + + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ir > 0).and.(ir <= nr)) then - - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_lc_csr_srch_upd diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 08532e12..b13476c0 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -661,7 +661,7 @@ end subroutine psb_c_trim -subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_c_mat_mod, psb_protect_name => psb_c_csput_a use psb_c_base_mat_mod use psb_error_mod @@ -670,7 +670,6 @@ subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -685,7 +684,7 @@ subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -698,7 +697,7 @@ subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_c_csput_a -subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_c_mat_mod, psb_protect_name => psb_c_csput_v use psb_c_base_mat_mod use psb_c_vect_mod, only : psb_c_vect_type @@ -710,7 +709,6 @@ subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -725,7 +723,7 @@ subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -3190,7 +3188,7 @@ end subroutine psb_lc_trim -subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_c_mat_mod, psb_protect_name => psb_lc_csput_a use psb_c_base_mat_mod use psb_error_mod @@ -3199,7 +3197,6 @@ subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -3214,7 +3211,7 @@ subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -3227,7 +3224,7 @@ subroutine psb_lc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_lc_csput_a -subroutine psb_lc_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lc_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_c_mat_mod, psb_protect_name => psb_lc_csput_v use psb_c_base_mat_mod use psb_c_vect_mod, only : psb_c_vect_type @@ -3239,7 +3236,6 @@ subroutine psb_lc_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -3254,7 +3250,7 @@ subroutine psb_lc_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index 332c1a7b..30411486 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -326,7 +326,7 @@ subroutine psb_d_base_clean_zeros(a, info) end subroutine psb_d_base_clean_zeros -subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput_a implicit none @@ -334,7 +334,6 @@ subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -351,7 +350,7 @@ subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_d_base_csput_a -subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput_v use psb_d_base_vect_mod @@ -361,7 +360,6 @@ subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csput_v' @@ -377,7 +375,7 @@ subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -2625,7 +2623,7 @@ subroutine psb_ld_base_clean_zeros(a, info) end subroutine psb_ld_base_clean_zeros -subroutine psb_ld_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_csput_a implicit none @@ -2633,7 +2631,6 @@ subroutine psb_ld_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -2650,7 +2647,7 @@ subroutine psb_ld_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_ld_base_csput_a -subroutine psb_ld_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_csput_v use psb_d_base_vect_mod @@ -2660,7 +2657,6 @@ subroutine psb_ld_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: nzin, nzout integer(psb_ipk_) :: err_act @@ -2677,7 +2673,7 @@ subroutine psb_ld_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 27f22219..cfbdb643 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -2515,7 +2515,7 @@ contains end subroutine psb_d_coo_csgetrow -subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -2526,7 +2526,6 @@ subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -2579,7 +2578,7 @@ subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -2589,7 +2588,7 @@ subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call d_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2619,7 +2618,7 @@ subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -2628,46 +2627,25 @@ contains real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: i,ir,ic,ng + integer(psb_ipk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine d_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2679,9 +2657,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nc,nnz,dupl,ng, nr + & i1,i2,nc,nnz,dupl,nr integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='d_coo_srch_upd' @@ -2703,188 +2680,88 @@ contains nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine d_coo_srch_upd @@ -5521,7 +5398,7 @@ contains end subroutine psb_ld_coo_csgetrow -subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -5532,7 +5409,6 @@ subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -5586,7 +5462,7 @@ subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -5596,7 +5472,7 @@ subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call ld_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -5626,7 +5502,7 @@ subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -5635,46 +5511,25 @@ contains real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) - integer(psb_lpk_) :: i,ir,ic,ng + integer(psb_lpk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine ld_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -5686,9 +5541,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nnz,dupl,ng, nr + & i1,i2,nnz,dupl, nr integer(psb_ipk_) :: debug_level, debug_unit, innz, nc character(len=20) :: name='ld_coo_srch_upd' @@ -5709,188 +5563,88 @@ contains nr = a%get_nrows() innz = nnz - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine ld_coo_srch_upd diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index c70868b1..8883d586 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -1880,7 +1880,7 @@ end subroutine psb_d_csc_csgetrow -subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csput_a @@ -1890,8 +1890,6 @@ subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -1941,7 +1939,7 @@ subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_d_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -1973,7 +1971,7 @@ subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_d_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -1986,9 +1984,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='d_csc_srch_upd' @@ -2009,138 +2006,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_d_csc_srch_upd @@ -3783,7 +3705,7 @@ end subroutine psb_ld_csc_csgetrow -subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_csput_a @@ -3793,7 +3715,6 @@ subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, debug_level, debug_unit, ierr(5) @@ -3843,7 +3764,7 @@ subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_ld_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -3875,7 +3796,7 @@ subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_ld_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -3888,9 +3809,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit, inr character(len=20) :: name='ld_csc_srch_upd' @@ -3911,138 +3831,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_ld_csc_srch_upd diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 8edbf43c..5ddec8b2 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -2490,7 +2490,7 @@ subroutine psb_d_csr_triu(a,u,info,& end subroutine psb_d_csr_triu -subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csput_a @@ -2500,8 +2500,6 @@ subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act character(len=20) :: name='d_csr_csput_a' @@ -2547,7 +2545,7 @@ subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_d_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2579,7 +2577,7 @@ subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_d_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2592,9 +2590,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng + & i1,i2,nr,nc,nnz,dupl integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='d_csr_srch_upd' @@ -2615,136 +2612,62 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then + if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_d_csr_srch_upd @@ -4661,7 +4584,7 @@ subroutine psb_ld_csr_triu(a,u,info,& end subroutine psb_ld_csr_triu -subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_csput_a @@ -4671,7 +4594,6 @@ subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -4719,7 +4641,7 @@ subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_ld_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -4751,7 +4673,7 @@ subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_ld_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -4764,9 +4686,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,ng + & i1,i2,nr,nc,nnz integer(psb_ipk_) :: debug_level, debug_unit,dupl, inc character(len=20) :: name='ld_csr_srch_upd' @@ -4787,138 +4708,63 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ir > 0).and.(ir <= nr)) then + + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ir > 0).and.(ir <= nr)) then - - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_ld_csr_srch_upd diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index a2f960ad..313930b8 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -661,7 +661,7 @@ end subroutine psb_d_trim -subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_d_mat_mod, psb_protect_name => psb_d_csput_a use psb_d_base_mat_mod use psb_error_mod @@ -670,7 +670,6 @@ subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -685,7 +684,7 @@ subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -698,7 +697,7 @@ subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_d_csput_a -subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_d_mat_mod, psb_protect_name => psb_d_csput_v use psb_d_base_mat_mod use psb_d_vect_mod, only : psb_d_vect_type @@ -710,7 +709,6 @@ subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -725,7 +723,7 @@ subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -3190,7 +3188,7 @@ end subroutine psb_ld_trim -subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_d_mat_mod, psb_protect_name => psb_ld_csput_a use psb_d_base_mat_mod use psb_error_mod @@ -3199,7 +3197,6 @@ subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -3214,7 +3211,7 @@ subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -3227,7 +3224,7 @@ subroutine psb_ld_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_ld_csput_a -subroutine psb_ld_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ld_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_d_mat_mod, psb_protect_name => psb_ld_csput_v use psb_d_base_mat_mod use psb_d_vect_mod, only : psb_d_vect_type @@ -3239,7 +3236,6 @@ subroutine psb_ld_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -3254,7 +3250,7 @@ subroutine psb_ld_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index 48733b74..1505ba40 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -326,7 +326,7 @@ subroutine psb_s_base_clean_zeros(a, info) end subroutine psb_s_base_clean_zeros -subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_s_base_mat_mod, psb_protect_name => psb_s_base_csput_a implicit none @@ -334,7 +334,6 @@ subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -351,7 +350,7 @@ subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_s_base_csput_a -subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_s_base_mat_mod, psb_protect_name => psb_s_base_csput_v use psb_s_base_vect_mod @@ -361,7 +360,6 @@ subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csput_v' @@ -377,7 +375,7 @@ subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -2625,7 +2623,7 @@ subroutine psb_ls_base_clean_zeros(a, info) end subroutine psb_ls_base_clean_zeros -subroutine psb_ls_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_csput_a implicit none @@ -2633,7 +2631,6 @@ subroutine psb_ls_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -2650,7 +2647,7 @@ subroutine psb_ls_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_ls_base_csput_a -subroutine psb_ls_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_csput_v use psb_s_base_vect_mod @@ -2660,7 +2657,6 @@ subroutine psb_ls_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: nzin, nzout integer(psb_ipk_) :: err_act @@ -2677,7 +2673,7 @@ subroutine psb_ls_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 849cc744..1e6f9365 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -2515,7 +2515,7 @@ contains end subroutine psb_s_coo_csgetrow -subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -2526,7 +2526,6 @@ subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -2579,7 +2578,7 @@ subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -2589,7 +2588,7 @@ subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call s_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2619,7 +2618,7 @@ subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -2628,46 +2627,25 @@ contains real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: i,ir,ic,ng + integer(psb_ipk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine s_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2679,9 +2657,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nc,nnz,dupl,ng, nr + & i1,i2,nc,nnz,dupl,nr integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='s_coo_srch_upd' @@ -2703,188 +2680,88 @@ contains nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine s_coo_srch_upd @@ -5521,7 +5398,7 @@ contains end subroutine psb_ls_coo_csgetrow -subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -5532,7 +5409,6 @@ subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -5586,7 +5462,7 @@ subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -5596,7 +5472,7 @@ subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call ls_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -5626,7 +5502,7 @@ subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -5635,46 +5511,25 @@ contains real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) - integer(psb_lpk_) :: i,ir,ic,ng + integer(psb_lpk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine ls_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -5686,9 +5541,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nnz,dupl,ng, nr + & i1,i2,nnz,dupl, nr integer(psb_ipk_) :: debug_level, debug_unit, innz, nc character(len=20) :: name='ls_coo_srch_upd' @@ -5709,188 +5563,88 @@ contains nr = a%get_nrows() innz = nnz - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine ls_coo_srch_upd diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index 5f313792..ecfa986d 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -1880,7 +1880,7 @@ end subroutine psb_s_csc_csgetrow -subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csput_a @@ -1890,8 +1890,6 @@ subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -1941,7 +1939,7 @@ subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_s_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -1973,7 +1971,7 @@ subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_s_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -1986,9 +1984,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='s_csc_srch_upd' @@ -2009,138 +2006,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_s_csc_srch_upd @@ -3783,7 +3705,7 @@ end subroutine psb_ls_csc_csgetrow -subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_csput_a @@ -3793,7 +3715,6 @@ subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, debug_level, debug_unit, ierr(5) @@ -3843,7 +3764,7 @@ subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_ls_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -3875,7 +3796,7 @@ subroutine psb_ls_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_ls_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -3888,9 +3809,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit, inr character(len=20) :: name='ls_csc_srch_upd' @@ -3911,138 +3831,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_ls_csc_srch_upd diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 8ed54ae9..a01336ed 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -2490,7 +2490,7 @@ subroutine psb_s_csr_triu(a,u,info,& end subroutine psb_s_csr_triu -subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_csput_a @@ -2500,8 +2500,6 @@ subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act character(len=20) :: name='s_csr_csput_a' @@ -2547,7 +2545,7 @@ subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_s_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2579,7 +2577,7 @@ subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_s_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2592,9 +2590,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng + & i1,i2,nr,nc,nnz,dupl integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='s_csr_srch_upd' @@ -2615,136 +2612,62 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then + if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_s_csr_srch_upd @@ -4661,7 +4584,7 @@ subroutine psb_ls_csr_triu(a,u,info,& end subroutine psb_ls_csr_triu -subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_csput_a @@ -4671,7 +4594,6 @@ subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -4719,7 +4641,7 @@ subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_ls_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -4751,7 +4673,7 @@ subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_ls_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -4764,9 +4686,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,ng + & i1,i2,nr,nc,nnz integer(psb_ipk_) :: debug_level, debug_unit,dupl, inc character(len=20) :: name='ls_csr_srch_upd' @@ -4787,138 +4708,63 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ir > 0).and.(ir <= nr)) then + + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ir > 0).and.(ir <= nr)) then - - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_ls_csr_srch_upd diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 64e8bbc4..aa08d787 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -661,7 +661,7 @@ end subroutine psb_s_trim -subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_s_mat_mod, psb_protect_name => psb_s_csput_a use psb_s_base_mat_mod use psb_error_mod @@ -670,7 +670,6 @@ subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -685,7 +684,7 @@ subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -698,7 +697,7 @@ subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_s_csput_a -subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_s_mat_mod, psb_protect_name => psb_s_csput_v use psb_s_base_mat_mod use psb_s_vect_mod, only : psb_s_vect_type @@ -710,7 +709,6 @@ subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -725,7 +723,7 @@ subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -3190,7 +3188,7 @@ end subroutine psb_ls_trim -subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_s_mat_mod, psb_protect_name => psb_ls_csput_a use psb_s_base_mat_mod use psb_error_mod @@ -3199,7 +3197,6 @@ subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) real(psb_spk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -3214,7 +3211,7 @@ subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -3227,7 +3224,7 @@ subroutine psb_ls_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_ls_csput_a -subroutine psb_ls_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_ls_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_s_mat_mod, psb_protect_name => psb_ls_csput_v use psb_s_base_mat_mod use psb_s_vect_mod, only : psb_s_vect_type @@ -3239,7 +3236,6 @@ subroutine psb_ls_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -3254,7 +3250,7 @@ subroutine psb_ls_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index ed77f84c..7bca2c7c 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -326,7 +326,7 @@ subroutine psb_z_base_clean_zeros(a, info) end subroutine psb_z_base_clean_zeros -subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_z_base_mat_mod, psb_protect_name => psb_z_base_csput_a implicit none @@ -334,7 +334,6 @@ subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -351,7 +350,7 @@ subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_z_base_csput_a -subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_z_base_mat_mod, psb_protect_name => psb_z_base_csput_v use psb_z_base_vect_mod @@ -361,7 +360,6 @@ subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_i_base_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, nzin, nzout character(len=20) :: name='csput_v' @@ -377,7 +375,7 @@ subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -2625,7 +2623,7 @@ subroutine psb_lz_base_clean_zeros(a, info) end subroutine psb_lz_base_clean_zeros -subroutine psb_lz_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_csput_a implicit none @@ -2633,7 +2631,6 @@ subroutine psb_lz_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput' @@ -2650,7 +2647,7 @@ subroutine psb_lz_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_lz_base_csput_a -subroutine psb_lz_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_csput_v use psb_z_base_vect_mod @@ -2660,7 +2657,6 @@ subroutine psb_lz_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) class(psb_l_base_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: nzin, nzout integer(psb_ipk_) :: err_act @@ -2677,7 +2673,7 @@ subroutine psb_lz_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (val%is_dev()) call val%sync() if (ia%is_dev()) call ia%sync() if (ja%is_dev()) call ja%sync() - call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%csput_a(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index db42931c..30b7f116 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -2515,7 +2515,7 @@ contains end subroutine psb_z_coo_csgetrow -subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -2526,7 +2526,6 @@ subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -2579,7 +2578,7 @@ subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -2589,7 +2588,7 @@ subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call z_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2619,7 +2618,7 @@ subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -2628,46 +2627,25 @@ contains complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: i,ir,ic,ng + integer(psb_ipk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine z_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2679,9 +2657,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nc,nnz,dupl,ng, nr + & i1,i2,nc,nnz,dupl,nr integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='z_coo_srch_upd' @@ -2703,188 +2680,88 @@ contains nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,nnz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,nnz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine z_coo_srch_upd @@ -5521,7 +5398,7 @@ contains end subroutine psb_lz_coo_csgetrow -subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_sort_mod @@ -5532,7 +5409,6 @@ subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -5586,7 +5462,7 @@ subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end if call psb_inner_ins(nz,ia,ja,val,nza,a%ia,a%ja,a%val,isza,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) call a%set_nzeros(nza) call a%set_sorted(.false.) @@ -5596,7 +5472,7 @@ subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_dev()) call a%sync() call lz_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -5626,7 +5502,7 @@ subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) implicit none integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax,maxsz @@ -5635,46 +5511,25 @@ contains complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(inout) :: aspk(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) - integer(psb_lpk_) :: i,ir,ic,ng + integer(psb_lpk_) :: i,ir,ic info = psb_success_ - if (present(gtl)) then - ng = size(gtl) - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end if - end do - else - - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then - nza = nza + 1 - ia1(nza) = ir - ia2(nza) = ic - aspk(nza) = val(i) - end if - end do - end if + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir >=imin).and.(ir<=imax).and.(ic>=jmin).and.(ic<=jmax)) then + nza = nza + 1 + ia1(nza) = ir + ia2(nza) = ic + aspk(nza) = val(i) + end if + end do end subroutine psb_inner_ins subroutine lz_coo_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -5686,9 +5541,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nnz,dupl,ng, nr + & i1,i2,nnz,dupl, nr integer(psb_ipk_) :: debug_level, debug_unit, innz, nc character(len=20) :: name='lz_coo_srch_upd' @@ -5709,188 +5563,88 @@ contains nr = a%get_nrows() innz = nnz - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - if ((ir > 0).and.(ir <= nr)) then - ic = gtl(ic) - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - endif + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,1) + i1 = 1 + i2 = 1 end if - end do - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - else + case(psb_dupl_add_) + ! Add + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + if (ir /= ilr) then + i1 = psb_bsrch(ir,innz,a%ia) + i2 = i1 + do + if (i2+1 > nnz) exit + if (a%ia(i2+1) /= a%ia(i2)) exit + i2 = i2 + 1 + end do + do + if (i1-1 < 1) exit + if (a%ia(i1-1) /= a%ia(i1)) exit + i1 = i1 - 1 + end do + ilr = ir else - info = max(info,2) + i1 = 1 + i2 = 1 end if - end do - - case(psb_dupl_add_) - ! Add - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - - if (ir /= ilr) then - i1 = psb_bsrch(ir,innz,a%ia) - i2 = i1 - do - if (i2+1 > nnz) exit - if (a%ia(i2+1) /= a%ia(i2)) exit - i2 = i2 + 1 - end do - do - if (i1-1 < 1) exit - if (a%ia(i1-1) /= a%ia(i1)) exit - i1 = i1 - 1 - end do - ilr = ir - else - i1 = 1 - i2 = 1 - end if - nc = i2-i1+1 - ip = psb_ssrch(ic,nc,a%ja(i1:i2)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + nc = i2-i1+1 + ip = psb_ssrch(ic,nc,a%ja(i1:i2)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine lz_coo_srch_upd diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 29c3e392..f3e604c1 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -1880,7 +1880,7 @@ end subroutine psb_z_csc_csgetrow -subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csput_a @@ -1890,8 +1890,6 @@ subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act integer(psb_ipk_) :: ierr(5) @@ -1941,7 +1939,7 @@ subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_z_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -1973,7 +1971,7 @@ subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_z_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -1986,9 +1984,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='z_csc_srch_upd' @@ -2009,138 +2006,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr=i2-i1 - - ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr=i2-i1 + + ip = psb_bsrch(ir,nr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_z_csc_srch_upd @@ -3783,7 +3705,7 @@ end subroutine psb_lz_csc_csgetrow -subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_csput_a @@ -3793,7 +3715,6 @@ subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act, debug_level, debug_unit, ierr(5) @@ -3843,7 +3764,7 @@ subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_lz_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -3875,7 +3796,7 @@ subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_lz_csc_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -3888,9 +3809,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng, nar, nac + & i1,i2,nr,nc,nnz,dupl,nar, nac integer(psb_ipk_) :: debug_level, debug_unit, inr character(len=20) :: name='lz_csc_srch_upd' @@ -3911,138 +3831,63 @@ contains nar = a%get_nrows() nac = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) + info = max(info,3) end if + else + info = max(info,2) + end if - end do + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ic > 0).and.(ic <= nac)) then - i1 = a%icp(ic) - i2 = a%icp(ic+1) - nr = i2-i1 - inr = nr - ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ic > 0).and.(ic <= nac)) then + i1 = a%icp(ic) + i2 = a%icp(ic+1) + nr = i2-i1 + inr = nr + ip = psb_bsrch(ir,inr,a%ia(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_lz_csc_srch_upd diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 808a407a..0cf34879 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -2490,7 +2490,7 @@ subroutine psb_z_csr_triu(a,u,info,& end subroutine psb_z_csr_triu -subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_csput_a @@ -2500,8 +2500,6 @@ subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) - integer(psb_ipk_) :: err_act character(len=20) :: name='z_csr_csput_a' @@ -2547,7 +2545,7 @@ subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_z_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -2579,7 +2577,7 @@ subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_z_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -2592,9 +2590,8 @@ contains integer(psb_ipk_), intent(in) :: ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,dupl,ng + & i1,i2,nr,nc,nnz,dupl integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name='z_csr_srch_upd' @@ -2615,136 +2612,62 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then + if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,2) + info = max(info,3) end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + ip = psb_bsrch(ic,nc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_z_csr_srch_upd @@ -4661,7 +4584,7 @@ subroutine psb_lz_csr_triu(a,u,info,& end subroutine psb_lz_csr_triu -subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_error_mod use psb_realloc_mod use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_csput_a @@ -4671,7 +4594,6 @@ subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act @@ -4719,7 +4641,7 @@ subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) else if (a%is_upd()) then call psb_lz_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) if (info < 0) then info = psb_err_internal_error_ @@ -4751,7 +4673,7 @@ subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) contains subroutine psb_lz_csr_srch_upd(nz,ia,ja,val,a,& - & imin,imax,jmin,jmax,info,gtl) + & imin,imax,jmin,jmax,info) use psb_const_mod use psb_realloc_mod @@ -4764,9 +4686,8 @@ contains integer(psb_lpk_), intent(in) :: ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_) :: i,ir,ic, ilr, ilc, ip, & - & i1,i2,nr,nc,nnz,ng + & i1,i2,nr,nc,nnz integer(psb_ipk_) :: debug_level, debug_unit,dupl, inc character(len=20) :: name='lz_csr_srch_upd' @@ -4787,138 +4708,63 @@ contains nr = a%get_nrows() nc = a%get_ncols() - if (present(gtl)) then - ng = size(gtl) - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - else - info = max(info,1) - end if - end do - - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then - ir = gtl(ir) - ic = gtl(ic) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if + select case(dupl) + case(psb_dupl_ovwrt_,psb_dupl_err_) + ! Overwrite. + ! Cannot test for error, should have been caught earlier. + + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + + if ((ir > 0).and.(ir <= nr)) then + + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc=i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = val(i) else - info = max(info,1) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select - - else - - select case(dupl) - case(psb_dupl_ovwrt_,psb_dupl_err_) - ! Overwrite. - ! Cannot test for error, should have been caught earlier. - - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - - if ((ir > 0).and.(ir <= nr)) then - - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc=i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = val(i) - else - info = max(info,3) - end if - else - info = max(info,2) - end if - end do + else + info = max(info,2) + end if + end do - case(psb_dupl_add_) - ! Add - ilr = -1 - ilc = -1 - do i=1, nz - ir = ia(i) - ic = ja(i) - if ((ir > 0).and.(ir <= nr)) then - i1 = a%irp(ir) - i2 = a%irp(ir+1) - nc = i2-i1 - inc = nc - ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) - if (ip>0) then - a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) - else - info = max(info,3) - end if + case(psb_dupl_add_) + ! Add + ilr = -1 + ilc = -1 + do i=1, nz + ir = ia(i) + ic = ja(i) + if ((ir > 0).and.(ir <= nr)) then + i1 = a%irp(ir) + i2 = a%irp(ir+1) + nc = i2-i1 + inc = nc + ip = psb_bsrch(ic,inc,a%ja(i1:i2-1)) + if (ip>0) then + a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = max(info,2) + info = max(info,3) end if - end do - - case default - info = -3 - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Duplicate handling: ',dupl - end select + else + info = max(info,2) + end if + end do - end if + case default + info = -3 + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Duplicate handling: ',dupl + end select end subroutine psb_lz_csr_srch_upd diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 9a80c2ef..0e24e924 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -661,7 +661,7 @@ end subroutine psb_z_trim -subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_z_mat_mod, psb_protect_name => psb_z_csput_a use psb_z_base_mat_mod use psb_error_mod @@ -670,7 +670,6 @@ subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -685,7 +684,7 @@ subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -698,7 +697,7 @@ subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_z_csput_a -subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_z_mat_mod, psb_protect_name => psb_z_csput_v use psb_z_base_mat_mod use psb_z_vect_mod, only : psb_z_vect_type @@ -710,7 +709,6 @@ subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_i_vect_type), intent(inout) :: ia, ja integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -725,7 +723,7 @@ subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif @@ -3190,7 +3188,7 @@ end subroutine psb_lz_trim -subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_z_mat_mod, psb_protect_name => psb_lz_csput_a use psb_z_base_mat_mod use psb_error_mod @@ -3199,7 +3197,6 @@ subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) complex(psb_dpk_), intent(in) :: val(:) integer(psb_lpk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_a' @@ -3214,7 +3211,7 @@ subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif - call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia,ja,val,imin,imax,jmin,jmax,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -3227,7 +3224,7 @@ subroutine psb_lz_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) end subroutine psb_lz_csput_a -subroutine psb_lz_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) +subroutine psb_lz_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) use psb_z_mat_mod, psb_protect_name => psb_lz_csput_v use psb_z_base_mat_mod use psb_z_vect_mod, only : psb_z_vect_type @@ -3239,7 +3236,6 @@ subroutine psb_lz_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) type(psb_l_vect_type), intent(inout) :: ia, ja integer(psb_lpk_), intent(in) :: nz, imin,imax,jmin,jmax integer(psb_ipk_), intent(out) :: info - integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_ipk_) :: err_act character(len=20) :: name='csput_v' @@ -3254,7 +3250,7 @@ subroutine psb_lz_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) endif if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then - call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl) + call a%a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info) else info = psb_err_invalid_mat_state_ endif