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

psblas:

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
 base/serial/psi_serial_impl.f90


Multivector gather
psblas-3.4-maint
Salvatore Filippone 10 years ago
parent b313f96bd8
commit ae735883ff
6 changed files with 205 additions and 1553 deletions
Show Stats Download Patch File Download Diff File

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

@ -1340,6 +1340,7 @@ module psb_c_base_multivect_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_c_base_vect_mod
!> \namespace psb_base_mod \class psb_c_base_vect_type !> \namespace psb_base_mod \class psb_c_base_vect_type
!! The psb_c_base_vect_type !! The psb_c_base_vect_type
@ -1440,9 +1441,9 @@ module psb_c_base_multivect_mod
!!$ ! May have to be reworked. !!$ ! May have to be reworked.
!!$ ! !!$ !
procedure, pass(x) :: gthab => c_base_mlv_gthab procedure, pass(x) :: gthab => c_base_mlv_gthab
!!$ procedure, pass(x) :: gthzv => c_base_mlv_gthzv procedure, pass(x) :: gthzv => c_base_mlv_gthzv
!!$ procedure, pass(x) :: gthzv_x => c_base_mlv_gthzv_x procedure, pass(x) :: gthzv_x => c_base_mlv_gthzv_x
!!$ generic, public :: gth => gthab, gthzv, gthzv_x generic, public :: gth => gthab, gthzv, gthzv_x
!!$ procedure, pass(y) :: sctb => c_base_mlv_sctb !!$ procedure, pass(y) :: sctb => c_base_mlv_sctb
!!$ procedure, pass(y) :: sctb_x => c_base_mlv_sctb_x !!$ procedure, pass(y) :: sctb_x => c_base_mlv_sctb_x
!!$ generic, public :: sct => sctb, sctb_x !!$ generic, public :: sct => sctb, sctb_x
@ -2435,46 +2436,53 @@ contains
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine c_base_mlv_gthab end subroutine c_base_mlv_gthab
!!$ ! !
!!$ ! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
!!$ ! !
!!$ !> Function base_mlv_gthzv !> Function base_mlv_gthzv
!!$ !! \memberof psb_c_base_multivect_type !! \memberof psb_c_base_multivect_type
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \brief gather into an array special alpha=1 beta=0
!!$ !! Y = X(IDX(:)) !! Y = X(IDX(:))
!!$ !! \param n how many entries to consider !! \param n how many entries to consider
!!$ !! \param idx(:) indices !! \param idx(:) indices
!!$ subroutine c_base_mlv_gthzv_x(i,n,idx,x,y) subroutine c_base_mlv_gthzv_x(i,n,idx,x,y)
!!$ use psi_serial_mod use psi_serial_mod
!!$ integer(psb_ipk_) :: i,n integer(psb_ipk_) :: i,n
!!$ class(psb_c_base_multivect_type) :: idx class(psb_i_base_vect_type) :: idx
!!$ complex(psb_spk_) :: y(:) complex(psb_spk_) :: y(:)
!!$ class(psb_c_base_multivect_type) :: x class(psb_c_base_multivect_type) :: x
!!$
!!$ call x%gth(n,idx%v(i:),y) call x%sync()
!!$ call x%gth(n,idx%v(i:),y)
!!$ end subroutine c_base_mlv_gthzv_x
!!$ end subroutine c_base_mlv_gthzv_x
!!$ !
!!$ ! shortcut alpha=1 beta=0 !
!!$ ! ! shortcut alpha=1 beta=0
!!$ !> Function base_mlv_gthzv !
!!$ !! \memberof psb_c_base_multivect_type !> Function base_mlv_gthzv
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \memberof psb_c_base_multivect_type
!!$ !! Y = X(IDX(:)) !! \brief gather into an array special alpha=1 beta=0
!!$ !! \param n how many entries to consider !! Y = X(IDX(:))
!!$ !! \param idx(:) indices !! \param n how many entries to consider
!!$ subroutine c_base_mlv_gthzv(n,idx,x,y) !! \param idx(:) indices
!!$ use psi_serial_mod subroutine c_base_mlv_gthzv(n,idx,x,y)
!!$ integer(psb_ipk_) :: n, idx(:) use psi_serial_mod
!!$ complex(psb_spk_) :: y(:) integer(psb_ipk_) :: n, idx(:)
!!$ class(psb_c_base_multivect_type) :: x complex(psb_spk_) :: y(:)
!!$ class(psb_c_base_multivect_type) :: x
!!$ call x%sync() integer(psb_ipk_) :: nc
!!$ call psi_gth(n,idx,x%v,y)
!!$ call x%sync()
!!$ end subroutine c_base_mlv_gthzv if (.not.allocated(x%v)) then
!!$ return
end if
nc = psb_size(x%v,2)
call psi_gth(n,nc,idx,x%v,y)
end subroutine c_base_mlv_gthzv
!!$ ! !!$ !
!!$ ! Scatter: !!$ ! Scatter:
!!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) !!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

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

