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

psblas3:

Browse Source 
base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_vect_mod.F90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_vect_mod.F90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_vect_mod.F90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_vect_mod.F90
 base/modules/psi_c_mod.f90
 base/modules/psi_d_mod.f90
 base/modules/psi_s_mod.f90
 base/psblas/psb_cspmm.f90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_sspmm.f90
 base/psblas/psb_zspmm.f90

New optional first/last in V%set(); use them to fix distributed
transpose product.
psblas-3.4-maint
Salvatore Filippone 10 years ago
parent 81329a76f4
commit 0fdb45d4e9
15 changed files with 204 additions and 160 deletions
Show Stats Download Patch File Download Diff File

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

@ -47,7 +47,7 @@ module psb_c_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod
!> \namespace psb_base_mod \class psb_c_base_vect_type
!! The psb_c_base_vect_type
@ -650,13 +650,20 @@ contains
!! \brief Set all entries
!! \param val The value to set
!!
subroutine c_base_set_scal(x,val)
subroutine c_base_set_scal(x,val,first,last)
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info, first_, last_
x%v = val
first_=1
last_=size(x%v)
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (x%is_dev()) call x%sync()
x%v(first_:last_) = val
call x%set_host()
end subroutine c_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine c_base_set_vect(x,val)
subroutine c_base_set_vect(x,val,first,last)
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
nr = min(size(x%v),size(val))
x%v(1:nr) = val(1:nr)
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if

10
base/modules/psb_c_vect_mod.F90
Unescape Escape View File

