diff --git a/base/modules/psb_c_base_vect_mod.f90 b/base/modules/psb_c_base_vect_mod.f90 index afdcf44e..0fb91efd 100644 --- a/base/modules/psb_c_base_vect_mod.f90 +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -704,7 +704,7 @@ contains ! Overwrite with absolute value ! ! - !> Function base_set_scal + !> Function base_absval1 !! \memberof psb_c_base_vect_type !! \brief Set all entries to their respective absolute values. !! @@ -1428,10 +1428,13 @@ module psb_c_base_multivect_mod !!$ ! !!$ ! Scaling and norms !!$ ! -!!$ procedure, pass(x) :: scal => c_base_mlv_scal -!!$ procedure, pass(x) :: nrm2 => c_base_mlv_nrm2 -!!$ procedure, pass(x) :: amax => c_base_mlv_amax -!!$ procedure, pass(x) :: asum => c_base_mlv_asum + procedure, pass(x) :: scal => c_base_mlv_scal + procedure, pass(x) :: nrm2 => c_base_mlv_nrm2 + procedure, pass(x) :: amax => c_base_mlv_amax + procedure, pass(x) :: asum => c_base_mlv_asum + procedure, pass(x) :: absval1 => c_base_mlv_absval1 + procedure, pass(x) :: absval2 => c_base_mlv_absval2 + generic, public :: absval => absval1, absval2 !!$ ! !!$ ! Gather/scatter. These are needed for MPI interfacing. !!$ ! May have to be reworked. @@ -2289,71 +2292,120 @@ contains !!$ end subroutine c_base_mlv_mlt_va !!$ !!$ -!!$ ! -!!$ ! Simple scaling -!!$ ! -!!$ !> Function base_mlv_scal -!!$ !! \memberof psb_c_base_multivect_type -!!$ !! \brief Scale all entries x = alpha*x -!!$ !! \param alpha The multiplier -!!$ !! -!!$ subroutine c_base_mlv_scal(alpha, x) -!!$ use psi_serial_mod -!!$ implicit none -!!$ class(psb_c_base_multivect_type), intent(inout) :: x -!!$ complex(psb_spk_), intent (in) :: alpha -!!$ -!!$ if (allocated(x%v)) x%v = alpha*x%v -!!$ -!!$ end subroutine c_base_mlv_scal -!!$ -!!$ ! -!!$ ! Norms 1, 2 and infinity -!!$ ! -!!$ !> Function base_mlv_nrm2 -!!$ !! \memberof psb_c_base_multivect_type -!!$ !! \brief 2-norm |x(1:n)|_2 -!!$ !! \param n how many entries to consider -!!$ function c_base_mlv_nrm2(n,x) result(res) -!!$ implicit none -!!$ class(psb_c_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_spk_) :: res -!!$ integer(psb_ipk_), external :: dnrm2 -!!$ -!!$ res = dnrm2(n,x%v,1) -!!$ -!!$ end function c_base_mlv_nrm2 -!!$ -!!$ ! -!!$ !> Function base_mlv_amax -!!$ !! \memberof psb_c_base_multivect_type -!!$ !! \brief infinity-norm |x(1:n)|_\infty -!!$ !! \param n how many entries to consider -!!$ function c_base_mlv_amax(n,x) result(res) -!!$ implicit none -!!$ class(psb_c_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_spk_) :: res -!!$ -!!$ res = maxval(abs(x%v(1:n))) -!!$ -!!$ end function c_base_mlv_amax -!!$ -!!$ ! -!!$ !> Function base_mlv_asum -!!$ !! \memberof psb_c_base_multivect_type -!!$ !! \brief 1-norm |x(1:n)|_1 -!!$ !! \param n how many entries to consider -!!$ function c_base_mlv_asum(n,x) result(res) -!!$ implicit none -!!$ class(psb_c_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_spk_) :: res -!!$ -!!$ res = sum(abs(x%v(1:n))) -!!$ -!!$ end function c_base_mlv_asum + ! + ! Simple scaling + ! + !> Function base_mlv_scal + !! \memberof psb_c_base_multivect_type + !! \brief Scale all entries x = alpha*x + !! \param alpha The multiplier + !! + subroutine c_base_mlv_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_c_base_multivect_type), intent(inout) :: x + complex(psb_spk_), intent (in) :: alpha + + if (x%is_dev()) call x%sync() + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine c_base_mlv_scal + + ! + ! Norms 1, 2 and infinity + ! + !> Function base_mlv_nrm2 + !! \memberof psb_c_base_multivect_type + !! \brief 2-norm |x(1:n)|_2 + !! \param n how many entries to consider + function c_base_mlv_nrm2(n,x) result(res) + implicit none + class(psb_c_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), allocatable :: res(:) + integer(psb_ipk_), external :: scnrm2 + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = scnrm2(n,x%v(:,j),1) + end do + + end function c_base_mlv_nrm2 + + ! + !> Function base_mlv_amax + !! \memberof psb_c_base_multivect_type + !! \brief infinity-norm |x(1:n)|_\infty + !! \param n how many entries to consider + function c_base_mlv_amax(n,x) result(res) + implicit none + class(psb_c_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = maxval(abs(x%v(1:n,j))) + end do + + end function c_base_mlv_amax + + ! + !> Function base_mlv_asum + !! \memberof psb_c_base_multivect_type + !! \brief 1-norm |x(1:n)|_1 + !! \param n how many entries to consider + function c_base_mlv_asum(n,x) result(res) + implicit none + class(psb_c_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = sum(abs(x%v(1:n,j))) + end do + + end function c_base_mlv_asum + ! + ! Overwrite with absolute value + ! + ! + !> Function base_absval1 + !! \memberof psb_c_base_vect_type + !! \brief Set all entries to their respective absolute values. + !! + subroutine c_base_mlv_absval1(x) + class(psb_c_base_multivect_type), intent(inout) :: x + + if (allocated(x%v)) then + if (x%is_dev()) call x%sync() + x%v = abs(x%v) + call x%set_host() + end if + + end subroutine c_base_mlv_absval1 + + subroutine c_base_mlv_absval2(x,y) + class(psb_c_base_multivect_type), intent(inout) :: x + class(psb_c_base_multivect_type), intent(inout) :: y + + if (.not.x%is_host()) call x%sync() + if (allocated(x%v)) then + call y%axpby(min(x%get_nrows(),y%get_nrows()),cone,x,czero,info) + call y%absval() + end if + + end subroutine c_base_mlv_absval2 !!$ !!$ !!$ ! diff --git a/base/modules/psb_c_sort_mod.f90 b/base/modules/psb_c_sort_mod.f90 index ee8c0d16..93f10b80 100644 --- a/base/modules/psb_c_sort_mod.f90 +++ b/base/modules/psb_c_sort_mod.f90 @@ -156,33 +156,6 @@ module psb_c_sort_mod end interface psb_hsort -!!$ interface !psb_howmany_heap -!!$ module procedure psb_c_howmany, psb_c_idx_howmany -!!$ end interface -!!$ -!!$ -!!$ interface !psb_init_heap -!!$ module procedure psb_c_init_heap, psb_c_idx_init_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_dump_heap -!!$ module procedure psb_c_dump_heap, psb_dump_c_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_insert_heap -!!$ module procedure psb_c_insert_heap, psb_c_idx_insert_heap -!!$ end interface -!!$ -!!$ interface !psb_heap_get_first -!!$ module procedure psb_c_heap_get_first, psb_c_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface !psb_free_heap -!!$ module procedure psb_free_c_heap, psb_free_c_idx_heap -!!$ end interface - interface subroutine psi_c_insert_heap(key,last,heap,dir,info) import diff --git a/base/modules/psb_d_base_vect_mod.f90 b/base/modules/psb_d_base_vect_mod.f90 index 657b3fc3..dc061325 100644 --- a/base/modules/psb_d_base_vect_mod.f90 +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -704,7 +704,7 @@ contains ! Overwrite with absolute value ! ! - !> Function base_set_scal + !> Function base_absval1 !! \memberof psb_d_base_vect_type !! \brief Set all entries to their respective absolute values. !! @@ -1428,10 +1428,13 @@ module psb_d_base_multivect_mod !!$ ! !!$ ! Scaling and norms !!$ ! -!!$ procedure, pass(x) :: scal => d_base_mlv_scal -!!$ procedure, pass(x) :: nrm2 => d_base_mlv_nrm2 -!!$ procedure, pass(x) :: amax => d_base_mlv_amax -!!$ procedure, pass(x) :: asum => d_base_mlv_asum + procedure, pass(x) :: scal => d_base_mlv_scal + procedure, pass(x) :: nrm2 => d_base_mlv_nrm2 + procedure, pass(x) :: amax => d_base_mlv_amax + procedure, pass(x) :: asum => d_base_mlv_asum + procedure, pass(x) :: absval1 => d_base_mlv_absval1 + procedure, pass(x) :: absval2 => d_base_mlv_absval2 + generic, public :: absval => absval1, absval2 !!$ ! !!$ ! Gather/scatter. These are needed for MPI interfacing. !!$ ! May have to be reworked. @@ -2289,71 +2292,120 @@ contains !!$ end subroutine d_base_mlv_mlt_va !!$ !!$ -!!$ ! -!!$ ! Simple scaling -!!$ ! -!!$ !> Function base_mlv_scal -!!$ !! \memberof psb_d_base_multivect_type -!!$ !! \brief Scale all entries x = alpha*x -!!$ !! \param alpha The multiplier -!!$ !! -!!$ subroutine d_base_mlv_scal(alpha, x) -!!$ use psi_serial_mod -!!$ implicit none -!!$ class(psb_d_base_multivect_type), intent(inout) :: x -!!$ real(psb_dpk_), intent (in) :: alpha -!!$ -!!$ if (allocated(x%v)) x%v = alpha*x%v -!!$ -!!$ end subroutine d_base_mlv_scal -!!$ -!!$ ! -!!$ ! Norms 1, 2 and infinity -!!$ ! -!!$ !> Function base_mlv_nrm2 -!!$ !! \memberof psb_d_base_multivect_type -!!$ !! \brief 2-norm |x(1:n)|_2 -!!$ !! \param n how many entries to consider -!!$ function d_base_mlv_nrm2(n,x) result(res) -!!$ implicit none -!!$ class(psb_d_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_dpk_) :: res -!!$ integer(psb_ipk_), external :: dnrm2 -!!$ -!!$ res = dnrm2(n,x%v,1) -!!$ -!!$ end function d_base_mlv_nrm2 -!!$ -!!$ ! -!!$ !> Function base_mlv_amax -!!$ !! \memberof psb_d_base_multivect_type -!!$ !! \brief infinity-norm |x(1:n)|_\infty -!!$ !! \param n how many entries to consider -!!$ function d_base_mlv_amax(n,x) result(res) -!!$ implicit none -!!$ class(psb_d_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_dpk_) :: res -!!$ -!!$ res = maxval(abs(x%v(1:n))) -!!$ -!!$ end function d_base_mlv_amax -!!$ -!!$ ! -!!$ !> Function base_mlv_asum -!!$ !! \memberof psb_d_base_multivect_type -!!$ !! \brief 1-norm |x(1:n)|_1 -!!$ !! \param n how many entries to consider -!!$ function d_base_mlv_asum(n,x) result(res) -!!$ implicit none -!!$ class(psb_d_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_dpk_) :: res -!!$ -!!$ res = sum(abs(x%v(1:n))) -!!$ -!!$ end function d_base_mlv_asum + ! + ! Simple scaling + ! + !> Function base_mlv_scal + !! \memberof psb_d_base_multivect_type + !! \brief Scale all entries x = alpha*x + !! \param alpha The multiplier + !! + subroutine d_base_mlv_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_d_base_multivect_type), intent(inout) :: x + real(psb_dpk_), intent (in) :: alpha + + if (x%is_dev()) call x%sync() + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine d_base_mlv_scal + + ! + ! Norms 1, 2 and infinity + ! + !> Function base_mlv_nrm2 + !! \memberof psb_d_base_multivect_type + !! \brief 2-norm |x(1:n)|_2 + !! \param n how many entries to consider + function d_base_mlv_nrm2(n,x) result(res) + implicit none + class(psb_d_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), allocatable :: res(:) + integer(psb_ipk_), external :: dnrm2 + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = dnrm2(n,x%v(:,j),1) + end do + + end function d_base_mlv_nrm2 + + ! + !> Function base_mlv_amax + !! \memberof psb_d_base_multivect_type + !! \brief infinity-norm |x(1:n)|_\infty + !! \param n how many entries to consider + function d_base_mlv_amax(n,x) result(res) + implicit none + class(psb_d_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = maxval(abs(x%v(1:n,j))) + end do + + end function d_base_mlv_amax + + ! + !> Function base_mlv_asum + !! \memberof psb_d_base_multivect_type + !! \brief 1-norm |x(1:n)|_1 + !! \param n how many entries to consider + function d_base_mlv_asum(n,x) result(res) + implicit none + class(psb_d_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = sum(abs(x%v(1:n,j))) + end do + + end function d_base_mlv_asum + ! + ! Overwrite with absolute value + ! + ! + !> Function base_absval1 + !! \memberof psb_d_base_vect_type + !! \brief Set all entries to their respective absolute values. + !! + subroutine d_base_mlv_absval1(x) + class(psb_d_base_multivect_type), intent(inout) :: x + + if (allocated(x%v)) then + if (x%is_dev()) call x%sync() + x%v = abs(x%v) + call x%set_host() + end if + + end subroutine d_base_mlv_absval1 + + subroutine d_base_mlv_absval2(x,y) + class(psb_d_base_multivect_type), intent(inout) :: x + class(psb_d_base_multivect_type), intent(inout) :: y + + if (.not.x%is_host()) call x%sync() + if (allocated(x%v)) then + call y%axpby(min(x%get_nrows(),y%get_nrows()),done,x,dzero,info) + call y%absval() + end if + + end subroutine d_base_mlv_absval2 !!$ !!$ !!$ ! diff --git a/base/modules/psb_d_sort_mod.f90 b/base/modules/psb_d_sort_mod.f90 index 1352a10a..67010d75 100644 --- a/base/modules/psb_d_sort_mod.f90 +++ b/base/modules/psb_d_sort_mod.f90 @@ -142,33 +142,6 @@ module psb_d_sort_mod end interface psb_hsort -!!$ interface !psb_howmany_heap -!!$ module procedure psb_d_howmany, psb_d_idx_howmany -!!$ end interface -!!$ -!!$ -!!$ interface !psb_init_heap -!!$ module procedure psb_d_init_heap, psb_d_idx_init_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_dump_heap -!!$ module procedure psb_d_dump_heap, psb_dump_d_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_insert_heap -!!$ module procedure psb_d_insert_heap, psb_d_idx_insert_heap -!!$ end interface -!!$ -!!$ interface !psb_heap_get_first -!!$ module procedure psb_d_heap_get_first, psb_d_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface !psb_free_heap -!!$ module procedure psb_free_d_heap, psb_free_d_idx_heap -!!$ end interface - interface subroutine psi_d_insert_heap(key,last,heap,dir,info) import diff --git a/base/modules/psb_i_sort_mod.f90 b/base/modules/psb_i_sort_mod.f90 index f4b9e925..373cc523 100644 --- a/base/modules/psb_i_sort_mod.f90 +++ b/base/modules/psb_i_sort_mod.f90 @@ -183,33 +183,6 @@ module psb_i_sort_mod end interface psb_hsort -!!$ interface !psb_howmany_heap -!!$ module procedure psb_i_howmany, psb_i_idx_howmany -!!$ end interface -!!$ -!!$ -!!$ interface !psb_init_heap -!!$ module procedure psb_i_init_heap, psb_i_idx_init_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_dump_heap -!!$ module procedure psb_i_dump_heap, psb_dump_i_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_insert_heap -!!$ module procedure psb_i_insert_heap, psb_i_idx_insert_heap -!!$ end interface -!!$ -!!$ interface !psb_heap_get_first -!!$ module procedure psb_i_heap_get_first, psb_i_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface !psb_free_heap -!!$ module procedure psb_free_i_heap, psb_free_i_idx_heap -!!$ end interface - interface subroutine psi_i_insert_heap(key,last,heap,dir,info) import diff --git a/base/modules/psb_s_base_vect_mod.f90 b/base/modules/psb_s_base_vect_mod.f90 index d82f5765..457c1e7d 100644 --- a/base/modules/psb_s_base_vect_mod.f90 +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -704,7 +704,7 @@ contains ! Overwrite with absolute value ! ! - !> Function base_set_scal + !> Function base_absval1 !! \memberof psb_s_base_vect_type !! \brief Set all entries to their respective absolute values. !! @@ -1428,10 +1428,13 @@ module psb_s_base_multivect_mod !!$ ! !!$ ! Scaling and norms !!$ ! -!!$ procedure, pass(x) :: scal => s_base_mlv_scal -!!$ procedure, pass(x) :: nrm2 => s_base_mlv_nrm2 -!!$ procedure, pass(x) :: amax => s_base_mlv_amax -!!$ procedure, pass(x) :: asum => s_base_mlv_asum + procedure, pass(x) :: scal => s_base_mlv_scal + procedure, pass(x) :: nrm2 => s_base_mlv_nrm2 + procedure, pass(x) :: amax => s_base_mlv_amax + procedure, pass(x) :: asum => s_base_mlv_asum + procedure, pass(x) :: absval1 => s_base_mlv_absval1 + procedure, pass(x) :: absval2 => s_base_mlv_absval2 + generic, public :: absval => absval1, absval2 !!$ ! !!$ ! Gather/scatter. These are needed for MPI interfacing. !!$ ! May have to be reworked. @@ -2289,71 +2292,120 @@ contains !!$ end subroutine s_base_mlv_mlt_va !!$ !!$ -!!$ ! -!!$ ! Simple scaling -!!$ ! -!!$ !> Function base_mlv_scal -!!$ !! \memberof psb_s_base_multivect_type -!!$ !! \brief Scale all entries x = alpha*x -!!$ !! \param alpha The multiplier -!!$ !! -!!$ subroutine s_base_mlv_scal(alpha, x) -!!$ use psi_serial_mod -!!$ implicit none -!!$ class(psb_s_base_multivect_type), intent(inout) :: x -!!$ real(psb_spk_), intent (in) :: alpha -!!$ -!!$ if (allocated(x%v)) x%v = alpha*x%v -!!$ -!!$ end subroutine s_base_mlv_scal -!!$ -!!$ ! -!!$ ! Norms 1, 2 and infinity -!!$ ! -!!$ !> Function base_mlv_nrm2 -!!$ !! \memberof psb_s_base_multivect_type -!!$ !! \brief 2-norm |x(1:n)|_2 -!!$ !! \param n how many entries to consider -!!$ function s_base_mlv_nrm2(n,x) result(res) -!!$ implicit none -!!$ class(psb_s_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_spk_) :: res -!!$ integer(psb_ipk_), external :: dnrm2 -!!$ -!!$ res = dnrm2(n,x%v,1) -!!$ -!!$ end function s_base_mlv_nrm2 -!!$ -!!$ ! -!!$ !> Function base_mlv_amax -!!$ !! \memberof psb_s_base_multivect_type -!!$ !! \brief infinity-norm |x(1:n)|_\infty -!!$ !! \param n how many entries to consider -!!$ function s_base_mlv_amax(n,x) result(res) -!!$ implicit none -!!$ class(psb_s_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_spk_) :: res -!!$ -!!$ res = maxval(abs(x%v(1:n))) -!!$ -!!$ end function s_base_mlv_amax -!!$ -!!$ ! -!!$ !> Function base_mlv_asum -!!$ !! \memberof psb_s_base_multivect_type -!!$ !! \brief 1-norm |x(1:n)|_1 -!!$ !! \param n how many entries to consider -!!$ function s_base_mlv_asum(n,x) result(res) -!!$ implicit none -!!$ class(psb_s_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_spk_) :: res -!!$ -!!$ res = sum(abs(x%v(1:n))) -!!$ -!!$ end function s_base_mlv_asum + ! + ! Simple scaling + ! + !> Function base_mlv_scal + !! \memberof psb_s_base_multivect_type + !! \brief Scale all entries x = alpha*x + !! \param alpha The multiplier + !! + subroutine s_base_mlv_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_s_base_multivect_type), intent(inout) :: x + real(psb_spk_), intent (in) :: alpha + + if (x%is_dev()) call x%sync() + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine s_base_mlv_scal + + ! + ! Norms 1, 2 and infinity + ! + !> Function base_mlv_nrm2 + !! \memberof psb_s_base_multivect_type + !! \brief 2-norm |x(1:n)|_2 + !! \param n how many entries to consider + function s_base_mlv_nrm2(n,x) result(res) + implicit none + class(psb_s_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), allocatable :: res(:) + integer(psb_ipk_), external :: snrm2 + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = snrm2(n,x%v(:,j),1) + end do + + end function s_base_mlv_nrm2 + + ! + !> Function base_mlv_amax + !! \memberof psb_s_base_multivect_type + !! \brief infinity-norm |x(1:n)|_\infty + !! \param n how many entries to consider + function s_base_mlv_amax(n,x) result(res) + implicit none + class(psb_s_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = maxval(abs(x%v(1:n,j))) + end do + + end function s_base_mlv_amax + + ! + !> Function base_mlv_asum + !! \memberof psb_s_base_multivect_type + !! \brief 1-norm |x(1:n)|_1 + !! \param n how many entries to consider + function s_base_mlv_asum(n,x) result(res) + implicit none + class(psb_s_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = sum(abs(x%v(1:n,j))) + end do + + end function s_base_mlv_asum + ! + ! Overwrite with absolute value + ! + ! + !> Function base_absval1 + !! \memberof psb_s_base_vect_type + !! \brief Set all entries to their respective absolute values. + !! + subroutine s_base_mlv_absval1(x) + class(psb_s_base_multivect_type), intent(inout) :: x + + if (allocated(x%v)) then + if (x%is_dev()) call x%sync() + x%v = abs(x%v) + call x%set_host() + end if + + end subroutine s_base_mlv_absval1 + + subroutine s_base_mlv_absval2(x,y) + class(psb_s_base_multivect_type), intent(inout) :: x + class(psb_s_base_multivect_type), intent(inout) :: y + + if (.not.x%is_host()) call x%sync() + if (allocated(x%v)) then + call y%axpby(min(x%get_nrows(),y%get_nrows()),sone,x,szero,info) + call y%absval() + end if + + end subroutine s_base_mlv_absval2 !!$ !!$ !!$ ! diff --git a/base/modules/psb_s_sort_mod.f90 b/base/modules/psb_s_sort_mod.f90 index 273c4116..47166214 100644 --- a/base/modules/psb_s_sort_mod.f90 +++ b/base/modules/psb_s_sort_mod.f90 @@ -142,33 +142,6 @@ module psb_s_sort_mod end interface psb_hsort -!!$ interface !psb_howmany_heap -!!$ module procedure psb_s_howmany, psb_s_idx_howmany -!!$ end interface -!!$ -!!$ -!!$ interface !psb_init_heap -!!$ module procedure psb_s_init_heap, psb_s_idx_init_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_dump_heap -!!$ module procedure psb_s_dump_heap, psb_dump_s_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_insert_heap -!!$ module procedure psb_s_insert_heap, psb_s_idx_insert_heap -!!$ end interface -!!$ -!!$ interface !psb_heap_get_first -!!$ module procedure psb_s_heap_get_first, psb_s_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface !psb_free_heap -!!$ module procedure psb_free_s_heap, psb_free_s_idx_heap -!!$ end interface - interface subroutine psi_s_insert_heap(key,last,heap,dir,info) import diff --git a/base/modules/psb_sort_mod.f90 b/base/modules/psb_sort_mod.f90 index 49a95e08..0177bbff 100644 --- a/base/modules/psb_sort_mod.f90 +++ b/base/modules/psb_sort_mod.f90 @@ -51,702 +51,4 @@ module psb_sort_mod use psb_d_sort_mod use psb_z_sort_mod -!!$module psb_sort_mod -!!$ use psb_const_mod -!!$ -!!$ -!!$ type psb_int_heap -!!$ integer(psb_ipk_) :: last, dir -!!$ integer(psb_ipk_), allocatable :: keys(:) -!!$ end type psb_int_heap -!!$ type psb_int_idx_heap -!!$ integer(psb_ipk_) :: last, dir -!!$ integer(psb_ipk_), allocatable :: keys(:) -!!$ integer(psb_ipk_), allocatable :: idxs(:) -!!$ end type psb_int_idx_heap -!!$ type psb_sreal_idx_heap -!!$ integer(psb_ipk_) :: last, dir -!!$ real(psb_spk_), allocatable :: keys(:) -!!$ integer(psb_ipk_), allocatable :: idxs(:) -!!$ end type psb_sreal_idx_heap -!!$ type psb_dreal_idx_heap -!!$ integer(psb_ipk_) :: last, dir -!!$ real(psb_dpk_), allocatable :: keys(:) -!!$ integer(psb_ipk_), allocatable :: idxs(:) -!!$ end type psb_dreal_idx_heap -!!$ type psb_scomplex_idx_heap -!!$ integer(psb_ipk_) :: last, dir -!!$ complex(psb_spk_), allocatable :: keys(:) -!!$ integer(psb_ipk_), allocatable :: idxs(:) -!!$ end type psb_scomplex_idx_heap -!!$ type psb_dcomplex_idx_heap -!!$ integer(psb_ipk_) :: last, dir -!!$ complex(psb_dpk_), allocatable :: keys(:) -!!$ integer(psb_ipk_), allocatable :: idxs(:) -!!$ end type psb_dcomplex_idx_heap -!!$ -!!$ -!!$ interface psb_iblsrch -!!$ function psb_iblsrch(key,n,v) result(ipos) -!!$ import :: psb_ipk_ -!!$ integer(psb_ipk_) :: ipos, key, n -!!$ integer(psb_ipk_) :: v(:) -!!$ end function psb_iblsrch -!!$ end interface -!!$ -!!$ interface psb_ibsrch -!!$ function psb_ibsrch(key,n,v) result(ipos) -!!$ import :: psb_ipk_ -!!$ integer(psb_ipk_) :: ipos, key, n -!!$ integer(psb_ipk_) :: v(:) -!!$ end function psb_ibsrch -!!$ end interface -!!$ -!!$ interface psb_issrch -!!$ function psb_issrch(key,n,v) result(ipos) -!!$ import :: psb_ipk_ -!!$ implicit none -!!$ integer(psb_ipk_) :: ipos, key, n -!!$ integer(psb_ipk_) :: v(:) -!!$ end function psb_issrch -!!$ end interface -!!$ -!!$ interface psb_isaperm -!!$ logical function psb_isaperm(n,eip) -!!$ import :: psb_ipk_ -!!$ integer(psb_ipk_), intent(in) :: n -!!$ integer(psb_ipk_), intent(in) :: eip(n) -!!$ end function psb_isaperm -!!$ end interface -!!$ -!!$ -!!$ interface psb_msort -!!$ subroutine imsort(x,ix,dir,flag) -!!$ import :: psb_ipk_ -!!$ integer(psb_ipk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine imsort -!!$ subroutine smsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ real(psb_spk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine smsort -!!$ subroutine dmsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ real(psb_dpk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine dmsort -!!$ subroutine camsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ complex(psb_spk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine camsort -!!$ subroutine zamsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ complex(psb_dpk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine zamsort -!!$ end interface -!!$ -!!$ -!!$ interface psb_msort_unique -!!$ subroutine imsort_u(x,nout,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ integer(psb_ipk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), intent(out) :: nout -!!$ integer(psb_ipk_), optional, intent(in) :: dir -!!$ end subroutine imsort_u -!!$ end interface -!!$ -!!$ interface psb_qsort -!!$ subroutine iqsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ integer(psb_ipk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine iqsort -!!$ subroutine sqsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ real(psb_spk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine sqsort -!!$ subroutine dqsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ real(psb_dpk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine dqsort -!!$ subroutine cqsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ complex(psb_spk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine cqsort -!!$ subroutine zqsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ complex(psb_dpk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine zqsort -!!$ end interface -!!$ -!!$ -!!$ interface psb_hsort -!!$ subroutine ihsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ integer(psb_ipk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine ihsort -!!$ subroutine shsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ real(psb_spk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine shsort -!!$ subroutine dhsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ real(psb_dpk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine dhsort -!!$ subroutine chsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ complex(psb_spk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine chsort -!!$ subroutine zhsort(x,ix,dir,flag) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ complex(psb_dpk_), intent(inout) :: x(:) -!!$ integer(psb_ipk_), optional, intent(in) :: dir, flag -!!$ integer(psb_ipk_), optional, intent(inout) :: ix(:) -!!$ end subroutine zhsort -!!$ end interface -!!$ -!!$ -!!$ interface psb_howmany_heap -!!$ function psb_howmany_int_heap(heap) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_int_heap -!!$ type(psb_int_heap), intent(in) :: heap -!!$ integer(psb_ipk_) :: psb_howmany_int_heap -!!$ end function psb_howmany_int_heap -!!$ function psb_howmany_sreal_idx_heap(heap) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_sreal_idx_heap -!!$ type(psb_sreal_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_) :: psb_howmany_sreal_idx_heap -!!$ end function psb_howmany_sreal_idx_heap -!!$ function psb_howmany_dreal_idx_heap(heap) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_dreal_idx_heap -!!$ type(psb_dreal_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_) :: psb_howmany_dreal_idx_heap -!!$ end function psb_howmany_dreal_idx_heap -!!$ function psb_howmany_int_idx_heap(heap) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_int_idx_heap -!!$ type(psb_int_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_) :: psb_howmany_int_idx_heap -!!$ end function psb_howmany_int_idx_heap -!!$ function psb_howmany_scomplex_idx_heap(heap) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_scomplex_idx_heap -!!$ type(psb_scomplex_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_) :: psb_howmany_scomplex_idx_heap -!!$ end function psb_howmany_scomplex_idx_heap -!!$ function psb_howmany_dcomplex_idx_heap(heap) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_dcomplex_idx_heap -!!$ type(psb_dcomplex_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_) :: psb_howmany_dcomplex_idx_heap -!!$ end function psb_howmany_dcomplex_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface psb_init_heap -!!$ subroutine psb_init_int_heap(heap,info,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_int_heap -!!$ type(psb_int_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: dir -!!$ end subroutine psb_init_int_heap -!!$ subroutine psb_init_sreal_idx_heap(heap,info,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_sreal_idx_heap -!!$ type(psb_sreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: dir -!!$ end subroutine psb_init_sreal_idx_heap -!!$ subroutine psb_init_int_idx_heap(heap,info,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_int_idx_heap -!!$ type(psb_int_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: dir -!!$ end subroutine psb_init_int_idx_heap -!!$ subroutine psb_init_scomplex_idx_heap(heap,info,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_scomplex_idx_heap -!!$ type(psb_scomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: dir -!!$ end subroutine psb_init_scomplex_idx_heap -!!$ subroutine psb_init_dcomplex_idx_heap(heap,info,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_dcomplex_idx_heap -!!$ type(psb_dcomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: dir -!!$ end subroutine psb_init_dcomplex_idx_heap -!!$ subroutine psb_init_dreal_idx_heap(heap,info,dir) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_dreal_idx_heap -!!$ type(psb_dreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: dir -!!$ end subroutine psb_init_dreal_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface psb_dump_heap -!!$ subroutine psb_dump_int_heap(iout,heap,info) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_int_heap -!!$ type(psb_int_heap), intent(in) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in) :: iout -!!$ end subroutine psb_dump_int_heap -!!$ subroutine psb_dump_sreal_idx_heap(iout,heap,info) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_sreal_idx_heap -!!$ type(psb_sreal_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in) :: iout -!!$ end subroutine psb_dump_sreal_idx_heap -!!$ subroutine psb_dump_dreal_idx_heap(iout,heap,info) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_dreal_idx_heap -!!$ type(psb_dreal_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in) :: iout -!!$ end subroutine psb_dump_dreal_idx_heap -!!$ subroutine psb_dump_int_idx_heap(iout,heap,info) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_int_idx_heap -!!$ type(psb_int_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in) :: iout -!!$ end subroutine psb_dump_int_idx_heap -!!$ subroutine psb_dump_scomplex_idx_heap(iout,heap,info) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_scomplex_idx_heap -!!$ type(psb_scomplex_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in) :: iout -!!$ end subroutine psb_dump_scomplex_idx_heap -!!$ subroutine psb_dump_dcomplex_idx_heap(iout,heap,info) -!!$ import :: psb_ipk_, psb_spk_, psb_dpk_ -!!$ import :: psb_dcomplex_idx_heap -!!$ type(psb_dcomplex_idx_heap), intent(in) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in) :: iout -!!$ end subroutine psb_dump_dcomplex_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface psb_insert_heap -!!$ subroutine psb_insert_int_heap(key,heap,info) -!!$ import :: psb_int_heap, psb_ipk_ -!!$ integer(psb_ipk_), intent(in) :: key -!!$ type(psb_int_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_insert_int_heap -!!$ subroutine psb_insert_int_idx_heap(key,index,heap,info) -!!$ import :: psb_dpk_, psb_int_idx_heap, psb_ipk_ -!!$ integer(psb_ipk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index -!!$ type(psb_int_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_insert_int_idx_heap -!!$ subroutine psb_insert_sreal_idx_heap(key,index,heap,info) -!!$ import :: psb_spk_, psb_sreal_idx_heap, psb_ipk_ -!!$ real(psb_spk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index -!!$ type(psb_sreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_insert_sreal_idx_heap -!!$ subroutine psb_insert_dreal_idx_heap(key,index,heap,info) -!!$ import :: psb_dpk_, psb_dreal_idx_heap, psb_ipk_ -!!$ real(psb_dpk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index -!!$ type(psb_dreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_insert_dreal_idx_heap -!!$ subroutine psb_insert_scomplex_idx_heap(key,index,heap,info) -!!$ import :: psb_spk_, psb_scomplex_idx_heap, psb_ipk_ -!!$ complex(psb_spk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index -!!$ type(psb_scomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_insert_scomplex_idx_heap -!!$ subroutine psb_insert_dcomplex_idx_heap(key,index,heap,info) -!!$ import :: psb_dpk_, psb_dcomplex_idx_heap, psb_ipk_ -!!$ complex(psb_dpk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index -!!$ type(psb_dcomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_insert_dcomplex_idx_heap -!!$ end interface -!!$ -!!$ interface psb_heap_get_first -!!$ subroutine psb_int_heap_get_first(key,heap,info) -!!$ import :: psb_int_heap, psb_ipk_ -!!$ type(psb_int_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: key,info -!!$ end subroutine psb_int_heap_get_first -!!$ subroutine psb_int_idx_heap_get_first(key,index,heap,info) -!!$ import :: psb_int_idx_heap, psb_ipk_ -!!$ type(psb_int_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ integer(psb_ipk_), intent(out) :: key -!!$ end subroutine psb_int_idx_heap_get_first -!!$ subroutine psb_sreal_idx_heap_get_first(key,index,heap,info) -!!$ import :: psb_spk_, psb_sreal_idx_heap, psb_ipk_ -!!$ type(psb_sreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ real(psb_spk_), intent(out) :: key -!!$ end subroutine psb_sreal_idx_heap_get_first -!!$ subroutine psb_dreal_idx_heap_get_first(key,index,heap,info) -!!$ import :: psb_dpk_, psb_dreal_idx_heap, psb_ipk_ -!!$ type(psb_dreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ real(psb_dpk_), intent(out) :: key -!!$ end subroutine psb_dreal_idx_heap_get_first -!!$ subroutine psb_scomplex_idx_heap_get_first(key,index,heap,info) -!!$ import :: psb_spk_, psb_scomplex_idx_heap, psb_ipk_ -!!$ type(psb_scomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ complex(psb_spk_), intent(out) :: key -!!$ end subroutine psb_scomplex_idx_heap_get_first -!!$ -!!$ subroutine psb_dcomplex_idx_heap_get_first(key,index,heap,info) -!!$ import :: psb_dpk_, psb_dcomplex_idx_heap, psb_ipk_ -!!$ type(psb_dcomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ complex(psb_dpk_), intent(out) :: key -!!$ end subroutine psb_dcomplex_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_int_heap(key,last,heap,dir,info) -!!$ import :: psb_ipk_ -!!$ implicit none -!!$ -!!$ ! -!!$ ! Input: -!!$ ! key: the new value -!!$ ! last: pointer to the last occupied element in heap -!!$ ! heap: the heap -!!$ ! dir: sorting direction -!!$ -!!$ integer(psb_ipk_), intent(in) :: key,dir -!!$ integer(psb_ipk_), intent(inout) :: heap(:),last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_int_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_int_heap_get_first(key,last,heap,dir,info) -!!$ import :: psb_ipk_ -!!$ implicit none -!!$ -!!$ integer(psb_ipk_), intent(inout) :: key,last -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ integer(psb_ipk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_int_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_real_heap(key,last,heap,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ real(psb_spk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ real(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_real_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_real_heap_get_first(key,last,heap,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ real(psb_spk_), intent(inout) :: key -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ real(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_real_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_double_heap(key,last,heap,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ real(psb_dpk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ real(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_double_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_double_heap_get_first(key,last,heap,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ real(psb_dpk_), intent(inout) :: key -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ real(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_double_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_scomplex_heap(key,last,heap,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ complex(psb_spk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ complex(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_scomplex_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_scomplex_heap_get_first(key,last,heap,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ complex(psb_spk_), intent(inout) :: key -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ complex(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_scomplex_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_dcomplex_heap(key,last,heap,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ complex(psb_dpk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ complex(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_dcomplex_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_dcomplex_heap_get_first(key,last,heap,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ complex(psb_dpk_), intent(inout) :: key -!!$ integer(psb_ipk_), intent(inout) :: last -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ complex(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_dcomplex_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_int_idx_heap(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_ipk_ -!!$ integer(psb_ipk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index,dir -!!$ integer(psb_ipk_), intent(inout) :: heap(:),last -!!$ integer(psb_ipk_), intent(inout) :: idxs(:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_int_idx_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_int_idx_heap_get_first(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_ipk_ -!!$ integer(psb_ipk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ integer(psb_ipk_), intent(inout) :: last,idxs(:) -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ integer(psb_ipk_), intent(out) :: key -!!$ end subroutine psi_int_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_sreal_idx_heap(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ real(psb_spk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index,dir -!!$ real(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: idxs(:),last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_sreal_idx_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_sreal_idx_heap_get_first(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ real(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ integer(psb_ipk_), intent(inout) :: last,idxs(:) -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ real(psb_spk_), intent(out) :: key -!!$ end subroutine psi_sreal_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_dreal_idx_heap(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ real(psb_dpk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index,dir -!!$ real(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: idxs(:),last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_dreal_idx_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_dreal_idx_heap_get_first(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ real(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ integer(psb_ipk_), intent(inout) :: last,idxs(:) -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ real(psb_dpk_), intent(out) :: key -!!$ end subroutine psi_dreal_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_scomplex_idx_heap(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ complex(psb_spk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index,dir -!!$ complex(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: idxs(:),last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_scomplex_idx_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_scomplex_idx_heap_get_first(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_spk_, psb_ipk_ -!!$ complex(psb_spk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ integer(psb_ipk_), intent(inout) :: last,idxs(:) -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ complex(psb_spk_), intent(out) :: key -!!$ end subroutine psi_scomplex_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_insert_dcomplex_idx_heap(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ complex(psb_dpk_), intent(in) :: key -!!$ integer(psb_ipk_), intent(in) :: index,dir -!!$ complex(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(inout) :: idxs(:),last -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_insert_dcomplex_idx_heap -!!$ end interface -!!$ -!!$ interface -!!$ subroutine psi_dcomplex_idx_heap_get_first(key,index,last,heap,idxs,dir,info) -!!$ import :: psb_dpk_, psb_ipk_ -!!$ complex(psb_dpk_), intent(inout) :: heap(:) -!!$ integer(psb_ipk_), intent(out) :: index,info -!!$ integer(psb_ipk_), intent(inout) :: last,idxs(:) -!!$ integer(psb_ipk_), intent(in) :: dir -!!$ complex(psb_dpk_), intent(out) :: key -!!$ end subroutine psi_dcomplex_idx_heap_get_first -!!$ end interface -!!$ -!!$ -!!$ interface psb_free_heap -!!$ module procedure psb_free_int_heap, psb_free_int_idx_heap,& -!!$ & psb_free_sreal_idx_heap, psb_free_scomplex_idx_heap, & -!!$ & psb_free_dreal_idx_heap, psb_free_dcomplex_idx_heap -!!$ end interface -!!$ -!!$contains -!!$ -!!$ subroutine psb_free_int_heap(heap,info) -!!$ implicit none -!!$ type(psb_int_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ info=psb_success_ -!!$ if (allocated(heap%keys)) deallocate(heap%keys,stat=info) -!!$ -!!$ end subroutine psb_free_int_heap -!!$ -!!$ subroutine psb_free_sreal_idx_heap(heap,info) -!!$ implicit none -!!$ type(psb_sreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ info=psb_success_ -!!$ if (allocated(heap%keys)) deallocate(heap%keys,stat=info) -!!$ if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) -!!$ -!!$ end subroutine psb_free_sreal_idx_heap -!!$ -!!$ subroutine psb_free_dreal_idx_heap(heap,info) -!!$ implicit none -!!$ type(psb_dreal_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ info=psb_success_ -!!$ if (allocated(heap%keys)) deallocate(heap%keys,stat=info) -!!$ if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) -!!$ -!!$ end subroutine psb_free_dreal_idx_heap -!!$ -!!$ subroutine psb_free_int_idx_heap(heap,info) -!!$ implicit none -!!$ type(psb_int_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ info=psb_success_ -!!$ if (allocated(heap%keys)) deallocate(heap%keys,stat=info) -!!$ if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) -!!$ -!!$ end subroutine psb_free_int_idx_heap -!!$ -!!$ subroutine psb_free_scomplex_idx_heap(heap,info) -!!$ implicit none -!!$ type(psb_scomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ info=psb_success_ -!!$ if (allocated(heap%keys)) deallocate(heap%keys,stat=info) -!!$ if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) -!!$ -!!$ end subroutine psb_free_scomplex_idx_heap -!!$ -!!$ subroutine psb_free_dcomplex_idx_heap(heap,info) -!!$ implicit none -!!$ type(psb_dcomplex_idx_heap), intent(inout) :: heap -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ info=psb_success_ -!!$ if (allocated(heap%keys)) deallocate(heap%keys,stat=info) -!!$ if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) -!!$ -!!$ end subroutine psb_free_dcomplex_idx_heap -!!$ - end module psb_sort_mod diff --git a/base/modules/psb_z_base_vect_mod.f90 b/base/modules/psb_z_base_vect_mod.f90 index 3717135b..ce1785fc 100644 --- a/base/modules/psb_z_base_vect_mod.f90 +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -704,7 +704,7 @@ contains ! Overwrite with absolute value ! ! - !> Function base_set_scal + !> Function base_absval1 !! \memberof psb_z_base_vect_type !! \brief Set all entries to their respective absolute values. !! @@ -1428,10 +1428,13 @@ module psb_z_base_multivect_mod !!$ ! !!$ ! Scaling and norms !!$ ! -!!$ procedure, pass(x) :: scal => z_base_mlv_scal -!!$ procedure, pass(x) :: nrm2 => z_base_mlv_nrm2 -!!$ procedure, pass(x) :: amax => z_base_mlv_amax -!!$ procedure, pass(x) :: asum => z_base_mlv_asum + procedure, pass(x) :: scal => z_base_mlv_scal + procedure, pass(x) :: nrm2 => z_base_mlv_nrm2 + procedure, pass(x) :: amax => z_base_mlv_amax + procedure, pass(x) :: asum => z_base_mlv_asum + procedure, pass(x) :: absval1 => z_base_mlv_absval1 + procedure, pass(x) :: absval2 => z_base_mlv_absval2 + generic, public :: absval => absval1, absval2 !!$ ! !!$ ! Gather/scatter. These are needed for MPI interfacing. !!$ ! May have to be reworked. @@ -2289,71 +2292,120 @@ contains !!$ end subroutine z_base_mlv_mlt_va !!$ !!$ -!!$ ! -!!$ ! Simple scaling -!!$ ! -!!$ !> Function base_mlv_scal -!!$ !! \memberof psb_z_base_multivect_type -!!$ !! \brief Scale all entries x = alpha*x -!!$ !! \param alpha The multiplier -!!$ !! -!!$ subroutine z_base_mlv_scal(alpha, x) -!!$ use psi_serial_mod -!!$ implicit none -!!$ class(psb_z_base_multivect_type), intent(inout) :: x -!!$ complex(psb_dpk_), intent (in) :: alpha -!!$ -!!$ if (allocated(x%v)) x%v = alpha*x%v -!!$ -!!$ end subroutine z_base_mlv_scal -!!$ -!!$ ! -!!$ ! Norms 1, 2 and infinity -!!$ ! -!!$ !> Function base_mlv_nrm2 -!!$ !! \memberof psb_z_base_multivect_type -!!$ !! \brief 2-norm |x(1:n)|_2 -!!$ !! \param n how many entries to consider -!!$ function z_base_mlv_nrm2(n,x) result(res) -!!$ implicit none -!!$ class(psb_z_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_dpk_) :: res -!!$ integer(psb_ipk_), external :: dnrm2 -!!$ -!!$ res = dnrm2(n,x%v,1) -!!$ -!!$ end function z_base_mlv_nrm2 -!!$ -!!$ ! -!!$ !> Function base_mlv_amax -!!$ !! \memberof psb_z_base_multivect_type -!!$ !! \brief infinity-norm |x(1:n)|_\infty -!!$ !! \param n how many entries to consider -!!$ function z_base_mlv_amax(n,x) result(res) -!!$ implicit none -!!$ class(psb_z_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_dpk_) :: res -!!$ -!!$ res = maxval(abs(x%v(1:n))) -!!$ -!!$ end function z_base_mlv_amax -!!$ -!!$ ! -!!$ !> Function base_mlv_asum -!!$ !! \memberof psb_z_base_multivect_type -!!$ !! \brief 1-norm |x(1:n)|_1 -!!$ !! \param n how many entries to consider -!!$ function z_base_mlv_asum(n,x) result(res) -!!$ implicit none -!!$ class(psb_z_base_multivect_type), intent(inout) :: x -!!$ integer(psb_ipk_), intent(in) :: n -!!$ real(psb_dpk_) :: res -!!$ -!!$ res = sum(abs(x%v(1:n))) -!!$ -!!$ end function z_base_mlv_asum + ! + ! Simple scaling + ! + !> Function base_mlv_scal + !! \memberof psb_z_base_multivect_type + !! \brief Scale all entries x = alpha*x + !! \param alpha The multiplier + !! + subroutine z_base_mlv_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_z_base_multivect_type), intent(inout) :: x + complex(psb_dpk_), intent (in) :: alpha + + if (x%is_dev()) call x%sync() + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine z_base_mlv_scal + + ! + ! Norms 1, 2 and infinity + ! + !> Function base_mlv_nrm2 + !! \memberof psb_z_base_multivect_type + !! \brief 2-norm |x(1:n)|_2 + !! \param n how many entries to consider + function z_base_mlv_nrm2(n,x) result(res) + implicit none + class(psb_z_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), allocatable :: res(:) + integer(psb_ipk_), external :: dznrm2 + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = dznrm2(n,x%v(:,j),1) + end do + + end function z_base_mlv_nrm2 + + ! + !> Function base_mlv_amax + !! \memberof psb_z_base_multivect_type + !! \brief infinity-norm |x(1:n)|_\infty + !! \param n how many entries to consider + function z_base_mlv_amax(n,x) result(res) + implicit none + class(psb_z_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = maxval(abs(x%v(1:n,j))) + end do + + end function z_base_mlv_amax + + ! + !> Function base_mlv_asum + !! \memberof psb_z_base_multivect_type + !! \brief 1-norm |x(1:n)|_1 + !! \param n how many entries to consider + function z_base_mlv_asum(n,x) result(res) + implicit none + class(psb_z_base_multivect_type), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_), allocatable :: res(:) + integer(psb_ipk_) :: j, nc + + if (x%is_dev()) call x%sync() + nc = psb_size(x%v,2) + allocate(res(nc)) + do j=1,nc + res(j) = sum(abs(x%v(1:n,j))) + end do + + end function z_base_mlv_asum + ! + ! Overwrite with absolute value + ! + ! + !> Function base_absval1 + !! \memberof psb_z_base_vect_type + !! \brief Set all entries to their respective absolute values. + !! + subroutine z_base_mlv_absval1(x) + class(psb_z_base_multivect_type), intent(inout) :: x + + if (allocated(x%v)) then + if (x%is_dev()) call x%sync() + x%v = abs(x%v) + call x%set_host() + end if + + end subroutine z_base_mlv_absval1 + + subroutine z_base_mlv_absval2(x,y) + class(psb_z_base_multivect_type), intent(inout) :: x + class(psb_z_base_multivect_type), intent(inout) :: y + + if (.not.x%is_host()) call x%sync() + if (allocated(x%v)) then + call y%axpby(min(x%get_nrows(),y%get_nrows()),zone,x,zzero,info) + call y%absval() + end if + + end subroutine z_base_mlv_absval2 !!$ !!$ !!$ ! diff --git a/base/modules/psb_z_sort_mod.f90 b/base/modules/psb_z_sort_mod.f90 index b944bd40..6a74ec66 100644 --- a/base/modules/psb_z_sort_mod.f90 +++ b/base/modules/psb_z_sort_mod.f90 @@ -156,33 +156,6 @@ module psb_z_sort_mod end interface psb_hsort -!!$ interface !psb_howmany_heap -!!$ module procedure psb_z_howmany, psb_z_idx_howmany -!!$ end interface -!!$ -!!$ -!!$ interface !psb_init_heap -!!$ module procedure psb_z_init_heap, psb_z_idx_init_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_dump_heap -!!$ module procedure psb_z_dump_heap, psb_dump_z_idx_heap -!!$ end interface -!!$ -!!$ -!!$ interface !psb_insert_heap -!!$ module procedure psb_z_insert_heap, psb_z_idx_insert_heap -!!$ end interface -!!$ -!!$ interface !psb_heap_get_first -!!$ module procedure psb_z_heap_get_first, psb_z_idx_heap_get_first -!!$ end interface -!!$ -!!$ interface !psb_free_heap -!!$ module procedure psb_free_z_heap, psb_free_z_idx_heap -!!$ end interface - interface subroutine psi_z_insert_heap(key,last,heap,dir,info) import diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index 76cca5d2..e69d75a9 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -1,8 +1,8 @@ 7 Number of entries below this -BICG STAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES +BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES BJAC Preconditioner NONE DIAG BJAC CSR Storage format for matrix A: CSR COO JAD -100 Domain size (acutal system is this**3) +080 Domain size (acutal system is this**3) 2 Stopping criterion 1000 MAXIT -1 ITRACE