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

Merge branch 'MixedI8' into ILmat

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent b8cba23663 27d74bc6cc
commit 47bac37ed7
68 changed files with 702 additions and 1174 deletions
Show Stats Download Patch File Download Diff File

12
base/modules/serial/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -511,7 +511,7 @@ module psb_c_base_mat_mod
!
interface
subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_c_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -522,7 +522,7 @@ module psb_c_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_base_csgetrow
end interface
@ -550,7 +550,7 @@ module psb_c_base_mat_mod
!
interface
subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
@ -559,7 +559,7 @@ module psb_c_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_base_csgetblk
end interface
@ -1910,7 +1910,7 @@ module psb_c_base_mat_mod
!! \see psb_c_base_mat_mod::psb_c_base_csgetrow
interface
subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -1921,7 +1921,7 @@ module psb_c_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_coo_csgetrow
end interface

11
base/modules/serial/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -738,19 +738,24 @@ contains
!! \brief Extract a copy of the contents
!!
!
function c_base_get_vect(x) result(res)
function c_base_get_vect(x,n) result(res)
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
! Local variables
integer(psb_ipk_) :: isz
if (.not.allocated(x%v)) return
if (.not.x%is_host()) call x%sync()
allocate(res(x%get_nrows()),stat=info)
isz = x%get_nrows()
if (present(n)) isz = max(0,min(isz,n))
allocate(res(isz),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
res(1:isz) = x%v(1:isz)
end function c_base_get_vect
!

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

@ -368,8 +368,8 @@ module psb_c_csc_mat_mod
!! \see psb_c_base_mat_mod::psb_c_base_csgetrow
interface
subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import :: psb_ipk_, psb_c_csc_sparse_mat, psb_spk_
class(psb_c_csc_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
@ -379,7 +379,7 @@ module psb_c_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_csc_csgetrow
end interface
@ -387,7 +387,7 @@ module psb_c_csc_mat_mod
!! \see psb_c_base_mat_mod::psb_c_base_csgetblk
interface
subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_c_csc_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
@ -396,7 +396,7 @@ module psb_c_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_csc_csgetblk
end interface

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

@ -405,7 +405,7 @@ module psb_c_csr_mat_mod
!! \see psb_c_base_mat_mod::psb_c_base_csgetrow
interface
subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_c_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -416,27 +416,10 @@ module psb_c_csr_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_csr_csgetrow
end interface
!> \memberof psb_c_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_csgetblk
interface
subroutine psb_c_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_c_csr_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_csr_csgetblk
end interface
!> \memberof psb_c_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_cssv
interface
@ -954,23 +937,6 @@ module psb_c_csr_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csr_csgetrow
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csgetblk
interface
subroutine psb_lc_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csr_csgetblk
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_get_diag

5
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -250,13 +250,14 @@ contains
end subroutine c_vect_bld_en
function c_vect_get_vect(x) result(res)
function c_vect_get_vect(x,n) result(res)
class(psb_c_vect_type), intent(inout) :: x
complex(psb_spk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
if (allocated(x%v)) then
res = x%v%get_vect()
res = x%v%get_vect(n)
end if
end function c_vect_get_vect

12
base/modules/serial/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -511,7 +511,7 @@ module psb_d_base_mat_mod
!
interface
subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_d_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -522,7 +522,7 @@ module psb_d_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_d_base_csgetrow
end interface
@ -550,7 +550,7 @@ module psb_d_base_mat_mod
!
interface
subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -559,7 +559,7 @@ module psb_d_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_d_base_csgetblk
end interface
@ -1910,7 +1910,7 @@ module psb_d_base_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_csgetrow
interface
subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -1921,7 +1921,7 @@ module psb_d_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_d_coo_csgetrow
end interface

11
base/modules/serial/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -738,19 +738,24 @@ contains
!! \brief Extract a copy of the contents
!!
!
function d_base_get_vect(x) result(res)
function d_base_get_vect(x,n) result(res)
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
! Local variables
integer(psb_ipk_) :: isz
if (.not.allocated(x%v)) return
if (.not.x%is_host()) call x%sync()
allocate(res(x%get_nrows()),stat=info)
isz = x%get_nrows()
if (present(n)) isz = max(0,min(isz,n))
allocate(res(isz),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
res(1:isz) = x%v(1:isz)
end function d_base_get_vect
!

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

@ -368,8 +368,8 @@ module psb_d_csc_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_csgetrow
interface
subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
@ -379,7 +379,7 @@ module psb_d_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_d_csc_csgetrow
end interface
@ -387,7 +387,7 @@ module psb_d_csc_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_csgetblk
interface
subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_d_csc_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -396,7 +396,7 @@ module psb_d_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_d_csc_csgetblk
end interface

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

@ -405,7 +405,7 @@ module psb_d_csr_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_csgetrow
interface
subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_d_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -416,27 +416,10 @@ module psb_d_csr_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_d_csr_csgetrow
end interface
!> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csgetblk
interface
subroutine psb_d_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_d_csr_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csr_csgetblk
end interface
!> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cssv
interface
@ -954,23 +937,6 @@ module psb_d_csr_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csr_csgetrow
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetblk
interface
subroutine psb_ld_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csr_csgetblk
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_get_diag

5
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -250,13 +250,14 @@ contains
end subroutine d_vect_bld_en
function d_vect_get_vect(x) result(res)
function d_vect_get_vect(x,n) result(res)
class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
if (allocated(x%v)) then
res = x%v%get_vect()
res = x%v%get_vect(n)
end if
end function d_vect_get_vect

11
base/modules/serial/psb_i_base_vect_mod.f90
Unescape Escape View File

@ -706,19 +706,24 @@ contains
!! \brief Extract a copy of the contents
!!
!
function i_base_get_vect(x) result(res)
function i_base_get_vect(x,n) result(res)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
! Local variables
integer(psb_ipk_) :: isz
if (.not.allocated(x%v)) return
if (.not.x%is_host()) call x%sync()
allocate(res(x%get_nrows()),stat=info)
isz = x%get_nrows()
if (present(n)) isz = max(0,min(isz,n))
allocate(res(isz),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
res(1:isz) = x%v(1:isz)
end function i_base_get_vect
!

5
base/modules/serial/psb_i_vect_mod.F90
Unescape Escape View File

@ -223,13 +223,14 @@ contains
end subroutine i_vect_bld_en
function i_vect_get_vect(x) result(res)
function i_vect_get_vect(x,n) result(res)
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
if (allocated(x%v)) then
res = x%v%get_vect()
res = x%v%get_vect(n)
end if
end function i_vect_get_vect

11
base/modules/serial/psb_l_base_vect_mod.f90
Unescape Escape View File

@ -707,19 +707,24 @@ contains
!! \brief Extract a copy of the contents
!!
!
function l_base_get_vect(x) result(res)
function l_base_get_vect(x,n) result(res)
class(psb_l_base_vect_type), intent(inout) :: x
integer(psb_lpk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
! Local variables
integer(psb_ipk_) :: isz
if (.not.allocated(x%v)) return
if (.not.x%is_host()) call x%sync()
allocate(res(x%get_nrows()),stat=info)
isz = x%get_nrows()
if (present(n)) isz = max(0,min(isz,n))
allocate(res(isz),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
res(1:isz) = x%v(1:isz)
end function l_base_get_vect
!

5
base/modules/serial/psb_l_vect_mod.F90
Unescape Escape View File

@ -224,13 +224,14 @@ contains
end subroutine l_vect_bld_en
function l_vect_get_vect(x) result(res)
function l_vect_get_vect(x,n) result(res)
class(psb_l_vect_type), intent(inout) :: x
integer(psb_lpk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
if (allocated(x%v)) then
res = x%v%get_vect()
res = x%v%get_vect(n)
end if
end function l_vect_get_vect

12
base/modules/serial/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -511,7 +511,7 @@ module psb_s_base_mat_mod
!
interface
subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_s_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -522,7 +522,7 @@ module psb_s_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_s_base_csgetrow
end interface
@ -550,7 +550,7 @@ module psb_s_base_mat_mod
!
interface
subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
@ -559,7 +559,7 @@ module psb_s_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_s_base_csgetblk
end interface
@ -1910,7 +1910,7 @@ module psb_s_base_mat_mod
!! \see psb_s_base_mat_mod::psb_s_base_csgetrow
interface
subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -1921,7 +1921,7 @@ module psb_s_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_s_coo_csgetrow
end interface

11
base/modules/serial/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -738,19 +738,24 @@ contains
!! \brief Extract a copy of the contents
!!
!
function s_base_get_vect(x) result(res)
function s_base_get_vect(x,n) result(res)
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
! Local variables
integer(psb_ipk_) :: isz
if (.not.allocated(x%v)) return
if (.not.x%is_host()) call x%sync()
allocate(res(x%get_nrows()),stat=info)
isz = x%get_nrows()
if (present(n)) isz = max(0,min(isz,n))
allocate(res(isz),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
res(1:isz) = x%v(1:isz)
end function s_base_get_vect
!

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

@ -368,8 +368,8 @@ module psb_s_csc_mat_mod
!! \see psb_s_base_mat_mod::psb_s_base_csgetrow
interface
subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import :: psb_ipk_, psb_s_csc_sparse_mat, psb_spk_
class(psb_s_csc_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
@ -379,7 +379,7 @@ module psb_s_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_s_csc_csgetrow
end interface
@ -387,7 +387,7 @@ module psb_s_csc_mat_mod
!! \see psb_s_base_mat_mod::psb_s_base_csgetblk
interface
subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_s_csc_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
@ -396,7 +396,7 @@ module psb_s_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_s_csc_csgetblk
end interface

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

@ -405,7 +405,7 @@ module psb_s_csr_mat_mod
!! \see psb_s_base_mat_mod::psb_s_base_csgetrow
interface
subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_s_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -416,27 +416,10 @@ module psb_s_csr_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_s_csr_csgetrow
end interface
!> \memberof psb_s_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_csgetblk
interface
subroutine psb_s_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_s_csr_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csr_csgetblk
end interface
!> \memberof psb_s_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_cssv
interface
@ -954,23 +937,6 @@ module psb_s_csr_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csr_csgetrow
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csgetblk
interface
subroutine psb_ls_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csr_csgetblk
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_get_diag

5
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -250,13 +250,14 @@ contains
end subroutine s_vect_bld_en
function s_vect_get_vect(x) result(res)
function s_vect_get_vect(x,n) result(res)
class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
if (allocated(x%v)) then
res = x%v%get_vect()
res = x%v%get_vect(n)
end if
end function s_vect_get_vect

12
base/modules/serial/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -511,7 +511,7 @@ module psb_z_base_mat_mod
!
interface
subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_z_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -522,7 +522,7 @@ module psb_z_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_z_base_csgetrow
end interface
@ -550,7 +550,7 @@ module psb_z_base_mat_mod
!
interface
subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
@ -559,7 +559,7 @@ module psb_z_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_z_base_csgetblk
end interface
@ -1910,7 +1910,7 @@ module psb_z_base_mat_mod
!! \see psb_z_base_mat_mod::psb_z_base_csgetrow
interface
subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -1921,7 +1921,7 @@ module psb_z_base_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_z_coo_csgetrow
end interface

11
base/modules/serial/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -738,19 +738,24 @@ contains
!! \brief Extract a copy of the contents
!!
!
function z_base_get_vect(x) result(res)
function z_base_get_vect(x,n) result(res)
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
! Local variables
integer(psb_ipk_) :: isz
if (.not.allocated(x%v)) return
if (.not.x%is_host()) call x%sync()
allocate(res(x%get_nrows()),stat=info)
isz = x%get_nrows()
if (present(n)) isz = max(0,min(isz,n))
allocate(res(isz),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
res(1:isz) = x%v(1:isz)
end function z_base_get_vect
!

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

@ -368,8 +368,8 @@ module psb_z_csc_mat_mod
!! \see psb_z_base_mat_mod::psb_z_base_csgetrow
interface
subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import :: psb_ipk_, psb_z_csc_sparse_mat, psb_dpk_
class(psb_z_csc_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
@ -379,7 +379,7 @@ module psb_z_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_z_csc_csgetrow
end interface
@ -387,7 +387,7 @@ module psb_z_csc_mat_mod
!! \see psb_z_base_mat_mod::psb_z_base_csgetblk
interface
subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
import
class(psb_z_csc_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
@ -396,7 +396,7 @@ module psb_z_csc_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_z_csc_csgetblk
end interface

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

@ -405,7 +405,7 @@ module psb_z_csr_mat_mod
!! \see psb_z_base_mat_mod::psb_z_base_csgetrow
interface
subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import
class(psb_z_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
@ -416,27 +416,10 @@ module psb_z_csr_mat_mod
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_z_csr_csgetrow
end interface
!> \memberof psb_z_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_csgetblk
interface
subroutine psb_z_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_z_csr_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_csr_csgetblk
end interface
!> \memberof psb_z_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_cssv
interface
@ -954,23 +937,6 @@ module psb_z_csr_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csr_csgetrow
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csgetblk
interface
subroutine psb_lz_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csr_csgetblk
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_get_diag

5
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -250,13 +250,14 @@ contains
end subroutine z_vect_bld_en
function z_vect_get_vect(x) result(res)
function z_vect_get_vect(x,n) result(res)
class(psb_z_vect_type), intent(inout) :: x
complex(psb_dpk_), allocatable :: res(:)
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: n
if (allocated(x%v)) then
res = x%v%get_vect()
res = x%v%get_vect(n)
end if
end function z_vect_get_vect

12
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -396,7 +396,7 @@ subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
end subroutine psb_c_base_csput_v
subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -412,7 +412,7 @@ subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -428,15 +428,13 @@ subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
end subroutine psb_c_base_csgetrow
!
! Here we have the base implementation of getblk and clip:
! this is just based on the getrow.
! If performance is critical it can be overridden.
!
subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -450,7 +448,7 @@ subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
integer(psb_ipk_) :: jmin_, jmax_
@ -510,7 +508,7 @@ subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
& nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz)
if (info /= psb_success_) goto 9999

62
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -2223,7 +2223,7 @@ end subroutine psb_c_coo_csgetptn
! The output is guaranteed to be sorted
!
subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2240,9 +2240,9 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2284,13 +2284,18 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2315,7 +2320,7 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2331,7 +2336,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append,chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd
@ -2415,11 +2420,13 @@ contains
nzt = jp - ip +1
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
@ -2451,11 +2458,13 @@ contains
nrd = max(a%get_nrows(),1)
nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1)
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
k = 0
do i=1, a%get_nzeros()
@ -2464,10 +2473,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = iren(a%ia(i))
@ -2482,11 +2493,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = (a%ia(i))

112
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -1686,7 +1686,7 @@ end subroutine psb_c_csc_csgetptn
subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -1704,7 +1704,7 @@ subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
@ -2557,60 +2557,60 @@ end subroutine psb_c_csc_reallocate_nz
subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csgetblk
implicit none
class(psb_c_csc_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_csc_csgetblk
!!$subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,&
!!$ & jmin,jmax,iren,append,rscale,cscale)
!!$ ! Output is always in COO format
!!$ use psb_error_mod
!!$ use psb_const_mod
!!$ use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csgetblk
!!$ implicit none
!!$
!!$ class(psb_c_csc_sparse_mat), intent(in) :: a
!!$ class(psb_c_coo_sparse_mat), intent(inout) :: b
!!$ integer(psb_ipk_), intent(in) :: imin,imax
!!$ integer(psb_ipk_),intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer(psb_ipk_), intent(in), optional :: iren(:)
!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax
!!$ logical, intent(in), optional :: rscale,cscale
!!$ integer(psb_ipk_) :: err_act, nzin, nzout
!!$ integer(psb_ipk_) :: ierr(5)
!!$ character(len=20) :: name='csget'
!!$ logical :: append_
!!$ logical, parameter :: debug=.false.
!!$
!!$ call psb_erractionsave(err_act)
!!$ info = psb_success_
!!$
!!$ if (present(append)) then
!!$ append_ = append
!!$ else
!!$ append_ = .false.
!!$ endif
!!$ if (append_) then
!!$ nzin = a%get_nzeros()
!!$ else
!!$ nzin = 0
!!$ endif
!!$
!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, &
!!$ & nzin=nzin, rscale=rscale, cscale=cscale)
!!$
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call b%set_nzeros(nzin+nzout)
!!$ call b%fix(info)
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
!!$9999 call psb_error_handler(err_act)
!!$
!!$ return
!!$
!!$end subroutine psb_c_csc_csgetblk
subroutine psb_c_csc_reinit(a,clear)
use psb_error_mod

144
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -1993,7 +1993,7 @@ end subroutine psb_c_csr_csgetptn
subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2011,9 +2011,9 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2056,13 +2056,18 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2087,7 +2092,7 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2102,7 +2107,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append, chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd
@ -2135,11 +2140,13 @@ contains
nzt = (a%irp(lrw+1)-a%irp(irw))
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=irw, lrw
@ -2171,59 +2178,6 @@ contains
end subroutine psb_c_csr_csgetrow
subroutine psb_c_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_csgetblk
implicit none
class(psb_c_csr_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_csr_csgetblk
!
! CSR implementation of tril/triu
@ -2245,8 +2199,6 @@ subroutine psb_c_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -2401,8 +2353,6 @@ subroutine psb_c_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_
@ -4397,60 +4347,6 @@ contains
end subroutine psb_lc_csr_csgetrow
subroutine psb_lc_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_csgetblk
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_lpk_) :: nzin, nzout
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csr_csgetblk
!
! CSR implementation of tril/triu
@ -4473,8 +4369,6 @@ subroutine psb_lc_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -4630,8 +4524,6 @@ subroutine psb_lc_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_

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

@ -791,7 +791,7 @@ end subroutine psb_c_csgetptn
subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -808,7 +808,7 @@ subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
@ -824,7 +824,7 @@ subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
call a%a%csget(imin,imax,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

12
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -396,7 +396,7 @@ subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
end subroutine psb_d_base_csput_v
subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -412,7 +412,7 @@ subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -428,15 +428,13 @@ subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
end subroutine psb_d_base_csgetrow
!
! Here we have the base implementation of getblk and clip:
! this is just based on the getrow.
! If performance is critical it can be overridden.
!
subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -450,7 +448,7 @@ subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
integer(psb_ipk_) :: jmin_, jmax_
@ -510,7 +508,7 @@ subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
& nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz)
if (info /= psb_success_) goto 9999

62
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -2223,7 +2223,7 @@ end subroutine psb_d_coo_csgetptn
! The output is guaranteed to be sorted
!
subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2240,9 +2240,9 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2284,13 +2284,18 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2315,7 +2320,7 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2331,7 +2336,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append,chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd
@ -2415,11 +2420,13 @@ contains
nzt = jp - ip +1
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
@ -2451,11 +2458,13 @@ contains
nrd = max(a%get_nrows(),1)
nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1)
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
k = 0
do i=1, a%get_nzeros()
@ -2464,10 +2473,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = iren(a%ia(i))
@ -2482,11 +2493,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = (a%ia(i))

112
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -1686,7 +1686,7 @@ end subroutine psb_d_csc_csgetptn
subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -1704,7 +1704,7 @@ subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
@ -2557,60 +2557,60 @@ end subroutine psb_d_csc_reallocate_nz
subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csgetblk
implicit none
class(psb_d_csc_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_csc_csgetblk
!!$subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,&
!!$ & jmin,jmax,iren,append,rscale,cscale)
!!$ ! Output is always in COO format
!!$ use psb_error_mod
!!$ use psb_const_mod
!!$ use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csgetblk
!!$ implicit none
!!$
!!$ class(psb_d_csc_sparse_mat), intent(in) :: a
!!$ class(psb_d_coo_sparse_mat), intent(inout) :: b
!!$ integer(psb_ipk_), intent(in) :: imin,imax
!!$ integer(psb_ipk_),intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer(psb_ipk_), intent(in), optional :: iren(:)
!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax
!!$ logical, intent(in), optional :: rscale,cscale
!!$ integer(psb_ipk_) :: err_act, nzin, nzout
!!$ integer(psb_ipk_) :: ierr(5)
!!$ character(len=20) :: name='csget'
!!$ logical :: append_
!!$ logical, parameter :: debug=.false.
!!$
!!$ call psb_erractionsave(err_act)
!!$ info = psb_success_
!!$
!!$ if (present(append)) then
!!$ append_ = append
!!$ else
!!$ append_ = .false.
!!$ endif
!!$ if (append_) then
!!$ nzin = a%get_nzeros()
!!$ else
!!$ nzin = 0
!!$ endif
!!$
!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, &
!!$ & nzin=nzin, rscale=rscale, cscale=cscale)
!!$
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call b%set_nzeros(nzin+nzout)
!!$ call b%fix(info)
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
!!$9999 call psb_error_handler(err_act)
!!$
!!$ return
!!$
!!$end subroutine psb_d_csc_csgetblk
subroutine psb_d_csc_reinit(a,clear)
use psb_error_mod

144
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -1993,7 +1993,7 @@ end subroutine psb_d_csr_csgetptn
subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2011,9 +2011,9 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2056,13 +2056,18 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2087,7 +2092,7 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2102,7 +2107,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append, chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd
@ -2135,11 +2140,13 @@ contains
nzt = (a%irp(lrw+1)-a%irp(irw))
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=irw, lrw
@ -2171,59 +2178,6 @@ contains
end subroutine psb_d_csr_csgetrow
subroutine psb_d_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csgetblk
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_csr_csgetblk
!
! CSR implementation of tril/triu
@ -2245,8 +2199,6 @@ subroutine psb_d_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -2401,8 +2353,6 @@ subroutine psb_d_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_
@ -4397,60 +4347,6 @@ contains
end subroutine psb_ld_csr_csgetrow
subroutine psb_ld_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_csgetblk
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_lpk_) :: nzin, nzout
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csr_csgetblk
!
! CSR implementation of tril/triu
@ -4473,8 +4369,6 @@ subroutine psb_ld_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -4630,8 +4524,6 @@ subroutine psb_ld_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_

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

@ -791,7 +791,7 @@ end subroutine psb_d_csgetptn
subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -808,7 +808,7 @@ subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
@ -824,7 +824,7 @@ subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
call a%a%csget(imin,imax,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

12
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -396,7 +396,7 @@ subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
end subroutine psb_s_base_csput_v
subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -412,7 +412,7 @@ subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -428,15 +428,13 @@ subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
end subroutine psb_s_base_csgetrow
!
! Here we have the base implementation of getblk and clip:
! this is just based on the getrow.
! If performance is critical it can be overridden.
!
subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -450,7 +448,7 @@ subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
integer(psb_ipk_) :: jmin_, jmax_
@ -510,7 +508,7 @@ subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
& nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz)
if (info /= psb_success_) goto 9999

62
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -2223,7 +2223,7 @@ end subroutine psb_s_coo_csgetptn
! The output is guaranteed to be sorted
!
subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2240,9 +2240,9 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2284,13 +2284,18 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2315,7 +2320,7 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2331,7 +2336,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append,chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd
@ -2415,11 +2420,13 @@ contains
nzt = jp - ip +1
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
@ -2451,11 +2458,13 @@ contains
nrd = max(a%get_nrows(),1)
nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1)
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
k = 0
do i=1, a%get_nzeros()
@ -2464,10 +2473,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = iren(a%ia(i))
@ -2482,11 +2493,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = (a%ia(i))

112
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -1686,7 +1686,7 @@ end subroutine psb_s_csc_csgetptn
subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -1704,7 +1704,7 @@ subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
@ -2557,60 +2557,60 @@ end subroutine psb_s_csc_reallocate_nz
subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csgetblk
implicit none
class(psb_s_csc_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_csc_csgetblk
!!$subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,&
!!$ & jmin,jmax,iren,append,rscale,cscale)
!!$ ! Output is always in COO format
!!$ use psb_error_mod
!!$ use psb_const_mod
!!$ use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csgetblk
!!$ implicit none
!!$
!!$ class(psb_s_csc_sparse_mat), intent(in) :: a
!!$ class(psb_s_coo_sparse_mat), intent(inout) :: b
!!$ integer(psb_ipk_), intent(in) :: imin,imax
!!$ integer(psb_ipk_),intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer(psb_ipk_), intent(in), optional :: iren(:)
!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax
!!$ logical, intent(in), optional :: rscale,cscale
!!$ integer(psb_ipk_) :: err_act, nzin, nzout
!!$ integer(psb_ipk_) :: ierr(5)
!!$ character(len=20) :: name='csget'
!!$ logical :: append_
!!$ logical, parameter :: debug=.false.
!!$
!!$ call psb_erractionsave(err_act)
!!$ info = psb_success_
!!$
!!$ if (present(append)) then
!!$ append_ = append
!!$ else
!!$ append_ = .false.
!!$ endif
!!$ if (append_) then
!!$ nzin = a%get_nzeros()
!!$ else
!!$ nzin = 0
!!$ endif
!!$
!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, &
!!$ & nzin=nzin, rscale=rscale, cscale=cscale)
!!$
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call b%set_nzeros(nzin+nzout)
!!$ call b%fix(info)
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
!!$9999 call psb_error_handler(err_act)
!!$
!!$ return
!!$
!!$end subroutine psb_s_csc_csgetblk
subroutine psb_s_csc_reinit(a,clear)
use psb_error_mod

144
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -1993,7 +1993,7 @@ end subroutine psb_s_csr_csgetptn
subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2011,9 +2011,9 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2056,13 +2056,18 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2087,7 +2092,7 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2102,7 +2107,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append, chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd
@ -2135,11 +2140,13 @@ contains
nzt = (a%irp(lrw+1)-a%irp(irw))
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=irw, lrw
@ -2171,59 +2178,6 @@ contains
end subroutine psb_s_csr_csgetrow
subroutine psb_s_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_csgetblk
implicit none
class(psb_s_csr_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_csr_csgetblk
!
! CSR implementation of tril/triu
@ -2245,8 +2199,6 @@ subroutine psb_s_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -2401,8 +2353,6 @@ subroutine psb_s_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_
@ -4397,60 +4347,6 @@ contains
end subroutine psb_ls_csr_csgetrow
subroutine psb_ls_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_csgetblk
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_lpk_) :: nzin, nzout
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csr_csgetblk
!
! CSR implementation of tril/triu
@ -4473,8 +4369,6 @@ subroutine psb_ls_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -4630,8 +4524,6 @@ subroutine psb_ls_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_

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

@ -791,7 +791,7 @@ end subroutine psb_s_csgetptn
subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -808,7 +808,7 @@ subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
@ -824,7 +824,7 @@ subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
call a%a%csget(imin,imax,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

12
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -396,7 +396,7 @@ subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
end subroutine psb_z_base_csput_v
subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -412,7 +412,7 @@ subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -428,15 +428,13 @@ subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
end subroutine psb_z_base_csgetrow
!
! Here we have the base implementation of getblk and clip:
! this is just based on the getrow.
! If performance is critical it can be overridden.
!
subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -450,7 +448,7 @@ subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
integer(psb_ipk_) :: jmin_, jmax_
@ -510,7 +508,7 @@ subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
& nzin=nzin, rscale=rscale, cscale=cscale, chksz=chksz)
if (info /= psb_success_) goto 9999

62
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -2223,7 +2223,7 @@ end subroutine psb_z_coo_csgetptn
! The output is guaranteed to be sorted
!
subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2240,9 +2240,9 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2284,13 +2284,18 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call coo_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2315,7 +2320,7 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine coo_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2331,7 +2336,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append,chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,ip,jp,i,k, nzt, irw, lrw, nra, nca, nrd
@ -2415,11 +2420,13 @@ contains
nzt = jp - ip +1
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
@ -2451,11 +2458,13 @@ contains
nrd = max(a%get_nrows(),1)
nzt = ((nza+nrd-1)/nrd)*(lrw-irw+1)
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
k = 0
do i=1, a%get_nzeros()
@ -2464,10 +2473,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = iren(a%ia(i))
@ -2482,11 +2493,12 @@ contains
k = k + 1
if (k > nzt) then
nzt = k + nzt
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
end if
val(nzin_+k) = a%val(i)
ia(nzin_+k) = (a%ia(i))

112
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -1686,7 +1686,7 @@ end subroutine psb_z_csc_csgetptn
subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -1704,7 +1704,7 @@ subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
@ -2557,60 +2557,60 @@ end subroutine psb_z_csc_reallocate_nz
subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csgetblk
implicit none
class(psb_z_csc_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_csc_csgetblk
!!$subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,&
!!$ & jmin,jmax,iren,append,rscale,cscale)
!!$ ! Output is always in COO format
!!$ use psb_error_mod
!!$ use psb_const_mod
!!$ use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csgetblk
!!$ implicit none
!!$
!!$ class(psb_z_csc_sparse_mat), intent(in) :: a
!!$ class(psb_z_coo_sparse_mat), intent(inout) :: b
!!$ integer(psb_ipk_), intent(in) :: imin,imax
!!$ integer(psb_ipk_),intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer(psb_ipk_), intent(in), optional :: iren(:)
!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax
!!$ logical, intent(in), optional :: rscale,cscale
!!$ integer(psb_ipk_) :: err_act, nzin, nzout
!!$ integer(psb_ipk_) :: ierr(5)
!!$ character(len=20) :: name='csget'
!!$ logical :: append_
!!$ logical, parameter :: debug=.false.
!!$
!!$ call psb_erractionsave(err_act)
!!$ info = psb_success_
!!$
!!$ if (present(append)) then
!!$ append_ = append
!!$ else
!!$ append_ = .false.
!!$ endif
!!$ if (append_) then
!!$ nzin = a%get_nzeros()
!!$ else
!!$ nzin = 0
!!$ endif
!!$
!!$ call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
!!$ & jmin=jmin, jmax=jmax, iren=iren, append=append_, &
!!$ & nzin=nzin, rscale=rscale, cscale=cscale)
!!$
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call b%set_nzeros(nzin+nzout)
!!$ call b%fix(info)
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
!!$9999 call psb_error_handler(err_act)
!!$
!!$ return
!!$
!!$end subroutine psb_z_csc_csgetblk
subroutine psb_z_csc_reinit(a,clear)
use psb_error_mod

144
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -1993,7 +1993,7 @@ end subroutine psb_z_csr_csgetptn
subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -2011,9 +2011,9 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
logical :: append_, rscale_, cscale_
logical :: append_, rscale_, cscale_, chksz_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
@ -2056,13 +2056,18 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
else
cscale_ = .false.
endif
if (present(chksz)) then
chksz_ = chksz
else
chksz_ = .true.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,info,&
call csr_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
& iren)
if (rscale_) then
@ -2087,7 +2092,7 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
contains
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,info,&
subroutine csr_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
& iren)
use psb_const_mod
@ -2102,7 +2107,7 @@ contains
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in) :: nzin
logical, intent(in) :: append
logical, intent(in) :: append, chksz
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: iren(:)
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, icl,lcl, nrd, ncd
@ -2135,11 +2140,13 @@ contains
nzt = (a%irp(lrw+1)-a%irp(irw))
nz = 0
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
if (chksz) then
call psb_ensure_size(nzin_+nzt,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= psb_success_) return
end if
if (present(iren)) then
do i=irw, lrw
@ -2171,59 +2178,6 @@ contains
end subroutine psb_z_csr_csgetrow
subroutine psb_z_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_csgetblk
implicit none
class(psb_z_csr_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_csr_csgetblk
!
! CSR implementation of tril/triu
@ -2245,8 +2199,6 @@ subroutine psb_z_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
complex(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -2401,8 +2353,6 @@ subroutine psb_z_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act, nzin, nzout, i, j, k
integer(psb_ipk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_ipk_), allocatable :: ia(:), ja(:)
complex(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_
@ -4397,60 +4347,6 @@ contains
end subroutine psb_lz_csr_csgetrow
subroutine psb_lz_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_csgetblk
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer(psb_lpk_) :: nzin, nzout
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csr_csgetblk
!
! CSR implementation of tril/triu
@ -4473,8 +4369,6 @@ subroutine psb_lz_csr_tril(a,l,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
complex(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='tril'
logical :: rscale_, cscale_
@ -4630,8 +4524,6 @@ subroutine psb_lz_csr_triu(a,u,info,&
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nzin, nzout, i, j, k
integer(psb_lpk_) :: imin_, imax_, jmin_, jmax_, mb,nb, diag_, nzlin, nzuin, nz
integer(psb_lpk_), allocatable :: ia(:), ja(:)
complex(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='triu'
logical :: rscale_, cscale_

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

@ -791,7 +791,7 @@ end subroutine psb_z_csgetptn
subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
@ -808,7 +808,7 @@ subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
logical, intent(in), optional :: rscale,cscale,chksz
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
@ -824,7 +824,7 @@ subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
call a%a%csget(imin,imax,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

26
base/tools/psb_csphalo.F90
Unescape Escape View File

@ -209,8 +209,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -618,8 +617,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -650,6 +648,11 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
if (info /= psb_success_) then
info=psb_err_from_subroutine_; ch_err='psb_sp_reall'
@ -676,8 +679,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& append=.true.,nzin=tot_elem)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_getrow'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
tot_elem=tot_elem+n_elem
@ -691,8 +693,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_loc_to_glob'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_loc_to_glob')
goto 9999
end if
@ -705,8 +706,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoallv')
goto 9999
end if
@ -717,8 +717,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psbglob_to_loc'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psbglob_to_loc')
goto 9999
end if
@ -770,8 +769,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spcnv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_spcnv')
goto 9999
end if

26
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -209,8 +209,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -618,8 +617,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -650,6 +648,11 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
if (info /= psb_success_) then
info=psb_err_from_subroutine_; ch_err='psb_sp_reall'
@ -676,8 +679,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& append=.true.,nzin=tot_elem)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_getrow'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
tot_elem=tot_elem+n_elem
@ -691,8 +693,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_loc_to_glob'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_loc_to_glob')
goto 9999
end if
@ -705,8 +706,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoallv')
goto 9999
end if
@ -717,8 +717,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psbglob_to_loc'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psbglob_to_loc')
goto 9999
end if
@ -770,8 +769,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spcnv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_spcnv')
goto 9999
end if

26
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -209,8 +209,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -618,8 +617,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -650,6 +648,11 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
if (info /= psb_success_) then
info=psb_err_from_subroutine_; ch_err='psb_sp_reall'
@ -676,8 +679,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& append=.true.,nzin=tot_elem)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_getrow'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
tot_elem=tot_elem+n_elem
@ -691,8 +693,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_loc_to_glob'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_loc_to_glob')
goto 9999
end if
@ -705,8 +706,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoallv')
goto 9999
end if
@ -717,8 +717,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psbglob_to_loc'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psbglob_to_loc')
goto 9999
end if
@ -770,8 +769,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spcnv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_spcnv')
goto 9999
end if

26
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -209,8 +209,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -618,8 +617,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoall'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
@ -650,6 +648,11 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
if (info /= psb_success_) then
info=psb_err_from_subroutine_; ch_err='psb_sp_reall'
@ -676,8 +679,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& append=.true.,nzin=tot_elem)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_getrow'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
tot_elem=tot_elem+n_elem
@ -691,8 +693,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_loc_to_glob'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_loc_to_glob')
goto 9999
end if
@ -705,8 +706,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& acoo%ja,rvsz,brvindx,psb_mpi_lpk_,icomm,minfo)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mpi_alltoallv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='mpi_alltoallv')
goto 9999
end if
@ -717,8 +717,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I')
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psbglob_to_loc'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psbglob_to_loc')
goto 9999
end if
@ -770,8 +769,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spcnv'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err='psb_spcnv')
goto 9999
end if

