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

Avoid specific method names' conflicts between vect and multivect.

Browse Source
randomized
sfilippone 1 year ago
parent ba1f980226
commit 55518f5553
12 changed files with 632 additions and 632 deletions
Show Stats Download Patch File Download Diff File

4
base/modules/serial/psb_c_base_vect_mod.F90
Unescape Escape View File

@ -1857,7 +1857,7 @@ contains
class(psb_c_base_vect_type) :: x
if (idx%is_dev()) call idx%sync()
call x%gth(n,idx%v(i:),y)
call x%gthzv(n,idx%v(i:),y)
end subroutine c_base_gthzv_x
@ -1877,7 +1877,7 @@ contains
end if
if (idx%is_dev()) call idx%sync()
if (x%is_dev()) call x%sync()
call x%gth(n,idx%v(i:),x%combuf(i:))
call x%gthzv(n,idx%v(i:),x%combuf(i:))
end subroutine c_base_gthzbuf
!

236
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -507,7 +507,7 @@ contains
class(psb_c_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
& call x%v%gthzv(n,idx,y)
end subroutine c_vect_gthzv
@ -705,7 +705,7 @@ contains
res = czero
if (allocated(x%v)) &
& res = x%v%dot(n,y)
& res = x%v%dot_a(n,y)
end function c_vect_dot_a
@ -1300,56 +1300,56 @@ module psb_c_multivect_mod
integer(psb_ipk_) :: dupl = psb_dupl_add_
complex(psb_spk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => c_vect_get_nrows
procedure, pass(x) :: get_ncols => c_vect_get_ncols
procedure, pass(x) :: sizeof => c_vect_sizeof
procedure, pass(x) :: get_fmt => c_vect_get_fmt
procedure, pass(x) :: get_nrows => c_mvect_get_nrows
procedure, pass(x) :: get_ncols => c_mvect_get_ncols
procedure, pass(x) :: sizeof => c_mvect_sizeof
procedure, pass(x) :: get_fmt => c_mvect_get_fmt
procedure, pass(x) :: is_remote_build => c_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => c_mvect_set_remote_build
procedure, pass(x) :: get_dupl => c_mvect_get_dupl
procedure, pass(x) :: set_dupl => c_mvect_set_dupl
procedure, pass(x) :: all => c_vect_all
procedure, pass(x) :: reall => c_vect_reall
procedure, pass(x) :: zero => c_vect_zero
procedure, pass(x) :: asb => c_vect_asb
procedure, pass(x) :: sync => c_vect_sync
procedure, pass(x) :: free => c_vect_free
procedure, pass(x) :: ins => c_vect_ins
procedure, pass(x) :: bld_x => c_vect_bld_x
procedure, pass(x) :: bld_n => c_vect_bld_n
procedure, pass(x) :: all => c_mvect_all
procedure, pass(x) :: reall => c_mvect_reall
procedure, pass(x) :: zero => c_mvect_zero
procedure, pass(x) :: asb => c_mvect_asb
procedure, pass(x) :: sync => c_mvect_sync
procedure, pass(x) :: free => c_mvect_free
procedure, pass(x) :: ins => c_mvect_ins
procedure, pass(x) :: bld_x => c_mvect_bld_x
procedure, pass(x) :: bld_n => c_mvect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => c_vect_get_vect
procedure, pass(x) :: cnv => c_vect_cnv
procedure, pass(x) :: set_scal => c_vect_set_scal
procedure, pass(x) :: set_vect => c_vect_set_vect
procedure, pass(x) :: get_vect => c_mvect_get_vect
procedure, pass(x) :: cnv => c_mvect_cnv
procedure, pass(x) :: set_scal => c_mvect_set_scal
procedure, pass(x) :: set_vect => c_mvect_set_vect
generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => c_vect_clone
procedure, pass(x) :: gthab => c_vect_gthab
procedure, pass(x) :: gthzv => c_vect_gthzv
procedure, pass(x) :: gthzv_x => c_vect_gthzv_x
procedure, pass(x) :: clone => c_mvect_clone
procedure, pass(x) :: gthab => c_mvect_gthab
procedure, pass(x) :: gthzv => c_mvect_gthzv
procedure, pass(x) :: gthzv_x => c_mvect_gthzv_x
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => c_vect_sctb
procedure, pass(y) :: sctb_x => c_vect_sctb_x
procedure, pass(y) :: sctb => c_mvect_sctb
procedure, pass(y) :: sctb_x => c_mvect_sctb_x
generic, public :: sct => sctb, sctb_x
!!$ procedure, pass(x) :: dot_v => c_vect_dot_v
!!$ procedure, pass(x) :: dot_a => c_vect_dot_a
!!$ procedure, pass(x) :: dot_v => c_mvect_dot_v
!!$ procedure, pass(x) :: dot_a => c_mvect_dot_a
!!$ generic, public :: dot => dot_v, dot_a
!!$ procedure, pass(y) :: axpby_v => c_vect_axpby_v
!!$ procedure, pass(y) :: axpby_a => c_vect_axpby_a
!!$ procedure, pass(y) :: axpby_v => c_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => c_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
!!$ procedure, pass(y) :: mlt_v => c_vect_mlt_v
!!$ procedure, pass(y) :: mlt_a => c_vect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => c_vect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => c_vect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => c_vect_mlt_va
!!$ procedure, pass(z) :: mlt_av => c_vect_mlt_av
!!$ procedure, pass(y) :: mlt_v => c_mvect_mlt_v
!!$ procedure, pass(y) :: mlt_a => c_mvect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => c_mvect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => c_mvect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => c_mvect_mlt_va
!!$ procedure, pass(z) :: mlt_av => c_mvect_mlt_av
!!$ generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
!!$ & mlt_v_2, mlt_av, mlt_va
!!$ procedure, pass(x) :: scal => c_vect_scal
!!$ procedure, pass(x) :: nrm2 => c_vect_nrm2
!!$ procedure, pass(x) :: amax => c_vect_amax
!!$ procedure, pass(x) :: asum => c_vect_asum
!!$ procedure, pass(x) :: scal => c_mvect_scal
!!$ procedure, pass(x) :: nrm2 => c_mvect_nrm2
!!$ procedure, pass(x) :: amax => c_mvect_amax
!!$ procedure, pass(x) :: asum => c_mvect_asum
end type psb_c_multivect_type
public :: psb_c_multivect, psb_c_multivect_type,&
@ -1450,7 +1450,7 @@ contains
end function psb_c_get_base_multivect_default
subroutine c_vect_clone(x,y,info)
subroutine c_mvect_clone(x,y,info)
implicit none
class(psb_c_multivect_type), intent(inout) :: x
class(psb_c_multivect_type), intent(inout) :: y
@ -1459,11 +1459,11 @@ contains
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
call y%bld_x(x%get_vect(),mold=x%v)
end if
end subroutine c_vect_clone
end subroutine c_mvect_clone
subroutine c_vect_bld_x(x,invect,mold)
subroutine c_mvect_bld_x(x,invect,mold)
complex(psb_spk_), intent(in) :: invect(:,:)
class(psb_c_multivect_type), intent(out) :: x
class(psb_c_base_multivect_type), intent(in), optional :: mold
@ -1479,10 +1479,10 @@ contains
if (info == psb_success_) call x%v%bld(invect)
end subroutine c_vect_bld_x
end subroutine c_mvect_bld_x
subroutine c_vect_bld_n(x,m,n,mold)
subroutine c_mvect_bld_n(x,m,n,mold)
integer(psb_ipk_), intent(in) :: m,n
class(psb_c_multivect_type), intent(out) :: x
class(psb_c_base_multivect_type), intent(in), optional :: mold
@ -1496,9 +1496,9 @@ contains
endif
if (info == psb_success_) call x%v%bld(m,n)
end subroutine c_vect_bld_n
end subroutine c_mvect_bld_n
function c_vect_get_vect(x) result(res)
function c_mvect_get_vect(x) result(res)
class(psb_c_multivect_type), intent(inout) :: x
complex(psb_spk_), allocatable :: res(:,:)
integer(psb_ipk_) :: info
@ -1506,25 +1506,25 @@ contains
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function c_vect_get_vect
end function c_mvect_get_vect
subroutine c_vect_set_scal(x,val)
subroutine c_mvect_set_scal(x,val)
class(psb_c_multivect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine c_vect_set_scal
end subroutine c_mvect_set_scal
subroutine c_vect_set_vect(x,val)
subroutine c_mvect_set_vect(x,val)
class(psb_c_multivect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine c_vect_set_vect
end subroutine c_mvect_set_vect
function constructor(x) result(this)
@ -1532,7 +1532,7 @@ contains
type(psb_c_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(x)
call this%bld_x(x)
call this%asb(size(x,dim=1,kind=psb_ipk_),size(x,dim=2,kind=psb_ipk_),info)
end function constructor
@ -1543,44 +1543,44 @@ contains
type(psb_c_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(m,n)
call this%bld_n(m,n)
call this%asb(m,n,info)
end function size_const
function c_vect_get_nrows(x) result(res)
function c_mvect_get_nrows(x) result(res)
implicit none
class(psb_c_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function c_vect_get_nrows
end function c_mvect_get_nrows
function c_vect_get_ncols(x) result(res)
function c_mvect_get_ncols(x) result(res)
implicit none
class(psb_c_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_ncols()
end function c_vect_get_ncols
end function c_mvect_get_ncols
function c_vect_sizeof(x) result(res)
function c_mvect_sizeof(x) result(res)
implicit none
class(psb_c_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function c_vect_sizeof
end function c_mvect_sizeof
function c_vect_get_fmt(x) result(res)
function c_mvect_get_fmt(x) result(res)
implicit none
class(psb_c_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt()
end function c_vect_get_fmt
end function c_mvect_get_fmt
subroutine c_vect_all(m,n, x, info, mold)
subroutine c_mvect_all(m,n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1599,9 +1599,9 @@ contains
info = psb_err_alloc_dealloc_
end if
end subroutine c_vect_all
end subroutine c_mvect_all
subroutine c_vect_reall(m,n, x, info)
subroutine c_mvect_reall(m,n, x, info)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1614,18 +1614,18 @@ contains
if (info == 0) &
& call x%asb(m,n,info)
end subroutine c_vect_reall
end subroutine c_mvect_reall
subroutine c_vect_zero(x)
subroutine c_mvect_zero(x)
use psi_serial_mod
implicit none
class(psb_c_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine c_vect_zero
end subroutine c_mvect_zero
subroutine c_vect_asb(m,n, x, info)
subroutine c_mvect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1636,18 +1636,18 @@ contains
if (allocated(x%v)) &
& call x%v%asb(m,n,info)
end subroutine c_vect_asb
end subroutine c_mvect_asb
subroutine c_vect_sync(x)
subroutine c_mvect_sync(x)
implicit none
class(psb_c_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine c_vect_sync
end subroutine c_mvect_sync
subroutine c_vect_gthab(n,idx,alpha,x,beta,y)
subroutine c_mvect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: alpha, beta, y(:)
@ -1656,9 +1656,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine c_vect_gthab
end subroutine c_mvect_gthab
subroutine c_vect_gthzv(n,idx,x,y)
subroutine c_mvect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: y(:)
@ -1667,9 +1667,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine c_vect_gthzv
end subroutine c_mvect_gthzv
subroutine c_vect_gthzv_x(i,n,idx,x,y)
subroutine c_mvect_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
@ -1677,11 +1677,11 @@ contains
class(psb_c_multivect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(i,n,idx,y)
& call x%v%gthzv_x(i,n,idx,y)
end subroutine c_vect_gthzv_x
end subroutine c_mvect_gthzv_x
subroutine c_vect_sctb(n,idx,x,beta,y)
subroutine c_mvect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: beta, x(:)
@ -1690,9 +1690,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine c_vect_sctb
end subroutine c_mvect_sctb
subroutine c_vect_sctb_x(i,n,idx,x,beta,y)
subroutine c_mvect_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
@ -1702,9 +1702,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(i,n,idx,x,beta)
end subroutine c_vect_sctb_x
end subroutine c_mvect_sctb_x
subroutine c_vect_free(x, info)
subroutine c_mvect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1717,9 +1717,9 @@ contains
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine c_vect_free
end subroutine c_mvect_free
subroutine c_vect_ins(n,irl,val,x,info)
subroutine c_mvect_ins(n,irl,val,x,info)
use psi_serial_mod
implicit none
class(psb_c_multivect_type), intent(inout) :: x
@ -1738,10 +1738,10 @@ contains
dupl = x%get_dupl()
call x%v%ins(n,irl,val,dupl,info)
end subroutine c_vect_ins
end subroutine c_mvect_ins
subroutine c_vect_cnv(x,mold)
subroutine c_mvect_cnv(x,mold)
class(psb_c_multivect_type), intent(inout) :: x
class(psb_c_base_multivect_type), intent(in), optional :: mold
class(psb_c_base_multivect_type), allocatable :: tmp
@ -1758,10 +1758,10 @@ contains
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine c_vect_cnv
end subroutine c_mvect_cnv
!!$ function c_vect_dot_v(n,x,y) result(res)
!!$ function c_mvect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
@ -1771,9 +1771,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function c_vect_dot_v
!!$ end function c_mvect_dot_v
!!$
!!$ function c_vect_dot_a(n,x,y) result(res)
!!$ function c_mvect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ complex(psb_spk_), intent(in) :: y(:)
@ -1784,9 +1784,9 @@ contains
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function c_vect_dot_a
!!$ end function c_mvect_dot_a
!!$
!!$ subroutine c_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ subroutine c_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1798,12 +1798,12 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) then
!!$ call y%v%axpby(m,alpha,x%v,beta,info)
!!$ else
!!$ info = psb_err_invalid_vect_state_
!!$ info = psb_err_invalid_mvect_state_
!!$ end if
!!$
!!$ end subroutine c_vect_axpby_v
!!$ end subroutine c_mvect_axpby_v
!!$
!!$ subroutine c_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ subroutine c_mvect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1815,10 +1815,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%axpby(m,alpha,x,beta,info)
!!$
!!$ end subroutine c_vect_axpby_a
!!$ end subroutine c_mvect_axpby_a
!!$
!!$
!!$ subroutine c_vect_mlt_v(x, y, info)
!!$ subroutine c_mvect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
@ -1830,9 +1830,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & call y%v%mlt(x%v,info)
!!$
!!$ end subroutine c_vect_mlt_v
!!$ end subroutine c_mvect_mlt_v
!!$
!!$ subroutine c_vect_mlt_a(x, y, info)
!!$ subroutine c_mvect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: x(:)
@ -1845,10 +1845,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%mlt(x,info)
!!$
!!$ end subroutine c_vect_mlt_a
!!$ end subroutine c_mvect_mlt_a
!!$
!!$
!!$ subroutine c_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ subroutine c_mvect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
@ -1862,9 +1862,9 @@ contains
!!$ if (allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x,y,beta,info)
!!$
!!$ end subroutine c_vect_mlt_a_2
!!$ end subroutine c_mvect_mlt_a_2
!!$
!!$ subroutine c_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ subroutine c_mvect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
@ -1881,9 +1881,9 @@ contains
!!$ & allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
!!$
!!$ end subroutine c_vect_mlt_v_2
!!$ end subroutine c_mvect_mlt_v_2
!!$
!!$ subroutine c_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ subroutine c_mvect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
@ -1897,9 +1897,9 @@ contains
!!$ if (allocated(z%v).and.allocated(y%v)) &
!!$ & call z%v%mlt(alpha,x,y%v,beta,info)
!!$
!!$ end subroutine c_vect_mlt_av
!!$ end subroutine c_mvect_mlt_av
!!$
!!$ subroutine c_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ subroutine c_mvect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_spk_), intent(in) :: alpha,beta
@ -1914,9 +1914,9 @@ contains
!!$ if (allocated(z%v).and.allocated(x%v)) &
!!$ & call z%v%mlt(alpha,x%v,y,beta,info)
!!$
!!$ end subroutine c_vect_mlt_va
!!$ end subroutine c_mvect_mlt_va
!!$
!!$ subroutine c_vect_scal(alpha, x)
!!$ subroutine c_mvect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
@ -1924,10 +1924,10 @@ contains
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine c_vect_scal
!!$ end subroutine c_mvect_scal
!!$
!!$
!!$ function c_vect_nrm2(n,x) result(res)
!!$ function c_mvect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -1939,9 +1939,9 @@ contains
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_nrm2
!!$ end function c_mvect_nrm2
!!$
!!$ function c_vect_amax(n,x) result(res)
!!$ function c_mvect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -1953,9 +1953,9 @@ contains
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_amax
!!$ end function c_mvect_amax
!!$
!!$ function c_vect_asum(n,x) result(res)
!!$ function c_mvect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_c_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -1967,6 +1967,6 @@ contains
!!$ res = szero
!!$ end if
!!$
!!$ end function c_vect_asum
!!$ end function c_mvect_asum
end module psb_c_multivect_mod

4
base/modules/serial/psb_d_base_vect_mod.F90
Unescape Escape View File

@ -1944,7 +1944,7 @@ contains
class(psb_d_base_vect_type) :: x
if (idx%is_dev()) call idx%sync()
call x%gth(n,idx%v(i:),y)
call x%gthzv(n,idx%v(i:),y)
end subroutine d_base_gthzv_x
@ -1964,7 +1964,7 @@ contains
end if
if (idx%is_dev()) call idx%sync()
if (x%is_dev()) call x%sync()
call x%gth(n,idx%v(i:),x%combuf(i:))
call x%gthzv(n,idx%v(i:),x%combuf(i:))
end subroutine d_base_gthzbuf
!

236
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -514,7 +514,7 @@ contains
class(psb_d_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
& call x%v%gthzv(n,idx,y)
end subroutine d_vect_gthzv
@ -712,7 +712,7 @@ contains
res = dzero
if (allocated(x%v)) &
& res = x%v%dot(n,y)
& res = x%v%dot_a(n,y)
end function d_vect_dot_a
@ -1379,56 +1379,56 @@ module psb_d_multivect_mod
integer(psb_ipk_) :: dupl = psb_dupl_add_
real(psb_dpk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => d_vect_get_nrows
procedure, pass(x) :: get_ncols => d_vect_get_ncols
procedure, pass(x) :: sizeof => d_vect_sizeof
procedure, pass(x) :: get_fmt => d_vect_get_fmt
procedure, pass(x) :: get_nrows => d_mvect_get_nrows
procedure, pass(x) :: get_ncols => d_mvect_get_ncols
procedure, pass(x) :: sizeof => d_mvect_sizeof
procedure, pass(x) :: get_fmt => d_mvect_get_fmt
procedure, pass(x) :: is_remote_build => d_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => d_mvect_set_remote_build
procedure, pass(x) :: get_dupl => d_mvect_get_dupl
procedure, pass(x) :: set_dupl => d_mvect_set_dupl
procedure, pass(x) :: all => d_vect_all
procedure, pass(x) :: reall => d_vect_reall
procedure, pass(x) :: zero => d_vect_zero
procedure, pass(x) :: asb => d_vect_asb
procedure, pass(x) :: sync => d_vect_sync
procedure, pass(x) :: free => d_vect_free
procedure, pass(x) :: ins => d_vect_ins
procedure, pass(x) :: bld_x => d_vect_bld_x
procedure, pass(x) :: bld_n => d_vect_bld_n
procedure, pass(x) :: all => d_mvect_all
procedure, pass(x) :: reall => d_mvect_reall
procedure, pass(x) :: zero => d_mvect_zero
procedure, pass(x) :: asb => d_mvect_asb
procedure, pass(x) :: sync => d_mvect_sync
procedure, pass(x) :: free => d_mvect_free
procedure, pass(x) :: ins => d_mvect_ins
procedure, pass(x) :: bld_x => d_mvect_bld_x
procedure, pass(x) :: bld_n => d_mvect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => d_vect_get_vect
procedure, pass(x) :: cnv => d_vect_cnv
procedure, pass(x) :: set_scal => d_vect_set_scal
procedure, pass(x) :: set_vect => d_vect_set_vect
procedure, pass(x) :: get_vect => d_mvect_get_vect
procedure, pass(x) :: cnv => d_mvect_cnv
procedure, pass(x) :: set_scal => d_mvect_set_scal
procedure, pass(x) :: set_vect => d_mvect_set_vect
generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => d_vect_clone
procedure, pass(x) :: gthab => d_vect_gthab
procedure, pass(x) :: gthzv => d_vect_gthzv
procedure, pass(x) :: gthzv_x => d_vect_gthzv_x
procedure, pass(x) :: clone => d_mvect_clone
procedure, pass(x) :: gthab => d_mvect_gthab
procedure, pass(x) :: gthzv => d_mvect_gthzv
procedure, pass(x) :: gthzv_x => d_mvect_gthzv_x
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => d_vect_sctb
procedure, pass(y) :: sctb_x => d_vect_sctb_x
procedure, pass(y) :: sctb => d_mvect_sctb
procedure, pass(y) :: sctb_x => d_mvect_sctb_x
generic, public :: sct => sctb, sctb_x
!!$ procedure, pass(x) :: dot_v => d_vect_dot_v
!!$ procedure, pass(x) :: dot_a => d_vect_dot_a
!!$ procedure, pass(x) :: dot_v => d_mvect_dot_v
!!$ procedure, pass(x) :: dot_a => d_mvect_dot_a
!!$ generic, public :: dot => dot_v, dot_a
!!$ procedure, pass(y) :: axpby_v => d_vect_axpby_v
!!$ procedure, pass(y) :: axpby_a => d_vect_axpby_a
!!$ procedure, pass(y) :: axpby_v => d_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => d_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
!!$ procedure, pass(y) :: mlt_v => d_vect_mlt_v
!!$ procedure, pass(y) :: mlt_a => d_vect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => d_vect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => d_vect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => d_vect_mlt_va
!!$ procedure, pass(z) :: mlt_av => d_vect_mlt_av
!!$ procedure, pass(y) :: mlt_v => d_mvect_mlt_v
!!$ procedure, pass(y) :: mlt_a => d_mvect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => d_mvect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => d_mvect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => d_mvect_mlt_va
!!$ procedure, pass(z) :: mlt_av => d_mvect_mlt_av
!!$ generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
!!$ & mlt_v_2, mlt_av, mlt_va
!!$ procedure, pass(x) :: scal => d_vect_scal
!!$ procedure, pass(x) :: nrm2 => d_vect_nrm2
!!$ procedure, pass(x) :: amax => d_vect_amax
!!$ procedure, pass(x) :: asum => d_vect_asum
!!$ procedure, pass(x) :: scal => d_mvect_scal
!!$ procedure, pass(x) :: nrm2 => d_mvect_nrm2
!!$ procedure, pass(x) :: amax => d_mvect_amax
!!$ procedure, pass(x) :: asum => d_mvect_asum
end type psb_d_multivect_type
public :: psb_d_multivect, psb_d_multivect_type,&
@ -1529,7 +1529,7 @@ contains
end function psb_d_get_base_multivect_default
subroutine d_vect_clone(x,y,info)
subroutine d_mvect_clone(x,y,info)
implicit none
class(psb_d_multivect_type), intent(inout) :: x
class(psb_d_multivect_type), intent(inout) :: y
@ -1538,11 +1538,11 @@ contains
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
call y%bld_x(x%get_vect(),mold=x%v)
end if
end subroutine d_vect_clone
end subroutine d_mvect_clone
subroutine d_vect_bld_x(x,invect,mold)
subroutine d_mvect_bld_x(x,invect,mold)
real(psb_dpk_), intent(in) :: invect(:,:)
class(psb_d_multivect_type), intent(out) :: x
class(psb_d_base_multivect_type), intent(in), optional :: mold
@ -1558,10 +1558,10 @@ contains
if (info == psb_success_) call x%v%bld(invect)
end subroutine d_vect_bld_x
end subroutine d_mvect_bld_x
subroutine d_vect_bld_n(x,m,n,mold)
subroutine d_mvect_bld_n(x,m,n,mold)
integer(psb_ipk_), intent(in) :: m,n
class(psb_d_multivect_type), intent(out) :: x
class(psb_d_base_multivect_type), intent(in), optional :: mold
@ -1575,9 +1575,9 @@ contains
endif
if (info == psb_success_) call x%v%bld(m,n)
end subroutine d_vect_bld_n
end subroutine d_mvect_bld_n
function d_vect_get_vect(x) result(res)
function d_mvect_get_vect(x) result(res)
class(psb_d_multivect_type), intent(inout) :: x
real(psb_dpk_), allocatable :: res(:,:)
integer(psb_ipk_) :: info
@ -1585,25 +1585,25 @@ contains
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function d_vect_get_vect
end function d_mvect_get_vect
subroutine d_vect_set_scal(x,val)
subroutine d_mvect_set_scal(x,val)
class(psb_d_multivect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine d_vect_set_scal
end subroutine d_mvect_set_scal
subroutine d_vect_set_vect(x,val)
subroutine d_mvect_set_vect(x,val)
class(psb_d_multivect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine d_vect_set_vect
end subroutine d_mvect_set_vect
function constructor(x) result(this)
@ -1611,7 +1611,7 @@ contains
type(psb_d_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(x)
call this%bld_x(x)
call this%asb(size(x,dim=1,kind=psb_ipk_),size(x,dim=2,kind=psb_ipk_),info)
end function constructor
@ -1622,44 +1622,44 @@ contains
type(psb_d_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(m,n)
call this%bld_n(m,n)
call this%asb(m,n,info)
end function size_const
function d_vect_get_nrows(x) result(res)
function d_mvect_get_nrows(x) result(res)
implicit none
class(psb_d_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function d_vect_get_nrows
end function d_mvect_get_nrows
function d_vect_get_ncols(x) result(res)
function d_mvect_get_ncols(x) result(res)
implicit none
class(psb_d_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_ncols()
end function d_vect_get_ncols
end function d_mvect_get_ncols
function d_vect_sizeof(x) result(res)
function d_mvect_sizeof(x) result(res)
implicit none
class(psb_d_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function d_vect_sizeof
end function d_mvect_sizeof
function d_vect_get_fmt(x) result(res)
function d_mvect_get_fmt(x) result(res)
implicit none
class(psb_d_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt()
end function d_vect_get_fmt
end function d_mvect_get_fmt
subroutine d_vect_all(m,n, x, info, mold)
subroutine d_mvect_all(m,n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1678,9 +1678,9 @@ contains
info = psb_err_alloc_dealloc_
end if
end subroutine d_vect_all
end subroutine d_mvect_all
subroutine d_vect_reall(m,n, x, info)
subroutine d_mvect_reall(m,n, x, info)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1693,18 +1693,18 @@ contains
if (info == 0) &
& call x%asb(m,n,info)
end subroutine d_vect_reall
end subroutine d_mvect_reall
subroutine d_vect_zero(x)
subroutine d_mvect_zero(x)
use psi_serial_mod
implicit none
class(psb_d_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine d_vect_zero
end subroutine d_mvect_zero
subroutine d_vect_asb(m,n, x, info)
subroutine d_mvect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1715,18 +1715,18 @@ contains
if (allocated(x%v)) &
& call x%v%asb(m,n,info)
end subroutine d_vect_asb
end subroutine d_mvect_asb
subroutine d_vect_sync(x)
subroutine d_mvect_sync(x)
implicit none
class(psb_d_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine d_vect_sync
end subroutine d_mvect_sync
subroutine d_vect_gthab(n,idx,alpha,x,beta,y)
subroutine d_mvect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: alpha, beta, y(:)
@ -1735,9 +1735,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine d_vect_gthab
end subroutine d_mvect_gthab
subroutine d_vect_gthzv(n,idx,x,y)
subroutine d_mvect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: y(:)
@ -1746,9 +1746,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine d_vect_gthzv
end subroutine d_mvect_gthzv
subroutine d_vect_gthzv_x(i,n,idx,x,y)
subroutine d_mvect_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
@ -1756,11 +1756,11 @@ contains
class(psb_d_multivect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(i,n,idx,y)
& call x%v%gthzv_x(i,n,idx,y)
end subroutine d_vect_gthzv_x
end subroutine d_mvect_gthzv_x
subroutine d_vect_sctb(n,idx,x,beta,y)
subroutine d_mvect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: beta, x(:)
@ -1769,9 +1769,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine d_vect_sctb
end subroutine d_mvect_sctb
subroutine d_vect_sctb_x(i,n,idx,x,beta,y)
subroutine d_mvect_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
@ -1781,9 +1781,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(i,n,idx,x,beta)
end subroutine d_vect_sctb_x
end subroutine d_mvect_sctb_x
subroutine d_vect_free(x, info)
subroutine d_mvect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1796,9 +1796,9 @@ contains
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine d_vect_free
end subroutine d_mvect_free
subroutine d_vect_ins(n,irl,val,x,info)
subroutine d_mvect_ins(n,irl,val,x,info)
use psi_serial_mod
implicit none
class(psb_d_multivect_type), intent(inout) :: x
@ -1817,10 +1817,10 @@ contains
dupl = x%get_dupl()
call x%v%ins(n,irl,val,dupl,info)
end subroutine d_vect_ins
end subroutine d_mvect_ins
subroutine d_vect_cnv(x,mold)
subroutine d_mvect_cnv(x,mold)
class(psb_d_multivect_type), intent(inout) :: x
class(psb_d_base_multivect_type), intent(in), optional :: mold
class(psb_d_base_multivect_type), allocatable :: tmp
@ -1837,10 +1837,10 @@ contains
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine d_vect_cnv
end subroutine d_mvect_cnv
!!$ function d_vect_dot_v(n,x,y) result(res)
!!$ function d_mvect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
@ -1850,9 +1850,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function d_vect_dot_v
!!$ end function d_mvect_dot_v
!!$
!!$ function d_vect_dot_a(n,x,y) result(res)
!!$ function d_mvect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ real(psb_dpk_), intent(in) :: y(:)
@ -1863,9 +1863,9 @@ contains
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function d_vect_dot_a
!!$ end function d_mvect_dot_a
!!$
!!$ subroutine d_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ subroutine d_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1877,12 +1877,12 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) then
!!$ call y%v%axpby(m,alpha,x%v,beta,info)
!!$ else
!!$ info = psb_err_invalid_vect_state_
!!$ info = psb_err_invalid_mvect_state_
!!$ end if
!!$
!!$ end subroutine d_vect_axpby_v
!!$ end subroutine d_mvect_axpby_v
!!$
!!$ subroutine d_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ subroutine d_mvect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1894,10 +1894,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%axpby(m,alpha,x,beta,info)
!!$
!!$ end subroutine d_vect_axpby_a
!!$ end subroutine d_mvect_axpby_a
!!$
!!$
!!$ subroutine d_vect_mlt_v(x, y, info)
!!$ subroutine d_mvect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
@ -1909,9 +1909,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & call y%v%mlt(x%v,info)
!!$
!!$ end subroutine d_vect_mlt_v
!!$ end subroutine d_mvect_mlt_v
!!$
!!$ subroutine d_vect_mlt_a(x, y, info)
!!$ subroutine d_mvect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: x(:)
@ -1924,10 +1924,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%mlt(x,info)
!!$
!!$ end subroutine d_vect_mlt_a
!!$ end subroutine d_mvect_mlt_a
!!$
!!$
!!$ subroutine d_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ subroutine d_mvect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
@ -1941,9 +1941,9 @@ contains
!!$ if (allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x,y,beta,info)
!!$
!!$ end subroutine d_vect_mlt_a_2
!!$ end subroutine d_mvect_mlt_a_2
!!$
!!$ subroutine d_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ subroutine d_mvect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
@ -1960,9 +1960,9 @@ contains
!!$ & allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
!!$
!!$ end subroutine d_vect_mlt_v_2
!!$ end subroutine d_mvect_mlt_v_2
!!$
!!$ subroutine d_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ subroutine d_mvect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
@ -1976,9 +1976,9 @@ contains
!!$ if (allocated(z%v).and.allocated(y%v)) &
!!$ & call z%v%mlt(alpha,x,y%v,beta,info)
!!$
!!$ end subroutine d_vect_mlt_av
!!$ end subroutine d_mvect_mlt_av
!!$
!!$ subroutine d_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ subroutine d_mvect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_dpk_), intent(in) :: alpha,beta
@ -1993,9 +1993,9 @@ contains
!!$ if (allocated(z%v).and.allocated(x%v)) &
!!$ & call z%v%mlt(alpha,x%v,y,beta,info)
!!$
!!$ end subroutine d_vect_mlt_va
!!$ end subroutine d_mvect_mlt_va
!!$
!!$ subroutine d_vect_scal(alpha, x)
!!$ subroutine d_mvect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
@ -2003,10 +2003,10 @@ contains
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine d_vect_scal
!!$ end subroutine d_mvect_scal
!!$
!!$
!!$ function d_vect_nrm2(n,x) result(res)
!!$ function d_mvect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -2018,9 +2018,9 @@ contains
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_nrm2
!!$ end function d_mvect_nrm2
!!$
!!$ function d_vect_amax(n,x) result(res)
!!$ function d_mvect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -2032,9 +2032,9 @@ contains
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_amax
!!$ end function d_mvect_amax
!!$
!!$ function d_vect_asum(n,x) result(res)
!!$ function d_mvect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_d_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -2046,6 +2046,6 @@ contains
!!$ res = dzero
!!$ end if
!!$
!!$ end function d_vect_asum
!!$ end function d_mvect_asum
end module psb_d_multivect_mod

4
base/modules/serial/psb_i_base_vect_mod.F90
Unescape Escape View File

@ -867,7 +867,7 @@ contains
class(psb_i_base_vect_type) :: x
if (idx%is_dev()) call idx%sync()
call x%gth(n,idx%v(i:),y)
call x%gthzv(n,idx%v(i:),y)
end subroutine i_base_gthzv_x
@ -887,7 +887,7 @@ contains
end if
if (idx%is_dev()) call idx%sync()
if (x%is_dev()) call x%sync()
call x%gth(n,idx%v(i:),x%combuf(i:))
call x%gthzv(n,idx%v(i:),x%combuf(i:))
end subroutine i_base_gthzbuf
!

148
base/modules/serial/psb_i_vect_mod.F90
Unescape Escape View File

@ -452,7 +452,7 @@ contains
class(psb_i_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
& call x%v%gthzv(n,idx,y)
end subroutine i_vect_gthzv
@ -641,37 +641,37 @@ module psb_i_multivect_mod
integer(psb_ipk_) :: dupl = psb_dupl_add_
integer(psb_ipk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: get_ncols => i_vect_get_ncols
procedure, pass(x) :: sizeof => i_vect_sizeof
procedure, pass(x) :: get_fmt => i_vect_get_fmt
procedure, pass(x) :: get_nrows => i_mvect_get_nrows
procedure, pass(x) :: get_ncols => i_mvect_get_ncols
procedure, pass(x) :: sizeof => i_mvect_sizeof
procedure, pass(x) :: get_fmt => i_mvect_get_fmt
procedure, pass(x) :: is_remote_build => i_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => i_mvect_set_remote_build
procedure, pass(x) :: get_dupl => i_mvect_get_dupl
procedure, pass(x) :: set_dupl => i_mvect_set_dupl
procedure, pass(x) :: all => i_vect_all
procedure, pass(x) :: reall => i_vect_reall
procedure, pass(x) :: zero => i_vect_zero
procedure, pass(x) :: asb => i_vect_asb
procedure, pass(x) :: sync => i_vect_sync
procedure, pass(x) :: free => i_vect_free
procedure, pass(x) :: ins => i_vect_ins
procedure, pass(x) :: bld_x => i_vect_bld_x
procedure, pass(x) :: bld_n => i_vect_bld_n
procedure, pass(x) :: all => i_mvect_all
procedure, pass(x) :: reall => i_mvect_reall
procedure, pass(x) :: zero => i_mvect_zero
procedure, pass(x) :: asb => i_mvect_asb
procedure, pass(x) :: sync => i_mvect_sync
procedure, pass(x) :: free => i_mvect_free
procedure, pass(x) :: ins => i_mvect_ins
procedure, pass(x) :: bld_x => i_mvect_bld_x
procedure, pass(x) :: bld_n => i_mvect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => i_vect_get_vect
procedure, pass(x) :: cnv => i_vect_cnv
procedure, pass(x) :: set_scal => i_vect_set_scal
procedure, pass(x) :: set_vect => i_vect_set_vect
procedure, pass(x) :: get_vect => i_mvect_get_vect
procedure, pass(x) :: cnv => i_mvect_cnv
procedure, pass(x) :: set_scal => i_mvect_set_scal
procedure, pass(x) :: set_vect => i_mvect_set_vect
generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => i_vect_clone
procedure, pass(x) :: gthab => i_vect_gthab
procedure, pass(x) :: gthzv => i_vect_gthzv
procedure, pass(x) :: gthzv_x => i_vect_gthzv_x
procedure, pass(x) :: clone => i_mvect_clone
procedure, pass(x) :: gthab => i_mvect_gthab
procedure, pass(x) :: gthzv => i_mvect_gthzv
procedure, pass(x) :: gthzv_x => i_mvect_gthzv_x
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => i_vect_sctb
procedure, pass(y) :: sctb_x => i_vect_sctb_x
procedure, pass(y) :: sctb => i_mvect_sctb
procedure, pass(y) :: sctb_x => i_mvect_sctb_x
generic, public :: sct => sctb, sctb_x
end type psb_i_multivect_type
@ -773,7 +773,7 @@ contains
end function psb_i_get_base_multivect_default
subroutine i_vect_clone(x,y,info)
subroutine i_mvect_clone(x,y,info)
implicit none
class(psb_i_multivect_type), intent(inout) :: x
class(psb_i_multivect_type), intent(inout) :: y
@ -782,11 +782,11 @@ contains
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
call y%bld_x(x%get_vect(),mold=x%v)
end if
end subroutine i_vect_clone
end subroutine i_mvect_clone
subroutine i_vect_bld_x(x,invect,mold)
subroutine i_mvect_bld_x(x,invect,mold)
integer(psb_ipk_), intent(in) :: invect(:,:)
class(psb_i_multivect_type), intent(out) :: x
class(psb_i_base_multivect_type), intent(in), optional :: mold
@ -802,10 +802,10 @@ contains
if (info == psb_success_) call x%v%bld(invect)
end subroutine i_vect_bld_x
end subroutine i_mvect_bld_x
subroutine i_vect_bld_n(x,m,n,mold)
subroutine i_mvect_bld_n(x,m,n,mold)
integer(psb_ipk_), intent(in) :: m,n
class(psb_i_multivect_type), intent(out) :: x
class(psb_i_base_multivect_type), intent(in), optional :: mold
@ -819,9 +819,9 @@ contains
endif
if (info == psb_success_) call x%v%bld(m,n)
end subroutine i_vect_bld_n
end subroutine i_mvect_bld_n
function i_vect_get_vect(x) result(res)
function i_mvect_get_vect(x) result(res)
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:,:)
integer(psb_ipk_) :: info
@ -829,25 +829,25 @@ contains
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function i_vect_get_vect
end function i_mvect_get_vect
subroutine i_vect_set_scal(x,val)
subroutine i_mvect_set_scal(x,val)
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine i_vect_set_scal
end subroutine i_mvect_set_scal
subroutine i_vect_set_vect(x,val)
subroutine i_mvect_set_vect(x,val)
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val(:,:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine i_vect_set_vect
end subroutine i_mvect_set_vect
function constructor(x) result(this)
@ -855,7 +855,7 @@ contains
type(psb_i_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(x)
call this%bld_x(x)
call this%asb(size(x,dim=1,kind=psb_ipk_),size(x,dim=2,kind=psb_ipk_),info)
end function constructor
@ -866,44 +866,44 @@ contains
type(psb_i_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(m,n)
call this%bld_n(m,n)
call this%asb(m,n,info)
end function size_const
function i_vect_get_nrows(x) result(res)
function i_mvect_get_nrows(x) result(res)
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function i_vect_get_nrows
end function i_mvect_get_nrows
function i_vect_get_ncols(x) result(res)
function i_mvect_get_ncols(x) result(res)
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_ncols()
end function i_vect_get_ncols
end function i_mvect_get_ncols
function i_vect_sizeof(x) result(res)
function i_mvect_sizeof(x) result(res)
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function i_vect_sizeof
end function i_mvect_sizeof
function i_vect_get_fmt(x) result(res)
function i_mvect_get_fmt(x) result(res)
implicit none
class(psb_i_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt()
end function i_vect_get_fmt
end function i_mvect_get_fmt
subroutine i_vect_all(m,n, x, info, mold)
subroutine i_mvect_all(m,n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -922,9 +922,9 @@ contains
info = psb_err_alloc_dealloc_
end if
end subroutine i_vect_all
end subroutine i_mvect_all
subroutine i_vect_reall(m,n, x, info)
subroutine i_mvect_reall(m,n, x, info)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -937,18 +937,18 @@ contains
if (info == 0) &
& call x%asb(m,n,info)
end subroutine i_vect_reall
end subroutine i_mvect_reall
subroutine i_vect_zero(x)
subroutine i_mvect_zero(x)
use psi_serial_mod
implicit none
class(psb_i_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine i_vect_zero
end subroutine i_mvect_zero
subroutine i_vect_asb(m,n, x, info)
subroutine i_mvect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -959,18 +959,18 @@ contains
if (allocated(x%v)) &
& call x%v%asb(m,n,info)
end subroutine i_vect_asb
end subroutine i_mvect_asb
subroutine i_vect_sync(x)
subroutine i_mvect_sync(x)
implicit none
class(psb_i_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine i_vect_sync
end subroutine i_mvect_sync
subroutine i_vect_gthab(n,idx,alpha,x,beta,y)
subroutine i_mvect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: alpha, beta, y(:)
@ -979,9 +979,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine i_vect_gthab
end subroutine i_mvect_gthab
subroutine i_vect_gthzv(n,idx,x,y)
subroutine i_mvect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: y(:)
@ -990,9 +990,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine i_vect_gthzv
end subroutine i_mvect_gthzv
subroutine i_vect_gthzv_x(i,n,idx,x,y)
subroutine i_mvect_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
@ -1000,11 +1000,11 @@ contains
class(psb_i_multivect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(i,n,idx,y)
& call x%v%gthzv_x(i,n,idx,y)
end subroutine i_vect_gthzv_x
end subroutine i_mvect_gthzv_x
subroutine i_vect_sctb(n,idx,x,beta,y)
subroutine i_mvect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:)
@ -1013,9 +1013,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine i_vect_sctb
end subroutine i_mvect_sctb
subroutine i_vect_sctb_x(i,n,idx,x,beta,y)
subroutine i_mvect_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
@ -1025,9 +1025,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(i,n,idx,x,beta)
end subroutine i_vect_sctb_x
end subroutine i_mvect_sctb_x
subroutine i_vect_free(x, info)
subroutine i_mvect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1040,9 +1040,9 @@ contains
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine i_vect_free
end subroutine i_mvect_free
subroutine i_vect_ins(n,irl,val,x,info)
subroutine i_mvect_ins(n,irl,val,x,info)
use psi_serial_mod
implicit none
class(psb_i_multivect_type), intent(inout) :: x
@ -1061,10 +1061,10 @@ contains
dupl = x%get_dupl()
call x%v%ins(n,irl,val,dupl,info)
end subroutine i_vect_ins
end subroutine i_mvect_ins
subroutine i_vect_cnv(x,mold)
subroutine i_mvect_cnv(x,mold)
class(psb_i_multivect_type), intent(inout) :: x
class(psb_i_base_multivect_type), intent(in), optional :: mold
class(psb_i_base_multivect_type), allocatable :: tmp
@ -1081,7 +1081,7 @@ contains
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine i_vect_cnv
end subroutine i_mvect_cnv
end module psb_i_multivect_mod

4
base/modules/serial/psb_l_base_vect_mod.F90
Unescape Escape View File

@ -868,7 +868,7 @@ contains
class(psb_l_base_vect_type) :: x
if (idx%is_dev()) call idx%sync()
call x%gth(n,idx%v(i:),y)
call x%gthzv(n,idx%v(i:),y)
end subroutine l_base_gthzv_x
@ -888,7 +888,7 @@ contains
end if
if (idx%is_dev()) call idx%sync()
if (x%is_dev()) call x%sync()
call x%gth(n,idx%v(i:),x%combuf(i:))
call x%gthzv(n,idx%v(i:),x%combuf(i:))
end subroutine l_base_gthzbuf
!

148
base/modules/serial/psb_l_vect_mod.F90
Unescape Escape View File

@ -453,7 +453,7 @@ contains
class(psb_l_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
& call x%v%gthzv(n,idx,y)
end subroutine l_vect_gthzv
@ -642,37 +642,37 @@ module psb_l_multivect_mod
integer(psb_ipk_) :: dupl = psb_dupl_add_
integer(psb_lpk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => l_vect_get_nrows
procedure, pass(x) :: get_ncols => l_vect_get_ncols
procedure, pass(x) :: sizeof => l_vect_sizeof
procedure, pass(x) :: get_fmt => l_vect_get_fmt
procedure, pass(x) :: get_nrows => l_mvect_get_nrows
procedure, pass(x) :: get_ncols => l_mvect_get_ncols
procedure, pass(x) :: sizeof => l_mvect_sizeof
procedure, pass(x) :: get_fmt => l_mvect_get_fmt
procedure, pass(x) :: is_remote_build => l_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => l_mvect_set_remote_build
procedure, pass(x) :: get_dupl => l_mvect_get_dupl
procedure, pass(x) :: set_dupl => l_mvect_set_dupl
procedure, pass(x) :: all => l_vect_all
procedure, pass(x) :: reall => l_vect_reall
procedure, pass(x) :: zero => l_vect_zero
procedure, pass(x) :: asb => l_vect_asb
procedure, pass(x) :: sync => l_vect_sync
procedure, pass(x) :: free => l_vect_free
procedure, pass(x) :: ins => l_vect_ins
procedure, pass(x) :: bld_x => l_vect_bld_x
procedure, pass(x) :: bld_n => l_vect_bld_n
procedure, pass(x) :: all => l_mvect_all
procedure, pass(x) :: reall => l_mvect_reall
procedure, pass(x) :: zero => l_mvect_zero
procedure, pass(x) :: asb => l_mvect_asb
procedure, pass(x) :: sync => l_mvect_sync
procedure, pass(x) :: free => l_mvect_free
procedure, pass(x) :: ins => l_mvect_ins
procedure, pass(x) :: bld_x => l_mvect_bld_x
procedure, pass(x) :: bld_n => l_mvect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => l_vect_get_vect
procedure, pass(x) :: cnv => l_vect_cnv
procedure, pass(x) :: set_scal => l_vect_set_scal
procedure, pass(x) :: set_vect => l_vect_set_vect
procedure, pass(x) :: get_vect => l_mvect_get_vect
procedure, pass(x) :: cnv => l_mvect_cnv
procedure, pass(x) :: set_scal => l_mvect_set_scal
procedure, pass(x) :: set_vect => l_mvect_set_vect
generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => l_vect_clone
procedure, pass(x) :: gthab => l_vect_gthab
procedure, pass(x) :: gthzv => l_vect_gthzv
procedure, pass(x) :: gthzv_x => l_vect_gthzv_x
procedure, pass(x) :: clone => l_mvect_clone
procedure, pass(x) :: gthab => l_mvect_gthab
procedure, pass(x) :: gthzv => l_mvect_gthzv
procedure, pass(x) :: gthzv_x => l_mvect_gthzv_x
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => l_vect_sctb
procedure, pass(y) :: sctb_x => l_vect_sctb_x
procedure, pass(y) :: sctb => l_mvect_sctb
procedure, pass(y) :: sctb_x => l_mvect_sctb_x
generic, public :: sct => sctb, sctb_x
end type psb_l_multivect_type
@ -774,7 +774,7 @@ contains
end function psb_l_get_base_multivect_default
subroutine l_vect_clone(x,y,info)
subroutine l_mvect_clone(x,y,info)
implicit none
class(psb_l_multivect_type), intent(inout) :: x
class(psb_l_multivect_type), intent(inout) :: y
@ -783,11 +783,11 @@ contains
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
call y%bld_x(x%get_vect(),mold=x%v)
end if
end subroutine l_vect_clone
end subroutine l_mvect_clone
subroutine l_vect_bld_x(x,invect,mold)
subroutine l_mvect_bld_x(x,invect,mold)
integer(psb_lpk_), intent(in) :: invect(:,:)
class(psb_l_multivect_type), intent(out) :: x
class(psb_l_base_multivect_type), intent(in), optional :: mold
@ -803,10 +803,10 @@ contains
if (info == psb_success_) call x%v%bld(invect)
end subroutine l_vect_bld_x
end subroutine l_mvect_bld_x
subroutine l_vect_bld_n(x,m,n,mold)
subroutine l_mvect_bld_n(x,m,n,mold)
integer(psb_ipk_), intent(in) :: m,n
class(psb_l_multivect_type), intent(out) :: x
class(psb_l_base_multivect_type), intent(in), optional :: mold
@ -820,9 +820,9 @@ contains
endif
if (info == psb_success_) call x%v%bld(m,n)
end subroutine l_vect_bld_n
end subroutine l_mvect_bld_n
function l_vect_get_vect(x) result(res)
function l_mvect_get_vect(x) result(res)
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_lpk_), allocatable :: res(:,:)
integer(psb_ipk_) :: info
@ -830,25 +830,25 @@ contains
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function l_vect_get_vect
end function l_mvect_get_vect
subroutine l_vect_set_scal(x,val)
subroutine l_mvect_set_scal(x,val)
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_lpk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine l_vect_set_scal
end subroutine l_mvect_set_scal
subroutine l_vect_set_vect(x,val)
subroutine l_mvect_set_vect(x,val)
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_lpk_), intent(in) :: val(:,:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine l_vect_set_vect
end subroutine l_mvect_set_vect
function constructor(x) result(this)
@ -856,7 +856,7 @@ contains
type(psb_l_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(x)
call this%bld_x(x)
call this%asb(size(x,dim=1,kind=psb_ipk_),size(x,dim=2,kind=psb_ipk_),info)
end function constructor
@ -867,44 +867,44 @@ contains
type(psb_l_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(m,n)
call this%bld_n(m,n)
call this%asb(m,n,info)
end function size_const
function l_vect_get_nrows(x) result(res)
function l_mvect_get_nrows(x) result(res)
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function l_vect_get_nrows
end function l_mvect_get_nrows
function l_vect_get_ncols(x) result(res)
function l_mvect_get_ncols(x) result(res)
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_ncols()
end function l_vect_get_ncols
end function l_mvect_get_ncols
function l_vect_sizeof(x) result(res)
function l_mvect_sizeof(x) result(res)
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function l_vect_sizeof
end function l_mvect_sizeof
function l_vect_get_fmt(x) result(res)
function l_mvect_get_fmt(x) result(res)
implicit none
class(psb_l_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt()
end function l_vect_get_fmt
end function l_mvect_get_fmt
subroutine l_vect_all(m,n, x, info, mold)
subroutine l_mvect_all(m,n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -923,9 +923,9 @@ contains
info = psb_err_alloc_dealloc_
end if
end subroutine l_vect_all
end subroutine l_mvect_all
subroutine l_vect_reall(m,n, x, info)
subroutine l_mvect_reall(m,n, x, info)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -938,18 +938,18 @@ contains
if (info == 0) &
& call x%asb(m,n,info)
end subroutine l_vect_reall
end subroutine l_mvect_reall
subroutine l_vect_zero(x)
subroutine l_mvect_zero(x)
use psi_serial_mod
implicit none
class(psb_l_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine l_vect_zero
end subroutine l_mvect_zero
subroutine l_vect_asb(m,n, x, info)
subroutine l_mvect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -960,18 +960,18 @@ contains
if (allocated(x%v)) &
& call x%v%asb(m,n,info)
end subroutine l_vect_asb
end subroutine l_mvect_asb
subroutine l_vect_sync(x)
subroutine l_mvect_sync(x)
implicit none
class(psb_l_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine l_vect_sync
end subroutine l_mvect_sync
subroutine l_vect_gthab(n,idx,alpha,x,beta,y)
subroutine l_mvect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: alpha, beta, y(:)
@ -980,9 +980,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine l_vect_gthab
end subroutine l_mvect_gthab
subroutine l_vect_gthzv(n,idx,x,y)
subroutine l_mvect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: y(:)
@ -991,9 +991,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine l_vect_gthzv
end subroutine l_mvect_gthzv
subroutine l_vect_gthzv_x(i,n,idx,x,y)
subroutine l_mvect_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
@ -1001,11 +1001,11 @@ contains
class(psb_l_multivect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(i,n,idx,y)
& call x%v%gthzv_x(i,n,idx,y)
end subroutine l_vect_gthzv_x
end subroutine l_mvect_gthzv_x
subroutine l_vect_sctb(n,idx,x,beta,y)
subroutine l_mvect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: beta, x(:)
@ -1014,9 +1014,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine l_vect_sctb
end subroutine l_mvect_sctb
subroutine l_vect_sctb_x(i,n,idx,x,beta,y)
subroutine l_mvect_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
@ -1026,9 +1026,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(i,n,idx,x,beta)
end subroutine l_vect_sctb_x
end subroutine l_mvect_sctb_x
subroutine l_vect_free(x, info)
subroutine l_mvect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1041,9 +1041,9 @@ contains
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine l_vect_free
end subroutine l_mvect_free
subroutine l_vect_ins(n,irl,val,x,info)
subroutine l_mvect_ins(n,irl,val,x,info)
use psi_serial_mod
implicit none
class(psb_l_multivect_type), intent(inout) :: x
@ -1062,10 +1062,10 @@ contains
dupl = x%get_dupl()
call x%v%ins(n,irl,val,dupl,info)
end subroutine l_vect_ins
end subroutine l_mvect_ins
subroutine l_vect_cnv(x,mold)
subroutine l_mvect_cnv(x,mold)
class(psb_l_multivect_type), intent(inout) :: x
class(psb_l_base_multivect_type), intent(in), optional :: mold
class(psb_l_base_multivect_type), allocatable :: tmp
@ -1082,7 +1082,7 @@ contains
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine l_vect_cnv
end subroutine l_mvect_cnv
end module psb_l_multivect_mod

4
base/modules/serial/psb_s_base_vect_mod.F90
Unescape Escape View File

@ -1944,7 +1944,7 @@ contains
class(psb_s_base_vect_type) :: x
if (idx%is_dev()) call idx%sync()
call x%gth(n,idx%v(i:),y)
call x%gthzv(n,idx%v(i:),y)
end subroutine s_base_gthzv_x
@ -1964,7 +1964,7 @@ contains
end if
if (idx%is_dev()) call idx%sync()
if (x%is_dev()) call x%sync()
call x%gth(n,idx%v(i:),x%combuf(i:))
call x%gthzv(n,idx%v(i:),x%combuf(i:))
end subroutine s_base_gthzbuf
!

236
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -514,7 +514,7 @@ contains
class(psb_s_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
& call x%v%gthzv(n,idx,y)
end subroutine s_vect_gthzv
@ -712,7 +712,7 @@ contains
res = szero
if (allocated(x%v)) &
& res = x%v%dot(n,y)
& res = x%v%dot_a(n,y)
end function s_vect_dot_a
@ -1379,56 +1379,56 @@ module psb_s_multivect_mod
integer(psb_ipk_) :: dupl = psb_dupl_add_
real(psb_spk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => s_vect_get_nrows
procedure, pass(x) :: get_ncols => s_vect_get_ncols
procedure, pass(x) :: sizeof => s_vect_sizeof
procedure, pass(x) :: get_fmt => s_vect_get_fmt
procedure, pass(x) :: get_nrows => s_mvect_get_nrows
procedure, pass(x) :: get_ncols => s_mvect_get_ncols
procedure, pass(x) :: sizeof => s_mvect_sizeof
procedure, pass(x) :: get_fmt => s_mvect_get_fmt
procedure, pass(x) :: is_remote_build => s_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => s_mvect_set_remote_build
procedure, pass(x) :: get_dupl => s_mvect_get_dupl
procedure, pass(x) :: set_dupl => s_mvect_set_dupl
procedure, pass(x) :: all => s_vect_all
procedure, pass(x) :: reall => s_vect_reall
procedure, pass(x) :: zero => s_vect_zero
procedure, pass(x) :: asb => s_vect_asb
procedure, pass(x) :: sync => s_vect_sync
procedure, pass(x) :: free => s_vect_free
procedure, pass(x) :: ins => s_vect_ins
procedure, pass(x) :: bld_x => s_vect_bld_x
procedure, pass(x) :: bld_n => s_vect_bld_n
procedure, pass(x) :: all => s_mvect_all
procedure, pass(x) :: reall => s_mvect_reall
procedure, pass(x) :: zero => s_mvect_zero
procedure, pass(x) :: asb => s_mvect_asb
procedure, pass(x) :: sync => s_mvect_sync
procedure, pass(x) :: free => s_mvect_free
procedure, pass(x) :: ins => s_mvect_ins
procedure, pass(x) :: bld_x => s_mvect_bld_x
procedure, pass(x) :: bld_n => s_mvect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => s_vect_get_vect
procedure, pass(x) :: cnv => s_vect_cnv
procedure, pass(x) :: set_scal => s_vect_set_scal
procedure, pass(x) :: set_vect => s_vect_set_vect
procedure, pass(x) :: get_vect => s_mvect_get_vect
procedure, pass(x) :: cnv => s_mvect_cnv
procedure, pass(x) :: set_scal => s_mvect_set_scal
procedure, pass(x) :: set_vect => s_mvect_set_vect
generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => s_vect_clone
procedure, pass(x) :: gthab => s_vect_gthab
procedure, pass(x) :: gthzv => s_vect_gthzv
procedure, pass(x) :: gthzv_x => s_vect_gthzv_x
procedure, pass(x) :: clone => s_mvect_clone
procedure, pass(x) :: gthab => s_mvect_gthab
procedure, pass(x) :: gthzv => s_mvect_gthzv
procedure, pass(x) :: gthzv_x => s_mvect_gthzv_x
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => s_vect_sctb
procedure, pass(y) :: sctb_x => s_vect_sctb_x
procedure, pass(y) :: sctb => s_mvect_sctb
procedure, pass(y) :: sctb_x => s_mvect_sctb_x
generic, public :: sct => sctb, sctb_x
!!$ procedure, pass(x) :: dot_v => s_vect_dot_v
!!$ procedure, pass(x) :: dot_a => s_vect_dot_a
!!$ procedure, pass(x) :: dot_v => s_mvect_dot_v
!!$ procedure, pass(x) :: dot_a => s_mvect_dot_a
!!$ generic, public :: dot => dot_v, dot_a
!!$ procedure, pass(y) :: axpby_v => s_vect_axpby_v
!!$ procedure, pass(y) :: axpby_a => s_vect_axpby_a
!!$ procedure, pass(y) :: axpby_v => s_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => s_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
!!$ procedure, pass(y) :: mlt_v => s_vect_mlt_v
!!$ procedure, pass(y) :: mlt_a => s_vect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => s_vect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => s_vect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => s_vect_mlt_va
!!$ procedure, pass(z) :: mlt_av => s_vect_mlt_av
!!$ procedure, pass(y) :: mlt_v => s_mvect_mlt_v
!!$ procedure, pass(y) :: mlt_a => s_mvect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => s_mvect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => s_mvect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => s_mvect_mlt_va
!!$ procedure, pass(z) :: mlt_av => s_mvect_mlt_av
!!$ generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
!!$ & mlt_v_2, mlt_av, mlt_va
!!$ procedure, pass(x) :: scal => s_vect_scal
!!$ procedure, pass(x) :: nrm2 => s_vect_nrm2
!!$ procedure, pass(x) :: amax => s_vect_amax
!!$ procedure, pass(x) :: asum => s_vect_asum
!!$ procedure, pass(x) :: scal => s_mvect_scal
!!$ procedure, pass(x) :: nrm2 => s_mvect_nrm2
!!$ procedure, pass(x) :: amax => s_mvect_amax
!!$ procedure, pass(x) :: asum => s_mvect_asum
end type psb_s_multivect_type
public :: psb_s_multivect, psb_s_multivect_type,&
@ -1529,7 +1529,7 @@ contains
end function psb_s_get_base_multivect_default
subroutine s_vect_clone(x,y,info)
subroutine s_mvect_clone(x,y,info)
implicit none
class(psb_s_multivect_type), intent(inout) :: x
class(psb_s_multivect_type), intent(inout) :: y
@ -1538,11 +1538,11 @@ contains
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
call y%bld_x(x%get_vect(),mold=x%v)
end if
end subroutine s_vect_clone
end subroutine s_mvect_clone
subroutine s_vect_bld_x(x,invect,mold)
subroutine s_mvect_bld_x(x,invect,mold)
real(psb_spk_), intent(in) :: invect(:,:)
class(psb_s_multivect_type), intent(out) :: x
class(psb_s_base_multivect_type), intent(in), optional :: mold
@ -1558,10 +1558,10 @@ contains
if (info == psb_success_) call x%v%bld(invect)
end subroutine s_vect_bld_x
end subroutine s_mvect_bld_x
subroutine s_vect_bld_n(x,m,n,mold)
subroutine s_mvect_bld_n(x,m,n,mold)
integer(psb_ipk_), intent(in) :: m,n
class(psb_s_multivect_type), intent(out) :: x
class(psb_s_base_multivect_type), intent(in), optional :: mold
@ -1575,9 +1575,9 @@ contains
endif
if (info == psb_success_) call x%v%bld(m,n)
end subroutine s_vect_bld_n
end subroutine s_mvect_bld_n
function s_vect_get_vect(x) result(res)
function s_mvect_get_vect(x) result(res)
class(psb_s_multivect_type), intent(inout) :: x
real(psb_spk_), allocatable :: res(:,:)
integer(psb_ipk_) :: info
@ -1585,25 +1585,25 @@ contains
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function s_vect_get_vect
end function s_mvect_get_vect
subroutine s_vect_set_scal(x,val)
subroutine s_mvect_set_scal(x,val)
class(psb_s_multivect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine s_vect_set_scal
end subroutine s_mvect_set_scal
subroutine s_vect_set_vect(x,val)
subroutine s_mvect_set_vect(x,val)
class(psb_s_multivect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine s_vect_set_vect
end subroutine s_mvect_set_vect
function constructor(x) result(this)
@ -1611,7 +1611,7 @@ contains
type(psb_s_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(x)
call this%bld_x(x)
call this%asb(size(x,dim=1,kind=psb_ipk_),size(x,dim=2,kind=psb_ipk_),info)
end function constructor
@ -1622,44 +1622,44 @@ contains
type(psb_s_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(m,n)
call this%bld_n(m,n)
call this%asb(m,n,info)
end function size_const
function s_vect_get_nrows(x) result(res)
function s_mvect_get_nrows(x) result(res)
implicit none
class(psb_s_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function s_vect_get_nrows
end function s_mvect_get_nrows
function s_vect_get_ncols(x) result(res)
function s_mvect_get_ncols(x) result(res)
implicit none
class(psb_s_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_ncols()
end function s_vect_get_ncols
end function s_mvect_get_ncols
function s_vect_sizeof(x) result(res)
function s_mvect_sizeof(x) result(res)
implicit none
class(psb_s_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function s_vect_sizeof
end function s_mvect_sizeof
function s_vect_get_fmt(x) result(res)
function s_mvect_get_fmt(x) result(res)
implicit none
class(psb_s_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt()
end function s_vect_get_fmt
end function s_mvect_get_fmt
subroutine s_vect_all(m,n, x, info, mold)
subroutine s_mvect_all(m,n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1678,9 +1678,9 @@ contains
info = psb_err_alloc_dealloc_
end if
end subroutine s_vect_all
end subroutine s_mvect_all
subroutine s_vect_reall(m,n, x, info)
subroutine s_mvect_reall(m,n, x, info)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1693,18 +1693,18 @@ contains
if (info == 0) &
& call x%asb(m,n,info)
end subroutine s_vect_reall
end subroutine s_mvect_reall
subroutine s_vect_zero(x)
subroutine s_mvect_zero(x)
use psi_serial_mod
implicit none
class(psb_s_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine s_vect_zero
end subroutine s_mvect_zero
subroutine s_vect_asb(m,n, x, info)
subroutine s_mvect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1715,18 +1715,18 @@ contains
if (allocated(x%v)) &
& call x%v%asb(m,n,info)
end subroutine s_vect_asb
end subroutine s_mvect_asb
subroutine s_vect_sync(x)
subroutine s_mvect_sync(x)
implicit none
class(psb_s_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine s_vect_sync
end subroutine s_mvect_sync
subroutine s_vect_gthab(n,idx,alpha,x,beta,y)
subroutine s_mvect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: alpha, beta, y(:)
@ -1735,9 +1735,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine s_vect_gthab
end subroutine s_mvect_gthab
subroutine s_vect_gthzv(n,idx,x,y)
subroutine s_mvect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: y(:)
@ -1746,9 +1746,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine s_vect_gthzv
end subroutine s_mvect_gthzv
subroutine s_vect_gthzv_x(i,n,idx,x,y)
subroutine s_mvect_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
@ -1756,11 +1756,11 @@ contains
class(psb_s_multivect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(i,n,idx,y)
& call x%v%gthzv_x(i,n,idx,y)
end subroutine s_vect_gthzv_x
end subroutine s_mvect_gthzv_x
subroutine s_vect_sctb(n,idx,x,beta,y)
subroutine s_mvect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: beta, x(:)
@ -1769,9 +1769,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine s_vect_sctb
end subroutine s_mvect_sctb
subroutine s_vect_sctb_x(i,n,idx,x,beta,y)
subroutine s_mvect_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
@ -1781,9 +1781,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(i,n,idx,x,beta)
end subroutine s_vect_sctb_x
end subroutine s_mvect_sctb_x
subroutine s_vect_free(x, info)
subroutine s_mvect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1796,9 +1796,9 @@ contains
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine s_vect_free
end subroutine s_mvect_free
subroutine s_vect_ins(n,irl,val,x,info)
subroutine s_mvect_ins(n,irl,val,x,info)
use psi_serial_mod
implicit none
class(psb_s_multivect_type), intent(inout) :: x
@ -1817,10 +1817,10 @@ contains
dupl = x%get_dupl()
call x%v%ins(n,irl,val,dupl,info)
end subroutine s_vect_ins
end subroutine s_mvect_ins
subroutine s_vect_cnv(x,mold)
subroutine s_mvect_cnv(x,mold)
class(psb_s_multivect_type), intent(inout) :: x
class(psb_s_base_multivect_type), intent(in), optional :: mold
class(psb_s_base_multivect_type), allocatable :: tmp
@ -1837,10 +1837,10 @@ contains
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine s_vect_cnv
end subroutine s_mvect_cnv
!!$ function s_vect_dot_v(n,x,y) result(res)
!!$ function s_mvect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
@ -1850,9 +1850,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function s_vect_dot_v
!!$ end function s_mvect_dot_v
!!$
!!$ function s_vect_dot_a(n,x,y) result(res)
!!$ function s_mvect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ real(psb_spk_), intent(in) :: y(:)
@ -1863,9 +1863,9 @@ contains
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function s_vect_dot_a
!!$ end function s_mvect_dot_a
!!$
!!$ subroutine s_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ subroutine s_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1877,12 +1877,12 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) then
!!$ call y%v%axpby(m,alpha,x%v,beta,info)
!!$ else
!!$ info = psb_err_invalid_vect_state_
!!$ info = psb_err_invalid_mvect_state_
!!$ end if
!!$
!!$ end subroutine s_vect_axpby_v
!!$ end subroutine s_mvect_axpby_v
!!$
!!$ subroutine s_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ subroutine s_mvect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1894,10 +1894,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%axpby(m,alpha,x,beta,info)
!!$
!!$ end subroutine s_vect_axpby_a
!!$ end subroutine s_mvect_axpby_a
!!$
!!$
!!$ subroutine s_vect_mlt_v(x, y, info)
!!$ subroutine s_mvect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
@ -1909,9 +1909,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & call y%v%mlt(x%v,info)
!!$
!!$ end subroutine s_vect_mlt_v
!!$ end subroutine s_mvect_mlt_v
!!$
!!$ subroutine s_vect_mlt_a(x, y, info)
!!$ subroutine s_mvect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: x(:)
@ -1924,10 +1924,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%mlt(x,info)
!!$
!!$ end subroutine s_vect_mlt_a
!!$ end subroutine s_mvect_mlt_a
!!$
!!$
!!$ subroutine s_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ subroutine s_mvect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
@ -1941,9 +1941,9 @@ contains
!!$ if (allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x,y,beta,info)
!!$
!!$ end subroutine s_vect_mlt_a_2
!!$ end subroutine s_mvect_mlt_a_2
!!$
!!$ subroutine s_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ subroutine s_mvect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
@ -1960,9 +1960,9 @@ contains
!!$ & allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
!!$
!!$ end subroutine s_vect_mlt_v_2
!!$ end subroutine s_mvect_mlt_v_2
!!$
!!$ subroutine s_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ subroutine s_mvect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
@ -1976,9 +1976,9 @@ contains
!!$ if (allocated(z%v).and.allocated(y%v)) &
!!$ & call z%v%mlt(alpha,x,y%v,beta,info)
!!$
!!$ end subroutine s_vect_mlt_av
!!$ end subroutine s_mvect_mlt_av
!!$
!!$ subroutine s_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ subroutine s_mvect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ real(psb_spk_), intent(in) :: alpha,beta
@ -1993,9 +1993,9 @@ contains
!!$ if (allocated(z%v).and.allocated(x%v)) &
!!$ & call z%v%mlt(alpha,x%v,y,beta,info)
!!$
!!$ end subroutine s_vect_mlt_va
!!$ end subroutine s_mvect_mlt_va
!!$
!!$ subroutine s_vect_scal(alpha, x)
!!$ subroutine s_mvect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
@ -2003,10 +2003,10 @@ contains
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine s_vect_scal
!!$ end subroutine s_mvect_scal
!!$
!!$
!!$ function s_vect_nrm2(n,x) result(res)
!!$ function s_mvect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -2018,9 +2018,9 @@ contains
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_nrm2
!!$ end function s_mvect_nrm2
!!$
!!$ function s_vect_amax(n,x) result(res)
!!$ function s_mvect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -2032,9 +2032,9 @@ contains
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_amax
!!$ end function s_mvect_amax
!!$
!!$ function s_vect_asum(n,x) result(res)
!!$ function s_mvect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_s_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -2046,6 +2046,6 @@ contains
!!$ res = szero
!!$ end if
!!$
!!$ end function s_vect_asum
!!$ end function s_mvect_asum
end module psb_s_multivect_mod

4
base/modules/serial/psb_z_base_vect_mod.F90
Unescape Escape View File

@ -1857,7 +1857,7 @@ contains
class(psb_z_base_vect_type) :: x
if (idx%is_dev()) call idx%sync()
call x%gth(n,idx%v(i:),y)
call x%gthzv(n,idx%v(i:),y)
end subroutine z_base_gthzv_x
@ -1877,7 +1877,7 @@ contains
end if
if (idx%is_dev()) call idx%sync()
if (x%is_dev()) call x%sync()
call x%gth(n,idx%v(i:),x%combuf(i:))
call x%gthzv(n,idx%v(i:),x%combuf(i:))
end subroutine z_base_gthzbuf
!

236
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -507,7 +507,7 @@ contains
class(psb_z_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
& call x%v%gthzv(n,idx,y)
end subroutine z_vect_gthzv
@ -705,7 +705,7 @@ contains
res = zzero
if (allocated(x%v)) &
& res = x%v%dot(n,y)
& res = x%v%dot_a(n,y)
end function z_vect_dot_a
@ -1300,56 +1300,56 @@ module psb_z_multivect_mod
integer(psb_ipk_) :: dupl = psb_dupl_add_
complex(psb_dpk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => z_vect_get_nrows
procedure, pass(x) :: get_ncols => z_vect_get_ncols
procedure, pass(x) :: sizeof => z_vect_sizeof
procedure, pass(x) :: get_fmt => z_vect_get_fmt
procedure, pass(x) :: get_nrows => z_mvect_get_nrows
procedure, pass(x) :: get_ncols => z_mvect_get_ncols
procedure, pass(x) :: sizeof => z_mvect_sizeof
procedure, pass(x) :: get_fmt => z_mvect_get_fmt
procedure, pass(x) :: is_remote_build => z_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => z_mvect_set_remote_build
procedure, pass(x) :: get_dupl => z_mvect_get_dupl
procedure, pass(x) :: set_dupl => z_mvect_set_dupl
procedure, pass(x) :: all => z_vect_all
procedure, pass(x) :: reall => z_vect_reall
procedure, pass(x) :: zero => z_vect_zero
procedure, pass(x) :: asb => z_vect_asb
procedure, pass(x) :: sync => z_vect_sync
procedure, pass(x) :: free => z_vect_free
procedure, pass(x) :: ins => z_vect_ins
procedure, pass(x) :: bld_x => z_vect_bld_x
procedure, pass(x) :: bld_n => z_vect_bld_n
procedure, pass(x) :: all => z_mvect_all
procedure, pass(x) :: reall => z_mvect_reall
procedure, pass(x) :: zero => z_mvect_zero
procedure, pass(x) :: asb => z_mvect_asb
procedure, pass(x) :: sync => z_mvect_sync
procedure, pass(x) :: free => z_mvect_free
procedure, pass(x) :: ins => z_mvect_ins
procedure, pass(x) :: bld_x => z_mvect_bld_x
procedure, pass(x) :: bld_n => z_mvect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => z_vect_get_vect
procedure, pass(x) :: cnv => z_vect_cnv
procedure, pass(x) :: set_scal => z_vect_set_scal
procedure, pass(x) :: set_vect => z_vect_set_vect
procedure, pass(x) :: get_vect => z_mvect_get_vect
procedure, pass(x) :: cnv => z_mvect_cnv
procedure, pass(x) :: set_scal => z_mvect_set_scal
procedure, pass(x) :: set_vect => z_mvect_set_vect
generic, public :: set => set_vect, set_scal
procedure, pass(x) :: clone => z_vect_clone
procedure, pass(x) :: gthab => z_vect_gthab
procedure, pass(x) :: gthzv => z_vect_gthzv
procedure, pass(x) :: gthzv_x => z_vect_gthzv_x
procedure, pass(x) :: clone => z_mvect_clone
procedure, pass(x) :: gthab => z_mvect_gthab
procedure, pass(x) :: gthzv => z_mvect_gthzv
procedure, pass(x) :: gthzv_x => z_mvect_gthzv_x
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => z_vect_sctb
procedure, pass(y) :: sctb_x => z_vect_sctb_x
procedure, pass(y) :: sctb => z_mvect_sctb
procedure, pass(y) :: sctb_x => z_mvect_sctb_x
generic, public :: sct => sctb, sctb_x
!!$ procedure, pass(x) :: dot_v => z_vect_dot_v
!!$ procedure, pass(x) :: dot_a => z_vect_dot_a
!!$ procedure, pass(x) :: dot_v => z_mvect_dot_v
!!$ procedure, pass(x) :: dot_a => z_mvect_dot_a
!!$ generic, public :: dot => dot_v, dot_a
!!$ procedure, pass(y) :: axpby_v => z_vect_axpby_v
!!$ procedure, pass(y) :: axpby_a => z_vect_axpby_a
!!$ procedure, pass(y) :: axpby_v => z_mvect_axpby_v
!!$ procedure, pass(y) :: axpby_a => z_mvect_axpby_a
!!$ generic, public :: axpby => axpby_v, axpby_a
!!$ procedure, pass(y) :: mlt_v => z_vect_mlt_v
!!$ procedure, pass(y) :: mlt_a => z_vect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => z_vect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => z_vect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => z_vect_mlt_va
!!$ procedure, pass(z) :: mlt_av => z_vect_mlt_av
!!$ procedure, pass(y) :: mlt_v => z_mvect_mlt_v
!!$ procedure, pass(y) :: mlt_a => z_mvect_mlt_a
!!$ procedure, pass(z) :: mlt_a_2 => z_mvect_mlt_a_2
!!$ procedure, pass(z) :: mlt_v_2 => z_mvect_mlt_v_2
!!$ procedure, pass(z) :: mlt_va => z_mvect_mlt_va
!!$ procedure, pass(z) :: mlt_av => z_mvect_mlt_av
!!$ generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
!!$ & mlt_v_2, mlt_av, mlt_va
!!$ procedure, pass(x) :: scal => z_vect_scal
!!$ procedure, pass(x) :: nrm2 => z_vect_nrm2
!!$ procedure, pass(x) :: amax => z_vect_amax
!!$ procedure, pass(x) :: asum => z_vect_asum
!!$ procedure, pass(x) :: scal => z_mvect_scal
!!$ procedure, pass(x) :: nrm2 => z_mvect_nrm2
!!$ procedure, pass(x) :: amax => z_mvect_amax
!!$ procedure, pass(x) :: asum => z_mvect_asum
end type psb_z_multivect_type
public :: psb_z_multivect, psb_z_multivect_type,&
@ -1450,7 +1450,7 @@ contains
end function psb_z_get_base_multivect_default
subroutine z_vect_clone(x,y,info)
subroutine z_mvect_clone(x,y,info)
implicit none
class(psb_z_multivect_type), intent(inout) :: x
class(psb_z_multivect_type), intent(inout) :: y
@ -1459,11 +1459,11 @@ contains
info = psb_success_
call y%free(info)
if ((info==0).and.allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
call y%bld_x(x%get_vect(),mold=x%v)
end if
end subroutine z_vect_clone
end subroutine z_mvect_clone
subroutine z_vect_bld_x(x,invect,mold)
subroutine z_mvect_bld_x(x,invect,mold)
complex(psb_dpk_), intent(in) :: invect(:,:)
class(psb_z_multivect_type), intent(out) :: x
class(psb_z_base_multivect_type), intent(in), optional :: mold
@ -1479,10 +1479,10 @@ contains
if (info == psb_success_) call x%v%bld(invect)
end subroutine z_vect_bld_x
end subroutine z_mvect_bld_x
subroutine z_vect_bld_n(x,m,n,mold)
subroutine z_mvect_bld_n(x,m,n,mold)
integer(psb_ipk_), intent(in) :: m,n
class(psb_z_multivect_type), intent(out) :: x
class(psb_z_base_multivect_type), intent(in), optional :: mold
@ -1496,9 +1496,9 @@ contains
endif
if (info == psb_success_) call x%v%bld(m,n)
end subroutine z_vect_bld_n
end subroutine z_mvect_bld_n
function z_vect_get_vect(x) result(res)
function z_mvect_get_vect(x) result(res)
class(psb_z_multivect_type), intent(inout) :: x
complex(psb_dpk_), allocatable :: res(:,:)
integer(psb_ipk_) :: info
@ -1506,25 +1506,25 @@ contains
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function z_vect_get_vect
end function z_mvect_get_vect
subroutine z_vect_set_scal(x,val)
subroutine z_mvect_set_scal(x,val)
class(psb_z_multivect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine z_vect_set_scal
end subroutine z_mvect_set_scal
subroutine z_vect_set_vect(x,val)
subroutine z_mvect_set_vect(x,val)
class(psb_z_multivect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine z_vect_set_vect
end subroutine z_mvect_set_vect
function constructor(x) result(this)
@ -1532,7 +1532,7 @@ contains
type(psb_z_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(x)
call this%bld_x(x)
call this%asb(size(x,dim=1,kind=psb_ipk_),size(x,dim=2,kind=psb_ipk_),info)
end function constructor
@ -1543,44 +1543,44 @@ contains
type(psb_z_multivect_type) :: this
integer(psb_ipk_) :: info
call this%bld(m,n)
call this%bld_n(m,n)
call this%asb(m,n,info)
end function size_const
function z_vect_get_nrows(x) result(res)
function z_mvect_get_nrows(x) result(res)
implicit none
class(psb_z_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function z_vect_get_nrows
end function z_mvect_get_nrows
function z_vect_get_ncols(x) result(res)
function z_mvect_get_ncols(x) result(res)
implicit none
class(psb_z_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_ncols()
end function z_vect_get_ncols
end function z_mvect_get_ncols
function z_vect_sizeof(x) result(res)
function z_mvect_sizeof(x) result(res)
implicit none
class(psb_z_multivect_type), intent(in) :: x
integer(psb_epk_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function z_vect_sizeof
end function z_mvect_sizeof
function z_vect_get_fmt(x) result(res)
function z_mvect_get_fmt(x) result(res)
implicit none
class(psb_z_multivect_type), intent(in) :: x
character(len=5) :: res
res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt()
end function z_vect_get_fmt
end function z_mvect_get_fmt
subroutine z_vect_all(m,n, x, info, mold)
subroutine z_mvect_all(m,n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1599,9 +1599,9 @@ contains
info = psb_err_alloc_dealloc_
end if
end subroutine z_vect_all
end subroutine z_mvect_all
subroutine z_vect_reall(m,n, x, info)
subroutine z_mvect_reall(m,n, x, info)
implicit none
integer(psb_ipk_), intent(in) :: m,n
@ -1614,18 +1614,18 @@ contains
if (info == 0) &
& call x%asb(m,n,info)
end subroutine z_vect_reall
end subroutine z_mvect_reall
subroutine z_vect_zero(x)
subroutine z_mvect_zero(x)
use psi_serial_mod
implicit none
class(psb_z_multivect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine z_vect_zero
end subroutine z_mvect_zero
subroutine z_vect_asb(m,n, x, info)
subroutine z_mvect_asb(m,n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1636,18 +1636,18 @@ contains
if (allocated(x%v)) &
& call x%v%asb(m,n,info)
end subroutine z_vect_asb
end subroutine z_mvect_asb
subroutine z_vect_sync(x)
subroutine z_mvect_sync(x)
implicit none
class(psb_z_multivect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine z_vect_sync
end subroutine z_mvect_sync
subroutine z_vect_gthab(n,idx,alpha,x,beta,y)
subroutine z_mvect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: alpha, beta, y(:)
@ -1656,9 +1656,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine z_vect_gthab
end subroutine z_mvect_gthab
subroutine z_vect_gthzv(n,idx,x,y)
subroutine z_mvect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: y(:)
@ -1667,9 +1667,9 @@ contains
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine z_vect_gthzv
end subroutine z_mvect_gthzv
subroutine z_vect_gthzv_x(i,n,idx,x,y)
subroutine z_mvect_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
@ -1677,11 +1677,11 @@ contains
class(psb_z_multivect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(i,n,idx,y)
& call x%v%gthzv_x(i,n,idx,y)
end subroutine z_vect_gthzv_x
end subroutine z_mvect_gthzv_x
subroutine z_vect_sctb(n,idx,x,beta,y)
subroutine z_mvect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: beta, x(:)
@ -1690,9 +1690,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine z_vect_sctb
end subroutine z_mvect_sctb
subroutine z_vect_sctb_x(i,n,idx,x,beta,y)
subroutine z_mvect_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
@ -1702,9 +1702,9 @@ contains
if (allocated(y%v)) &
& call y%v%sct(i,n,idx,x,beta)
end subroutine z_vect_sctb_x
end subroutine z_mvect_sctb_x
subroutine z_vect_free(x, info)
subroutine z_mvect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1717,9 +1717,9 @@ contains
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine z_vect_free
end subroutine z_mvect_free
subroutine z_vect_ins(n,irl,val,x,info)
subroutine z_mvect_ins(n,irl,val,x,info)
use psi_serial_mod
implicit none
class(psb_z_multivect_type), intent(inout) :: x
@ -1738,10 +1738,10 @@ contains
dupl = x%get_dupl()
call x%v%ins(n,irl,val,dupl,info)
end subroutine z_vect_ins
end subroutine z_mvect_ins
subroutine z_vect_cnv(x,mold)
subroutine z_mvect_cnv(x,mold)
class(psb_z_multivect_type), intent(inout) :: x
class(psb_z_base_multivect_type), intent(in), optional :: mold
class(psb_z_base_multivect_type), allocatable :: tmp
@ -1758,10 +1758,10 @@ contains
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end subroutine z_vect_cnv
end subroutine z_mvect_cnv
!!$ function z_vect_dot_v(n,x,y) result(res)
!!$ function z_mvect_dot_v(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x, y
!!$ integer(psb_ipk_), intent(in) :: n
@ -1771,9 +1771,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & res = x%v%dot(n,y%v)
!!$
!!$ end function z_vect_dot_v
!!$ end function z_mvect_dot_v
!!$
!!$ function z_vect_dot_a(n,x,y) result(res)
!!$ function z_mvect_dot_a(n,x,y) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ complex(psb_dpk_), intent(in) :: y(:)
@ -1784,9 +1784,9 @@ contains
!!$ if (allocated(x%v)) &
!!$ & res = x%v%dot(n,y)
!!$
!!$ end function z_vect_dot_a
!!$ end function z_mvect_dot_a
!!$
!!$ subroutine z_vect_axpby_v(m,alpha, x, beta, y, info)
!!$ subroutine z_mvect_axpby_v(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1798,12 +1798,12 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) then
!!$ call y%v%axpby(m,alpha,x%v,beta,info)
!!$ else
!!$ info = psb_err_invalid_vect_state_
!!$ info = psb_err_invalid_mvect_state_
!!$ end if
!!$
!!$ end subroutine z_vect_axpby_v
!!$ end subroutine z_mvect_axpby_v
!!$
!!$ subroutine z_vect_axpby_a(m,alpha, x, beta, y, info)
!!$ subroutine z_mvect_axpby_a(m,alpha, x, beta, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ integer(psb_ipk_), intent(in) :: m
@ -1815,10 +1815,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%axpby(m,alpha,x,beta,info)
!!$
!!$ end subroutine z_vect_axpby_a
!!$ end subroutine z_mvect_axpby_a
!!$
!!$
!!$ subroutine z_vect_mlt_v(x, y, info)
!!$ subroutine z_mvect_mlt_v(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
@ -1830,9 +1830,9 @@ contains
!!$ if (allocated(x%v).and.allocated(y%v)) &
!!$ & call y%v%mlt(x%v,info)
!!$
!!$ end subroutine z_vect_mlt_v
!!$ end subroutine z_mvect_mlt_v
!!$
!!$ subroutine z_vect_mlt_a(x, y, info)
!!$ subroutine z_mvect_mlt_a(x, y, info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: x(:)
@ -1845,10 +1845,10 @@ contains
!!$ if (allocated(y%v)) &
!!$ & call y%v%mlt(x,info)
!!$
!!$ end subroutine z_vect_mlt_a
!!$ end subroutine z_mvect_mlt_a
!!$
!!$
!!$ subroutine z_vect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ subroutine z_mvect_mlt_a_2(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
@ -1862,9 +1862,9 @@ contains
!!$ if (allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x,y,beta,info)
!!$
!!$ end subroutine z_vect_mlt_a_2
!!$ end subroutine z_mvect_mlt_a_2
!!$
!!$ subroutine z_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ subroutine z_mvect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
@ -1881,9 +1881,9 @@ contains
!!$ & allocated(z%v)) &
!!$ & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
!!$
!!$ end subroutine z_vect_mlt_v_2
!!$ end subroutine z_mvect_mlt_v_2
!!$
!!$ subroutine z_vect_mlt_av(alpha,x,y,beta,z,info)
!!$ subroutine z_mvect_mlt_av(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
@ -1897,9 +1897,9 @@ contains
!!$ if (allocated(z%v).and.allocated(y%v)) &
!!$ & call z%v%mlt(alpha,x,y%v,beta,info)
!!$
!!$ end subroutine z_vect_mlt_av
!!$ end subroutine z_mvect_mlt_av
!!$
!!$ subroutine z_vect_mlt_va(alpha,x,y,beta,z,info)
!!$ subroutine z_mvect_mlt_va(alpha,x,y,beta,z,info)
!!$ use psi_serial_mod
!!$ implicit none
!!$ complex(psb_dpk_), intent(in) :: alpha,beta
@ -1914,9 +1914,9 @@ contains
!!$ if (allocated(z%v).and.allocated(x%v)) &
!!$ & call z%v%mlt(alpha,x%v,y,beta,info)
!!$
!!$ end subroutine z_vect_mlt_va
!!$ end subroutine z_mvect_mlt_va
!!$
!!$ subroutine z_vect_scal(alpha, x)
!!$ subroutine z_mvect_scal(alpha, x)
!!$ use psi_serial_mod
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
@ -1924,10 +1924,10 @@ contains
!!$
!!$ if (allocated(x%v)) call x%v%scal(alpha)
!!$
!!$ end subroutine z_vect_scal
!!$ end subroutine z_mvect_scal
!!$
!!$
!!$ function z_vect_nrm2(n,x) result(res)
!!$ function z_mvect_nrm2(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -1939,9 +1939,9 @@ contains
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_nrm2
!!$ end function z_mvect_nrm2
!!$
!!$ function z_vect_amax(n,x) result(res)
!!$ function z_mvect_amax(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -1953,9 +1953,9 @@ contains
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_amax
!!$ end function z_mvect_amax
!!$
!!$ function z_vect_asum(n,x) result(res)
!!$ function z_mvect_asum(n,x) result(res)
!!$ implicit none
!!$ class(psb_z_multivect_type), intent(inout) :: x
!!$ integer(psb_ipk_), intent(in) :: n
@ -1967,6 +1967,6 @@ contains
!!$ res = dzero
!!$ end if
!!$
!!$ end function z_vect_asum
!!$ end function z_mvect_asum
end module psb_z_multivect_mod

Write Preview
Loading…
Cancel
Save