|
|
|
@ -129,6 +129,7 @@ module psb_d_base_vect_mod
|
|
|
|
procedure, pass(x) :: set_vect => d_base_set_vect
|
|
|
|
procedure, pass(x) :: set_vect => d_base_set_vect
|
|
|
|
generic, public :: set => set_vect, set_scal
|
|
|
|
generic, public :: set => set_vect, set_scal
|
|
|
|
procedure, pass(x) :: get_entry=> d_base_get_entry
|
|
|
|
procedure, pass(x) :: get_entry=> d_base_get_entry
|
|
|
|
|
|
|
|
procedure, pass(x) :: set_entry=> d_base_set_entry
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! Gather/scatter. These are needed for MPI interfacing.
|
|
|
|
! Gather/scatter. These are needed for MPI interfacing.
|
|
|
|
! May have to be reworked.
|
|
|
|
! May have to be reworked.
|
|
|
|
@ -910,15 +911,31 @@ contains
|
|
|
|
!
|
|
|
|
!
|
|
|
|
function d_base_get_entry(x, index) result(res)
|
|
|
|
function d_base_get_entry(x, index) result(res)
|
|
|
|
implicit none
|
|
|
|
implicit none
|
|
|
|
class(psb_d_base_vect_type), intent(in) :: x
|
|
|
|
class(psb_d_base_vect_type), intent(inout) :: x
|
|
|
|
integer(psb_ipk_), intent(in) :: index
|
|
|
|
integer(psb_ipk_), intent(in) :: index
|
|
|
|
real(psb_dpk_) :: res
|
|
|
|
real(psb_dpk_) :: res
|
|
|
|
|
|
|
|
|
|
|
|
res = 0
|
|
|
|
res = dzero
|
|
|
|
if (allocated(x%v)) res = x%v(index)
|
|
|
|
if (allocated(x%v)) then
|
|
|
|
|
|
|
|
if (x%is_dev()) call x%sync()
|
|
|
|
|
|
|
|
res = x%v(index)
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
end function d_base_get_entry
|
|
|
|
end function d_base_get_entry
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine d_base_set_entry(x, index, val)
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
class(psb_d_base_vect_type), intent(inout) :: x
|
|
|
|
|
|
|
|
integer(psb_ipk_), intent(in) :: index
|
|
|
|
|
|
|
|
real(psb_dpk_) :: val
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (allocated(x%v)) then
|
|
|
|
|
|
|
|
if (x%is_dev()) call x%sync()
|
|
|
|
|
|
|
|
x%v(index) = val
|
|
|
|
|
|
|
|
call x%set_host()
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end subroutine d_base_set_entry
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! Overwrite with absolute value
|
|
|
|
! Overwrite with absolute value
|
|
|
|
!
|
|
|
|
!
|
|
|
|
@ -1810,8 +1827,8 @@ contains
|
|
|
|
integer(psb_ipk_) :: i
|
|
|
|
integer(psb_ipk_) :: i
|
|
|
|
|
|
|
|
|
|
|
|
if (x%is_dev()) call x%sync()
|
|
|
|
if (x%is_dev()) call x%sync()
|
|
|
|
#if defined(PSB_OPENMP)
|
|
|
|
|
|
|
|
res = HUGE(done)
|
|
|
|
res = HUGE(done)
|
|
|
|
|
|
|
|
#if defined(PSB_OPENMP)
|
|
|
|
!$omp parallel do private(i) reduction(min: res)
|
|
|
|
!$omp parallel do private(i) reduction(min: res)
|
|
|
|
do i=1, n
|
|
|
|
do i=1, n
|
|
|
|
res = min(res,abs(x%v(i)))
|
|
|
|
res = min(res,abs(x%v(i)))
|
|
|
|
|