6
cbind/prec/psb_cprec_cbind_mod.f90
Unescape Escape View File

@ -13,12 +13,14 @@ module psb_cprec_cbind_mod
contains
function psb_c_cprecinit(ph,ptype) bind(c) result(res)
function psb_c_cprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk) :: res
integer(psb_c_ipk), value :: ictxt
type(psb_c_cprec) :: ph
character(c_char) :: ptype(*)
type(psb_cprec_type), pointer :: precp
@ -36,7 +38,7 @@ contains
call stringc2f(ptype,fptype)
call psb_precinit(precp,fptype,info)
call psb_precinit(ictxt,precp,fptype,info)
res = min(0,info)
return

6
cbind/prec/psb_dprec_cbind_mod.f90
Unescape Escape View File

@ -13,12 +13,14 @@ module psb_dprec_cbind_mod
contains
function psb_c_dprecinit(ph,ptype) bind(c) result(res)
function psb_c_dprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk) :: res
integer(psb_c_ipk), value :: ictxt
type(psb_c_dprec) :: ph
character(c_char) :: ptype(*)
type(psb_dprec_type), pointer :: precp
@ -36,7 +38,7 @@ contains
call stringc2f(ptype,fptype)
call psb_precinit(precp,fptype,info)
call psb_precinit(ictxt,precp,fptype,info)
res = min(0,info)
return

