base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_sort_mod.f90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_sort_mod.f90
 base/modules/psb_i_sort_mod.f90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_sort_mod.f90
 base/modules/psb_sort_mod.f90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_sort_mod.f90
 test/pargen/runs/ppde.inp

Further steps in multivectors.
Cosmetics in sort_mod.
psblas-3.4-maint
Salvatore Filippone 10 years ago
parent 117204446e
commit 06ce920e4d

@ -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
!!$
!!$
!!$ !

@ -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

@ -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
!!$
!!$
!!$ !

@ -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

@ -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

@ -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
!!$
!!$
!!$ !

@ -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

@ -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

@ -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
!!$
!!$
!!$ !

@ -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

@ -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

Loading…
Cancel
Save