fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

New interface for methods with global reductions.

Browse Source
This commit is contained in:
Salvatore Filippone
2018-04-20 15:13:36 +01:00
parent 462f1d098c
commit eaaa701c2e
28 changed files with 1172 additions and 436 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psblas/psb_c_psblas_mod.F90
+68 -47
View File
@@ -35,50 +35,55 @@ module psb_c_psblas_mod
use psb_c_mat_mod, only : psb_cspmat_type use psb_c_mat_mod, only : psb_cspmat_type
interface psb_gedot interface psb_gedot
function psb_cdot_vect(x, y, desc_a,info) result(res) function psb_cdot_vect(x, y, desc_a,info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
complex(psb_spk_) :: res complex(psb_spk_) :: res
type(psb_c_vect_type), intent(inout) :: x, y type(psb_c_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cdot_vect end function psb_cdot_vect
function psb_cdotv(x, y, desc_a,info) function psb_cdotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
complex(psb_spk_) :: psb_cdotv complex(psb_spk_) :: psb_cdotv
complex(psb_spk_), intent(in) :: x(:), y(:) complex(psb_spk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cdotv end function psb_cdotv
function psb_cdot(x, y, desc_a, info, jx, jy) function psb_cdot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
complex(psb_spk_) :: psb_cdot complex(psb_spk_) :: psb_cdot
complex(psb_spk_), intent(in) :: x(:,:), y(:,:) complex(psb_spk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: jx, jy integer(psb_ipk_), optional, intent(in) :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cdot end function psb_cdot
end interface end interface
interface psb_gedots interface psb_gedots
subroutine psb_cdotvs(res,x, y, desc_a, info) subroutine psb_cdotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
complex(psb_spk_), intent(out) :: res complex(psb_spk_), intent(out) :: res
complex(psb_spk_), intent(in) :: x(:), y(:) complex(psb_spk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_cdotvs end subroutine psb_cdotvs
subroutine psb_cmdots(res,x, y, desc_a,info) subroutine psb_cmdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
complex(psb_spk_), intent(out) :: res(:) complex(psb_spk_), intent(out) :: res(:)
complex(psb_spk_), intent(in) :: x(:,:), y(:,:) complex(psb_spk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_cmdots end subroutine psb_cmdots
end interface end interface
@@ -91,7 +96,7 @@ module psb_c_psblas_mod
type(psb_c_vect_type), intent (inout) :: y type(psb_c_vect_type), intent (inout) :: y
complex(psb_spk_), intent (in) :: alpha, beta complex(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_caxpby_vect end subroutine psb_caxpby_vect
subroutine psb_caxpbyv(alpha, x, beta, y,& subroutine psb_caxpbyv(alpha, x, beta, y,&
& desc_a, info) & desc_a, info)
@@ -112,35 +117,38 @@ module psb_c_psblas_mod
complex(psb_spk_), intent (in) :: alpha, beta complex(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: n, jx, jy integer(psb_ipk_), optional, intent(in) :: n, jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_caxpby end subroutine psb_caxpby
end interface end interface
interface psb_geamax interface psb_geamax
function psb_camax(x, desc_a, info, jx) function psb_camax(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) psb_camax real(psb_spk_) psb_camax
complex(psb_spk_), intent (in) :: x(:,:) complex(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_camax end function psb_camax
function psb_camaxv(x, desc_a,info) function psb_camaxv(x, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) psb_camaxv real(psb_spk_) psb_camaxv
complex(psb_spk_), intent (in) :: x(:) complex(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_camaxv end function psb_camaxv
function psb_camax_vect(x, desc_a, info) result(res) function psb_camax_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_c_vect_type), intent (inout) :: x type(psb_c_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_camax_vect end function psb_camax_vect
end interface end interface
@@ -154,69 +162,76 @@ module psb_c_psblas_mod
#endif #endif
interface psb_geamaxs interface psb_geamaxs
subroutine psb_camaxvs(res,x,desc_a,info) subroutine psb_camaxvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_), intent (out) :: res real(psb_spk_), intent (out) :: res
complex(psb_spk_), intent (in) :: x(:) complex(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_camaxvs end subroutine psb_camaxvs
subroutine psb_cmamaxs(res,x,desc_a,info,jx) subroutine psb_cmamaxs(res,x,desc_a,info,jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_), intent (out) :: res(:) real(psb_spk_), intent (out) :: res(:)
complex(psb_spk_), intent (in) :: x(:,:) complex(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
logical, intent(in), optional :: global
end subroutine psb_cmamaxs end subroutine psb_cmamaxs
end interface end interface
interface psb_geasum interface psb_geasum
function psb_casum_vect(x, desc_a, info) result(res) function psb_casum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_c_vect_type), intent (inout) :: x type(psb_c_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_casum_vect end function psb_casum_vect
function psb_casum(x, desc_a, info, jx) function psb_casum(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) psb_casum real(psb_spk_) psb_casum
complex(psb_spk_), intent (in) :: x(:,:) complex(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_casum end function psb_casum
function psb_casumv(x, desc_a, info) function psb_casumv(x, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) psb_casumv real(psb_spk_) psb_casumv
complex(psb_spk_), intent (in) :: x(:) complex(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_casumv end function psb_casumv
end interface end interface
interface psb_geasums interface psb_geasums
subroutine psb_casumvs(res,x,desc_a,info) subroutine psb_casumvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_), intent (out) :: res real(psb_spk_), intent (out) :: res
complex(psb_spk_), intent (in) :: x(:) complex(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_casumvs end subroutine psb_casumvs
subroutine psb_cmasum(res,x,desc_a,info) subroutine psb_cmasum(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_), intent (out) :: res(:) real(psb_spk_), intent (out) :: res(:)
complex(psb_spk_), intent (in) :: x(:,:) complex(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_cmasum end subroutine psb_cmasum
end interface end interface
@@ -230,30 +245,33 @@ module psb_c_psblas_mod
#endif #endif
interface psb_genrm2 interface psb_genrm2
function psb_cnrm2(x, desc_a, info, jx) function psb_cnrm2(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) psb_cnrm2 real(psb_spk_) psb_cnrm2
complex(psb_spk_), intent (in) :: x(:,:) complex(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2 end function psb_cnrm2
function psb_cnrm2v(x, desc_a, info) function psb_cnrm2v(x, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) psb_cnrm2v real(psb_spk_) psb_cnrm2v
complex(psb_spk_), intent (in) :: x(:) complex(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2v end function psb_cnrm2v
function psb_cnrm2_vect(x, desc_a, info) result(res) function psb_cnrm2_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_c_vect_type), intent (inout) :: x type(psb_c_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2_vect end function psb_cnrm2_vect
end interface end interface
@@ -264,25 +282,27 @@ module psb_c_psblas_mod
#endif #endif
interface psb_genrm2s interface psb_genrm2s
subroutine psb_cnrm2vs(res,x,desc_a,info) subroutine psb_cnrm2vs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_), intent (out) :: res real(psb_spk_), intent (out) :: res
complex(psb_spk_), intent (in) :: x(:) complex(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_cnrm2vs end subroutine psb_cnrm2vs
end interface end interface
interface psb_spnrmi interface psb_spnrmi
function psb_cnrmi(a, desc_a,info) function psb_cnrmi(a, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: psb_cnrmi real(psb_spk_) :: psb_cnrmi
type(psb_cspmat_type), intent (in) :: a type(psb_cspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrmi end function psb_cnrmi
end interface end interface
@@ -293,13 +313,14 @@ module psb_c_psblas_mod
#endif #endif
interface psb_spnrm1 interface psb_spnrm1
function psb_cspnrm1(a, desc_a,info) function psb_cspnrm1(a, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type & psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: psb_cspnrm1 real(psb_spk_) :: psb_cspnrm1
type(psb_cspmat_type), intent (in) :: a type(psb_cspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cspnrm1 end function psb_cspnrm1
end interface end interface
base/modules/psblas/psb_d_psblas_mod.F90
+68 -47
View File
@@ -35,50 +35,55 @@ module psb_d_psblas_mod
use psb_d_mat_mod, only : psb_dspmat_type use psb_d_mat_mod, only : psb_dspmat_type
interface psb_gedot interface psb_gedot
function psb_ddot_vect(x, y, desc_a,info) result(res) function psb_ddot_vect(x, y, desc_a,info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_d_vect_type), intent(inout) :: x, y type(psb_d_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_ddot_vect end function psb_ddot_vect
function psb_ddotv(x, y, desc_a,info) function psb_ddotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: psb_ddotv real(psb_dpk_) :: psb_ddotv
real(psb_dpk_), intent(in) :: x(:), y(:) real(psb_dpk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_ddotv end function psb_ddotv
function psb_ddot(x, y, desc_a, info, jx, jy) function psb_ddot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: psb_ddot real(psb_dpk_) :: psb_ddot
real(psb_dpk_), intent(in) :: x(:,:), y(:,:) real(psb_dpk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: jx, jy integer(psb_ipk_), optional, intent(in) :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_ddot end function psb_ddot
end interface end interface
interface psb_gedots interface psb_gedots
subroutine psb_ddotvs(res,x, y, desc_a, info) subroutine psb_ddotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
real(psb_dpk_), intent(in) :: x(:), y(:) real(psb_dpk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_ddotvs end subroutine psb_ddotvs
subroutine psb_dmdots(res,x, y, desc_a,info) subroutine psb_dmdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent(out) :: res(:) real(psb_dpk_), intent(out) :: res(:)
real(psb_dpk_), intent(in) :: x(:,:), y(:,:) real(psb_dpk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_dmdots end subroutine psb_dmdots
end interface end interface
@@ -91,7 +96,7 @@ module psb_d_psblas_mod
type(psb_d_vect_type), intent (inout) :: y type(psb_d_vect_type), intent (inout) :: y
real(psb_dpk_), intent (in) :: alpha, beta real(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_daxpby_vect end subroutine psb_daxpby_vect
subroutine psb_daxpbyv(alpha, x, beta, y,& subroutine psb_daxpbyv(alpha, x, beta, y,&
& desc_a, info) & desc_a, info)
@@ -112,35 +117,38 @@ module psb_d_psblas_mod
real(psb_dpk_), intent (in) :: alpha, beta real(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: n, jx, jy integer(psb_ipk_), optional, intent(in) :: n, jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_daxpby end subroutine psb_daxpby
end interface end interface
interface psb_geamax interface psb_geamax
function psb_damax(x, desc_a, info, jx) function psb_damax(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) psb_damax real(psb_dpk_) psb_damax
real(psb_dpk_), intent (in) :: x(:,:) real(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_damax end function psb_damax
function psb_damaxv(x, desc_a,info) function psb_damaxv(x, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) psb_damaxv real(psb_dpk_) psb_damaxv
real(psb_dpk_), intent (in) :: x(:) real(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_damaxv end function psb_damaxv
function psb_damax_vect(x, desc_a, info) result(res) function psb_damax_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_damax_vect end function psb_damax_vect
end interface end interface
@@ -154,69 +162,76 @@ module psb_d_psblas_mod
#endif #endif
interface psb_geamaxs interface psb_geamaxs
subroutine psb_damaxvs(res,x,desc_a,info) subroutine psb_damaxvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent (out) :: res real(psb_dpk_), intent (out) :: res
real(psb_dpk_), intent (in) :: x(:) real(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_damaxvs end subroutine psb_damaxvs
subroutine psb_dmamaxs(res,x,desc_a,info,jx) subroutine psb_dmamaxs(res,x,desc_a,info,jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent (out) :: res(:) real(psb_dpk_), intent (out) :: res(:)
real(psb_dpk_), intent (in) :: x(:,:) real(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
logical, intent(in), optional :: global
end subroutine psb_dmamaxs end subroutine psb_dmamaxs
end interface end interface
interface psb_geasum interface psb_geasum
function psb_dasum_vect(x, desc_a, info) result(res) function psb_dasum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dasum_vect end function psb_dasum_vect
function psb_dasum(x, desc_a, info, jx) function psb_dasum(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) psb_dasum real(psb_dpk_) psb_dasum
real(psb_dpk_), intent (in) :: x(:,:) real(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dasum end function psb_dasum
function psb_dasumv(x, desc_a, info) function psb_dasumv(x, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) psb_dasumv real(psb_dpk_) psb_dasumv
real(psb_dpk_), intent (in) :: x(:) real(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dasumv end function psb_dasumv
end interface end interface
interface psb_geasums interface psb_geasums
subroutine psb_dasumvs(res,x,desc_a,info) subroutine psb_dasumvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent (out) :: res real(psb_dpk_), intent (out) :: res
real(psb_dpk_), intent (in) :: x(:) real(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_dasumvs end subroutine psb_dasumvs
subroutine psb_dmasum(res,x,desc_a,info) subroutine psb_dmasum(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent (out) :: res(:) real(psb_dpk_), intent (out) :: res(:)
real(psb_dpk_), intent (in) :: x(:,:) real(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_dmasum end subroutine psb_dmasum
end interface end interface
@@ -230,30 +245,33 @@ module psb_d_psblas_mod
#endif #endif
interface psb_genrm2 interface psb_genrm2
function psb_dnrm2(x, desc_a, info, jx) function psb_dnrm2(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) psb_dnrm2 real(psb_dpk_) psb_dnrm2
real(psb_dpk_), intent (in) :: x(:,:) real(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2 end function psb_dnrm2
function psb_dnrm2v(x, desc_a, info) function psb_dnrm2v(x, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) psb_dnrm2v real(psb_dpk_) psb_dnrm2v
real(psb_dpk_), intent (in) :: x(:) real(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2v end function psb_dnrm2v
function psb_dnrm2_vect(x, desc_a, info) result(res) function psb_dnrm2_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2_vect end function psb_dnrm2_vect
end interface end interface
@@ -264,25 +282,27 @@ module psb_d_psblas_mod
#endif #endif
interface psb_genrm2s interface psb_genrm2s
subroutine psb_dnrm2vs(res,x,desc_a,info) subroutine psb_dnrm2vs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_), intent (out) :: res real(psb_dpk_), intent (out) :: res
real(psb_dpk_), intent (in) :: x(:) real(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_dnrm2vs end subroutine psb_dnrm2vs
end interface end interface
interface psb_spnrmi interface psb_spnrmi
function psb_dnrmi(a, desc_a,info) function psb_dnrmi(a, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: psb_dnrmi real(psb_dpk_) :: psb_dnrmi
type(psb_dspmat_type), intent (in) :: a type(psb_dspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrmi end function psb_dnrmi
end interface end interface
@@ -293,13 +313,14 @@ module psb_d_psblas_mod
#endif #endif
interface psb_spnrm1 interface psb_spnrm1
function psb_dspnrm1(a, desc_a,info) function psb_dspnrm1(a, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type & psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: psb_dspnrm1 real(psb_dpk_) :: psb_dspnrm1
type(psb_dspmat_type), intent (in) :: a type(psb_dspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dspnrm1 end function psb_dspnrm1
end interface end interface
base/modules/psblas/psb_s_psblas_mod.F90
+68 -47
View File
@@ -35,50 +35,55 @@ module psb_s_psblas_mod
use psb_s_mat_mod, only : psb_sspmat_type use psb_s_mat_mod, only : psb_sspmat_type
interface psb_gedot interface psb_gedot
function psb_sdot_vect(x, y, desc_a,info) result(res) function psb_sdot_vect(x, y, desc_a,info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_s_vect_type), intent(inout) :: x, y type(psb_s_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sdot_vect end function psb_sdot_vect
function psb_sdotv(x, y, desc_a,info) function psb_sdotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: psb_sdotv real(psb_spk_) :: psb_sdotv
real(psb_spk_), intent(in) :: x(:), y(:) real(psb_spk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sdotv end function psb_sdotv
function psb_sdot(x, y, desc_a, info, jx, jy) function psb_sdot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: psb_sdot real(psb_spk_) :: psb_sdot
real(psb_spk_), intent(in) :: x(:,:), y(:,:) real(psb_spk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: jx, jy integer(psb_ipk_), optional, intent(in) :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sdot end function psb_sdot
end interface end interface
interface psb_gedots interface psb_gedots
subroutine psb_sdotvs(res,x, y, desc_a, info) subroutine psb_sdotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
real(psb_spk_), intent(in) :: x(:), y(:) real(psb_spk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_sdotvs end subroutine psb_sdotvs
subroutine psb_smdots(res,x, y, desc_a,info) subroutine psb_smdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent(out) :: res(:) real(psb_spk_), intent(out) :: res(:)
real(psb_spk_), intent(in) :: x(:,:), y(:,:) real(psb_spk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_smdots end subroutine psb_smdots
end interface end interface
@@ -91,7 +96,7 @@ module psb_s_psblas_mod
type(psb_s_vect_type), intent (inout) :: y type(psb_s_vect_type), intent (inout) :: y
real(psb_spk_), intent (in) :: alpha, beta real(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_saxpby_vect end subroutine psb_saxpby_vect
subroutine psb_saxpbyv(alpha, x, beta, y,& subroutine psb_saxpbyv(alpha, x, beta, y,&
& desc_a, info) & desc_a, info)
@@ -112,35 +117,38 @@ module psb_s_psblas_mod
real(psb_spk_), intent (in) :: alpha, beta real(psb_spk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: n, jx, jy integer(psb_ipk_), optional, intent(in) :: n, jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_saxpby end subroutine psb_saxpby
end interface end interface
interface psb_geamax interface psb_geamax
function psb_samax(x, desc_a, info, jx) function psb_samax(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) psb_samax real(psb_spk_) psb_samax
real(psb_spk_), intent (in) :: x(:,:) real(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_samax end function psb_samax
function psb_samaxv(x, desc_a,info) function psb_samaxv(x, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) psb_samaxv real(psb_spk_) psb_samaxv
real(psb_spk_), intent (in) :: x(:) real(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_samaxv end function psb_samaxv
function psb_samax_vect(x, desc_a, info) result(res) function psb_samax_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_samax_vect end function psb_samax_vect
end interface end interface
@@ -154,69 +162,76 @@ module psb_s_psblas_mod
#endif #endif
interface psb_geamaxs interface psb_geamaxs
subroutine psb_samaxvs(res,x,desc_a,info) subroutine psb_samaxvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent (out) :: res real(psb_spk_), intent (out) :: res
real(psb_spk_), intent (in) :: x(:) real(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_samaxvs end subroutine psb_samaxvs
subroutine psb_smamaxs(res,x,desc_a,info,jx) subroutine psb_smamaxs(res,x,desc_a,info,jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent (out) :: res(:) real(psb_spk_), intent (out) :: res(:)
real(psb_spk_), intent (in) :: x(:,:) real(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
logical, intent(in), optional :: global
end subroutine psb_smamaxs end subroutine psb_smamaxs
end interface end interface
interface psb_geasum interface psb_geasum
function psb_sasum_vect(x, desc_a, info) result(res) function psb_sasum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sasum_vect end function psb_sasum_vect
function psb_sasum(x, desc_a, info, jx) function psb_sasum(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) psb_sasum real(psb_spk_) psb_sasum
real(psb_spk_), intent (in) :: x(:,:) real(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sasum end function psb_sasum
function psb_sasumv(x, desc_a, info) function psb_sasumv(x, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) psb_sasumv real(psb_spk_) psb_sasumv
real(psb_spk_), intent (in) :: x(:) real(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sasumv end function psb_sasumv
end interface end interface
interface psb_geasums interface psb_geasums
subroutine psb_sasumvs(res,x,desc_a,info) subroutine psb_sasumvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent (out) :: res real(psb_spk_), intent (out) :: res
real(psb_spk_), intent (in) :: x(:) real(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_sasumvs end subroutine psb_sasumvs
subroutine psb_smasum(res,x,desc_a,info) subroutine psb_smasum(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent (out) :: res(:) real(psb_spk_), intent (out) :: res(:)
real(psb_spk_), intent (in) :: x(:,:) real(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_smasum end subroutine psb_smasum
end interface end interface
@@ -230,30 +245,33 @@ module psb_s_psblas_mod
#endif #endif
interface psb_genrm2 interface psb_genrm2
function psb_snrm2(x, desc_a, info, jx) function psb_snrm2(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) psb_snrm2 real(psb_spk_) psb_snrm2
real(psb_spk_), intent (in) :: x(:,:) real(psb_spk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2 end function psb_snrm2
function psb_snrm2v(x, desc_a, info) function psb_snrm2v(x, desc_a, info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) psb_snrm2v real(psb_spk_) psb_snrm2v
real(psb_spk_), intent (in) :: x(:) real(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2v end function psb_snrm2v
function psb_snrm2_vect(x, desc_a, info) result(res) function psb_snrm2_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2_vect end function psb_snrm2_vect
end interface end interface
@@ -264,25 +282,27 @@ module psb_s_psblas_mod
#endif #endif
interface psb_genrm2s interface psb_genrm2s
subroutine psb_snrm2vs(res,x,desc_a,info) subroutine psb_snrm2vs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_), intent (out) :: res real(psb_spk_), intent (out) :: res
real(psb_spk_), intent (in) :: x(:) real(psb_spk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_snrm2vs end subroutine psb_snrm2vs
end interface end interface
interface psb_spnrmi interface psb_spnrmi
function psb_snrmi(a, desc_a,info) function psb_snrmi(a, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: psb_snrmi real(psb_spk_) :: psb_snrmi
type(psb_sspmat_type), intent (in) :: a type(psb_sspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrmi end function psb_snrmi
end interface end interface
@@ -293,13 +313,14 @@ module psb_s_psblas_mod
#endif #endif
interface psb_spnrm1 interface psb_spnrm1
function psb_sspnrm1(a, desc_a,info) function psb_sspnrm1(a, desc_a,info,global)
import :: psb_desc_type, psb_spk_, psb_ipk_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type & psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: psb_sspnrm1 real(psb_spk_) :: psb_sspnrm1
type(psb_sspmat_type), intent (in) :: a type(psb_sspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_sspnrm1 end function psb_sspnrm1
end interface end interface
base/modules/psblas/psb_z_psblas_mod.F90
+68 -47
View File
@@ -35,50 +35,55 @@ module psb_z_psblas_mod
use psb_z_mat_mod, only : psb_zspmat_type use psb_z_mat_mod, only : psb_zspmat_type
interface psb_gedot interface psb_gedot
function psb_zdot_vect(x, y, desc_a,info) result(res) function psb_zdot_vect(x, y, desc_a,info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_) :: res complex(psb_dpk_) :: res
type(psb_z_vect_type), intent(inout) :: x, y type(psb_z_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zdot_vect end function psb_zdot_vect
function psb_zdotv(x, y, desc_a,info) function psb_zdotv(x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_) :: psb_zdotv complex(psb_dpk_) :: psb_zdotv
complex(psb_dpk_), intent(in) :: x(:), y(:) complex(psb_dpk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zdotv end function psb_zdotv
function psb_zdot(x, y, desc_a, info, jx, jy) function psb_zdot(x, y, desc_a, info, jx, jy,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_) :: psb_zdot complex(psb_dpk_) :: psb_zdot
complex(psb_dpk_), intent(in) :: x(:,:), y(:,:) complex(psb_dpk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: jx, jy integer(psb_ipk_), optional, intent(in) :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zdot end function psb_zdot
end interface end interface
interface psb_gedots interface psb_gedots
subroutine psb_zdotvs(res,x, y, desc_a, info) subroutine psb_zdotvs(res,x, y, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_), intent(out) :: res complex(psb_dpk_), intent(out) :: res
complex(psb_dpk_), intent(in) :: x(:), y(:) complex(psb_dpk_), intent(in) :: x(:), y(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_zdotvs end subroutine psb_zdotvs
subroutine psb_zmdots(res,x, y, desc_a,info) subroutine psb_zmdots(res,x, y, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
complex(psb_dpk_), intent(out) :: res(:) complex(psb_dpk_), intent(out) :: res(:)
complex(psb_dpk_), intent(in) :: x(:,:), y(:,:) complex(psb_dpk_), intent(in) :: x(:,:), y(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_zmdots end subroutine psb_zmdots
end interface end interface
@@ -91,7 +96,7 @@ module psb_z_psblas_mod
type(psb_z_vect_type), intent (inout) :: y type(psb_z_vect_type), intent (inout) :: y
complex(psb_dpk_), intent (in) :: alpha, beta complex(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaxpby_vect end subroutine psb_zaxpby_vect
subroutine psb_zaxpbyv(alpha, x, beta, y,& subroutine psb_zaxpbyv(alpha, x, beta, y,&
& desc_a, info) & desc_a, info)
@@ -112,35 +117,38 @@ module psb_z_psblas_mod
complex(psb_dpk_), intent (in) :: alpha, beta complex(psb_dpk_), intent (in) :: alpha, beta
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent(in) :: n, jx, jy integer(psb_ipk_), optional, intent(in) :: n, jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaxpby end subroutine psb_zaxpby
end interface end interface
interface psb_geamax interface psb_geamax
function psb_zamax(x, desc_a, info, jx) function psb_zamax(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) psb_zamax real(psb_dpk_) psb_zamax
complex(psb_dpk_), intent (in) :: x(:,:) complex(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zamax end function psb_zamax
function psb_zamaxv(x, desc_a,info) function psb_zamaxv(x, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) psb_zamaxv real(psb_dpk_) psb_zamaxv
complex(psb_dpk_), intent (in) :: x(:) complex(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zamaxv end function psb_zamaxv
function psb_zamax_vect(x, desc_a, info) result(res) function psb_zamax_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_z_vect_type), intent (inout) :: x type(psb_z_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zamax_vect end function psb_zamax_vect
end interface end interface
@@ -154,69 +162,76 @@ module psb_z_psblas_mod
#endif #endif
interface psb_geamaxs interface psb_geamaxs
subroutine psb_zamaxvs(res,x,desc_a,info) subroutine psb_zamaxvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_), intent (out) :: res real(psb_dpk_), intent (out) :: res
complex(psb_dpk_), intent (in) :: x(:) complex(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_zamaxvs end subroutine psb_zamaxvs
subroutine psb_zmamaxs(res,x,desc_a,info,jx) subroutine psb_zmamaxs(res,x,desc_a,info,jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_), intent (out) :: res(:) real(psb_dpk_), intent (out) :: res(:)
complex(psb_dpk_), intent (in) :: x(:,:) complex(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
logical, intent(in), optional :: global
end subroutine psb_zmamaxs end subroutine psb_zmamaxs
end interface end interface
interface psb_geasum interface psb_geasum
function psb_zasum_vect(x, desc_a, info) result(res) function psb_zasum_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_z_vect_type), intent (inout) :: x type(psb_z_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zasum_vect end function psb_zasum_vect
function psb_zasum(x, desc_a, info, jx) function psb_zasum(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) psb_zasum real(psb_dpk_) psb_zasum
complex(psb_dpk_), intent (in) :: x(:,:) complex(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zasum end function psb_zasum
function psb_zasumv(x, desc_a, info) function psb_zasumv(x, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) psb_zasumv real(psb_dpk_) psb_zasumv
complex(psb_dpk_), intent (in) :: x(:) complex(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zasumv end function psb_zasumv
end interface end interface
interface psb_geasums interface psb_geasums
subroutine psb_zasumvs(res,x,desc_a,info) subroutine psb_zasumvs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_), intent (out) :: res real(psb_dpk_), intent (out) :: res
complex(psb_dpk_), intent (in) :: x(:) complex(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_zasumvs end subroutine psb_zasumvs
subroutine psb_zmasum(res,x,desc_a,info) subroutine psb_zmasum(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_), intent (out) :: res(:) real(psb_dpk_), intent (out) :: res(:)
complex(psb_dpk_), intent (in) :: x(:,:) complex(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_zmasum end subroutine psb_zmasum
end interface end interface
@@ -230,30 +245,33 @@ module psb_z_psblas_mod
#endif #endif
interface psb_genrm2 interface psb_genrm2
function psb_znrm2(x, desc_a, info, jx) function psb_znrm2(x, desc_a, info, jx,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) psb_znrm2 real(psb_dpk_) psb_znrm2
complex(psb_dpk_), intent (in) :: x(:,:) complex(psb_dpk_), intent (in) :: x(:,:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), optional, intent (in) :: jx integer(psb_ipk_), optional, intent (in) :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2 end function psb_znrm2
function psb_znrm2v(x, desc_a, info) function psb_znrm2v(x, desc_a, info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) psb_znrm2v real(psb_dpk_) psb_znrm2v
complex(psb_dpk_), intent (in) :: x(:) complex(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2v end function psb_znrm2v
function psb_znrm2_vect(x, desc_a, info) result(res) function psb_znrm2_vect(x, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: res real(psb_dpk_) :: res
type(psb_z_vect_type), intent (inout) :: x type(psb_z_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2_vect end function psb_znrm2_vect
end interface end interface
@@ -264,25 +282,27 @@ module psb_z_psblas_mod
#endif #endif
interface psb_genrm2s interface psb_genrm2s
subroutine psb_znrm2vs(res,x,desc_a,info) subroutine psb_znrm2vs(res,x,desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_), intent (out) :: res real(psb_dpk_), intent (out) :: res
complex(psb_dpk_), intent (in) :: x(:) complex(psb_dpk_), intent (in) :: x(:)
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end subroutine psb_znrm2vs end subroutine psb_znrm2vs
end interface end interface
interface psb_spnrmi interface psb_spnrmi
function psb_znrmi(a, desc_a,info) function psb_znrmi(a, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: psb_znrmi real(psb_dpk_) :: psb_znrmi
type(psb_zspmat_type), intent (in) :: a type(psb_zspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrmi end function psb_znrmi
end interface end interface
@@ -293,13 +313,14 @@ module psb_z_psblas_mod
#endif #endif
interface psb_spnrm1 interface psb_spnrm1
function psb_zspnrm1(a, desc_a,info) function psb_zspnrm1(a, desc_a,info,global)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type & psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: psb_zspnrm1 real(psb_dpk_) :: psb_zspnrm1
type(psb_zspmat_type), intent (in) :: a type(psb_zspmat_type), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_zspnrm1 end function psb_zspnrm1
end interface end interface
base/psblas/psb_camax.f90
+50 -11
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_camax(x,desc_a, info, jx) result(res) function psb_camax(x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_camax use psb_base_mod, psb_protect_name => psb_camax
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_camax(x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_camax' name='psb_camax'
@@ -82,6 +84,12 @@ function psb_camax(x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
@@ -107,7 +115,7 @@ function psb_camax(x,desc_a, info, jx) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -162,7 +170,7 @@ end function psb_camax
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_camaxv (x,desc_a, info) result(res) function psb_camaxv (x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_camaxv use psb_base_mod, psb_protect_name => psb_camaxv
implicit none implicit none
@@ -171,11 +179,12 @@ function psb_camaxv (x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx & err_act, iix, jjx, jx, ix, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_camaxv' name='psb_camaxv'
@@ -193,6 +202,12 @@ function psb_camaxv (x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -221,7 +236,7 @@ function psb_camaxv (x,desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -232,7 +247,7 @@ function psb_camaxv (x,desc_a, info) result(res)
end function psb_camaxv end function psb_camaxv
function psb_camax_vect(x, desc_a, info) result(res) function psb_camax_vect(x, desc_a, info,global) result(res)
use psb_penv_mod use psb_penv_mod
use psb_serial_mod use psb_serial_mod
use psb_desc_mod use psb_desc_mod
@@ -245,10 +260,12 @@ function psb_camax_vect(x, desc_a, info) result(res)
type(psb_c_vect_type), intent (inout) :: x type(psb_c_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m & err_act, iix, jjx, jx, ix, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_camaxv' name='psb_camaxv'
@@ -271,6 +288,12 @@ function psb_camax_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -297,7 +320,7 @@ function psb_camax_vect(x, desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -355,7 +378,7 @@ end function psb_camax_vect
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_camaxvs(res,x,desc_a, info) subroutine psb_camaxvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_camaxvs use psb_base_mod, psb_protect_name => psb_camaxvs
implicit none implicit none
@@ -364,10 +387,12 @@ subroutine psb_camaxvs(res,x,desc_a, info)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_camaxvs' name='psb_camaxvs'
@@ -385,6 +410,12 @@ subroutine psb_camaxvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
ijx=1 ijx=1
@@ -412,7 +443,7 @@ subroutine psb_camaxvs(res,x,desc_a, info)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -466,7 +497,7 @@ end subroutine psb_camaxvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_cmamaxs(res,x,desc_a, info,jx) subroutine psb_cmamaxs(res,x,desc_a, info,jx,global)
use psb_base_mod, psb_protect_name => psb_cmamaxs use psb_base_mod, psb_protect_name => psb_cmamaxs
implicit none implicit none
@@ -476,10 +507,12 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_spk_), intent(out) :: res(:) real(psb_spk_), intent(out) :: res(:)
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k & err_act, iix, jjx, ix, ijx, m, ldx, i, k
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cmamaxs' name='psb_cmamaxs'
@@ -503,6 +536,12 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1)) k = min(size(x,2),size(res,1))
ldx = size(x,1) ldx = size(x,1)
@@ -529,7 +568,7 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res(1:k)) if (global_) call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_casum.f90
+49 -9
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_casum (x,desc_a, info, jx) result(res) function psb_casum (x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_casum use psb_base_mod, psb_protect_name => psb_casum
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_casum (x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, & integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_casum' name='psb_casum'
@@ -82,6 +84,12 @@ function psb_casum (x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
! check vector correctness ! check vector correctness
@@ -114,7 +122,7 @@ function psb_casum (x,desc_a, info, jx) result(res)
res = szero res = szero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -125,7 +133,7 @@ function psb_casum (x,desc_a, info, jx) result(res)
end function psb_casum end function psb_casum
function psb_casum_vect(x, desc_a, info) result(res) function psb_casum_vect(x, desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_casum_vect use psb_base_mod, psb_protect_name => psb_casum_vect
implicit none implicit none
@@ -133,10 +141,12 @@ function psb_casum_vect(x, desc_a, info) result(res)
type(psb_c_vect_type), intent (inout) :: x type(psb_c_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax & err_act, iix, jjx, jx, ix, m, imax, i, idx, ndm
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_casumv' name='psb_casumv'
@@ -160,6 +170,11 @@ function psb_casum_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -182,12 +197,21 @@ function psb_casum_vect(x, desc_a, info) result(res)
! compute local max ! compute local max
if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then
res = x%asum(desc_a%get_local_rows()) res = x%asum(desc_a%get_local_rows())
if (size(desc_a%ovrlap_elem,1)>0) then
if (x%is_dev()) call x%sync()
! adjust res because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*abs(x%v%v(idx))
end do
end if
else else
res = szero res = szero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -242,7 +266,7 @@ end function psb_casum_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_casumv(x,desc_a, info) result(res) function psb_casumv(x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_casumv use psb_base_mod, psb_protect_name => psb_casumv
implicit none implicit none
@@ -251,10 +275,12 @@ function psb_casumv(x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx & err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_casumv' name='psb_casumv'
@@ -271,6 +297,12 @@ function psb_casumv(x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,7 +339,7 @@ function psb_casumv(x,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -362,7 +394,7 @@ end function psb_casumv
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_casumvs(res,x,desc_a, info) subroutine psb_casumvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_casumvs use psb_base_mod, psb_protect_name => psb_casumvs
implicit none implicit none
@@ -371,10 +403,12 @@ subroutine psb_casumvs(res,x,desc_a, info)
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_casumvs' name='psb_casumvs'
@@ -391,6 +425,12 @@ subroutine psb_casumvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -427,7 +467,7 @@ subroutine psb_casumvs(res,x,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt,res) if (global_) call psb_sum(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_cdot.f90
+57 -15
View File
@@ -48,7 +48,7 @@
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! jy - integer(optional). The column offset for sub( Y ). ! jy - integer(optional). The column offset for sub( Y ).
! !
function psb_cdot_vect(x, y, desc_a,info) result(res) function psb_cdot_vect(x, y, desc_a,info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_c_base_mat_mod use psb_c_base_mat_mod
use psb_check_mod use psb_check_mod
@@ -61,10 +61,12 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
type(psb_c_vect_type), intent(inout) :: x, y type(psb_c_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cdot_vect' name='psb_cdot_vect'
@@ -91,6 +93,11 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
ijx = ione ijx = ione
@@ -122,17 +129,21 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
res = x%dot(nr,y) res = x%dot(nr,y)
! FIXME ! FIXME
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) if (y%is_dev()) call y%sync()
!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) do i=1,size(desc_a%ovrlap_elem,1)
!!$ end do idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*(x%v%v(idx)*y%v%v(idx))
end do
end if
else else
res = czero res = czero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -143,7 +154,7 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
end function psb_cdot_vect end function psb_cdot_vect
function psb_cdot(x, y,desc_a, info, jx, jy) result(res) function psb_cdot(x, y,desc_a, info, jx, jy,global) result(res)
use psb_base_mod, psb_protect_name => psb_cdot use psb_base_mod, psb_protect_name => psb_cdot
implicit none implicit none
@@ -152,12 +163,14 @@ function psb_cdot(x, y,desc_a, info, jx, jy) result(res)
integer(psb_ipk_), intent(in), optional :: jx, jy integer(psb_ipk_), intent(in), optional :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: res complex(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
complex(psb_spk_) :: cdotc complex(psb_spk_) :: cdotc
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cdot' name='psb_cdot'
@@ -193,6 +206,12 @@ function psb_cdot(x, y,desc_a, info, jx, jy) result(res)
goto 9999 goto 9999
end if end if
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@@ -228,7 +247,7 @@ function psb_cdot(x, y,desc_a, info, jx, jy) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -284,7 +303,7 @@ end function psb_cdot
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_cdotv(x, y,desc_a, info) result(res) function psb_cdotv(x, y,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_cdotv use psb_base_mod, psb_protect_name => psb_cdotv
implicit none implicit none
@@ -292,11 +311,13 @@ function psb_cdotv(x, y,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: res complex(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
complex(psb_spk_) :: cdotc complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -314,6 +335,12 @@ function psb_cdotv(x, y,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
jx = ione jx = ione
@@ -352,7 +379,7 @@ function psb_cdotv(x, y,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@@ -409,7 +436,7 @@ end function psb_cdotv
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_cdotvs(res, x, y,desc_a, info) subroutine psb_cdotvs(res, x, y,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_cdotvs use psb_base_mod, psb_protect_name => psb_cdotvs
implicit none implicit none
@@ -417,11 +444,13 @@ subroutine psb_cdotvs(res, x, y,desc_a, info)
complex(psb_spk_), intent(out) :: res complex(psb_spk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy & lldx, lldy
logical :: global_
complex(psb_spk_) :: cdotc complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -439,6 +468,12 @@ subroutine psb_cdotvs(res, x, y,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -475,7 +510,7 @@ subroutine psb_cdotvs(res, x, y,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -532,7 +567,7 @@ end subroutine psb_cdotvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_cmdots(res, x, y, desc_a, info) subroutine psb_cmdots(res, x, y, desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_cmdots use psb_base_mod, psb_protect_name => psb_cmdots
implicit none implicit none
@@ -540,11 +575,13 @@ subroutine psb_cmdots(res, x, y, desc_a, info)
complex(psb_spk_), intent(out) :: res(:) complex(psb_spk_), intent(out) :: res(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
complex(psb_spk_) :: cdotc complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -562,6 +599,11 @@ subroutine psb_cmdots(res, x, y, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
@@ -611,7 +653,7 @@ subroutine psb_cmdots(res, x, y, desc_a, info)
! compute global sum ! compute global sum
call psb_sum(ictxt, res(1:k)) if (global_) call psb_sum(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_cnrm2.f90
+49 -23
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! !
function psb_cnrm2(x, desc_a, info, jx) result(res) function psb_cnrm2(x, desc_a, info, jx,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -56,10 +56,12 @@ function psb_cnrm2(x, desc_a, info, jx) result(res)
integer(psb_ipk_), intent(in), optional :: jx integer(psb_ipk_), intent(in), optional :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: scnrm2, dd real(psb_spk_) :: scnrm2, dd
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -84,6 +86,12 @@ function psb_cnrm2(x, desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@@ -114,7 +122,7 @@ function psb_cnrm2(x, desc_a, info, jx) result(res)
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -168,7 +176,7 @@ end function psb_cnrm2
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_cnrm2v(x, desc_a, info) result(res) function psb_cnrm2v(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -179,13 +187,13 @@ function psb_cnrm2v(x, desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: scnrm2, dd real(psb_spk_) :: scnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cnrm2v' name='psb_cnrm2v'
@@ -202,6 +210,11 @@ function psb_cnrm2v(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -233,8 +246,7 @@ function psb_cnrm2v(x, desc_a, info) result(res)
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -246,7 +258,7 @@ end function psb_cnrm2v
function psb_cnrm2_vect(x, desc_a, info) result(res) function psb_cnrm2_vect(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -258,12 +270,13 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
type(psb_c_vect_type), intent (inout) :: x type(psb_c_vect_type), intent (inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: snrm2, dd real(psb_spk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cnrm2v' name='psb_cnrm2v'
@@ -286,6 +299,11 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,18 +325,21 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
if (desc_a%get_local_rows() > 0) then if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows() ndim = desc_a%get_local_rows()
res = x%nrm2(ndim) res = x%nrm2(ndim)
!!$ ! adjust because overlapped elements are computed more than once ! adjust because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) do i=1,size(desc_a%ovrlap_elem,1)
!!$ dd = dble(ndm-1)/dble(ndm) idx = desc_a%ovrlap_elem(i,1)
!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) ndm = desc_a%ovrlap_elem(i,2)
!!$ end do dd = dble(ndm-1)/dble(ndm)
else res = res - sqrt(cone - dd*(abs(x%v%v(idx))/res)**2)
end do
end if
else
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -329,7 +350,6 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
end function psb_cnrm2_vect end function psb_cnrm2_vect
!!$ !!$
!!$ Parallel Sparse BLAS version 3.5 !!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018 !!$ (C) Copyright 2006-2018
@@ -373,7 +393,7 @@ end function psb_cnrm2_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_cnrm2vs(res, x, desc_a, info) subroutine psb_cnrm2vs(res, x, desc_a, info,global)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -384,13 +404,13 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: nrm2, scnrm2, dd real(psb_spk_) :: nrm2, scnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cnrm2' name='psb_cnrm2'
@@ -407,6 +427,12 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -439,7 +465,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
base/psblas/psb_cnrmi.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_cnrmi(a,desc_a,info) result(res) function psb_cnrmi(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_cnrmi use psb_base_mod, psb_protect_name => psb_cnrmi
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_cnrmi(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_cnrmi' name='psb_cnrmi'
@@ -69,6 +71,12 @@ function psb_cnrmi(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -101,7 +109,7 @@ function psb_cnrmi(a,desc_a,info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_cspnrm1.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_cspnrm1(a,desc_a,info) result(res) function psb_cspnrm1(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_cspnrm1 use psb_base_mod, psb_protect_name => psb_cspnrm1
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_cspnrm1(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,& integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
real(psb_spk_), allocatable :: v(:) real(psb_spk_), allocatable :: v(:)
@@ -70,6 +72,12 @@ function psb_cspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -119,7 +127,7 @@ function psb_cspnrm1(a,desc_a,info) result(res)
res = szero res = szero
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_damax.f90
+50 -11
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_damax(x,desc_a, info, jx) result(res) function psb_damax(x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_damax use psb_base_mod, psb_protect_name => psb_damax
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_damax(x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damax' name='psb_damax'
@@ -82,6 +84,12 @@ function psb_damax(x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
@@ -107,7 +115,7 @@ function psb_damax(x,desc_a, info, jx) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -162,7 +170,7 @@ end function psb_damax
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_damaxv (x,desc_a, info) result(res) function psb_damaxv (x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_damaxv use psb_base_mod, psb_protect_name => psb_damaxv
implicit none implicit none
@@ -171,11 +179,12 @@ function psb_damaxv (x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx & err_act, iix, jjx, jx, ix, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damaxv' name='psb_damaxv'
@@ -193,6 +202,12 @@ function psb_damaxv (x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -221,7 +236,7 @@ function psb_damaxv (x,desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -232,7 +247,7 @@ function psb_damaxv (x,desc_a, info) result(res)
end function psb_damaxv end function psb_damaxv
function psb_damax_vect(x, desc_a, info) result(res) function psb_damax_vect(x, desc_a, info,global) result(res)
use psb_penv_mod use psb_penv_mod
use psb_serial_mod use psb_serial_mod
use psb_desc_mod use psb_desc_mod
@@ -245,10 +260,12 @@ function psb_damax_vect(x, desc_a, info) result(res)
type(psb_d_vect_type), intent (inout) :: x type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m & err_act, iix, jjx, jx, ix, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damaxv' name='psb_damaxv'
@@ -271,6 +288,12 @@ function psb_damax_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -297,7 +320,7 @@ function psb_damax_vect(x, desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -355,7 +378,7 @@ end function psb_damax_vect
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_damaxvs(res,x,desc_a, info) subroutine psb_damaxvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_damaxvs use psb_base_mod, psb_protect_name => psb_damaxvs
implicit none implicit none
@@ -364,10 +387,12 @@ subroutine psb_damaxvs(res,x,desc_a, info)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damaxvs' name='psb_damaxvs'
@@ -385,6 +410,12 @@ subroutine psb_damaxvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
ijx=1 ijx=1
@@ -412,7 +443,7 @@ subroutine psb_damaxvs(res,x,desc_a, info)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -466,7 +497,7 @@ end subroutine psb_damaxvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_dmamaxs(res,x,desc_a, info,jx) subroutine psb_dmamaxs(res,x,desc_a, info,jx,global)
use psb_base_mod, psb_protect_name => psb_dmamaxs use psb_base_mod, psb_protect_name => psb_dmamaxs
implicit none implicit none
@@ -476,10 +507,12 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_dpk_), intent(out) :: res(:) real(psb_dpk_), intent(out) :: res(:)
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k & err_act, iix, jjx, ix, ijx, m, ldx, i, k
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dmamaxs' name='psb_dmamaxs'
@@ -503,6 +536,12 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1)) k = min(size(x,2),size(res,1))
ldx = size(x,1) ldx = size(x,1)
@@ -529,7 +568,7 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res(1:k)) if (global_) call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_dasum.f90
+49 -9
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_dasum (x,desc_a, info, jx) result(res) function psb_dasum (x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_dasum use psb_base_mod, psb_protect_name => psb_dasum
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_dasum (x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, & integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasum' name='psb_dasum'
@@ -82,6 +84,12 @@ function psb_dasum (x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
! check vector correctness ! check vector correctness
@@ -114,7 +122,7 @@ function psb_dasum (x,desc_a, info, jx) result(res)
res = dzero res = dzero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -125,7 +133,7 @@ function psb_dasum (x,desc_a, info, jx) result(res)
end function psb_dasum end function psb_dasum
function psb_dasum_vect(x, desc_a, info) result(res) function psb_dasum_vect(x, desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_dasum_vect use psb_base_mod, psb_protect_name => psb_dasum_vect
implicit none implicit none
@@ -133,10 +141,12 @@ function psb_dasum_vect(x, desc_a, info) result(res)
type(psb_d_vect_type), intent (inout) :: x type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax & err_act, iix, jjx, jx, ix, m, imax, i, idx, ndm
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasumv' name='psb_dasumv'
@@ -160,6 +170,11 @@ function psb_dasum_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -182,12 +197,21 @@ function psb_dasum_vect(x, desc_a, info) result(res)
! compute local max ! compute local max
if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then
res = x%asum(desc_a%get_local_rows()) res = x%asum(desc_a%get_local_rows())
if (size(desc_a%ovrlap_elem,1)>0) then
if (x%is_dev()) call x%sync()
! adjust res because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*abs(x%v%v(idx))
end do
end if
else else
res = dzero res = dzero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -242,7 +266,7 @@ end function psb_dasum_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_dasumv(x,desc_a, info) result(res) function psb_dasumv(x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_dasumv use psb_base_mod, psb_protect_name => psb_dasumv
implicit none implicit none
@@ -251,10 +275,12 @@ function psb_dasumv(x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx & err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasumv' name='psb_dasumv'
@@ -271,6 +297,12 @@ function psb_dasumv(x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,7 +339,7 @@ function psb_dasumv(x,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -362,7 +394,7 @@ end function psb_dasumv
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_dasumvs(res,x,desc_a, info) subroutine psb_dasumvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_dasumvs use psb_base_mod, psb_protect_name => psb_dasumvs
implicit none implicit none
@@ -371,10 +403,12 @@ subroutine psb_dasumvs(res,x,desc_a, info)
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasumvs' name='psb_dasumvs'
@@ -391,6 +425,12 @@ subroutine psb_dasumvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -427,7 +467,7 @@ subroutine psb_dasumvs(res,x,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt,res) if (global_) call psb_sum(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_ddot.f90
+57 -15
View File
@@ -48,7 +48,7 @@
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! jy - integer(optional). The column offset for sub( Y ). ! jy - integer(optional). The column offset for sub( Y ).
! !
function psb_ddot_vect(x, y, desc_a,info) result(res) function psb_ddot_vect(x, y, desc_a,info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_d_base_mat_mod use psb_d_base_mat_mod
use psb_check_mod use psb_check_mod
@@ -61,10 +61,12 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
type(psb_d_vect_type), intent(inout) :: x, y type(psb_d_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_ddot_vect' name='psb_ddot_vect'
@@ -91,6 +93,11 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
ijx = ione ijx = ione
@@ -122,17 +129,21 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
res = x%dot(nr,y) res = x%dot(nr,y)
! FIXME ! FIXME
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) if (y%is_dev()) call y%sync()
!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) do i=1,size(desc_a%ovrlap_elem,1)
!!$ end do idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*(x%v%v(idx)*y%v%v(idx))
end do
end if
else else
res = dzero res = dzero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -143,7 +154,7 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
end function psb_ddot_vect end function psb_ddot_vect
function psb_ddot(x, y,desc_a, info, jx, jy) result(res) function psb_ddot(x, y,desc_a, info, jx, jy,global) result(res)
use psb_base_mod, psb_protect_name => psb_ddot use psb_base_mod, psb_protect_name => psb_ddot
implicit none implicit none
@@ -152,12 +163,14 @@ function psb_ddot(x, y,desc_a, info, jx, jy) result(res)
integer(psb_ipk_), intent(in), optional :: jx, jy integer(psb_ipk_), intent(in), optional :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
real(psb_dpk_) :: ddot real(psb_dpk_) :: ddot
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_ddot' name='psb_ddot'
@@ -193,6 +206,12 @@ function psb_ddot(x, y,desc_a, info, jx, jy) result(res)
goto 9999 goto 9999
end if end if
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@@ -228,7 +247,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -284,7 +303,7 @@ end function psb_ddot
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_ddotv(x, y,desc_a, info) result(res) function psb_ddotv(x, y,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_ddotv use psb_base_mod, psb_protect_name => psb_ddotv
implicit none implicit none
@@ -292,11 +311,13 @@ function psb_ddotv(x, y,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
real(psb_dpk_) :: ddot real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -314,6 +335,12 @@ function psb_ddotv(x, y,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
jx = ione jx = ione
@@ -352,7 +379,7 @@ function psb_ddotv(x, y,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@@ -409,7 +436,7 @@ end function psb_ddotv
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_ddotvs(res, x, y,desc_a, info) subroutine psb_ddotvs(res, x, y,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_ddotvs use psb_base_mod, psb_protect_name => psb_ddotvs
implicit none implicit none
@@ -417,11 +444,13 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy & lldx, lldy
logical :: global_
real(psb_dpk_) :: ddot real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -439,6 +468,12 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -475,7 +510,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -532,7 +567,7 @@ end subroutine psb_ddotvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_dmdots(res, x, y, desc_a, info) subroutine psb_dmdots(res, x, y, desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_dmdots use psb_base_mod, psb_protect_name => psb_dmdots
implicit none implicit none
@@ -540,11 +575,13 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
real(psb_dpk_), intent(out) :: res(:) real(psb_dpk_), intent(out) :: res(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
real(psb_dpk_) :: ddot real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -562,6 +599,11 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
@@ -611,7 +653,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
! compute global sum ! compute global sum
call psb_sum(ictxt, res(1:k)) if (global_) call psb_sum(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_dnrm2.f90
+49 -23
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! !
function psb_dnrm2(x, desc_a, info, jx) result(res) function psb_dnrm2(x, desc_a, info, jx,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -56,10 +56,12 @@ function psb_dnrm2(x, desc_a, info, jx) result(res)
integer(psb_ipk_), intent(in), optional :: jx integer(psb_ipk_), intent(in), optional :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: dnrm2, dd real(psb_dpk_) :: dnrm2, dd
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -84,6 +86,12 @@ function psb_dnrm2(x, desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@@ -114,7 +122,7 @@ function psb_dnrm2(x, desc_a, info, jx) result(res)
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -168,7 +176,7 @@ end function psb_dnrm2
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_dnrm2v(x, desc_a, info) result(res) function psb_dnrm2v(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -179,13 +187,13 @@ function psb_dnrm2v(x, desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: dnrm2, dd real(psb_dpk_) :: dnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dnrm2v' name='psb_dnrm2v'
@@ -202,6 +210,11 @@ function psb_dnrm2v(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -233,8 +246,7 @@ function psb_dnrm2v(x, desc_a, info) result(res)
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -246,7 +258,7 @@ end function psb_dnrm2v
function psb_dnrm2_vect(x, desc_a, info) result(res) function psb_dnrm2_vect(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -258,12 +270,13 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
type(psb_d_vect_type), intent (inout) :: x type(psb_d_vect_type), intent (inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: snrm2, dd real(psb_dpk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dnrm2v' name='psb_dnrm2v'
@@ -286,6 +299,11 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,18 +325,21 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
if (desc_a%get_local_rows() > 0) then if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows() ndim = desc_a%get_local_rows()
res = x%nrm2(ndim) res = x%nrm2(ndim)
!!$ ! adjust because overlapped elements are computed more than once ! adjust because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) do i=1,size(desc_a%ovrlap_elem,1)
!!$ dd = dble(ndm-1)/dble(ndm) idx = desc_a%ovrlap_elem(i,1)
!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) ndm = desc_a%ovrlap_elem(i,2)
!!$ end do dd = dble(ndm-1)/dble(ndm)
else res = res - sqrt(done - dd*(abs(x%v%v(idx))/res)**2)
end do
end if
else
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -329,7 +350,6 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
end function psb_dnrm2_vect end function psb_dnrm2_vect
!!$ !!$
!!$ Parallel Sparse BLAS version 3.5 !!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018 !!$ (C) Copyright 2006-2018
@@ -373,7 +393,7 @@ end function psb_dnrm2_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_dnrm2vs(res, x, desc_a, info) subroutine psb_dnrm2vs(res, x, desc_a, info,global)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -384,13 +404,13 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: nrm2, dnrm2, dd real(psb_dpk_) :: nrm2, dnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dnrm2' name='psb_dnrm2'
@@ -407,6 +427,12 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -439,7 +465,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
base/psblas/psb_dnrmi.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_dnrmi(a,desc_a,info) result(res) function psb_dnrmi(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_dnrmi use psb_base_mod, psb_protect_name => psb_dnrmi
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_dnrmi(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dnrmi' name='psb_dnrmi'
@@ -69,6 +71,12 @@ function psb_dnrmi(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -101,7 +109,7 @@ function psb_dnrmi(a,desc_a,info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_dspnrm1.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_dspnrm1(a,desc_a,info) result(res) function psb_dspnrm1(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_dspnrm1 use psb_base_mod, psb_protect_name => psb_dspnrm1
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_dspnrm1(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,& integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
real(psb_dpk_), allocatable :: v(:) real(psb_dpk_), allocatable :: v(:)
@@ -70,6 +72,12 @@ function psb_dspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -119,7 +127,7 @@ function psb_dspnrm1(a,desc_a,info) result(res)
res = dzero res = dzero
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_samax.f90
+50 -11
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_samax(x,desc_a, info, jx) result(res) function psb_samax(x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_samax use psb_base_mod, psb_protect_name => psb_samax
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_samax(x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_samax' name='psb_samax'
@@ -82,6 +84,12 @@ function psb_samax(x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
@@ -107,7 +115,7 @@ function psb_samax(x,desc_a, info, jx) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -162,7 +170,7 @@ end function psb_samax
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_samaxv (x,desc_a, info) result(res) function psb_samaxv (x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_samaxv use psb_base_mod, psb_protect_name => psb_samaxv
implicit none implicit none
@@ -171,11 +179,12 @@ function psb_samaxv (x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx & err_act, iix, jjx, jx, ix, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_samaxv' name='psb_samaxv'
@@ -193,6 +202,12 @@ function psb_samaxv (x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -221,7 +236,7 @@ function psb_samaxv (x,desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -232,7 +247,7 @@ function psb_samaxv (x,desc_a, info) result(res)
end function psb_samaxv end function psb_samaxv
function psb_samax_vect(x, desc_a, info) result(res) function psb_samax_vect(x, desc_a, info,global) result(res)
use psb_penv_mod use psb_penv_mod
use psb_serial_mod use psb_serial_mod
use psb_desc_mod use psb_desc_mod
@@ -245,10 +260,12 @@ function psb_samax_vect(x, desc_a, info) result(res)
type(psb_s_vect_type), intent (inout) :: x type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m & err_act, iix, jjx, jx, ix, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_samaxv' name='psb_samaxv'
@@ -271,6 +288,12 @@ function psb_samax_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -297,7 +320,7 @@ function psb_samax_vect(x, desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -355,7 +378,7 @@ end function psb_samax_vect
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_samaxvs(res,x,desc_a, info) subroutine psb_samaxvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_samaxvs use psb_base_mod, psb_protect_name => psb_samaxvs
implicit none implicit none
@@ -364,10 +387,12 @@ subroutine psb_samaxvs(res,x,desc_a, info)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_samaxvs' name='psb_samaxvs'
@@ -385,6 +410,12 @@ subroutine psb_samaxvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
ijx=1 ijx=1
@@ -412,7 +443,7 @@ subroutine psb_samaxvs(res,x,desc_a, info)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -466,7 +497,7 @@ end subroutine psb_samaxvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_smamaxs(res,x,desc_a, info,jx) subroutine psb_smamaxs(res,x,desc_a, info,jx,global)
use psb_base_mod, psb_protect_name => psb_smamaxs use psb_base_mod, psb_protect_name => psb_smamaxs
implicit none implicit none
@@ -476,10 +507,12 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_spk_), intent(out) :: res(:) real(psb_spk_), intent(out) :: res(:)
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k & err_act, iix, jjx, ix, ijx, m, ldx, i, k
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_smamaxs' name='psb_smamaxs'
@@ -503,6 +536,12 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1)) k = min(size(x,2),size(res,1))
ldx = size(x,1) ldx = size(x,1)
@@ -529,7 +568,7 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res(1:k)) if (global_) call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_sasum.f90
+49 -9
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_sasum (x,desc_a, info, jx) result(res) function psb_sasum (x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_sasum use psb_base_mod, psb_protect_name => psb_sasum
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_sasum (x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, & integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_sasum' name='psb_sasum'
@@ -82,6 +84,12 @@ function psb_sasum (x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
! check vector correctness ! check vector correctness
@@ -114,7 +122,7 @@ function psb_sasum (x,desc_a, info, jx) result(res)
res = szero res = szero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -125,7 +133,7 @@ function psb_sasum (x,desc_a, info, jx) result(res)
end function psb_sasum end function psb_sasum
function psb_sasum_vect(x, desc_a, info) result(res) function psb_sasum_vect(x, desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_sasum_vect use psb_base_mod, psb_protect_name => psb_sasum_vect
implicit none implicit none
@@ -133,10 +141,12 @@ function psb_sasum_vect(x, desc_a, info) result(res)
type(psb_s_vect_type), intent (inout) :: x type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax & err_act, iix, jjx, jx, ix, m, imax, i, idx, ndm
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_sasumv' name='psb_sasumv'
@@ -160,6 +170,11 @@ function psb_sasum_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -182,12 +197,21 @@ function psb_sasum_vect(x, desc_a, info) result(res)
! compute local max ! compute local max
if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then
res = x%asum(desc_a%get_local_rows()) res = x%asum(desc_a%get_local_rows())
if (size(desc_a%ovrlap_elem,1)>0) then
if (x%is_dev()) call x%sync()
! adjust res because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*abs(x%v%v(idx))
end do
end if
else else
res = szero res = szero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -242,7 +266,7 @@ end function psb_sasum_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_sasumv(x,desc_a, info) result(res) function psb_sasumv(x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_sasumv use psb_base_mod, psb_protect_name => psb_sasumv
implicit none implicit none
@@ -251,10 +275,12 @@ function psb_sasumv(x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx & err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_sasumv' name='psb_sasumv'
@@ -271,6 +297,12 @@ function psb_sasumv(x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,7 +339,7 @@ function psb_sasumv(x,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -362,7 +394,7 @@ end function psb_sasumv
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_sasumvs(res,x,desc_a, info) subroutine psb_sasumvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_sasumvs use psb_base_mod, psb_protect_name => psb_sasumvs
implicit none implicit none
@@ -371,10 +403,12 @@ subroutine psb_sasumvs(res,x,desc_a, info)
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_sasumvs' name='psb_sasumvs'
@@ -391,6 +425,12 @@ subroutine psb_sasumvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -427,7 +467,7 @@ subroutine psb_sasumvs(res,x,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt,res) if (global_) call psb_sum(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_sdot.f90
+57 -15
View File
@@ -48,7 +48,7 @@
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! jy - integer(optional). The column offset for sub( Y ). ! jy - integer(optional). The column offset for sub( Y ).
! !
function psb_sdot_vect(x, y, desc_a,info) result(res) function psb_sdot_vect(x, y, desc_a,info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_s_base_mat_mod use psb_s_base_mat_mod
use psb_check_mod use psb_check_mod
@@ -61,10 +61,12 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
type(psb_s_vect_type), intent(inout) :: x, y type(psb_s_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_sdot_vect' name='psb_sdot_vect'
@@ -91,6 +93,11 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
ijx = ione ijx = ione
@@ -122,17 +129,21 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
res = x%dot(nr,y) res = x%dot(nr,y)
! FIXME ! FIXME
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) if (y%is_dev()) call y%sync()
!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) do i=1,size(desc_a%ovrlap_elem,1)
!!$ end do idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*(x%v%v(idx)*y%v%v(idx))
end do
end if
else else
res = szero res = szero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -143,7 +154,7 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
end function psb_sdot_vect end function psb_sdot_vect
function psb_sdot(x, y,desc_a, info, jx, jy) result(res) function psb_sdot(x, y,desc_a, info, jx, jy,global) result(res)
use psb_base_mod, psb_protect_name => psb_sdot use psb_base_mod, psb_protect_name => psb_sdot
implicit none implicit none
@@ -152,12 +163,14 @@ function psb_sdot(x, y,desc_a, info, jx, jy) result(res)
integer(psb_ipk_), intent(in), optional :: jx, jy integer(psb_ipk_), intent(in), optional :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
real(psb_spk_) :: sdot real(psb_spk_) :: sdot
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_sdot' name='psb_sdot'
@@ -193,6 +206,12 @@ function psb_sdot(x, y,desc_a, info, jx, jy) result(res)
goto 9999 goto 9999
end if end if
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@@ -228,7 +247,7 @@ function psb_sdot(x, y,desc_a, info, jx, jy) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -284,7 +303,7 @@ end function psb_sdot
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_sdotv(x, y,desc_a, info) result(res) function psb_sdotv(x, y,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_sdotv use psb_base_mod, psb_protect_name => psb_sdotv
implicit none implicit none
@@ -292,11 +311,13 @@ function psb_sdotv(x, y,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
real(psb_spk_) :: sdot real(psb_spk_) :: sdot
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -314,6 +335,12 @@ function psb_sdotv(x, y,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
jx = ione jx = ione
@@ -352,7 +379,7 @@ function psb_sdotv(x, y,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@@ -409,7 +436,7 @@ end function psb_sdotv
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_sdotvs(res, x, y,desc_a, info) subroutine psb_sdotvs(res, x, y,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_sdotvs use psb_base_mod, psb_protect_name => psb_sdotvs
implicit none implicit none
@@ -417,11 +444,13 @@ subroutine psb_sdotvs(res, x, y,desc_a, info)
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy & lldx, lldy
logical :: global_
real(psb_spk_) :: sdot real(psb_spk_) :: sdot
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -439,6 +468,12 @@ subroutine psb_sdotvs(res, x, y,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -475,7 +510,7 @@ subroutine psb_sdotvs(res, x, y,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -532,7 +567,7 @@ end subroutine psb_sdotvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_smdots(res, x, y, desc_a, info) subroutine psb_smdots(res, x, y, desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_smdots use psb_base_mod, psb_protect_name => psb_smdots
implicit none implicit none
@@ -540,11 +575,13 @@ subroutine psb_smdots(res, x, y, desc_a, info)
real(psb_spk_), intent(out) :: res(:) real(psb_spk_), intent(out) :: res(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
real(psb_spk_) :: sdot real(psb_spk_) :: sdot
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -562,6 +599,11 @@ subroutine psb_smdots(res, x, y, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
@@ -611,7 +653,7 @@ subroutine psb_smdots(res, x, y, desc_a, info)
! compute global sum ! compute global sum
call psb_sum(ictxt, res(1:k)) if (global_) call psb_sum(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_snrm2.f90
+49 -23
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! !
function psb_snrm2(x, desc_a, info, jx) result(res) function psb_snrm2(x, desc_a, info, jx,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -56,10 +56,12 @@ function psb_snrm2(x, desc_a, info, jx) result(res)
integer(psb_ipk_), intent(in), optional :: jx integer(psb_ipk_), intent(in), optional :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: snrm2, dd real(psb_spk_) :: snrm2, dd
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -84,6 +86,12 @@ function psb_snrm2(x, desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@@ -114,7 +122,7 @@ function psb_snrm2(x, desc_a, info, jx) result(res)
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -168,7 +176,7 @@ end function psb_snrm2
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_snrm2v(x, desc_a, info) result(res) function psb_snrm2v(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -179,13 +187,13 @@ function psb_snrm2v(x, desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: snrm2, dd real(psb_spk_) :: snrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_snrm2v' name='psb_snrm2v'
@@ -202,6 +210,11 @@ function psb_snrm2v(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -233,8 +246,7 @@ function psb_snrm2v(x, desc_a, info) result(res)
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -246,7 +258,7 @@ end function psb_snrm2v
function psb_snrm2_vect(x, desc_a, info) result(res) function psb_snrm2_vect(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -258,12 +270,13 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
type(psb_s_vect_type), intent (inout) :: x type(psb_s_vect_type), intent (inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: snrm2, dd real(psb_spk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_snrm2v' name='psb_snrm2v'
@@ -286,6 +299,11 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,18 +325,21 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
if (desc_a%get_local_rows() > 0) then if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows() ndim = desc_a%get_local_rows()
res = x%nrm2(ndim) res = x%nrm2(ndim)
!!$ ! adjust because overlapped elements are computed more than once ! adjust because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) do i=1,size(desc_a%ovrlap_elem,1)
!!$ dd = dble(ndm-1)/dble(ndm) idx = desc_a%ovrlap_elem(i,1)
!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) ndm = desc_a%ovrlap_elem(i,2)
!!$ end do dd = dble(ndm-1)/dble(ndm)
else res = res - sqrt(sone - dd*(abs(x%v%v(idx))/res)**2)
end do
end if
else
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -329,7 +350,6 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
end function psb_snrm2_vect end function psb_snrm2_vect
!!$ !!$
!!$ Parallel Sparse BLAS version 3.5 !!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018 !!$ (C) Copyright 2006-2018
@@ -373,7 +393,7 @@ end function psb_snrm2_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_snrm2vs(res, x, desc_a, info) subroutine psb_snrm2vs(res, x, desc_a, info,global)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -384,13 +404,13 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
real(psb_spk_), intent(out) :: res real(psb_spk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_spk_) :: nrm2, snrm2, dd real(psb_spk_) :: nrm2, snrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_snrm2' name='psb_snrm2'
@@ -407,6 +427,12 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -439,7 +465,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
res = szero res = szero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
base/psblas/psb_snrmi.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_snrmi(a,desc_a,info) result(res) function psb_snrmi(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_snrmi use psb_base_mod, psb_protect_name => psb_snrmi
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_snrmi(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_snrmi' name='psb_snrmi'
@@ -69,6 +71,12 @@ function psb_snrmi(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -101,7 +109,7 @@ function psb_snrmi(a,desc_a,info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_sspnrm1.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_sspnrm1(a,desc_a,info) result(res) function psb_sspnrm1(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_sspnrm1 use psb_base_mod, psb_protect_name => psb_sspnrm1
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_sspnrm1(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_) :: res real(psb_spk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,& integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
real(psb_spk_), allocatable :: v(:) real(psb_spk_), allocatable :: v(:)
@@ -70,6 +72,12 @@ function psb_sspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -119,7 +127,7 @@ function psb_sspnrm1(a,desc_a,info) result(res)
res = szero res = szero
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_zamax.f90
+50 -11
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_zamax(x,desc_a, info, jx) result(res) function psb_zamax(x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_zamax use psb_base_mod, psb_protect_name => psb_zamax
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_zamax(x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zamax' name='psb_zamax'
@@ -82,6 +84,12 @@ function psb_zamax(x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
@@ -107,7 +115,7 @@ function psb_zamax(x,desc_a, info, jx) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -162,7 +170,7 @@ end function psb_zamax
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_zamaxv (x,desc_a, info) result(res) function psb_zamaxv (x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_zamaxv use psb_base_mod, psb_protect_name => psb_zamaxv
implicit none implicit none
@@ -171,11 +179,12 @@ function psb_zamaxv (x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx & err_act, iix, jjx, jx, ix, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zamaxv' name='psb_zamaxv'
@@ -193,6 +202,12 @@ function psb_zamaxv (x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -221,7 +236,7 @@ function psb_zamaxv (x,desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -232,7 +247,7 @@ function psb_zamaxv (x,desc_a, info) result(res)
end function psb_zamaxv end function psb_zamaxv
function psb_zamax_vect(x, desc_a, info) result(res) function psb_zamax_vect(x, desc_a, info,global) result(res)
use psb_penv_mod use psb_penv_mod
use psb_serial_mod use psb_serial_mod
use psb_desc_mod use psb_desc_mod
@@ -245,10 +260,12 @@ function psb_zamax_vect(x, desc_a, info) result(res)
type(psb_z_vect_type), intent (inout) :: x type(psb_z_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m & err_act, iix, jjx, jx, ix, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zamaxv' name='psb_zamaxv'
@@ -271,6 +288,12 @@ function psb_zamax_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -297,7 +320,7 @@ function psb_zamax_vect(x, desc_a, info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -355,7 +378,7 @@ end function psb_zamax_vect
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_zamaxvs(res,x,desc_a, info) subroutine psb_zamaxvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_zamaxvs use psb_base_mod, psb_protect_name => psb_zamaxvs
implicit none implicit none
@@ -364,10 +387,12 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx & err_act, iix, jjx, ix, ijx, m, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zamaxvs' name='psb_zamaxvs'
@@ -385,6 +410,12 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
ijx=1 ijx=1
@@ -412,7 +443,7 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -466,7 +497,7 @@ end subroutine psb_zamaxvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_zmamaxs(res,x,desc_a, info,jx) subroutine psb_zmamaxs(res,x,desc_a, info,jx,global)
use psb_base_mod, psb_protect_name => psb_zmamaxs use psb_base_mod, psb_protect_name => psb_zmamaxs
implicit none implicit none
@@ -476,10 +507,12 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_dpk_), intent(out) :: res(:) real(psb_dpk_), intent(out) :: res(:)
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k & err_act, iix, jjx, ix, ijx, m, ldx, i, k
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zmamaxs' name='psb_zmamaxs'
@@ -503,6 +536,12 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1)) k = min(size(x,2),size(res,1))
ldx = size(x,1) ldx = size(x,1)
@@ -529,7 +568,7 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res(1:k)) if (global_) call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_zasum.f90
+49 -9
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
function psb_zasum (x,desc_a, info, jx) result(res) function psb_zasum (x,desc_a, info, jx,global) result(res)
use psb_base_mod, psb_protect_name => psb_zasum use psb_base_mod, psb_protect_name => psb_zasum
implicit none implicit none
@@ -54,10 +54,12 @@ function psb_zasum (x,desc_a, info, jx) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: jx integer(psb_ipk_), optional, intent(in) :: jx
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, & integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zasum' name='psb_zasum'
@@ -82,6 +84,12 @@ function psb_zasum (x,desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
! check vector correctness ! check vector correctness
@@ -114,7 +122,7 @@ function psb_zasum (x,desc_a, info, jx) result(res)
res = dzero res = dzero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -125,7 +133,7 @@ function psb_zasum (x,desc_a, info, jx) result(res)
end function psb_zasum end function psb_zasum
function psb_zasum_vect(x, desc_a, info) result(res) function psb_zasum_vect(x, desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_zasum_vect use psb_base_mod, psb_protect_name => psb_zasum_vect
implicit none implicit none
@@ -133,10 +141,12 @@ function psb_zasum_vect(x, desc_a, info) result(res)
type(psb_z_vect_type), intent (inout) :: x type(psb_z_vect_type), intent (inout) :: x
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax & err_act, iix, jjx, jx, ix, m, imax, i, idx, ndm
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zasumv' name='psb_zasumv'
@@ -160,6 +170,11 @@ function psb_zasum_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -182,12 +197,21 @@ function psb_zasum_vect(x, desc_a, info) result(res)
! compute local max ! compute local max
if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then
res = x%asum(desc_a%get_local_rows()) res = x%asum(desc_a%get_local_rows())
if (size(desc_a%ovrlap_elem,1)>0) then
if (x%is_dev()) call x%sync()
! adjust res because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*abs(x%v%v(idx))
end do
end if
else else
res = dzero res = dzero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -242,7 +266,7 @@ end function psb_zasum_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_zasumv(x,desc_a, info) result(res) function psb_zasumv(x,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_zasumv use psb_base_mod, psb_protect_name => psb_zasumv
implicit none implicit none
@@ -251,10 +275,12 @@ function psb_zasumv(x,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx & err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zasumv' name='psb_zasumv'
@@ -271,6 +297,12 @@ function psb_zasumv(x,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,7 +339,7 @@ function psb_zasumv(x,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -362,7 +394,7 @@ end function psb_zasumv
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset. ! jx - integer(optional). The column offset.
! !
subroutine psb_zasumvs(res,x,desc_a, info) subroutine psb_zasumvs(res,x,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_zasumvs use psb_base_mod, psb_protect_name => psb_zasumvs
implicit none implicit none
@@ -371,10 +403,12 @@ subroutine psb_zasumvs(res,x,desc_a, info)
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx & err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zasumvs' name='psb_zasumvs'
@@ -391,6 +425,12 @@ subroutine psb_zasumvs(res,x,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
@@ -427,7 +467,7 @@ subroutine psb_zasumvs(res,x,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt,res) if (global_) call psb_sum(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_zdot.f90
+57 -15
View File
@@ -48,7 +48,7 @@
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! jy - integer(optional). The column offset for sub( Y ). ! jy - integer(optional). The column offset for sub( Y ).
! !
function psb_zdot_vect(x, y, desc_a,info) result(res) function psb_zdot_vect(x, y, desc_a,info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_z_base_mat_mod use psb_z_base_mat_mod
use psb_check_mod use psb_check_mod
@@ -61,10 +61,12 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
type(psb_z_vect_type), intent(inout) :: x, y type(psb_z_vect_type), intent(inout) :: x, y
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zdot_vect' name='psb_zdot_vect'
@@ -91,6 +93,11 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
ijx = ione ijx = ione
@@ -122,17 +129,21 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
res = x%dot(nr,y) res = x%dot(nr,y)
! FIXME ! FIXME
! adjust dot_local because overlapped elements are computed more than once ! adjust dot_local because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) if (y%is_dev()) call y%sync()
!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) do i=1,size(desc_a%ovrlap_elem,1)
!!$ end do idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
res = res - (real(ndm-1)/real(ndm))*(x%v%v(idx)*y%v%v(idx))
end do
end if
else else
res = zzero res = zzero
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -143,7 +154,7 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
end function psb_zdot_vect end function psb_zdot_vect
function psb_zdot(x, y,desc_a, info, jx, jy) result(res) function psb_zdot(x, y,desc_a, info, jx, jy,global) result(res)
use psb_base_mod, psb_protect_name => psb_zdot use psb_base_mod, psb_protect_name => psb_zdot
implicit none implicit none
@@ -152,12 +163,14 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
integer(psb_ipk_), intent(in), optional :: jx, jy integer(psb_ipk_), intent(in), optional :: jx, jy
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: res complex(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
complex(psb_dpk_) :: zdotc complex(psb_dpk_) :: zdotc
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zdot' name='psb_zdot'
@@ -193,6 +206,12 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
goto 9999 goto 9999
end if end if
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
lldx = size(x,1) lldx = size(x,1)
lldy = size(y,1) lldy = size(y,1)
@@ -228,7 +247,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -284,7 +303,7 @@ end function psb_zdot
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_zdotv(x, y,desc_a, info) result(res) function psb_zdotv(x, y,desc_a, info,global) result(res)
use psb_base_mod, psb_protect_name => psb_zdotv use psb_base_mod, psb_protect_name => psb_zdotv
implicit none implicit none
@@ -292,11 +311,13 @@ function psb_zdotv(x, y,desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: res complex(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, & & err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
complex(psb_dpk_) :: zdotc complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -314,6 +335,12 @@ function psb_zdotv(x, y,desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
jx = ione jx = ione
@@ -352,7 +379,7 @@ function psb_zdotv(x, y,desc_a, info) result(res)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@@ -409,7 +436,7 @@ end function psb_zdotv
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_zdotvs(res, x, y,desc_a, info) subroutine psb_zdotvs(res, x, y,desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_zdotvs use psb_base_mod, psb_protect_name => psb_zdotvs
implicit none implicit none
@@ -417,11 +444,13 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
complex(psb_dpk_), intent(out) :: res complex(psb_dpk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy & lldx, lldy
logical :: global_
complex(psb_dpk_) :: zdotc complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -439,6 +468,12 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -475,7 +510,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
end if end if
! compute global sum ! compute global sum
call psb_sum(ictxt, res) if (global_) call psb_sum(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -532,7 +567,7 @@ end subroutine psb_zdotvs
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_zmdots(res, x, y, desc_a, info) subroutine psb_zmdots(res, x, y, desc_a, info,global)
use psb_base_mod, psb_protect_name => psb_zmdots use psb_base_mod, psb_protect_name => psb_zmdots
implicit none implicit none
@@ -540,11 +575,13 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
complex(psb_dpk_), intent(out) :: res(:) complex(psb_dpk_), intent(out) :: res(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, & & err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy & lldx, lldy
logical :: global_
complex(psb_dpk_) :: zdotc complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -562,6 +599,11 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = ione ix = ione
iy = ione iy = ione
@@ -611,7 +653,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
! compute global sum ! compute global sum
call psb_sum(ictxt, res(1:k)) if (global_) call psb_sum(ictxt, res(1:k))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_znrm2.f90
+49 -23
View File
@@ -44,7 +44,7 @@
! info - integer. Return code ! info - integer. Return code
! jx - integer(optional). The column offset for sub( X ). ! jx - integer(optional). The column offset for sub( X ).
! !
function psb_znrm2(x, desc_a, info, jx) result(res) function psb_znrm2(x, desc_a, info, jx,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -56,10 +56,12 @@ function psb_znrm2(x, desc_a, info, jx) result(res)
integer(psb_ipk_), intent(in), optional :: jx integer(psb_ipk_), intent(in), optional :: jx
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: dznrm2, dd real(psb_dpk_) :: dznrm2, dd
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@@ -84,6 +86,12 @@ function psb_znrm2(x, desc_a, info, jx) result(res)
ijx = 1 ijx = 1
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
ldx = size(x,1) ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx) call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@@ -114,7 +122,7 @@ function psb_znrm2(x, desc_a, info, jx) result(res)
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -168,7 +176,7 @@ end function psb_znrm2
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_znrm2v(x, desc_a, info) result(res) function psb_znrm2v(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -179,13 +187,13 @@ function psb_znrm2v(x, desc_a, info) result(res)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: dznrm2, dd real(psb_dpk_) :: dznrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_znrm2v' name='psb_znrm2v'
@@ -202,6 +210,11 @@ function psb_znrm2v(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -233,8 +246,7 @@ function psb_znrm2v(x, desc_a, info) result(res)
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -246,7 +258,7 @@ end function psb_znrm2v
function psb_znrm2_vect(x, desc_a, info) result(res) function psb_znrm2_vect(x, desc_a, info,global) result(res)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -258,12 +270,13 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
type(psb_z_vect_type), intent (inout) :: x type(psb_z_vect_type), intent (inout) :: x
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: snrm2, dd real(psb_dpk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_znrm2v' name='psb_znrm2v'
@@ -286,6 +299,11 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx=1 jx=1
@@ -307,18 +325,21 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
if (desc_a%get_local_rows() > 0) then if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows() ndim = desc_a%get_local_rows()
res = x%nrm2(ndim) res = x%nrm2(ndim)
!!$ ! adjust because overlapped elements are computed more than once ! adjust because overlapped elements are computed more than once
!!$ do i=1,size(desc_a%ovrlap_elem,1) if (size(desc_a%ovrlap_elem,1)>0) then
!!$ idx = desc_a%ovrlap_elem(i,1) if (x%is_dev()) call x%sync()
!!$ ndm = desc_a%ovrlap_elem(i,2) do i=1,size(desc_a%ovrlap_elem,1)
!!$ dd = dble(ndm-1)/dble(ndm) idx = desc_a%ovrlap_elem(i,1)
!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) ndm = desc_a%ovrlap_elem(i,2)
!!$ end do dd = dble(ndm-1)/dble(ndm)
else res = res - sqrt(zone - dd*(abs(x%v%v(idx))/res)**2)
end do
end if
else
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@@ -329,7 +350,6 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
end function psb_znrm2_vect end function psb_znrm2_vect
!!$ !!$
!!$ Parallel Sparse BLAS version 3.5 !!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018 !!$ (C) Copyright 2006-2018
@@ -373,7 +393,7 @@ end function psb_znrm2_vect
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
subroutine psb_znrm2vs(res, x, desc_a, info) subroutine psb_znrm2vs(res, x, desc_a, info,global)
use psb_desc_mod use psb_desc_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
@@ -384,13 +404,13 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
real(psb_dpk_), intent(out) :: res real(psb_dpk_), intent(out) :: res
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
logical :: global_
real(psb_dpk_) :: nrm2, dznrm2, dd real(psb_dpk_) :: nrm2, dznrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_znrm2' name='psb_znrm2'
@@ -407,6 +427,12 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ix = 1 ix = 1
jx = 1 jx = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -439,7 +465,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
res = dzero res = dzero
end if end if
call psb_nrm2(ictxt,res) if (global_) call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
base/psblas/psb_znrmi.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_znrmi(a,desc_a,info) result(res) function psb_znrmi(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_znrmi use psb_base_mod, psb_protect_name => psb_znrmi
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_znrmi(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_znrmi' name='psb_znrmi'
@@ -69,6 +71,12 @@ function psb_znrmi(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -101,7 +109,7 @@ function psb_znrmi(a,desc_a,info) result(res)
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
base/psblas/psb_zspnrm1.f90
+10 -2
View File
@@ -41,7 +41,7 @@
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! !
function psb_zspnrm1(a,desc_a,info) result(res) function psb_zspnrm1(a,desc_a,info,global) result(res)
use psb_base_mod, psb_protect_name => psb_zspnrm1 use psb_base_mod, psb_protect_name => psb_zspnrm1
implicit none implicit none
@@ -49,10 +49,12 @@ function psb_zspnrm1(a,desc_a,info) result(res)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_) :: res real(psb_dpk_) :: res
logical, intent(in), optional :: global
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,& integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
logical :: global_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
real(psb_dpk_), allocatable :: v(:) real(psb_dpk_), allocatable :: v(:)
@@ -70,6 +72,12 @@ function psb_zspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
endif endif
if (present(global)) then
global_ = global
else
global_ = .true.
end if
ia = 1 ia = 1
ja = 1 ja = 1
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
@@ -119,7 +127,7 @@ function psb_zspnrm1(a,desc_a,info) result(res)
res = dzero res = dzero
end if end if
! compute global max ! compute global max
call psb_amx(ictxt, res) if (global_) call psb_amx(ictxt, res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return