6
cbind/prec/psb_sprec_cbind_mod.f90
Unescape Escape View File

@ -13,12 +13,14 @@ module psb_sprec_cbind_mod
contains
function psb_c_sprecinit(ph,ptype) bind(c) result(res)
function psb_c_sprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk) :: res
integer(psb_c_ipk), value :: ictxt
type(psb_c_sprec) :: ph
character(c_char) :: ptype(*)
type(psb_sprec_type), pointer :: precp
@ -36,7 +38,7 @@ contains
call stringc2f(ptype,fptype)
call psb_precinit(precp,fptype,info)
call psb_precinit(ictxt,precp,fptype,info)
res = min(0,info)
return

6
cbind/prec/psb_zprec_cbind_mod.f90
Unescape Escape View File

@ -13,12 +13,14 @@ module psb_zprec_cbind_mod
contains
function psb_c_zprecinit(ph,ptype) bind(c) result(res)
function psb_c_zprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk) :: res
integer(psb_c_ipk), value :: ictxt
type(psb_c_zprec) :: ph
character(c_char) :: ptype(*)
type(psb_zprec_type), pointer :: precp
@ -36,7 +38,7 @@ contains
call stringc2f(ptype,fptype)
call psb_precinit(precp,fptype,info)
call psb_precinit(ictxt,precp,fptype,info)
res = min(0,info)
return

