mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 07:04:57 +00:00
psblas:
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.
This commit is contained in:
Salvatore Filippone
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user