@ -231,21 +231,23 @@ contains
end if
end function c_vect_get_vect
subroutine c_vect_set_scal(x,val)
subroutine c_vect_set_scal(x,val,first,last)
class(psb_c_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine c_vect_set_scal
subroutine c_vect_set_vect(x,val)
subroutine c_vect_set_vect(x,val,first,last)
class(psb_c_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine c_vect_set_vect

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

@ -47,7 +47,7 @@ module psb_d_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod
!> \namespace psb_base_mod \class psb_d_base_vect_type
!! The psb_d_base_vect_type
@ -650,13 +650,20 @@ contains
!! \brief Set all entries
!! \param val The value to set
!!
subroutine d_base_set_scal(x,val)
subroutine d_base_set_scal(x,val,first,last)
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info, first_, last_
x%v = val
first_=1
last_=size(x%v)
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (x%is_dev()) call x%sync()
x%v(first_:last_) = val
call x%set_host()
end subroutine d_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine d_base_set_vect(x,val)
subroutine d_base_set_vect(x,val,first,last)
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
nr = min(size(x%v),size(val))
x%v(1:nr) = val(1:nr)
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if

10
base/modules/psb_d_vect_mod.F90
Unescape Escape View File

@ -231,21 +231,23 @@ contains
end if
end function d_vect_get_vect
subroutine d_vect_set_scal(x,val)
subroutine d_vect_set_scal(x,val,first,last)
class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine d_vect_set_scal
subroutine d_vect_set_vect(x,val)
subroutine d_vect_set_vect(x,val,first,last)
class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine d_vect_set_vect

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

@ -47,7 +47,7 @@ module psb_s_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod
!> \namespace psb_base_mod \class psb_s_base_vect_type
!! The psb_s_base_vect_type
@ -650,13 +650,20 @@ contains
!! \brief Set all entries
!! \param val The value to set
!!
subroutine s_base_set_scal(x,val)
subroutine s_base_set_scal(x,val,first,last)
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info, first_, last_
x%v = val
first_=1
last_=size(x%v)
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (x%is_dev()) call x%sync()
x%v(first_:last_) = val
call x%set_host()
end subroutine s_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine s_base_set_vect(x,val)
subroutine s_base_set_vect(x,val,first,last)
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
nr = min(size(x%v),size(val))
x%v(1:nr) = val(1:nr)
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if

10
base/modules/psb_s_vect_mod.F90
Unescape Escape View File

@ -231,21 +231,23 @@ contains
end if
end function s_vect_get_vect
subroutine s_vect_set_scal(x,val)
subroutine s_vect_set_scal(x,val,first,last)
class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine s_vect_set_scal
subroutine s_vect_set_vect(x,val)
subroutine s_vect_set_vect(x,val,first,last)
class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine s_vect_set_vect

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

@ -47,7 +47,7 @@ module psb_z_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
use psb_realloc_mod
!> \namespace psb_base_mod \class psb_z_base_vect_type
!! The psb_z_base_vect_type
@ -650,13 +650,20 @@ contains
!! \brief Set all entries
!! \param val The value to set
!!
subroutine z_base_set_scal(x,val)
subroutine z_base_set_scal(x,val,first,last)
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info, first_, last_
x%v = val
first_=1
last_=size(x%v)
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (x%is_dev()) call x%sync()
x%v(first_:last_) = val
call x%set_host()
end subroutine z_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries
!! \param val(:) The vector to be copied in
!!
subroutine z_base_set_vect(x,val)
subroutine z_base_set_vect(x,val,first,last)
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr
integer(psb_ipk_) :: info
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info, first_, last_, nr
first_=1
last_=min(psb_size(x%v),size(val))
if (present(first)) first_ = max(1,first)
if (present(last)) last_ = min(last,last_)
if (allocated(x%v)) then
nr = min(size(x%v),size(val))
x%v(1:nr) = val(1:nr)
x%v(first_:last_) = val(1:last_-first_+1)
else
x%v = val
end if

10
base/modules/psb_z_vect_mod.F90
Unescape Escape View File

@ -231,21 +231,23 @@ contains
end if
end function z_vect_get_vect
subroutine z_vect_set_scal(x,val)
subroutine z_vect_set_scal(x,val,first,last)
class(psb_z_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine z_vect_set_scal
subroutine z_vect_set_vect(x,val)
subroutine z_vect_set_vect(x,val,first,last)
class(psb_z_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
if (allocated(x%v)) call x%v%set(val,first,last)
end subroutine z_vect_set_vect

4
base/modules/psi_c_mod.f90
Unescape Escape View File

@ -30,8 +30,8 @@
!!$
!!$
module psi_c_mod
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_i_base_vect_type
use psb_c_vect_mod, only : psb_c_base_vect_type
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type
use psb_c_vect_mod, only : psb_c_base_vect_type
interface psi_swapdata
subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)

90
base/modules/psi_d_mod.f90
Unescape Escape View File

@ -38,8 +38,8 @@ module psi_d_mod
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswapdatam
@ -47,8 +47,8 @@ module psi_d_mod
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:), beta
real(psb_dpk_),target :: work(:)
real(psb_dpk_) :: y(:), beta
real(psb_dpk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswapdatav
@ -57,36 +57,36 @@ module psi_d_mod
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type) :: y
real(psb_dpk_) :: beta
real(psb_dpk_),target :: work(:)
real(psb_dpk_) :: beta
real(psb_dpk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswapdata_vect
subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dswapidxm
subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:), beta
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dswapidxv
subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type) :: y
real(psb_dpk_) :: beta
real(psb_dpk_), target :: work(:)
real(psb_dpk_) :: beta
real(psb_dpk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_dswap_vidx_vect
@ -98,8 +98,8 @@ module psi_d_mod
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswaptranm
@ -107,8 +107,8 @@ module psi_d_mod
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:), beta
real(psb_dpk_),target :: work(:)
real(psb_dpk_) :: y(:), beta
real(psb_dpk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswaptranv
@ -117,38 +117,38 @@ module psi_d_mod
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type) :: y
real(psb_dpk_) :: beta
real(psb_dpk_),target :: work(:)
real(psb_dpk_) :: beta
real(psb_dpk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswaptran_vect
subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dtranidxm
subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:), beta
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dtranidxv
subroutine psi_dtranidx_vect(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type) :: y
real(psb_dpk_) :: beta
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
real(psb_dpk_) :: beta
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dtranidx_vect
end interface
@ -156,16 +156,16 @@ module psi_d_mod
subroutine psi_dovrl_updr1(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
real(psb_dpk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_updr1
subroutine psi_dovrl_updr2(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_updr2
subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
@ -179,22 +179,22 @@ module psi_d_mod
interface psi_ovrl_save
subroutine psi_dovrl_saver1(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), allocatable :: xs(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_saver1
subroutine psi_dovrl_saver2(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), allocatable :: xs(:,:)
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_saver2
subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
class(psb_d_base_vect_type) :: x
real(psb_dpk_), allocatable :: xs(:)
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_save_vect
@ -210,15 +210,15 @@ module psi_d_mod
end subroutine psi_dovrl_restrr1
subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_) :: xs(:,:)
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_restrr2
subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
class(psb_d_base_vect_type) :: x
real(psb_dpk_) :: xs(:)
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_restr_vect

90
base/modules/psi_s_mod.f90
Unescape Escape View File

@ -38,8 +38,8 @@ module psi_s_mod
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswapdatam
@ -47,8 +47,8 @@ module psi_s_mod
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta
real(psb_spk_),target :: work(:)
real(psb_spk_) :: y(:), beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswapdatav
@ -57,36 +57,36 @@ module psi_s_mod
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_) :: beta
real(psb_spk_),target :: work(:)
real(psb_spk_) :: beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswapdata_vect
subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_sswapidxm
subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_sswapidxv
subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_) :: beta
real(psb_spk_), target :: work(:)
real(psb_spk_) :: beta
real(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_sswap_vidx_vect
@ -98,8 +98,8 @@ module psi_s_mod
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswaptranm
@ -107,8 +107,8 @@ module psi_s_mod
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta
real(psb_spk_),target :: work(:)
real(psb_spk_) :: y(:), beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswaptranv
@ -117,38 +117,38 @@ module psi_s_mod
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_) :: beta
real(psb_spk_),target :: work(:)
real(psb_spk_) :: beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswaptran_vect
subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_stranidxm
subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:), beta
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_stranidxv
subroutine psi_stranidx_vect(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_) :: beta
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
real(psb_spk_) :: beta
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_stranidx_vect
end interface
@ -156,16 +156,16 @@ module psi_s_mod
subroutine psi_sovrl_updr1(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
real(psb_spk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_updr1
subroutine psi_sovrl_updr2(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
real(psb_spk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_updr2
subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
@ -179,22 +179,22 @@ module psi_s_mod
interface psi_ovrl_save
subroutine psi_sovrl_saver1(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), allocatable :: xs(:)
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_saver1
subroutine psi_sovrl_saver2(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_), allocatable :: xs(:,:)
real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_saver2
subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
class(psb_s_base_vect_type) :: x
real(psb_spk_), allocatable :: xs(:)
real(psb_spk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_save_vect
@ -210,15 +210,15 @@ module psi_s_mod
end subroutine psi_sovrl_restrr1
subroutine psi_sovrl_restrr2(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_) :: xs(:,:)
real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_restrr2
subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type
class(psb_s_base_vect_type) :: x
real(psb_spk_) :: xs(:)
real(psb_spk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_sovrl_restr_vect

4
base/psblas/psb_cspmm.f90
Unescape Escape View File

@ -813,9 +813,7 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x%v,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = czero
if (beta /= czero) call y%set(czero,nrow+1,ncol)
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)

8
base/psblas/psb_dspmm.f90
Unescape Escape View File

@ -813,13 +813,7 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x%v,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = dzero
! FIXME
info = psb_err_transpose_not_n_unsupported_
call psb_errpush(info,name)
goto 9999
if (beta /= dzero) call y%set(dzero,nrow+1,ncol)
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)

4
base/psblas/psb_sspmm.f90
Unescape Escape View File

@ -813,9 +813,7 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x%v,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = szero
if (beta /= szero) call y%set(szero,nrow+1,ncol)
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)

4
base/psblas/psb_zspmm.f90
Unescape Escape View File

@ -813,9 +813,7 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x%v,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info)
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = zzero
if (beta /= zzero) call y%set(zzero,nrow+1,ncol)
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)

Write Preview
Loading…
Cancel
Save