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

psblas3:

Browse Source 
base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_i_base_vect_mod.f90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_z_base_vect_mod.f90
 test/fileread/runs/dfs.inp
 test/pargen/runs/ppde.inp
 util/psb_d_genpde_impl.f90
 util/psb_d_genpde_mod.f90
 util/psb_s_genpde_impl.f90
 util/psb_s_genpde_mod.f90


Added doxygen comments to base_vect. 

Changed afmt to len=* in genpde.
psblas3-final
Salvatore Filippone 12 years ago
parent 1acacb1f5f
commit 693bad0f6b
11 changed files with 1383 additions and 98 deletions
Show Stats Download Patch File Download Diff File

289
base/modules/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -59,6 +59,7 @@ module psb_c_base_vect_mod
!! sparse matrix types. !! sparse matrix types.
!! !!
type psb_c_base_vect_type type psb_c_base_vect_type
!> Values.
complex(psb_spk_), allocatable :: v(:) complex(psb_spk_), allocatable :: v(:)
contains contains
! !
@ -156,6 +157,10 @@ contains
! Constructors. ! Constructors.
! !
!> Function constructor:
!! \brief Constructor from an array
!! \param x(:) input array to be copied
!!
function constructor(x) result(this) function constructor(x) result(this)
complex(psb_spk_) :: x(:) complex(psb_spk_) :: x(:)
type(psb_c_base_vect_type) :: this type(psb_c_base_vect_type) :: this
@ -166,6 +171,10 @@ contains
end function constructor end function constructor
!> Function constructor:
!! \brief Constructor from size
!! \param n Size of vector to be built.
!!
function size_const(n) result(this) function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
type(psb_c_base_vect_type) :: this type(psb_c_base_vect_type) :: this
@ -179,6 +188,11 @@ contains
! Build from a sample ! Build from a sample
! !
!> Function bld_x:
!! \memberof psb_c_base_vect_type
!! \brief Build method from an array
!! \param x(:) input array to be copied
!!
subroutine c_base_bld_x(x,this) subroutine c_base_bld_x(x,this)
use psb_realloc_mod use psb_realloc_mod
complex(psb_spk_), intent(in) :: this(:) complex(psb_spk_), intent(in) :: this(:)
@ -197,6 +211,12 @@ contains
! !
! Create with size, but no initialization ! Create with size, but no initialization
! !
!> Function bld_n:
!! \memberof psb_c_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine c_base_bld_n(x,n) subroutine c_base_bld_n(x,n)
use psb_realloc_mod use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
@ -208,6 +228,13 @@ contains
end subroutine c_base_bld_n end subroutine c_base_bld_n
!> Function base_all:
!! \memberof psb_c_base_vect_type
!! \brief Build method with size (uninitialized data) and
!! allocation return code.
!! \param n size to be allocated.
!! \param info return code
!!
subroutine c_base_all(n, x, info) subroutine c_base_all(n, x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -220,6 +247,12 @@ contains
end subroutine c_base_all end subroutine c_base_all
!> Function base_mold:
!! \memberof psb_c_base_vect_type
!! \brief Mold method: return a variable with the same dynamic type
!! \param y returned variable
!! \param info return code
!!
subroutine c_base_mold(x, y, info) subroutine c_base_mold(x, y, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -235,6 +268,30 @@ contains
! !
! Insert a bunch of values at specified positions. ! Insert a bunch of values at specified positions.
! !
!> Function base_ins:
!! \memberof psb_c_base_vect_type
!! \brief Insert coefficients.
!!
!!
!! Given a list of N pairs
!! (IRL(i),VAL(i))
!! record a new coefficient in X such that
!! X(IRL(1:N)) = VAL(1:N).
!!
!! - the update operation will perform either
!! X(IRL(1:n)) = VAL(1:N)
!! or
!! X(IRL(1:n)) = X(IRL(1:n))+VAL(1:N)
!! according to the value of DUPLICATE.
!!
!!
!! \param n number of pairs in input
!! \param irl(:) the input row indices
!! \param val(:) the input coefficients
!! \param dupl how to treat duplicate entries
!! \param info return code
!!
!
subroutine c_base_ins(n,irl,val,dupl,x,info) subroutine c_base_ins(n,irl,val,dupl,x,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -244,7 +301,7 @@ contains
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i, isz
info = 0 info = 0
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -255,13 +312,14 @@ contains
info = psb_err_invalid_input_ info = psb_err_invalid_input_
else else
isz = size(x%v)
select case(dupl) select case(dupl)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
! row actual block row ! row actual block row
if (irl(i) > 0) then if ((1 <= irl(i)).and.(irl(i) <= isz)) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = val(i) x%v(irl(i)) = val(i)
@ -272,8 +330,7 @@ contains
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
if ((1 <= irl(i)).and.(irl(i) <= isz)) then
if (irl(i) > 0) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = x%v(irl(i)) + val(i) x%v(irl(i)) = x%v(irl(i)) + val(i)
@ -282,8 +339,8 @@ contains
case default case default
info = 321 info = 321
!!$ call psb_errpush(info,name) ! !$ call psb_errpush(info,name)
!!$ goto 9999 ! !$ goto 9999
end select end select
end if end if
if (info /= 0) then if (info /= 0) then
@ -293,6 +350,11 @@ contains
end subroutine c_base_ins end subroutine c_base_ins
!
!> Function base_zero
!! \memberof psb_c_base_vect_type
!! \brief Zero out contents
!!
! !
subroutine c_base_zero(x) subroutine c_base_zero(x)
use psi_serial_mod use psi_serial_mod
@ -309,6 +371,14 @@ contains
! For derived classes: after this the vector ! For derived classes: after this the vector
! storage is supposed to be in sync. ! storage is supposed to be in sync.
! !
!> Function base_asb:
!! \memberof psb_c_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine c_base_asb(n, x, info) subroutine c_base_asb(n, x, info)
use psi_serial_mod use psi_serial_mod
@ -326,6 +396,14 @@ contains
end subroutine c_base_asb end subroutine c_base_asb
!
!> Function base_free:
!! \memberof psb_c_base_vect_type
!! \brief Free vector
!!
!! \param info return code
!!
!
subroutine c_base_free(x, info) subroutine c_base_free(x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -346,31 +424,60 @@ contains
! The base version of SYNC & friends does nothing, it's just ! The base version of SYNC & friends does nothing, it's just
! a placeholder. ! a placeholder.
! !
!
!> Function base_sync:
!! \memberof psb_c_base_vect_type
!! \brief Sync: base version is a no-op.
!!
!
subroutine c_base_sync(x) subroutine c_base_sync(x)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
end subroutine c_base_sync end subroutine c_base_sync
!
!> Function base_set_host:
!! \memberof psb_c_base_vect_type
!! \brief Set_host: base version is a no-op.
!!
!
subroutine c_base_set_host(x) subroutine c_base_set_host(x)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
end subroutine c_base_set_host end subroutine c_base_set_host
!
!> Function base_set_dev:
!! \memberof psb_c_base_vect_type
!! \brief Set_dev: base version is a no-op.
!!
!
subroutine c_base_set_dev(x) subroutine c_base_set_dev(x)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
end subroutine c_base_set_dev end subroutine c_base_set_dev
!
!> Function base_set_sync:
!! \memberof psb_c_base_vect_type
!! \brief Set_sync: base version is a no-op.
!!
!
subroutine c_base_set_sync(x) subroutine c_base_set_sync(x)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
end subroutine c_base_set_sync end subroutine c_base_set_sync
!
!> Function base_is_dev:
!! \memberof psb_c_base_vect_type
!! \brief Is vector on external device .
!!
!
function c_base_is_dev(x) result(res) function c_base_is_dev(x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(in) :: x class(psb_c_base_vect_type), intent(in) :: x
@ -379,6 +486,12 @@ contains
res = .false. res = .false.
end function c_base_is_dev end function c_base_is_dev
!
!> Function base_is_host
!! \memberof psb_c_base_vect_type
!! \brief Is vector on standard memory .
!!
!
function c_base_is_host(x) result(res) function c_base_is_host(x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(in) :: x class(psb_c_base_vect_type), intent(in) :: x
@ -387,6 +500,12 @@ contains
res = .true. res = .true.
end function c_base_is_host end function c_base_is_host
!
!> Function base_is_sync
!! \memberof psb_c_base_vect_type
!! \brief Is vector on sync .
!!
!
function c_base_is_sync(x) result(res) function c_base_is_sync(x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(in) :: x class(psb_c_base_vect_type), intent(in) :: x
@ -399,7 +518,12 @@ contains
! !
! Size info. ! Size info.
! !
!
!> Function base_get_nrows
!! \memberof psb_c_base_vect_type
!! \brief Number of entries
!!
!
function c_base_get_nrows(x) result(res) function c_base_get_nrows(x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(in) :: x class(psb_c_base_vect_type), intent(in) :: x
@ -410,6 +534,12 @@ contains
end function c_base_get_nrows end function c_base_get_nrows
!
!> Function base_get_sizeof
!! \memberof psb_c_base_vect_type
!! \brief Size in bytes
!!
!
function c_base_sizeof(x) result(res) function c_base_sizeof(x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(in) :: x class(psb_c_base_vect_type), intent(in) :: x
@ -422,10 +552,13 @@ contains
! !
! Two versions of extracting an array: one of them
! overload the assignment.
! !
!
!> Function base_get_vect
!! \memberof psb_c_base_vect_type
!! \brief Extract a copy of the contents
!!
!
function c_base_get_vect(x) result(res) function c_base_get_vect(x) result(res)
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), allocatable :: res(:) complex(psb_spk_), allocatable :: res(:)
@ -444,6 +577,12 @@ contains
! !
! Reset all values ! Reset all values
! !
!
!> Function base_set_scal
!! \memberof psb_c_base_vect_type
!! \brief Set all entries
!! \param val The value to set
!!
subroutine c_base_set_scal(x,val) subroutine c_base_set_scal(x,val)
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val complex(psb_spk_), intent(in) :: val
@ -453,6 +592,12 @@ contains
end subroutine c_base_set_scal end subroutine c_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_c_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine c_base_set_vect(x,val) subroutine c_base_set_vect(x,val)
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
@ -471,6 +616,13 @@ contains
! !
! Dot products ! Dot products
! !
!
!> Function base_dot_v
!! \memberof psb_c_base_vect_type
!! \brief Dot product by another base_vector
!! \param n Number of entries to be considere
!! \param y The other (base_vect) to be multiplied by
!!
function c_base_dot_v(n,x,y) result(res) function c_base_dot_v(n,x,y) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x, y class(psb_c_base_vect_type), intent(inout) :: x, y
@ -498,6 +650,13 @@ contains
! !
! Base workhorse is good old BLAS1 ! Base workhorse is good old BLAS1
! !
!
!> Function base_dot_a
!! \memberof psb_c_base_vect_type
!! \brief Dot product by a normal array
!! \param n Number of entries to be considere
!! \param y(:) The array to be multiplied by
!!
function c_base_dot_a(n,x,y) result(res) function c_base_dot_a(n,x,y) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
@ -513,6 +672,17 @@ contains
! !
! AXPBY is invoked via Y, hence the structure below. ! AXPBY is invoked via Y, hence the structure below.
! !
!
!
!> Function base_axpby_v
!! \memberof psb_c_base_vect_type
!! \brief AXPBY by a (base_vect) y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x The class(base_vect) to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine c_base_axpby_v(m,alpha, x, beta, y, info) subroutine c_base_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -531,6 +701,19 @@ contains
end subroutine c_base_axpby_v end subroutine c_base_axpby_v
!
! AXPBY is invoked via Y, hence the structure below.
!
!
!> Function base_axpby_a
!! \memberof psb_c_base_vect_type
!! \brief AXPBY by a normal array y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x(:) The array to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine c_base_axpby_a(m,alpha, x, beta, y, info) subroutine c_base_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -553,7 +736,13 @@ contains
! Variants expanded according to the dynamic type ! Variants expanded according to the dynamic type
! of the involved entities ! of the involved entities
! !
!
!> Function base_mlt_a
!! \memberof psb_c_base_vect_type
!! \brief Vector entry-by-entry multiply by a base_vect array y=x*y
!! \param x The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine c_base_mlt_v(x, y, info) subroutine c_base_mlt_v(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -575,6 +764,13 @@ contains
end subroutine c_base_mlt_v end subroutine c_base_mlt_v
!
!> Function base_mlt_a
!! \memberof psb_c_base_vect_type
!! \brief Vector entry-by-entry multiply by a normal array y=x*y
!! \param x(:) The array to be multiplied by
!! \param info return code
!!
subroutine c_base_mlt_a(x, y, info) subroutine c_base_mlt_a(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -592,6 +788,17 @@ contains
end subroutine c_base_mlt_a end subroutine c_base_mlt_a
!
!> Function base_mlt_a_2
!! \memberof psb_c_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by normal arrays
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x(:) The array to be multiplied b
!! \param y(:) The array to be multiplied by
!! \param info return code
!!
subroutine c_base_mlt_a_2(alpha,x,y,beta,z,info) subroutine c_base_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -660,6 +867,17 @@ contains
end if end if
end subroutine c_base_mlt_a_2 end subroutine c_base_mlt_a_2
!
!> Function base_mlt_v_2
!! \memberof psb_c_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by class(base_vect)
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x The class(base_vect) to be multiplied b
!! \param y The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod use psi_serial_mod
use psb_string_mod use psb_string_mod
@ -725,7 +943,11 @@ contains
! !
! Simple scaling ! Simple scaling
! !
!> Function base_scal
!! \memberof psb_c_base_vect_type
!! \brief Scale all entries x = alpha*x
!! \param alpha The multiplier
!!
subroutine c_base_scal(alpha, x) subroutine c_base_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -739,7 +961,10 @@ contains
! !
! Norms 1, 2 and infinity ! Norms 1, 2 and infinity
! !
!> Function base_nrm2
!! \memberof psb_c_base_vect_type
!! \brief 2-norm |x(1:n)|_2
!! \param n how many entries to consider
function c_base_nrm2(n,x) result(res) function c_base_nrm2(n,x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
@ -751,6 +976,11 @@ contains
end function c_base_nrm2 end function c_base_nrm2
!
!> Function base_amax
!! \memberof psb_c_base_vect_type
!! \brief infinity-norm |x(1:n)|_\infty
!! \param n how many entries to consider
function c_base_amax(n,x) result(res) function c_base_amax(n,x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
@ -761,6 +991,11 @@ contains
end function c_base_amax end function c_base_amax
!
!> Function base_asum
!! \memberof psb_c_base_vect_type
!! \brief 1-norm |x(1:n)|_1
!! \param n how many entries to consider
function c_base_asum(n,x) result(res) function c_base_asum(n,x) result(res)
implicit none implicit none
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
@ -775,7 +1010,15 @@ contains
! !
! Gather: Y = beta * Y + alpha * X(IDX(:)) ! Gather: Y = beta * Y + alpha * X(IDX(:))
! !
!
!> Function base_gthab
!! \memberof psb_c_base_vect_type
!! \brief gather into an array
!! Y = beta * Y + alpha * X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param alpha
!! \param beta
subroutine c_base_gthab(n,idx,alpha,x,beta,y) subroutine c_base_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -789,6 +1032,12 @@ contains
! !
! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
! !
!> Function base_gthzv
!! \memberof psb_c_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine c_base_gthzv(n,idx,x,y) subroutine c_base_gthzv(n,idx,x,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -804,7 +1053,15 @@ contains
! Scatter: ! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
! !
!
!> Function base_sctb
!! \memberof psb_c_base_vect_type
!! \brief scatter into a class(base_vect)
!! Y(IDX(:)) = beta * Y(IDX(:)) + X(:)
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param beta
!! \param x(:)
subroutine c_base_sctb(n,idx,x,beta,y) subroutine c_base_sctb(n,idx,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)

289
base/modules/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -59,6 +59,7 @@ module psb_d_base_vect_mod
!! sparse matrix types. !! sparse matrix types.
!! !!
type psb_d_base_vect_type type psb_d_base_vect_type
!> Values.
real(psb_dpk_), allocatable :: v(:) real(psb_dpk_), allocatable :: v(:)
contains contains
! !
@ -156,6 +157,10 @@ contains
! Constructors. ! Constructors.
! !
!> Function constructor:
!! \brief Constructor from an array
!! \param x(:) input array to be copied
!!
function constructor(x) result(this) function constructor(x) result(this)
real(psb_dpk_) :: x(:) real(psb_dpk_) :: x(:)
type(psb_d_base_vect_type) :: this type(psb_d_base_vect_type) :: this
@ -166,6 +171,10 @@ contains
end function constructor end function constructor
!> Function constructor:
!! \brief Constructor from size
!! \param n Size of vector to be built.
!!
function size_const(n) result(this) function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
type(psb_d_base_vect_type) :: this type(psb_d_base_vect_type) :: this
@ -179,6 +188,11 @@ contains
! Build from a sample ! Build from a sample
! !
!> Function bld_x:
!! \memberof psb_d_base_vect_type
!! \brief Build method from an array
!! \param x(:) input array to be copied
!!
subroutine d_base_bld_x(x,this) subroutine d_base_bld_x(x,this)
use psb_realloc_mod use psb_realloc_mod
real(psb_dpk_), intent(in) :: this(:) real(psb_dpk_), intent(in) :: this(:)
@ -197,6 +211,12 @@ contains
! !
! Create with size, but no initialization ! Create with size, but no initialization
! !
!> Function bld_n:
!! \memberof psb_d_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine d_base_bld_n(x,n) subroutine d_base_bld_n(x,n)
use psb_realloc_mod use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
@ -208,6 +228,13 @@ contains
end subroutine d_base_bld_n end subroutine d_base_bld_n
!> Function base_all:
!! \memberof psb_d_base_vect_type
!! \brief Build method with size (uninitialized data) and
!! allocation return code.
!! \param n size to be allocated.
!! \param info return code
!!
subroutine d_base_all(n, x, info) subroutine d_base_all(n, x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -220,6 +247,12 @@ contains
end subroutine d_base_all end subroutine d_base_all
!> Function base_mold:
!! \memberof psb_d_base_vect_type
!! \brief Mold method: return a variable with the same dynamic type
!! \param y returned variable
!! \param info return code
!!
subroutine d_base_mold(x, y, info) subroutine d_base_mold(x, y, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -235,6 +268,30 @@ contains
! !
! Insert a bunch of values at specified positions. ! Insert a bunch of values at specified positions.
! !
!> Function base_ins:
!! \memberof psb_d_base_vect_type
!! \brief Insert coefficients.
!!
!!
!! Given a list of N pairs
!! (IRL(i),VAL(i))
!! record a new coefficient in X such that
!! X(IRL(1:N)) = VAL(1:N).
!!
!! - the update operation will perform either
!! X(IRL(1:n)) = VAL(1:N)
!! or
!! X(IRL(1:n)) = X(IRL(1:n))+VAL(1:N)
!! according to the value of DUPLICATE.
!!
!!
!! \param n number of pairs in input
!! \param irl(:) the input row indices
!! \param val(:) the input coefficients
!! \param dupl how to treat duplicate entries
!! \param info return code
!!
!
subroutine d_base_ins(n,irl,val,dupl,x,info) subroutine d_base_ins(n,irl,val,dupl,x,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -244,7 +301,7 @@ contains
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i, isz
info = 0 info = 0
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -255,13 +312,14 @@ contains
info = psb_err_invalid_input_ info = psb_err_invalid_input_
else else
isz = size(x%v)
select case(dupl) select case(dupl)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
! row actual block row ! row actual block row
if (irl(i) > 0) then if ((1 <= irl(i)).and.(irl(i) <= isz)) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = val(i) x%v(irl(i)) = val(i)
@ -272,8 +330,7 @@ contains
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
if ((1 <= irl(i)).and.(irl(i) <= isz)) then
if (irl(i) > 0) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = x%v(irl(i)) + val(i) x%v(irl(i)) = x%v(irl(i)) + val(i)
@ -282,8 +339,8 @@ contains
case default case default
info = 321 info = 321
!!$ call psb_errpush(info,name) ! !$ call psb_errpush(info,name)
!!$ goto 9999 ! !$ goto 9999
end select end select
end if end if
if (info /= 0) then if (info /= 0) then
@ -293,6 +350,11 @@ contains
end subroutine d_base_ins end subroutine d_base_ins
!
!> Function base_zero
!! \memberof psb_d_base_vect_type
!! \brief Zero out contents
!!
! !
subroutine d_base_zero(x) subroutine d_base_zero(x)
use psi_serial_mod use psi_serial_mod
@ -309,6 +371,14 @@ contains
! For derived classes: after this the vector ! For derived classes: after this the vector
! storage is supposed to be in sync. ! storage is supposed to be in sync.
! !
!> Function base_asb:
!! \memberof psb_d_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine d_base_asb(n, x, info) subroutine d_base_asb(n, x, info)
use psi_serial_mod use psi_serial_mod
@ -326,6 +396,14 @@ contains
end subroutine d_base_asb end subroutine d_base_asb
!
!> Function base_free:
!! \memberof psb_d_base_vect_type
!! \brief Free vector
!!
!! \param info return code
!!
!
subroutine d_base_free(x, info) subroutine d_base_free(x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -346,31 +424,60 @@ contains
! The base version of SYNC & friends does nothing, it's just ! The base version of SYNC & friends does nothing, it's just
! a placeholder. ! a placeholder.
! !
!
!> Function base_sync:
!! \memberof psb_d_base_vect_type
!! \brief Sync: base version is a no-op.
!!
!
subroutine d_base_sync(x) subroutine d_base_sync(x)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
end subroutine d_base_sync end subroutine d_base_sync
!
!> Function base_set_host:
!! \memberof psb_d_base_vect_type
!! \brief Set_host: base version is a no-op.
!!
!
subroutine d_base_set_host(x) subroutine d_base_set_host(x)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
end subroutine d_base_set_host end subroutine d_base_set_host
!
!> Function base_set_dev:
!! \memberof psb_d_base_vect_type
!! \brief Set_dev: base version is a no-op.
!!
!
subroutine d_base_set_dev(x) subroutine d_base_set_dev(x)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
end subroutine d_base_set_dev end subroutine d_base_set_dev
!
!> Function base_set_sync:
!! \memberof psb_d_base_vect_type
!! \brief Set_sync: base version is a no-op.
!!
!
subroutine d_base_set_sync(x) subroutine d_base_set_sync(x)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
end subroutine d_base_set_sync end subroutine d_base_set_sync
!
!> Function base_is_dev:
!! \memberof psb_d_base_vect_type
!! \brief Is vector on external device .
!!
!
function d_base_is_dev(x) result(res) function d_base_is_dev(x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(in) :: x class(psb_d_base_vect_type), intent(in) :: x
@ -379,6 +486,12 @@ contains
res = .false. res = .false.
end function d_base_is_dev end function d_base_is_dev
!
!> Function base_is_host
!! \memberof psb_d_base_vect_type
!! \brief Is vector on standard memory .
!!
!
function d_base_is_host(x) result(res) function d_base_is_host(x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(in) :: x class(psb_d_base_vect_type), intent(in) :: x
@ -387,6 +500,12 @@ contains
res = .true. res = .true.
end function d_base_is_host end function d_base_is_host
!
!> Function base_is_sync
!! \memberof psb_d_base_vect_type
!! \brief Is vector on sync .
!!
!
function d_base_is_sync(x) result(res) function d_base_is_sync(x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(in) :: x class(psb_d_base_vect_type), intent(in) :: x
@ -399,7 +518,12 @@ contains
! !
! Size info. ! Size info.
! !
!
!> Function base_get_nrows
!! \memberof psb_d_base_vect_type
!! \brief Number of entries
!!
!
function d_base_get_nrows(x) result(res) function d_base_get_nrows(x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(in) :: x class(psb_d_base_vect_type), intent(in) :: x
@ -410,6 +534,12 @@ contains
end function d_base_get_nrows end function d_base_get_nrows
!
!> Function base_get_sizeof
!! \memberof psb_d_base_vect_type
!! \brief Size in bytes
!!
!
function d_base_sizeof(x) result(res) function d_base_sizeof(x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(in) :: x class(psb_d_base_vect_type), intent(in) :: x
@ -422,10 +552,13 @@ contains
! !
! Two versions of extracting an array: one of them
! overload the assignment.
! !
!
!> Function base_get_vect
!! \memberof psb_d_base_vect_type
!! \brief Extract a copy of the contents
!!
!
function d_base_get_vect(x) result(res) function d_base_get_vect(x) result(res)
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), allocatable :: res(:) real(psb_dpk_), allocatable :: res(:)
@ -444,6 +577,12 @@ contains
! !
! Reset all values ! Reset all values
! !
!
!> Function base_set_scal
!! \memberof psb_d_base_vect_type
!! \brief Set all entries
!! \param val The value to set
!!
subroutine d_base_set_scal(x,val) subroutine d_base_set_scal(x,val)
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
@ -453,6 +592,12 @@ contains
end subroutine d_base_set_scal end subroutine d_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_d_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine d_base_set_vect(x,val) subroutine d_base_set_vect(x,val)
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
@ -471,6 +616,13 @@ contains
! !
! Dot products ! Dot products
! !
!
!> Function base_dot_v
!! \memberof psb_d_base_vect_type
!! \brief Dot product by another base_vector
!! \param n Number of entries to be considere
!! \param y The other (base_vect) to be multiplied by
!!
function d_base_dot_v(n,x,y) result(res) function d_base_dot_v(n,x,y) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x, y class(psb_d_base_vect_type), intent(inout) :: x, y
@ -498,6 +650,13 @@ contains
! !
! Base workhorse is good old BLAS1 ! Base workhorse is good old BLAS1
! !
!
!> Function base_dot_a
!! \memberof psb_d_base_vect_type
!! \brief Dot product by a normal array
!! \param n Number of entries to be considere
!! \param y(:) The array to be multiplied by
!!
function d_base_dot_a(n,x,y) result(res) function d_base_dot_a(n,x,y) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
@ -513,6 +672,17 @@ contains
! !
! AXPBY is invoked via Y, hence the structure below. ! AXPBY is invoked via Y, hence the structure below.
! !
!
!
!> Function base_axpby_v
!! \memberof psb_d_base_vect_type
!! \brief AXPBY by a (base_vect) y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x The class(base_vect) to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine d_base_axpby_v(m,alpha, x, beta, y, info) subroutine d_base_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -531,6 +701,19 @@ contains
end subroutine d_base_axpby_v end subroutine d_base_axpby_v
!
! AXPBY is invoked via Y, hence the structure below.
!
!
!> Function base_axpby_a
!! \memberof psb_d_base_vect_type
!! \brief AXPBY by a normal array y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x(:) The array to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine d_base_axpby_a(m,alpha, x, beta, y, info) subroutine d_base_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -553,7 +736,13 @@ contains
! Variants expanded according to the dynamic type ! Variants expanded according to the dynamic type
! of the involved entities ! of the involved entities
! !
!
!> Function base_mlt_a
!! \memberof psb_d_base_vect_type
!! \brief Vector entry-by-entry multiply by a base_vect array y=x*y
!! \param x The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine d_base_mlt_v(x, y, info) subroutine d_base_mlt_v(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -575,6 +764,13 @@ contains
end subroutine d_base_mlt_v end subroutine d_base_mlt_v
!
!> Function base_mlt_a
!! \memberof psb_d_base_vect_type
!! \brief Vector entry-by-entry multiply by a normal array y=x*y
!! \param x(:) The array to be multiplied by
!! \param info return code
!!
subroutine d_base_mlt_a(x, y, info) subroutine d_base_mlt_a(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -592,6 +788,17 @@ contains
end subroutine d_base_mlt_a end subroutine d_base_mlt_a
!
!> Function base_mlt_a_2
!! \memberof psb_d_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by normal arrays
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x(:) The array to be multiplied b
!! \param y(:) The array to be multiplied by
!! \param info return code
!!
subroutine d_base_mlt_a_2(alpha,x,y,beta,z,info) subroutine d_base_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -660,6 +867,17 @@ contains
end if end if
end subroutine d_base_mlt_a_2 end subroutine d_base_mlt_a_2
!
!> Function base_mlt_v_2
!! \memberof psb_d_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by class(base_vect)
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x The class(base_vect) to be multiplied b
!! \param y The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine d_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) subroutine d_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod use psi_serial_mod
use psb_string_mod use psb_string_mod
@ -725,7 +943,11 @@ contains
! !
! Simple scaling ! Simple scaling
! !
!> Function base_scal
!! \memberof psb_d_base_vect_type
!! \brief Scale all entries x = alpha*x
!! \param alpha The multiplier
!!
subroutine d_base_scal(alpha, x) subroutine d_base_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -739,7 +961,10 @@ contains
! !
! Norms 1, 2 and infinity ! Norms 1, 2 and infinity
! !
!> Function base_nrm2
!! \memberof psb_d_base_vect_type
!! \brief 2-norm |x(1:n)|_2
!! \param n how many entries to consider
function d_base_nrm2(n,x) result(res) function d_base_nrm2(n,x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
@ -751,6 +976,11 @@ contains
end function d_base_nrm2 end function d_base_nrm2
!
!> Function base_amax
!! \memberof psb_d_base_vect_type
!! \brief infinity-norm |x(1:n)|_\infty
!! \param n how many entries to consider
function d_base_amax(n,x) result(res) function d_base_amax(n,x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
@ -761,6 +991,11 @@ contains
end function d_base_amax end function d_base_amax
!
!> Function base_asum
!! \memberof psb_d_base_vect_type
!! \brief 1-norm |x(1:n)|_1
!! \param n how many entries to consider
function d_base_asum(n,x) result(res) function d_base_asum(n,x) result(res)
implicit none implicit none
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
@ -775,7 +1010,15 @@ contains
! !
! Gather: Y = beta * Y + alpha * X(IDX(:)) ! Gather: Y = beta * Y + alpha * X(IDX(:))
! !
!
!> Function base_gthab
!! \memberof psb_d_base_vect_type
!! \brief gather into an array
!! Y = beta * Y + alpha * X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param alpha
!! \param beta
subroutine d_base_gthab(n,idx,alpha,x,beta,y) subroutine d_base_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -789,6 +1032,12 @@ contains
! !
! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
! !
!> Function base_gthzv
!! \memberof psb_d_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine d_base_gthzv(n,idx,x,y) subroutine d_base_gthzv(n,idx,x,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -804,7 +1053,15 @@ contains
! Scatter: ! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
! !
!
!> Function base_sctb
!! \memberof psb_d_base_vect_type
!! \brief scatter into a class(base_vect)
!! Y(IDX(:)) = beta * Y(IDX(:)) + X(:)
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param beta
!! \param x(:)
subroutine d_base_sctb(n,idx,x,beta,y) subroutine d_base_sctb(n,idx,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)

289
base/modules/psb_i_base_vect_mod.f90
Unescape Escape View File

@ -59,6 +59,7 @@ module psb_i_base_vect_mod
!! sparse matrix types. !! sparse matrix types.
!! !!
type psb_i_base_vect_type type psb_i_base_vect_type
!> Values.
integer(psb_ipk_), allocatable :: v(:) integer(psb_ipk_), allocatable :: v(:)
contains contains
! !
@ -156,6 +157,10 @@ contains
! Constructors. ! Constructors.
! !
!> Function constructor:
!! \brief Constructor from an array
!! \param x(:) input array to be copied
!!
function constructor(x) result(this) function constructor(x) result(this)
integer(psb_ipk_) :: x(:) integer(psb_ipk_) :: x(:)
type(psb_i_base_vect_type) :: this type(psb_i_base_vect_type) :: this
@ -166,6 +171,10 @@ contains
end function constructor end function constructor
!> Function constructor:
!! \brief Constructor from size
!! \param n Size of vector to be built.
!!
function size_const(n) result(this) function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
type(psb_i_base_vect_type) :: this type(psb_i_base_vect_type) :: this
@ -179,6 +188,11 @@ contains
! Build from a sample ! Build from a sample
! !
!> Function bld_x:
!! \memberof psb_i_base_vect_type
!! \brief Build method from an array
!! \param x(:) input array to be copied
!!
subroutine i_base_bld_x(x,this) subroutine i_base_bld_x(x,this)
use psb_realloc_mod use psb_realloc_mod
integer(psb_ipk_), intent(in) :: this(:) integer(psb_ipk_), intent(in) :: this(:)
@ -197,6 +211,12 @@ contains
! !
! Create with size, but no initialization ! Create with size, but no initialization
! !
!> Function bld_n:
!! \memberof psb_i_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine i_base_bld_n(x,n) subroutine i_base_bld_n(x,n)
use psb_realloc_mod use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
@ -208,6 +228,13 @@ contains
end subroutine i_base_bld_n end subroutine i_base_bld_n
!> Function base_all:
!! \memberof psb_i_base_vect_type
!! \brief Build method with size (uninitialized data) and
!! allocation return code.
!! \param n size to be allocated.
!! \param info return code
!!
subroutine i_base_all(n, x, info) subroutine i_base_all(n, x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -220,6 +247,12 @@ contains
end subroutine i_base_all end subroutine i_base_all
!> Function base_mold:
!! \memberof psb_i_base_vect_type
!! \brief Mold method: return a variable with the same dynamic type
!! \param y returned variable
!! \param info return code
!!
subroutine i_base_mold(x, y, info) subroutine i_base_mold(x, y, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -235,6 +268,30 @@ contains
! !
! Insert a bunch of values at specified positions. ! Insert a bunch of values at specified positions.
! !
!> Function base_ins:
!! \memberof psb_i_base_vect_type
!! \brief Insert coefficients.
!!
!!
!! Given a list of N pairs
!! (IRL(i),VAL(i))
!! record a new coefficient in X such that
!! X(IRL(1:N)) = VAL(1:N).
!!
!! - the update operation will perform either
!! X(IRL(1:n)) = VAL(1:N)
!! or
!! X(IRL(1:n)) = X(IRL(1:n))+VAL(1:N)
!! according to the value of DUPLICATE.
!!
!!
!! \param n number of pairs in input
!! \param irl(:) the input row indices
!! \param val(:) the input coefficients
!! \param dupl how to treat duplicate entries
!! \param info return code
!!
!
subroutine i_base_ins(n,irl,val,dupl,x,info) subroutine i_base_ins(n,irl,val,dupl,x,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -244,7 +301,7 @@ contains
integer(psb_ipk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i, isz
info = 0 info = 0
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -255,13 +312,14 @@ contains
info = psb_err_invalid_input_ info = psb_err_invalid_input_
else else
isz = size(x%v)
select case(dupl) select case(dupl)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
! row actual block row ! row actual block row
if (irl(i) > 0) then if ((1 <= irl(i)).and.(irl(i) <= isz)) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = val(i) x%v(irl(i)) = val(i)
@ -272,8 +330,7 @@ contains
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
if ((1 <= irl(i)).and.(irl(i) <= isz)) then
if (irl(i) > 0) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = x%v(irl(i)) + val(i) x%v(irl(i)) = x%v(irl(i)) + val(i)
@ -282,8 +339,8 @@ contains
case default case default
info = 321 info = 321
!!$ call psb_errpush(info,name) ! !$ call psb_errpush(info,name)
!!$ goto 9999 ! !$ goto 9999
end select end select
end if end if
if (info /= 0) then if (info /= 0) then
@ -293,6 +350,11 @@ contains
end subroutine i_base_ins end subroutine i_base_ins
!
!> Function base_zero
!! \memberof psb_i_base_vect_type
!! \brief Zero out contents
!!
! !
subroutine i_base_zero(x) subroutine i_base_zero(x)
use psi_serial_mod use psi_serial_mod
@ -309,6 +371,14 @@ contains
! For derived classes: after this the vector ! For derived classes: after this the vector
! storage is supposed to be in sync. ! storage is supposed to be in sync.
! !
!> Function base_asb:
!! \memberof psb_i_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine i_base_asb(n, x, info) subroutine i_base_asb(n, x, info)
use psi_serial_mod use psi_serial_mod
@ -326,6 +396,14 @@ contains
end subroutine i_base_asb end subroutine i_base_asb
!
!> Function base_free:
!! \memberof psb_i_base_vect_type
!! \brief Free vector
!!
!! \param info return code
!!
!
subroutine i_base_free(x, info) subroutine i_base_free(x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -346,31 +424,60 @@ contains
! The base version of SYNC & friends does nothing, it's just ! The base version of SYNC & friends does nothing, it's just
! a placeholder. ! a placeholder.
! !
!
!> Function base_sync:
!! \memberof psb_i_base_vect_type
!! \brief Sync: base version is a no-op.
!!
!
subroutine i_base_sync(x) subroutine i_base_sync(x)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_sync end subroutine i_base_sync
!
!> Function base_set_host:
!! \memberof psb_i_base_vect_type
!! \brief Set_host: base version is a no-op.
!!
!
subroutine i_base_set_host(x) subroutine i_base_set_host(x)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_set_host end subroutine i_base_set_host
!
!> Function base_set_dev:
!! \memberof psb_i_base_vect_type
!! \brief Set_dev: base version is a no-op.
!!
!
subroutine i_base_set_dev(x) subroutine i_base_set_dev(x)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_set_dev end subroutine i_base_set_dev
!
!> Function base_set_sync:
!! \memberof psb_i_base_vect_type
!! \brief Set_sync: base version is a no-op.
!!
!
subroutine i_base_set_sync(x) subroutine i_base_set_sync(x)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_set_sync end subroutine i_base_set_sync
!
!> Function base_is_dev:
!! \memberof psb_i_base_vect_type
!! \brief Is vector on external device .
!!
!
function i_base_is_dev(x) result(res) function i_base_is_dev(x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(in) :: x class(psb_i_base_vect_type), intent(in) :: x
@ -379,6 +486,12 @@ contains
res = .false. res = .false.
end function i_base_is_dev end function i_base_is_dev
!
!> Function base_is_host
!! \memberof psb_i_base_vect_type
!! \brief Is vector on standard memory .
!!
!
function i_base_is_host(x) result(res) function i_base_is_host(x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(in) :: x class(psb_i_base_vect_type), intent(in) :: x
@ -387,6 +500,12 @@ contains
res = .true. res = .true.
end function i_base_is_host end function i_base_is_host
!
!> Function base_is_sync
!! \memberof psb_i_base_vect_type
!! \brief Is vector on sync .
!!
!
function i_base_is_sync(x) result(res) function i_base_is_sync(x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(in) :: x class(psb_i_base_vect_type), intent(in) :: x
@ -399,7 +518,12 @@ contains
! !
! Size info. ! Size info.
! !
!
!> Function base_get_nrows
!! \memberof psb_i_base_vect_type
!! \brief Number of entries
!!
!
function i_base_get_nrows(x) result(res) function i_base_get_nrows(x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(in) :: x class(psb_i_base_vect_type), intent(in) :: x
@ -410,6 +534,12 @@ contains
end function i_base_get_nrows end function i_base_get_nrows
!
!> Function base_get_sizeof
!! \memberof psb_i_base_vect_type
!! \brief Size in bytes
!!
!
function i_base_sizeof(x) result(res) function i_base_sizeof(x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(in) :: x class(psb_i_base_vect_type), intent(in) :: x
@ -422,10 +552,13 @@ contains
! !
! Two versions of extracting an array: one of them
! overload the assignment.
! !
!
!> Function base_get_vect
!! \memberof psb_i_base_vect_type
!! \brief Extract a copy of the contents
!!
!
function i_base_get_vect(x) result(res) function i_base_get_vect(x) result(res)
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:) integer(psb_ipk_), allocatable :: res(:)
@ -444,6 +577,12 @@ contains
! !
! Reset all values ! Reset all values
! !
!
!> Function base_set_scal
!! \memberof psb_i_base_vect_type
!! \brief Set all entries
!! \param val The value to set
!!
subroutine i_base_set_scal(x,val) subroutine i_base_set_scal(x,val)
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
@ -453,6 +592,12 @@ contains
end subroutine i_base_set_scal end subroutine i_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_i_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine i_base_set_vect(x,val) subroutine i_base_set_vect(x,val)
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val(:) integer(psb_ipk_), intent(in) :: val(:)
@ -471,6 +616,13 @@ contains
! !
! Dot products ! Dot products
! !
!
!> Function base_dot_v
!! \memberof psb_i_base_vect_type
!! \brief Dot product by another base_vector
!! \param n Number of entries to be considere
!! \param y The other (base_vect) to be multiplied by
!!
function i_base_dot_v(n,x,y) result(res) function i_base_dot_v(n,x,y) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x, y class(psb_i_base_vect_type), intent(inout) :: x, y
@ -498,6 +650,13 @@ contains
! !
! Base workhorse is good old BLAS1 ! Base workhorse is good old BLAS1
! !
!
!> Function base_dot_a
!! \memberof psb_i_base_vect_type
!! \brief Dot product by a normal array
!! \param n Number of entries to be considere
!! \param y(:) The array to be multiplied by
!!
function i_base_dot_a(n,x,y) result(res) function i_base_dot_a(n,x,y) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
@ -513,6 +672,17 @@ contains
! !
! AXPBY is invoked via Y, hence the structure below. ! AXPBY is invoked via Y, hence the structure below.
! !
!
!
!> Function base_axpby_v
!! \memberof psb_i_base_vect_type
!! \brief AXPBY by a (base_vect) y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x The class(base_vect) to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine i_base_axpby_v(m,alpha, x, beta, y, info) subroutine i_base_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -531,6 +701,19 @@ contains
end subroutine i_base_axpby_v end subroutine i_base_axpby_v
!
! AXPBY is invoked via Y, hence the structure below.
!
!
!> Function base_axpby_a
!! \memberof psb_i_base_vect_type
!! \brief AXPBY by a normal array y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x(:) The array to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine i_base_axpby_a(m,alpha, x, beta, y, info) subroutine i_base_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -553,7 +736,13 @@ contains
! Variants expanded according to the dynamic type ! Variants expanded according to the dynamic type
! of the involved entities ! of the involved entities
! !
!
!> Function base_mlt_a
!! \memberof psb_i_base_vect_type
!! \brief Vector entry-by-entry multiply by a base_vect array y=x*y
!! \param x The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine i_base_mlt_v(x, y, info) subroutine i_base_mlt_v(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -575,6 +764,13 @@ contains
end subroutine i_base_mlt_v end subroutine i_base_mlt_v
!
!> Function base_mlt_a
!! \memberof psb_i_base_vect_type
!! \brief Vector entry-by-entry multiply by a normal array y=x*y
!! \param x(:) The array to be multiplied by
!! \param info return code
!!
subroutine i_base_mlt_a(x, y, info) subroutine i_base_mlt_a(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -592,6 +788,17 @@ contains
end subroutine i_base_mlt_a end subroutine i_base_mlt_a
!
!> Function base_mlt_a_2
!! \memberof psb_i_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by normal arrays
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x(:) The array to be multiplied b
!! \param y(:) The array to be multiplied by
!! \param info return code
!!
subroutine i_base_mlt_a_2(alpha,x,y,beta,z,info) subroutine i_base_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -660,6 +867,17 @@ contains
end if end if
end subroutine i_base_mlt_a_2 end subroutine i_base_mlt_a_2
!
!> Function base_mlt_v_2
!! \memberof psb_i_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by class(base_vect)
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x The class(base_vect) to be multiplied b
!! \param y The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine i_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) subroutine i_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod use psi_serial_mod
use psb_string_mod use psb_string_mod
@ -725,7 +943,11 @@ contains
! !
! Simple scaling ! Simple scaling
! !
!> Function base_scal
!! \memberof psb_i_base_vect_type
!! \brief Scale all entries x = alpha*x
!! \param alpha The multiplier
!!
subroutine i_base_scal(alpha, x) subroutine i_base_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -739,7 +961,10 @@ contains
! !
! Norms 1, 2 and infinity ! Norms 1, 2 and infinity
! !
!> Function base_nrm2
!! \memberof psb_i_base_vect_type
!! \brief 2-norm |x(1:n)|_2
!! \param n how many entries to consider
function i_base_nrm2(n,x) result(res) function i_base_nrm2(n,x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
@ -751,6 +976,11 @@ contains
end function i_base_nrm2 end function i_base_nrm2
!
!> Function base_amax
!! \memberof psb_i_base_vect_type
!! \brief infinity-norm |x(1:n)|_\infty
!! \param n how many entries to consider
function i_base_amax(n,x) result(res) function i_base_amax(n,x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
@ -761,6 +991,11 @@ contains
end function i_base_amax end function i_base_amax
!
!> Function base_asum
!! \memberof psb_i_base_vect_type
!! \brief 1-norm |x(1:n)|_1
!! \param n how many entries to consider
function i_base_asum(n,x) result(res) function i_base_asum(n,x) result(res)
implicit none implicit none
class(psb_i_base_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(inout) :: x
@ -775,7 +1010,15 @@ contains
! !
! Gather: Y = beta * Y + alpha * X(IDX(:)) ! Gather: Y = beta * Y + alpha * X(IDX(:))
! !
!
!> Function base_gthab
!! \memberof psb_i_base_vect_type
!! \brief gather into an array
!! Y = beta * Y + alpha * X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param alpha
!! \param beta
subroutine i_base_gthab(n,idx,alpha,x,beta,y) subroutine i_base_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -789,6 +1032,12 @@ contains
! !
! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
! !
!> Function base_gthzv
!! \memberof psb_i_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine i_base_gthzv(n,idx,x,y) subroutine i_base_gthzv(n,idx,x,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -804,7 +1053,15 @@ contains
! Scatter: ! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
! !
!
!> Function base_sctb
!! \memberof psb_i_base_vect_type
!! \brief scatter into a class(base_vect)
!! Y(IDX(:)) = beta * Y(IDX(:)) + X(:)
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param beta
!! \param x(:)
subroutine i_base_sctb(n,idx,x,beta,y) subroutine i_base_sctb(n,idx,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)

289
base/modules/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -59,6 +59,7 @@ module psb_s_base_vect_mod
!! sparse matrix types. !! sparse matrix types.
!! !!
type psb_s_base_vect_type type psb_s_base_vect_type
!> Values.
real(psb_spk_), allocatable :: v(:) real(psb_spk_), allocatable :: v(:)
contains contains
! !
@ -156,6 +157,10 @@ contains
! Constructors. ! Constructors.
! !
!> Function constructor:
!! \brief Constructor from an array
!! \param x(:) input array to be copied
!!
function constructor(x) result(this) function constructor(x) result(this)
real(psb_spk_) :: x(:) real(psb_spk_) :: x(:)
type(psb_s_base_vect_type) :: this type(psb_s_base_vect_type) :: this
@ -166,6 +171,10 @@ contains
end function constructor end function constructor
!> Function constructor:
!! \brief Constructor from size
!! \param n Size of vector to be built.
!!
function size_const(n) result(this) function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
type(psb_s_base_vect_type) :: this type(psb_s_base_vect_type) :: this
@ -179,6 +188,11 @@ contains
! Build from a sample ! Build from a sample
! !
!> Function bld_x:
!! \memberof psb_s_base_vect_type
!! \brief Build method from an array
!! \param x(:) input array to be copied
!!
subroutine s_base_bld_x(x,this) subroutine s_base_bld_x(x,this)
use psb_realloc_mod use psb_realloc_mod
real(psb_spk_), intent(in) :: this(:) real(psb_spk_), intent(in) :: this(:)
@ -197,6 +211,12 @@ contains
! !
! Create with size, but no initialization ! Create with size, but no initialization
! !
!> Function bld_n:
!! \memberof psb_s_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine s_base_bld_n(x,n) subroutine s_base_bld_n(x,n)
use psb_realloc_mod use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
@ -208,6 +228,13 @@ contains
end subroutine s_base_bld_n end subroutine s_base_bld_n
!> Function base_all:
!! \memberof psb_s_base_vect_type
!! \brief Build method with size (uninitialized data) and
!! allocation return code.
!! \param n size to be allocated.
!! \param info return code
!!
subroutine s_base_all(n, x, info) subroutine s_base_all(n, x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -220,6 +247,12 @@ contains
end subroutine s_base_all end subroutine s_base_all
!> Function base_mold:
!! \memberof psb_s_base_vect_type
!! \brief Mold method: return a variable with the same dynamic type
!! \param y returned variable
!! \param info return code
!!
subroutine s_base_mold(x, y, info) subroutine s_base_mold(x, y, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -235,6 +268,30 @@ contains
! !
! Insert a bunch of values at specified positions. ! Insert a bunch of values at specified positions.
! !
!> Function base_ins:
!! \memberof psb_s_base_vect_type
!! \brief Insert coefficients.
!!
!!
!! Given a list of N pairs
!! (IRL(i),VAL(i))
!! record a new coefficient in X such that
!! X(IRL(1:N)) = VAL(1:N).
!!
!! - the update operation will perform either
!! X(IRL(1:n)) = VAL(1:N)
!! or
!! X(IRL(1:n)) = X(IRL(1:n))+VAL(1:N)
!! according to the value of DUPLICATE.
!!
!!
!! \param n number of pairs in input
!! \param irl(:) the input row indices
!! \param val(:) the input coefficients
!! \param dupl how to treat duplicate entries
!! \param info return code
!!
!
subroutine s_base_ins(n,irl,val,dupl,x,info) subroutine s_base_ins(n,irl,val,dupl,x,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -244,7 +301,7 @@ contains
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i, isz
info = 0 info = 0
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -255,13 +312,14 @@ contains
info = psb_err_invalid_input_ info = psb_err_invalid_input_
else else
isz = size(x%v)
select case(dupl) select case(dupl)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
! row actual block row ! row actual block row
if (irl(i) > 0) then if ((1 <= irl(i)).and.(irl(i) <= isz)) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = val(i) x%v(irl(i)) = val(i)
@ -272,8 +330,7 @@ contains
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
if ((1 <= irl(i)).and.(irl(i) <= isz)) then
if (irl(i) > 0) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = x%v(irl(i)) + val(i) x%v(irl(i)) = x%v(irl(i)) + val(i)
@ -282,8 +339,8 @@ contains
case default case default
info = 321 info = 321
!!$ call psb_errpush(info,name) ! !$ call psb_errpush(info,name)
!!$ goto 9999 ! !$ goto 9999
end select end select
end if end if
if (info /= 0) then if (info /= 0) then
@ -293,6 +350,11 @@ contains
end subroutine s_base_ins end subroutine s_base_ins
!
!> Function base_zero
!! \memberof psb_s_base_vect_type
!! \brief Zero out contents
!!
! !
subroutine s_base_zero(x) subroutine s_base_zero(x)
use psi_serial_mod use psi_serial_mod
@ -309,6 +371,14 @@ contains
! For derived classes: after this the vector ! For derived classes: after this the vector
! storage is supposed to be in sync. ! storage is supposed to be in sync.
! !
!> Function base_asb:
!! \memberof psb_s_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine s_base_asb(n, x, info) subroutine s_base_asb(n, x, info)
use psi_serial_mod use psi_serial_mod
@ -326,6 +396,14 @@ contains
end subroutine s_base_asb end subroutine s_base_asb
!
!> Function base_free:
!! \memberof psb_s_base_vect_type
!! \brief Free vector
!!
!! \param info return code
!!
!
subroutine s_base_free(x, info) subroutine s_base_free(x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -346,31 +424,60 @@ contains
! The base version of SYNC & friends does nothing, it's just ! The base version of SYNC & friends does nothing, it's just
! a placeholder. ! a placeholder.
! !
!
!> Function base_sync:
!! \memberof psb_s_base_vect_type
!! \brief Sync: base version is a no-op.
!!
!
subroutine s_base_sync(x) subroutine s_base_sync(x)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
end subroutine s_base_sync end subroutine s_base_sync
!
!> Function base_set_host:
!! \memberof psb_s_base_vect_type
!! \brief Set_host: base version is a no-op.
!!
!
subroutine s_base_set_host(x) subroutine s_base_set_host(x)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
end subroutine s_base_set_host end subroutine s_base_set_host
!
!> Function base_set_dev:
!! \memberof psb_s_base_vect_type
!! \brief Set_dev: base version is a no-op.
!!
!
subroutine s_base_set_dev(x) subroutine s_base_set_dev(x)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
end subroutine s_base_set_dev end subroutine s_base_set_dev
!
!> Function base_set_sync:
!! \memberof psb_s_base_vect_type
!! \brief Set_sync: base version is a no-op.
!!
!
subroutine s_base_set_sync(x) subroutine s_base_set_sync(x)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
end subroutine s_base_set_sync end subroutine s_base_set_sync
!
!> Function base_is_dev:
!! \memberof psb_s_base_vect_type
!! \brief Is vector on external device .
!!
!
function s_base_is_dev(x) result(res) function s_base_is_dev(x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(in) :: x class(psb_s_base_vect_type), intent(in) :: x
@ -379,6 +486,12 @@ contains
res = .false. res = .false.
end function s_base_is_dev end function s_base_is_dev
!
!> Function base_is_host
!! \memberof psb_s_base_vect_type
!! \brief Is vector on standard memory .
!!
!
function s_base_is_host(x) result(res) function s_base_is_host(x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(in) :: x class(psb_s_base_vect_type), intent(in) :: x
@ -387,6 +500,12 @@ contains
res = .true. res = .true.
end function s_base_is_host end function s_base_is_host
!
!> Function base_is_sync
!! \memberof psb_s_base_vect_type
!! \brief Is vector on sync .
!!
!
function s_base_is_sync(x) result(res) function s_base_is_sync(x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(in) :: x class(psb_s_base_vect_type), intent(in) :: x
@ -399,7 +518,12 @@ contains
! !
! Size info. ! Size info.
! !
!
!> Function base_get_nrows
!! \memberof psb_s_base_vect_type
!! \brief Number of entries
!!
!
function s_base_get_nrows(x) result(res) function s_base_get_nrows(x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(in) :: x class(psb_s_base_vect_type), intent(in) :: x
@ -410,6 +534,12 @@ contains
end function s_base_get_nrows end function s_base_get_nrows
!
!> Function base_get_sizeof
!! \memberof psb_s_base_vect_type
!! \brief Size in bytes
!!
!
function s_base_sizeof(x) result(res) function s_base_sizeof(x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(in) :: x class(psb_s_base_vect_type), intent(in) :: x
@ -422,10 +552,13 @@ contains
! !
! Two versions of extracting an array: one of them
! overload the assignment.
! !
!
!> Function base_get_vect
!! \memberof psb_s_base_vect_type
!! \brief Extract a copy of the contents
!!
!
function s_base_get_vect(x) result(res) function s_base_get_vect(x) result(res)
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), allocatable :: res(:) real(psb_spk_), allocatable :: res(:)
@ -444,6 +577,12 @@ contains
! !
! Reset all values ! Reset all values
! !
!
!> Function base_set_scal
!! \memberof psb_s_base_vect_type
!! \brief Set all entries
!! \param val The value to set
!!
subroutine s_base_set_scal(x,val) subroutine s_base_set_scal(x,val)
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
@ -453,6 +592,12 @@ contains
end subroutine s_base_set_scal end subroutine s_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_s_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine s_base_set_vect(x,val) subroutine s_base_set_vect(x,val)
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
@ -471,6 +616,13 @@ contains
! !
! Dot products ! Dot products
! !
!
!> Function base_dot_v
!! \memberof psb_s_base_vect_type
!! \brief Dot product by another base_vector
!! \param n Number of entries to be considere
!! \param y The other (base_vect) to be multiplied by
!!
function s_base_dot_v(n,x,y) result(res) function s_base_dot_v(n,x,y) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x, y class(psb_s_base_vect_type), intent(inout) :: x, y
@ -498,6 +650,13 @@ contains
! !
! Base workhorse is good old BLAS1 ! Base workhorse is good old BLAS1
! !
!
!> Function base_dot_a
!! \memberof psb_s_base_vect_type
!! \brief Dot product by a normal array
!! \param n Number of entries to be considere
!! \param y(:) The array to be multiplied by
!!
function s_base_dot_a(n,x,y) result(res) function s_base_dot_a(n,x,y) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
@ -513,6 +672,17 @@ contains
! !
! AXPBY is invoked via Y, hence the structure below. ! AXPBY is invoked via Y, hence the structure below.
! !
!
!
!> Function base_axpby_v
!! \memberof psb_s_base_vect_type
!! \brief AXPBY by a (base_vect) y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x The class(base_vect) to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine s_base_axpby_v(m,alpha, x, beta, y, info) subroutine s_base_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -531,6 +701,19 @@ contains
end subroutine s_base_axpby_v end subroutine s_base_axpby_v
!
! AXPBY is invoked via Y, hence the structure below.
!
!
!> Function base_axpby_a
!! \memberof psb_s_base_vect_type
!! \brief AXPBY by a normal array y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x(:) The array to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine s_base_axpby_a(m,alpha, x, beta, y, info) subroutine s_base_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -553,7 +736,13 @@ contains
! Variants expanded according to the dynamic type ! Variants expanded according to the dynamic type
! of the involved entities ! of the involved entities
! !
!
!> Function base_mlt_a
!! \memberof psb_s_base_vect_type
!! \brief Vector entry-by-entry multiply by a base_vect array y=x*y
!! \param x The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine s_base_mlt_v(x, y, info) subroutine s_base_mlt_v(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -575,6 +764,13 @@ contains
end subroutine s_base_mlt_v end subroutine s_base_mlt_v
!
!> Function base_mlt_a
!! \memberof psb_s_base_vect_type
!! \brief Vector entry-by-entry multiply by a normal array y=x*y
!! \param x(:) The array to be multiplied by
!! \param info return code
!!
subroutine s_base_mlt_a(x, y, info) subroutine s_base_mlt_a(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -592,6 +788,17 @@ contains
end subroutine s_base_mlt_a end subroutine s_base_mlt_a
!
!> Function base_mlt_a_2
!! \memberof psb_s_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by normal arrays
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x(:) The array to be multiplied b
!! \param y(:) The array to be multiplied by
!! \param info return code
!!
subroutine s_base_mlt_a_2(alpha,x,y,beta,z,info) subroutine s_base_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -660,6 +867,17 @@ contains
end if end if
end subroutine s_base_mlt_a_2 end subroutine s_base_mlt_a_2
!
!> Function base_mlt_v_2
!! \memberof psb_s_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by class(base_vect)
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x The class(base_vect) to be multiplied b
!! \param y The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine s_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) subroutine s_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod use psi_serial_mod
use psb_string_mod use psb_string_mod
@ -725,7 +943,11 @@ contains
! !
! Simple scaling ! Simple scaling
! !
!> Function base_scal
!! \memberof psb_s_base_vect_type
!! \brief Scale all entries x = alpha*x
!! \param alpha The multiplier
!!
subroutine s_base_scal(alpha, x) subroutine s_base_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -739,7 +961,10 @@ contains
! !
! Norms 1, 2 and infinity ! Norms 1, 2 and infinity
! !
!> Function base_nrm2
!! \memberof psb_s_base_vect_type
!! \brief 2-norm |x(1:n)|_2
!! \param n how many entries to consider
function s_base_nrm2(n,x) result(res) function s_base_nrm2(n,x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
@ -751,6 +976,11 @@ contains
end function s_base_nrm2 end function s_base_nrm2
!
!> Function base_amax
!! \memberof psb_s_base_vect_type
!! \brief infinity-norm |x(1:n)|_\infty
!! \param n how many entries to consider
function s_base_amax(n,x) result(res) function s_base_amax(n,x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
@ -761,6 +991,11 @@ contains
end function s_base_amax end function s_base_amax
!
!> Function base_asum
!! \memberof psb_s_base_vect_type
!! \brief 1-norm |x(1:n)|_1
!! \param n how many entries to consider
function s_base_asum(n,x) result(res) function s_base_asum(n,x) result(res)
implicit none implicit none
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
@ -775,7 +1010,15 @@ contains
! !
! Gather: Y = beta * Y + alpha * X(IDX(:)) ! Gather: Y = beta * Y + alpha * X(IDX(:))
! !
!
!> Function base_gthab
!! \memberof psb_s_base_vect_type
!! \brief gather into an array
!! Y = beta * Y + alpha * X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param alpha
!! \param beta
subroutine s_base_gthab(n,idx,alpha,x,beta,y) subroutine s_base_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -789,6 +1032,12 @@ contains
! !
! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
! !
!> Function base_gthzv
!! \memberof psb_s_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine s_base_gthzv(n,idx,x,y) subroutine s_base_gthzv(n,idx,x,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -804,7 +1053,15 @@ contains
! Scatter: ! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
! !
!
!> Function base_sctb
!! \memberof psb_s_base_vect_type
!! \brief scatter into a class(base_vect)
!! Y(IDX(:)) = beta * Y(IDX(:)) + X(:)
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param beta
!! \param x(:)
subroutine s_base_sctb(n,idx,x,beta,y) subroutine s_base_sctb(n,idx,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)

289
base/modules/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -59,6 +59,7 @@ module psb_z_base_vect_mod
!! sparse matrix types. !! sparse matrix types.
!! !!
type psb_z_base_vect_type type psb_z_base_vect_type
!> Values.
complex(psb_dpk_), allocatable :: v(:) complex(psb_dpk_), allocatable :: v(:)
contains contains
! !
@ -156,6 +157,10 @@ contains
! Constructors. ! Constructors.
! !
!> Function constructor:
!! \brief Constructor from an array
!! \param x(:) input array to be copied
!!
function constructor(x) result(this) function constructor(x) result(this)
complex(psb_dpk_) :: x(:) complex(psb_dpk_) :: x(:)
type(psb_z_base_vect_type) :: this type(psb_z_base_vect_type) :: this
@ -166,6 +171,10 @@ contains
end function constructor end function constructor
!> Function constructor:
!! \brief Constructor from size
!! \param n Size of vector to be built.
!!
function size_const(n) result(this) function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
type(psb_z_base_vect_type) :: this type(psb_z_base_vect_type) :: this
@ -179,6 +188,11 @@ contains
! Build from a sample ! Build from a sample
! !
!> Function bld_x:
!! \memberof psb_z_base_vect_type
!! \brief Build method from an array
!! \param x(:) input array to be copied
!!
subroutine z_base_bld_x(x,this) subroutine z_base_bld_x(x,this)
use psb_realloc_mod use psb_realloc_mod
complex(psb_dpk_), intent(in) :: this(:) complex(psb_dpk_), intent(in) :: this(:)
@ -197,6 +211,12 @@ contains
! !
! Create with size, but no initialization ! Create with size, but no initialization
! !
!> Function bld_n:
!! \memberof psb_z_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine z_base_bld_n(x,n) subroutine z_base_bld_n(x,n)
use psb_realloc_mod use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
@ -208,6 +228,13 @@ contains
end subroutine z_base_bld_n end subroutine z_base_bld_n
!> Function base_all:
!! \memberof psb_z_base_vect_type
!! \brief Build method with size (uninitialized data) and
!! allocation return code.
!! \param n size to be allocated.
!! \param info return code
!!
subroutine z_base_all(n, x, info) subroutine z_base_all(n, x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -220,6 +247,12 @@ contains
end subroutine z_base_all end subroutine z_base_all
!> Function base_mold:
!! \memberof psb_z_base_vect_type
!! \brief Mold method: return a variable with the same dynamic type
!! \param y returned variable
!! \param info return code
!!
subroutine z_base_mold(x, y, info) subroutine z_base_mold(x, y, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -235,6 +268,30 @@ contains
! !
! Insert a bunch of values at specified positions. ! Insert a bunch of values at specified positions.
! !
!> Function base_ins:
!! \memberof psb_z_base_vect_type
!! \brief Insert coefficients.
!!
!!
!! Given a list of N pairs
!! (IRL(i),VAL(i))
!! record a new coefficient in X such that
!! X(IRL(1:N)) = VAL(1:N).
!!
!! - the update operation will perform either
!! X(IRL(1:n)) = VAL(1:N)
!! or
!! X(IRL(1:n)) = X(IRL(1:n))+VAL(1:N)
!! according to the value of DUPLICATE.
!!
!!
!! \param n number of pairs in input
!! \param irl(:) the input row indices
!! \param val(:) the input coefficients
!! \param dupl how to treat duplicate entries
!! \param info return code
!!
!
subroutine z_base_ins(n,irl,val,dupl,x,info) subroutine z_base_ins(n,irl,val,dupl,x,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -244,7 +301,7 @@ contains
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i, isz
info = 0 info = 0
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -255,13 +312,14 @@ contains
info = psb_err_invalid_input_ info = psb_err_invalid_input_
else else
isz = size(x%v)
select case(dupl) select case(dupl)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
! row actual block row ! row actual block row
if (irl(i) > 0) then if ((1 <= irl(i)).and.(irl(i) <= isz)) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = val(i) x%v(irl(i)) = val(i)
@ -272,8 +330,7 @@ contains
do i = 1, n do i = 1, n
!loop over all val's rows !loop over all val's rows
if ((1 <= irl(i)).and.(irl(i) <= isz)) then
if (irl(i) > 0) then
! this row belongs to me ! this row belongs to me
! copy i-th row of block val in x ! copy i-th row of block val in x
x%v(irl(i)) = x%v(irl(i)) + val(i) x%v(irl(i)) = x%v(irl(i)) + val(i)
@ -282,8 +339,8 @@ contains
case default case default
info = 321 info = 321
!!$ call psb_errpush(info,name) ! !$ call psb_errpush(info,name)
!!$ goto 9999 ! !$ goto 9999
end select end select
end if end if
if (info /= 0) then if (info /= 0) then
@ -293,6 +350,11 @@ contains
end subroutine z_base_ins end subroutine z_base_ins
!
!> Function base_zero
!! \memberof psb_z_base_vect_type
!! \brief Zero out contents
!!
! !
subroutine z_base_zero(x) subroutine z_base_zero(x)
use psi_serial_mod use psi_serial_mod
@ -309,6 +371,14 @@ contains
! For derived classes: after this the vector ! For derived classes: after this the vector
! storage is supposed to be in sync. ! storage is supposed to be in sync.
! !
!> Function base_asb:
!! \memberof psb_z_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine z_base_asb(n, x, info) subroutine z_base_asb(n, x, info)
use psi_serial_mod use psi_serial_mod
@ -326,6 +396,14 @@ contains
end subroutine z_base_asb end subroutine z_base_asb
!
!> Function base_free:
!! \memberof psb_z_base_vect_type
!! \brief Free vector
!!
!! \param info return code
!!
!
subroutine z_base_free(x, info) subroutine z_base_free(x, info)
use psi_serial_mod use psi_serial_mod
use psb_realloc_mod use psb_realloc_mod
@ -346,31 +424,60 @@ contains
! The base version of SYNC & friends does nothing, it's just ! The base version of SYNC & friends does nothing, it's just
! a placeholder. ! a placeholder.
! !
!
!> Function base_sync:
!! \memberof psb_z_base_vect_type
!! \brief Sync: base version is a no-op.
!!
!
subroutine z_base_sync(x) subroutine z_base_sync(x)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
end subroutine z_base_sync end subroutine z_base_sync
!
!> Function base_set_host:
!! \memberof psb_z_base_vect_type
!! \brief Set_host: base version is a no-op.
!!
!
subroutine z_base_set_host(x) subroutine z_base_set_host(x)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
end subroutine z_base_set_host end subroutine z_base_set_host
!
!> Function base_set_dev:
!! \memberof psb_z_base_vect_type
!! \brief Set_dev: base version is a no-op.
!!
!
subroutine z_base_set_dev(x) subroutine z_base_set_dev(x)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
end subroutine z_base_set_dev end subroutine z_base_set_dev
!
!> Function base_set_sync:
!! \memberof psb_z_base_vect_type
!! \brief Set_sync: base version is a no-op.
!!
!
subroutine z_base_set_sync(x) subroutine z_base_set_sync(x)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
end subroutine z_base_set_sync end subroutine z_base_set_sync
!
!> Function base_is_dev:
!! \memberof psb_z_base_vect_type
!! \brief Is vector on external device .
!!
!
function z_base_is_dev(x) result(res) function z_base_is_dev(x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(in) :: x class(psb_z_base_vect_type), intent(in) :: x
@ -379,6 +486,12 @@ contains
res = .false. res = .false.
end function z_base_is_dev end function z_base_is_dev
!
!> Function base_is_host
!! \memberof psb_z_base_vect_type
!! \brief Is vector on standard memory .
!!
!
function z_base_is_host(x) result(res) function z_base_is_host(x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(in) :: x class(psb_z_base_vect_type), intent(in) :: x
@ -387,6 +500,12 @@ contains
res = .true. res = .true.
end function z_base_is_host end function z_base_is_host
!
!> Function base_is_sync
!! \memberof psb_z_base_vect_type
!! \brief Is vector on sync .
!!
!
function z_base_is_sync(x) result(res) function z_base_is_sync(x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(in) :: x class(psb_z_base_vect_type), intent(in) :: x
@ -399,7 +518,12 @@ contains
! !
! Size info. ! Size info.
! !
!
!> Function base_get_nrows
!! \memberof psb_z_base_vect_type
!! \brief Number of entries
!!
!
function z_base_get_nrows(x) result(res) function z_base_get_nrows(x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(in) :: x class(psb_z_base_vect_type), intent(in) :: x
@ -410,6 +534,12 @@ contains
end function z_base_get_nrows end function z_base_get_nrows
!
!> Function base_get_sizeof
!! \memberof psb_z_base_vect_type
!! \brief Size in bytes
!!
!
function z_base_sizeof(x) result(res) function z_base_sizeof(x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(in) :: x class(psb_z_base_vect_type), intent(in) :: x
@ -422,10 +552,13 @@ contains
! !
! Two versions of extracting an array: one of them
! overload the assignment.
! !
!
!> Function base_get_vect
!! \memberof psb_z_base_vect_type
!! \brief Extract a copy of the contents
!!
!
function z_base_get_vect(x) result(res) function z_base_get_vect(x) result(res)
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), allocatable :: res(:) complex(psb_dpk_), allocatable :: res(:)
@ -444,6 +577,12 @@ contains
! !
! Reset all values ! Reset all values
! !
!
!> Function base_set_scal
!! \memberof psb_z_base_vect_type
!! \brief Set all entries
!! \param val The value to set
!!
subroutine z_base_set_scal(x,val) subroutine z_base_set_scal(x,val)
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val complex(psb_dpk_), intent(in) :: val
@ -453,6 +592,12 @@ contains
end subroutine z_base_set_scal end subroutine z_base_set_scal
!
!> Function base_set_vect
!! \memberof psb_z_base_vect_type
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine z_base_set_vect(x,val) subroutine z_base_set_vect(x,val)
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
@ -471,6 +616,13 @@ contains
! !
! Dot products ! Dot products
! !
!
!> Function base_dot_v
!! \memberof psb_z_base_vect_type
!! \brief Dot product by another base_vector
!! \param n Number of entries to be considere
!! \param y The other (base_vect) to be multiplied by
!!
function z_base_dot_v(n,x,y) result(res) function z_base_dot_v(n,x,y) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x, y class(psb_z_base_vect_type), intent(inout) :: x, y
@ -498,6 +650,13 @@ contains
! !
! Base workhorse is good old BLAS1 ! Base workhorse is good old BLAS1
! !
!
!> Function base_dot_a
!! \memberof psb_z_base_vect_type
!! \brief Dot product by a normal array
!! \param n Number of entries to be considere
!! \param y(:) The array to be multiplied by
!!
function z_base_dot_a(n,x,y) result(res) function z_base_dot_a(n,x,y) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
@ -513,6 +672,17 @@ contains
! !
! AXPBY is invoked via Y, hence the structure below. ! AXPBY is invoked via Y, hence the structure below.
! !
!
!
!> Function base_axpby_v
!! \memberof psb_z_base_vect_type
!! \brief AXPBY by a (base_vect) y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x The class(base_vect) to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine z_base_axpby_v(m,alpha, x, beta, y, info) subroutine z_base_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -531,6 +701,19 @@ contains
end subroutine z_base_axpby_v end subroutine z_base_axpby_v
!
! AXPBY is invoked via Y, hence the structure below.
!
!
!> Function base_axpby_a
!! \memberof psb_z_base_vect_type
!! \brief AXPBY by a normal array y=alpha*x+beta*y
!! \param m Number of entries to be considere
!! \param alpha scalar alpha
!! \param x(:) The array to be added
!! \param beta scalar alpha
!! \param info return code
!!
subroutine z_base_axpby_a(m,alpha, x, beta, y, info) subroutine z_base_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -553,7 +736,13 @@ contains
! Variants expanded according to the dynamic type ! Variants expanded according to the dynamic type
! of the involved entities ! of the involved entities
! !
!
!> Function base_mlt_a
!! \memberof psb_z_base_vect_type
!! \brief Vector entry-by-entry multiply by a base_vect array y=x*y
!! \param x The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine z_base_mlt_v(x, y, info) subroutine z_base_mlt_v(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -575,6 +764,13 @@ contains
end subroutine z_base_mlt_v end subroutine z_base_mlt_v
!
!> Function base_mlt_a
!! \memberof psb_z_base_vect_type
!! \brief Vector entry-by-entry multiply by a normal array y=x*y
!! \param x(:) The array to be multiplied by
!! \param info return code
!!
subroutine z_base_mlt_a(x, y, info) subroutine z_base_mlt_a(x, y, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -592,6 +788,17 @@ contains
end subroutine z_base_mlt_a end subroutine z_base_mlt_a
!
!> Function base_mlt_a_2
!! \memberof psb_z_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by normal arrays
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x(:) The array to be multiplied b
!! \param y(:) The array to be multiplied by
!! \param info return code
!!
subroutine z_base_mlt_a_2(alpha,x,y,beta,z,info) subroutine z_base_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -660,6 +867,17 @@ contains
end if end if
end subroutine z_base_mlt_a_2 end subroutine z_base_mlt_a_2
!
!> Function base_mlt_v_2
!! \memberof psb_z_base_vect_type
!! \brief AXPBY-like Vector entry-by-entry multiply by class(base_vect)
!! z=beta*z+alpha*x*y
!! \param alpha
!! \param beta
!! \param x The class(base_vect) to be multiplied b
!! \param y The class(base_vect) to be multiplied by
!! \param info return code
!!
subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod use psi_serial_mod
use psb_string_mod use psb_string_mod
@ -725,7 +943,11 @@ contains
! !
! Simple scaling ! Simple scaling
! !
!> Function base_scal
!! \memberof psb_z_base_vect_type
!! \brief Scale all entries x = alpha*x
!! \param alpha The multiplier
!!
subroutine z_base_scal(alpha, x) subroutine z_base_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -739,7 +961,10 @@ contains
! !
! Norms 1, 2 and infinity ! Norms 1, 2 and infinity
! !
!> Function base_nrm2
!! \memberof psb_z_base_vect_type
!! \brief 2-norm |x(1:n)|_2
!! \param n how many entries to consider
function z_base_nrm2(n,x) result(res) function z_base_nrm2(n,x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
@ -751,6 +976,11 @@ contains
end function z_base_nrm2 end function z_base_nrm2
!
!> Function base_amax
!! \memberof psb_z_base_vect_type
!! \brief infinity-norm |x(1:n)|_\infty
!! \param n how many entries to consider
function z_base_amax(n,x) result(res) function z_base_amax(n,x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
@ -761,6 +991,11 @@ contains
end function z_base_amax end function z_base_amax
!
!> Function base_asum
!! \memberof psb_z_base_vect_type
!! \brief 1-norm |x(1:n)|_1
!! \param n how many entries to consider
function z_base_asum(n,x) result(res) function z_base_asum(n,x) result(res)
implicit none implicit none
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
@ -775,7 +1010,15 @@ contains
! !
! Gather: Y = beta * Y + alpha * X(IDX(:)) ! Gather: Y = beta * Y + alpha * X(IDX(:))
! !
!
!> Function base_gthab
!! \memberof psb_z_base_vect_type
!! \brief gather into an array
!! Y = beta * Y + alpha * X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param alpha
!! \param beta
subroutine z_base_gthab(n,idx,alpha,x,beta,y) subroutine z_base_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -789,6 +1032,12 @@ contains
! !
! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
! !
!> Function base_gthzv
!! \memberof psb_z_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine z_base_gthzv(n,idx,x,y) subroutine z_base_gthzv(n,idx,x,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
@ -804,7 +1053,15 @@ contains
! Scatter: ! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
! !
!
!> Function base_sctb
!! \memberof psb_z_base_vect_type
!! \brief scatter into a class(base_vect)
!! Y(IDX(:)) = beta * Y(IDX(:)) + X(:)
!! \param n how many entries to consider
!! \param idx(:) indices
!! \param beta
!! \param x(:)
subroutine z_base_sctb(n,idx,x,beta,y) subroutine z_base_sctb(n,idx,x,beta,y)
use psi_serial_mod use psi_serial_mod
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)

6
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -1,13 +1,13 @@
11 Number of inputs 11 Number of inputs
pde40.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or kivap005.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html NONE sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
MM File format: MM: Matrix Market HB: Harwell-Boeing. MM File format: MM: Matrix Market HB: Harwell-Boeing.
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BiCG Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD CSR Storage format CSR COO JAD
3 IPART: Partition method 0: BLK 2: graph (with Metis) 3 IPART: Partition method 0: BLK 2: graph (with Metis)
2 ISTOPC 2 ISTOPC
02100 ITMAX 02100 ITMAX
-1 ITRACE -1 ITRACE
30 IRST (restart for RGMRES and BiCGSTABL) 002 IRST (restart for RGMRES and BiCGSTABL)
1.d-6 EPS 1.d-6 EPS

4
test/pargen/runs/ppde.inp
Unescape Escape View File

@ -5,7 +5,7 @@ CSR Storage format for matrix A: CSR COO JAD
040 Domain size (acutal system is this**3) 040 Domain size (acutal system is this**3)
2 Stopping criterion 2 Stopping criterion
1000 MAXIT 1000 MAXIT
-2 ITRACE 01 ITRACE
02 IRST restart for RGMRES and BiCGSTABL 002 IRST restart for RGMRES and BiCGSTABL

4
util/psb_d_genpde_impl.f90
Unescape Escape View File

@ -28,7 +28,7 @@ subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,&
type(psb_d_vect_type) :: xv,bv type(psb_d_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(d_func_3d), optional :: f procedure(d_func_3d), optional :: f
class(psb_d_base_sparse_mat), optional :: amold class(psb_d_base_sparse_mat), optional :: amold
class(psb_d_base_vect_type), optional :: vmold class(psb_d_base_vect_type), optional :: vmold
@ -331,7 +331,7 @@ subroutine psb_d_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,&
type(psb_d_vect_type) :: xv,bv type(psb_d_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(d_func_2d), optional :: f procedure(d_func_2d), optional :: f
class(psb_d_base_sparse_mat), optional :: amold class(psb_d_base_sparse_mat), optional :: amold
class(psb_d_base_vect_type), optional :: vmold class(psb_d_base_vect_type), optional :: vmold

4
util/psb_d_genpde_mod.f90
Unescape Escape View File

@ -39,7 +39,7 @@ module psb_d_genpde_mod
type(psb_d_vect_type) :: xv,bv type(psb_d_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(d_func_3d), optional :: f procedure(d_func_3d), optional :: f
class(psb_d_base_sparse_mat), optional :: amold class(psb_d_base_sparse_mat), optional :: amold
class(psb_d_base_vect_type), optional :: vmold class(psb_d_base_vect_type), optional :: vmold
@ -82,7 +82,7 @@ module psb_d_genpde_mod
type(psb_d_vect_type) :: xv,bv type(psb_d_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(d_func_2d), optional :: f procedure(d_func_2d), optional :: f
class(psb_d_base_sparse_mat), optional :: amold class(psb_d_base_sparse_mat), optional :: amold
class(psb_d_base_vect_type), optional :: vmold class(psb_d_base_vect_type), optional :: vmold

4
util/psb_s_genpde_impl.f90
Unescape Escape View File

@ -28,7 +28,7 @@ subroutine psb_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,&
type(psb_s_vect_type) :: xv,bv type(psb_s_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(s_func_3d), optional :: f procedure(s_func_3d), optional :: f
class(psb_s_base_sparse_mat), optional :: amold class(psb_s_base_sparse_mat), optional :: amold
class(psb_s_base_vect_type), optional :: vmold class(psb_s_base_vect_type), optional :: vmold
@ -331,7 +331,7 @@ subroutine psb_s_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,&
type(psb_s_vect_type) :: xv,bv type(psb_s_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(s_func_2d), optional :: f procedure(s_func_2d), optional :: f
class(psb_s_base_sparse_mat), optional :: amold class(psb_s_base_sparse_mat), optional :: amold
class(psb_s_base_vect_type), optional :: vmold class(psb_s_base_vect_type), optional :: vmold

4
util/psb_s_genpde_mod.f90
Unescape Escape View File

@ -39,7 +39,7 @@ module psb_s_genpde_mod
type(psb_s_vect_type) :: xv,bv type(psb_s_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(s_func_3d), optional :: f procedure(s_func_3d), optional :: f
class(psb_s_base_sparse_mat), optional :: amold class(psb_s_base_sparse_mat), optional :: amold
class(psb_s_base_vect_type), optional :: vmold class(psb_s_base_vect_type), optional :: vmold
@ -82,7 +82,7 @@ module psb_s_genpde_mod
type(psb_s_vect_type) :: xv,bv type(psb_s_vect_type) :: xv,bv
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer(psb_ipk_) :: ictxt, info integer(psb_ipk_) :: ictxt, info
character :: afmt*5 character(len=*) :: afmt
procedure(s_func_2d), optional :: f procedure(s_func_2d), optional :: f
class(psb_s_base_sparse_mat), optional :: amold class(psb_s_base_sparse_mat), optional :: amold
class(psb_s_base_vect_type), optional :: vmold class(psb_s_base_vect_type), optional :: vmold

Write Preview
Loading…
Cancel
Save