@ -1340,6 +1340,7 @@ module psb_d_base_multivect_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_d_base_vect_mod
!> \namespace psb_base_mod \class psb_d_base_vect_type !> \namespace psb_base_mod \class psb_d_base_vect_type
!! The psb_d_base_vect_type !! The psb_d_base_vect_type
@ -1440,9 +1441,9 @@ module psb_d_base_multivect_mod
!!$ ! May have to be reworked. !!$ ! May have to be reworked.
!!$ ! !!$ !
procedure, pass(x) :: gthab => d_base_mlv_gthab procedure, pass(x) :: gthab => d_base_mlv_gthab
!!$ procedure, pass(x) :: gthzv => d_base_mlv_gthzv procedure, pass(x) :: gthzv => d_base_mlv_gthzv
!!$ procedure, pass(x) :: gthzv_x => d_base_mlv_gthzv_x procedure, pass(x) :: gthzv_x => d_base_mlv_gthzv_x
!!$ generic, public :: gth => gthab, gthzv, gthzv_x generic, public :: gth => gthab, gthzv, gthzv_x
!!$ procedure, pass(y) :: sctb => d_base_mlv_sctb !!$ procedure, pass(y) :: sctb => d_base_mlv_sctb
!!$ procedure, pass(y) :: sctb_x => d_base_mlv_sctb_x !!$ procedure, pass(y) :: sctb_x => d_base_mlv_sctb_x
!!$ generic, public :: sct => sctb, sctb_x !!$ generic, public :: sct => sctb, sctb_x
@ -2435,46 +2436,53 @@ contains
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine d_base_mlv_gthab end subroutine d_base_mlv_gthab
!!$ ! !
!!$ ! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
!!$ ! !
!!$ !> Function base_mlv_gthzv !> Function base_mlv_gthzv
!!$ !! \memberof psb_d_base_multivect_type !! \memberof psb_d_base_multivect_type
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \brief gather into an array special alpha=1 beta=0
!!$ !! Y = X(IDX(:)) !! Y = X(IDX(:))
!!$ !! \param n how many entries to consider !! \param n how many entries to consider
!!$ !! \param idx(:) indices !! \param idx(:) indices
!!$ subroutine d_base_mlv_gthzv_x(i,n,idx,x,y) subroutine d_base_mlv_gthzv_x(i,n,idx,x,y)
!!$ use psi_serial_mod use psi_serial_mod
!!$ integer(psb_ipk_) :: i,n integer(psb_ipk_) :: i,n
!!$ class(psb_d_base_multivect_type) :: idx class(psb_i_base_vect_type) :: idx
!!$ real(psb_dpk_) :: y(:) real(psb_dpk_) :: y(:)
!!$ class(psb_d_base_multivect_type) :: x class(psb_d_base_multivect_type) :: x
!!$
!!$ call x%gth(n,idx%v(i:),y) call x%sync()
!!$ call x%gth(n,idx%v(i:),y)
!!$ end subroutine d_base_mlv_gthzv_x
!!$ end subroutine d_base_mlv_gthzv_x
!!$ !
!!$ ! shortcut alpha=1 beta=0 !
!!$ ! ! shortcut alpha=1 beta=0
!!$ !> Function base_mlv_gthzv !
!!$ !! \memberof psb_d_base_multivect_type !> Function base_mlv_gthzv
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \memberof psb_d_base_multivect_type
!!$ !! Y = X(IDX(:)) !! \brief gather into an array special alpha=1 beta=0
!!$ !! \param n how many entries to consider !! Y = X(IDX(:))
!!$ !! \param idx(:) indices !! \param n how many entries to consider
!!$ subroutine d_base_mlv_gthzv(n,idx,x,y) !! \param idx(:) indices
!!$ use psi_serial_mod subroutine d_base_mlv_gthzv(n,idx,x,y)
!!$ integer(psb_ipk_) :: n, idx(:) use psi_serial_mod
!!$ real(psb_dpk_) :: y(:) integer(psb_ipk_) :: n, idx(:)
!!$ class(psb_d_base_multivect_type) :: x real(psb_dpk_) :: y(:)
!!$ class(psb_d_base_multivect_type) :: x
!!$ call x%sync() integer(psb_ipk_) :: nc
!!$ call psi_gth(n,idx,x%v,y)
!!$ call x%sync()
!!$ end subroutine d_base_mlv_gthzv if (.not.allocated(x%v)) then
!!$ return
end if
nc = psb_size(x%v,2)
call psi_gth(n,nc,idx,x%v,y)
end subroutine d_base_mlv_gthzv
!!$ ! !!$ !
!!$ ! Scatter: !!$ ! Scatter:
!!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) !!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

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