7
prec/impl/psb_cprecinit.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_cprecinit(p,ptype,info)
subroutine psb_cprecinit(ictxt,p,ptype,info)
use psb_base_mod
use psb_c_prec_type, psb_protect_name => psb_cprecinit
@ -37,7 +37,8 @@ subroutine psb_cprecinit(p,ptype,info)
use psb_c_diagprec, only : psb_c_diag_prec_type
use psb_c_bjacprec, only : psb_c_bjac_prec_type
implicit none
class(psb_cprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: ictxt
class(psb_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -49,6 +50,8 @@ subroutine psb_cprecinit(p,ptype,info)
if (info /= psb_success_) return
end if
p%ictxt = ictxt
select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')

7
prec/impl/psb_dprecinit.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_dprecinit(p,ptype,info)
subroutine psb_dprecinit(ictxt,p,ptype,info)
use psb_base_mod
use psb_d_prec_type, psb_protect_name => psb_dprecinit
@ -37,7 +37,8 @@ subroutine psb_dprecinit(p,ptype,info)
use psb_d_diagprec, only : psb_d_diag_prec_type
use psb_d_bjacprec, only : psb_d_bjac_prec_type
implicit none
class(psb_dprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: ictxt
class(psb_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -49,6 +50,8 @@ subroutine psb_dprecinit(p,ptype,info)
if (info /= psb_success_) return
end if
p%ictxt = ictxt
select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')

7
prec/impl/psb_sprecinit.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_sprecinit(p,ptype,info)
subroutine psb_sprecinit(ictxt,p,ptype,info)
use psb_base_mod
use psb_s_prec_type, psb_protect_name => psb_sprecinit
@ -37,7 +37,8 @@ subroutine psb_sprecinit(p,ptype,info)
use psb_s_diagprec, only : psb_s_diag_prec_type
use psb_s_bjacprec, only : psb_s_bjac_prec_type
implicit none
class(psb_sprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: ictxt
class(psb_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -49,6 +50,8 @@ subroutine psb_sprecinit(p,ptype,info)
if (info /= psb_success_) return
end if
p%ictxt = ictxt
select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')

7
prec/impl/psb_zprecinit.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_zprecinit(p,ptype,info)
subroutine psb_zprecinit(ictxt,p,ptype,info)
use psb_base_mod
use psb_z_prec_type, psb_protect_name => psb_zprecinit
@ -37,7 +37,8 @@ subroutine psb_zprecinit(p,ptype,info)
use psb_z_diagprec, only : psb_z_diag_prec_type
use psb_z_bjacprec, only : psb_z_bjac_prec_type
implicit none
class(psb_zprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: ictxt
class(psb_zprec_type), intent(inout) :: p
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -49,6 +50,8 @@ subroutine psb_zprecinit(p,ptype,info)
if (info /= psb_success_) return
end if
p%ictxt = ictxt
select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')

4
prec/psb_c_prec_type.f90
Unescape Escape View File

@ -39,6 +39,7 @@ module psb_c_prec_type
use psb_c_base_prec_mod
type psb_cprec_type
integer(psb_ipk_) :: ictxt
class(psb_c_base_prec_type), allocatable :: prec
contains
procedure, pass(prec) :: psb_c_apply1_vect
@ -60,9 +61,10 @@ module psb_c_prec_type
end interface
interface psb_precinit
subroutine psb_cprecinit(prec,ptype,info)
subroutine psb_cprecinit(ictxt,prec,ptype,info)
import :: psb_ipk_, psb_cprec_type
implicit none
integer(psb_ipk_), intent(in) :: ictxt
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info

4
prec/psb_d_prec_type.f90
Unescape Escape View File

@ -39,6 +39,7 @@ module psb_d_prec_type
use psb_d_base_prec_mod
type psb_dprec_type
integer(psb_ipk_) :: ictxt
class(psb_d_base_prec_type), allocatable :: prec
contains
procedure, pass(prec) :: psb_d_apply1_vect
@ -60,9 +61,10 @@ module psb_d_prec_type
end interface
interface psb_precinit
subroutine psb_dprecinit(prec,ptype,info)
subroutine psb_dprecinit(ictxt,prec,ptype,info)
import :: psb_ipk_, psb_dprec_type
implicit none
integer(psb_ipk_), intent(in) :: ictxt
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info

4
prec/psb_s_prec_type.f90
Unescape Escape View File

@ -39,6 +39,7 @@ module psb_s_prec_type
use psb_s_base_prec_mod
type psb_sprec_type
integer(psb_ipk_) :: ictxt
class(psb_s_base_prec_type), allocatable :: prec
contains
procedure, pass(prec) :: psb_s_apply1_vect
@ -60,9 +61,10 @@ module psb_s_prec_type
end interface
interface psb_precinit
subroutine psb_sprecinit(prec,ptype,info)
subroutine psb_sprecinit(ictxt,prec,ptype,info)
import :: psb_ipk_, psb_sprec_type
implicit none
integer(psb_ipk_), intent(in) :: ictxt
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info

4
prec/psb_z_prec_type.f90
Unescape Escape View File

@ -39,6 +39,7 @@ module psb_z_prec_type
use psb_z_base_prec_mod
type psb_zprec_type
integer(psb_ipk_) :: ictxt
class(psb_z_base_prec_type), allocatable :: prec
contains
procedure, pass(prec) :: psb_z_apply1_vect
@ -60,9 +61,10 @@ module psb_z_prec_type
end interface
interface psb_precinit
subroutine psb_zprecinit(prec,ptype,info)
subroutine psb_zprecinit(ictxt,prec,ptype,info)
import :: psb_ipk_, psb_zprec_type
implicit none
integer(psb_ipk_), intent(in) :: ictxt
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info

2
test/fileread/psb_cf_sample.f90
Unescape Escape View File

@ -213,7 +213,7 @@ program psb_cf_sample
!
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
! building the preconditioner
t1 = psb_wtime()

2
test/fileread/psb_df_sample.f90
Unescape Escape View File

@ -213,7 +213,7 @@ program psb_df_sample
!
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
! building the preconditioner
t1 = psb_wtime()

2
test/fileread/psb_sf_sample.f90
Unescape Escape View File

@ -213,7 +213,7 @@ program psb_sf_sample
!
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
! building the preconditioner
t1 = psb_wtime()

2
test/fileread/psb_zf_sample.f90
Unescape Escape View File

@ -213,7 +213,7 @@ program psb_zf_sample
!
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
! building the preconditioner
t1 = psb_wtime()

4
test/pargen/psb_d_pde2d.f90
Unescape Escape View File

@ -613,7 +613,7 @@ program psb_d_pde2d
! prepare the preconditioner.
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -638,7 +638,7 @@ program psb_d_pde2d
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ictxt)
t1 = psb_wtime()
eps = 1.d-9
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)

4
test/pargen/psb_d_pde3d.f90
Unescape Escape View File

@ -654,7 +654,7 @@ program psb_d_pde3d
! prepare the preconditioner.
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -679,7 +679,7 @@ program psb_d_pde3d
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ictxt)
t1 = psb_wtime()
eps = 1.d-9
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)

4
test/pargen/psb_s_pde2d.f90
Unescape Escape View File

@ -613,7 +613,7 @@ program psb_s_pde2d
! prepare the preconditioner.
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -638,7 +638,7 @@ program psb_s_pde2d
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ictxt)
t1 = psb_wtime()
eps = 1.d-9
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)

4
test/pargen/psb_s_pde3d.f90
Unescape Escape View File

@ -654,7 +654,7 @@ program psb_s_pde3d
! prepare the preconditioner.
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ptype,info)
call prec%init(ictxt,ptype,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -679,7 +679,7 @@ program psb_s_pde3d
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ictxt)
t1 = psb_wtime()
eps = 1.d-9
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)

Write Preview
Loading…
Cancel
Save