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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_realloc_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
@ -650,13 +650,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val The value to set !! \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 class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val 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() call x%set_host()
end subroutine c_base_set_scal end subroutine c_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val(:) The vector to be copied in !! \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 class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
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 if (allocated(x%v)) then
nr = min(size(x%v),size(val)) x%v(first_:last_) = val(1:last_-first_+1)
x%v(1:nr) = val(1:nr)
else else
x%v = val x%v = val
end if end if

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

@ -231,21 +231,23 @@ contains
end if end if
end function c_vect_get_vect 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 class(psb_c_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val complex(psb_spk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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 class(psb_c_vect_type), intent(inout) :: x
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_realloc_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
@ -650,13 +650,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val The value to set !! \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 class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val 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() call x%set_host()
end subroutine d_base_set_scal end subroutine d_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val(:) The vector to be copied in !! \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 class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
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 if (allocated(x%v)) then
nr = min(size(x%v),size(val)) x%v(first_:last_) = val(1:last_-first_+1)
x%v(1:nr) = val(1:nr)
else else
x%v = val x%v = val
end if end if

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

@ -231,21 +231,23 @@ contains
end if end if
end function d_vect_get_vect 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 class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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 class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_realloc_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
@ -650,13 +650,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val The value to set !! \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 class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val 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() call x%set_host()
end subroutine s_base_set_scal end subroutine s_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val(:) The vector to be copied in !! \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 class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
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 if (allocated(x%v)) then
nr = min(size(x%v),size(val)) x%v(first_:last_) = val(1:last_-first_+1)
x%v(1:nr) = val(1:nr)
else else
x%v = val x%v = val
end if end if

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

@ -231,21 +231,23 @@ contains
end if end if
end function s_vect_get_vect 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 class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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 class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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_const_mod
use psb_error_mod use psb_error_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_realloc_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
@ -650,13 +650,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val The value to set !! \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 class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val 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() call x%set_host()
end subroutine z_base_set_scal end subroutine z_base_set_scal
@ -699,15 +706,20 @@ contains
!! \brief Set all entries !! \brief Set all entries
!! \param val(:) The vector to be copied in !! \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 class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info
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 if (allocated(x%v)) then
nr = min(size(x%v),size(val)) x%v(first_:last_) = val(1:last_-first_+1)
x%v(1:nr) = val(1:nr)
else else
x%v = val x%v = val
end if end if

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

@ -231,21 +231,23 @@ contains
end if end if
end function z_vect_get_vect 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 class(psb_z_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val complex(psb_dpk_), intent(in) :: val
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 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 class(psb_z_vect_type), intent(inout) :: x
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), optional :: first, last
integer(psb_ipk_) :: info 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 end subroutine z_vect_set_vect

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

@ -30,7 +30,7 @@
!!$ !!$
!!$ !!$
module psi_c_mod module psi_c_mod
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_i_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 use psb_c_vect_mod, only : psb_c_base_vect_type
interface psi_swapdata interface psi_swapdata

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) 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) 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 if (beta /= czero) call y%set(czero,nrow+1,ncol)
!!$ yp(nrow+1:ncol) = czero
! local Matrix-vector product ! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) 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) 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) 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 if (beta /= dzero) call y%set(dzero,nrow+1,ncol)
!!$ yp(nrow+1:ncol) = dzero
! FIXME
info = psb_err_transpose_not_n_unsupported_
call psb_errpush(info,name)
goto 9999
! local Matrix-vector product ! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) 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) 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) 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 if (beta /= szero) call y%set(szero,nrow+1,ncol)
!!$ yp(nrow+1:ncol) = szero
! local Matrix-vector product ! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) 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) 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) 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 if (beta /= zzero) call y%set(zzero,nrow+1,ncol)
!!$ yp(nrow+1:ncol) = zzero
! local Matrix-vector product ! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)

Write Preview
Loading…
Cancel
Save