@ -880,6 +880,7 @@ module psb_i_base_multivect_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_i_base_vect_type !> \namespace psb_base_mod \class psb_i_base_vect_type
!! The psb_i_base_vect_type !! The psb_i_base_vect_type

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

@ -1340,6 +1340,7 @@ module psb_s_base_multivect_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_s_base_vect_mod
!> \namespace psb_base_mod \class psb_s_base_vect_type !> \namespace psb_base_mod \class psb_s_base_vect_type
!! The psb_s_base_vect_type !! The psb_s_base_vect_type
@ -1440,9 +1441,9 @@ module psb_s_base_multivect_mod
!!$ ! May have to be reworked. !!$ ! May have to be reworked.
!!$ ! !!$ !
procedure, pass(x) :: gthab => s_base_mlv_gthab procedure, pass(x) :: gthab => s_base_mlv_gthab
!!$ procedure, pass(x) :: gthzv => s_base_mlv_gthzv procedure, pass(x) :: gthzv => s_base_mlv_gthzv
!!$ procedure, pass(x) :: gthzv_x => s_base_mlv_gthzv_x procedure, pass(x) :: gthzv_x => s_base_mlv_gthzv_x
!!$ generic, public :: gth => gthab, gthzv, gthzv_x generic, public :: gth => gthab, gthzv, gthzv_x
!!$ procedure, pass(y) :: sctb => s_base_mlv_sctb !!$ procedure, pass(y) :: sctb => s_base_mlv_sctb
!!$ procedure, pass(y) :: sctb_x => s_base_mlv_sctb_x !!$ procedure, pass(y) :: sctb_x => s_base_mlv_sctb_x
!!$ generic, public :: sct => sctb, sctb_x !!$ generic, public :: sct => sctb, sctb_x
@ -2435,46 +2436,53 @@ contains
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine s_base_mlv_gthab end subroutine s_base_mlv_gthab
!!$ ! !
!!$ ! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
!!$ ! !
!!$ !> Function base_mlv_gthzv !> Function base_mlv_gthzv
!!$ !! \memberof psb_s_base_multivect_type !! \memberof psb_s_base_multivect_type
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \brief gather into an array special alpha=1 beta=0
!!$ !! Y = X(IDX(:)) !! Y = X(IDX(:))
!!$ !! \param n how many entries to consider !! \param n how many entries to consider
!!$ !! \param idx(:) indices !! \param idx(:) indices
!!$ subroutine s_base_mlv_gthzv_x(i,n,idx,x,y) subroutine s_base_mlv_gthzv_x(i,n,idx,x,y)
!!$ use psi_serial_mod use psi_serial_mod
!!$ integer(psb_ipk_) :: i,n integer(psb_ipk_) :: i,n
!!$ class(psb_s_base_multivect_type) :: idx class(psb_i_base_vect_type) :: idx
!!$ real(psb_spk_) :: y(:) real(psb_spk_) :: y(:)
!!$ class(psb_s_base_multivect_type) :: x class(psb_s_base_multivect_type) :: x
!!$
!!$ call x%gth(n,idx%v(i:),y) call x%sync()
!!$ call x%gth(n,idx%v(i:),y)
!!$ end subroutine s_base_mlv_gthzv_x
!!$ end subroutine s_base_mlv_gthzv_x
!!$ !
!!$ ! shortcut alpha=1 beta=0 !
!!$ ! ! shortcut alpha=1 beta=0
!!$ !> Function base_mlv_gthzv !
!!$ !! \memberof psb_s_base_multivect_type !> Function base_mlv_gthzv
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \memberof psb_s_base_multivect_type
!!$ !! Y = X(IDX(:)) !! \brief gather into an array special alpha=1 beta=0
!!$ !! \param n how many entries to consider !! Y = X(IDX(:))
!!$ !! \param idx(:) indices !! \param n how many entries to consider
!!$ subroutine s_base_mlv_gthzv(n,idx,x,y) !! \param idx(:) indices
!!$ use psi_serial_mod subroutine s_base_mlv_gthzv(n,idx,x,y)
!!$ integer(psb_ipk_) :: n, idx(:) use psi_serial_mod
!!$ real(psb_spk_) :: y(:) integer(psb_ipk_) :: n, idx(:)
!!$ class(psb_s_base_multivect_type) :: x real(psb_spk_) :: y(:)
!!$ class(psb_s_base_multivect_type) :: x
!!$ call x%sync() integer(psb_ipk_) :: nc
!!$ call psi_gth(n,idx,x%v,y)
!!$ call x%sync()
!!$ end subroutine s_base_mlv_gthzv if (.not.allocated(x%v)) then
!!$ return
end if
nc = psb_size(x%v,2)
call psi_gth(n,nc,idx,x%v,y)
end subroutine s_base_mlv_gthzv
!!$ ! !!$ !
!!$ ! Scatter: !!$ ! Scatter:
!!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) !!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

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

@ -1340,6 +1340,7 @@ module psb_z_base_multivect_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_z_base_vect_mod
!> \namespace psb_base_mod \class psb_z_base_vect_type !> \namespace psb_base_mod \class psb_z_base_vect_type
!! The psb_z_base_vect_type !! The psb_z_base_vect_type
@ -1440,9 +1441,9 @@ module psb_z_base_multivect_mod
!!$ ! May have to be reworked. !!$ ! May have to be reworked.
!!$ ! !!$ !
procedure, pass(x) :: gthab => z_base_mlv_gthab procedure, pass(x) :: gthab => z_base_mlv_gthab
!!$ procedure, pass(x) :: gthzv => z_base_mlv_gthzv procedure, pass(x) :: gthzv => z_base_mlv_gthzv
!!$ procedure, pass(x) :: gthzv_x => z_base_mlv_gthzv_x procedure, pass(x) :: gthzv_x => z_base_mlv_gthzv_x
!!$ generic, public :: gth => gthab, gthzv, gthzv_x generic, public :: gth => gthab, gthzv, gthzv_x
!!$ procedure, pass(y) :: sctb => z_base_mlv_sctb !!$ procedure, pass(y) :: sctb => z_base_mlv_sctb
!!$ procedure, pass(y) :: sctb_x => z_base_mlv_sctb_x !!$ procedure, pass(y) :: sctb_x => z_base_mlv_sctb_x
!!$ generic, public :: sct => sctb, sctb_x !!$ generic, public :: sct => sctb, sctb_x
@ -2435,46 +2436,53 @@ contains
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine z_base_mlv_gthab end subroutine z_base_mlv_gthab
!!$ ! !
!!$ ! shortcut alpha=1 beta=0 ! shortcut alpha=1 beta=0
!!$ ! !
!!$ !> Function base_mlv_gthzv !> Function base_mlv_gthzv
!!$ !! \memberof psb_z_base_multivect_type !! \memberof psb_z_base_multivect_type
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \brief gather into an array special alpha=1 beta=0
!!$ !! Y = X(IDX(:)) !! Y = X(IDX(:))
!!$ !! \param n how many entries to consider !! \param n how many entries to consider
!!$ !! \param idx(:) indices !! \param idx(:) indices
!!$ subroutine z_base_mlv_gthzv_x(i,n,idx,x,y) subroutine z_base_mlv_gthzv_x(i,n,idx,x,y)
!!$ use psi_serial_mod use psi_serial_mod
!!$ integer(psb_ipk_) :: i,n integer(psb_ipk_) :: i,n
!!$ class(psb_z_base_multivect_type) :: idx class(psb_i_base_vect_type) :: idx
!!$ complex(psb_dpk_) :: y(:) complex(psb_dpk_) :: y(:)
!!$ class(psb_z_base_multivect_type) :: x class(psb_z_base_multivect_type) :: x
!!$
!!$ call x%gth(n,idx%v(i:),y) call x%sync()
!!$ call x%gth(n,idx%v(i:),y)
!!$ end subroutine z_base_mlv_gthzv_x
!!$ end subroutine z_base_mlv_gthzv_x
!!$ !
!!$ ! shortcut alpha=1 beta=0 !
!!$ ! ! shortcut alpha=1 beta=0
!!$ !> Function base_mlv_gthzv !
!!$ !! \memberof psb_z_base_multivect_type !> Function base_mlv_gthzv
!!$ !! \brief gather into an array special alpha=1 beta=0 !! \memberof psb_z_base_multivect_type
!!$ !! Y = X(IDX(:)) !! \brief gather into an array special alpha=1 beta=0
!!$ !! \param n how many entries to consider !! Y = X(IDX(:))
!!$ !! \param idx(:) indices !! \param n how many entries to consider
!!$ subroutine z_base_mlv_gthzv(n,idx,x,y) !! \param idx(:) indices
!!$ use psi_serial_mod subroutine z_base_mlv_gthzv(n,idx,x,y)
!!$ integer(psb_ipk_) :: n, idx(:) use psi_serial_mod
!!$ complex(psb_dpk_) :: y(:) integer(psb_ipk_) :: n, idx(:)
!!$ class(psb_z_base_multivect_type) :: x complex(psb_dpk_) :: y(:)
!!$ class(psb_z_base_multivect_type) :: x
!!$ call x%sync() integer(psb_ipk_) :: nc
!!$ call psi_gth(n,idx,x%v,y)
!!$ call x%sync()
!!$ end subroutine z_base_mlv_gthzv if (.not.allocated(x%v)) then
!!$ return
end if
nc = psb_size(x%v,2)
call psi_gth(n,nc,idx,x%v,y)
end subroutine z_base_mlv_gthzv
!!$ ! !!$ !
!!$ ! Scatter: !!$ ! Scatter:
!!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:) !!$ ! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)

1381
base/serial/psi_serial_impl.f90
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save