mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
New interface for methods with global reductions.
This commit is contained in:
Salvatore Filippone
+57
-15
@@ -48,7 +48,7 @@
|
||||
! jx - integer(optional). The column offset for sub( X ).
|
||||
! 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_z_base_mat_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_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: global
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
|
||||
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
|
||||
logical :: global_
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_zdot_vect'
|
||||
@@ -91,6 +93,11 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .true.
|
||||
end if
|
||||
|
||||
ix = ione
|
||||
ijx = ione
|
||||
@@ -122,17 +129,21 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
|
||||
res = x%dot(nr,y)
|
||||
! FIXME
|
||||
! adjust dot_local 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)
|
||||
!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx))
|
||||
!!$ end do
|
||||
if (size(desc_a%ovrlap_elem,1)>0) then
|
||||
if (x%is_dev()) call x%sync()
|
||||
if (y%is_dev()) call y%sync()
|
||||
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))*(x%v%v(idx)*y%v%v(idx))
|
||||
end do
|
||||
end if
|
||||
else
|
||||
res = zzero
|
||||
end if
|
||||
|
||||
! compute global sum
|
||||
call psb_sum(ictxt, res)
|
||||
if (global_) call psb_sum(ictxt, res)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -143,7 +154,7 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
|
||||
|
||||
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
|
||||
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(out) :: info
|
||||
complex(psb_dpk_) :: res
|
||||
logical, intent(in), optional :: global
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
|
||||
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
|
||||
& lldx, lldy
|
||||
complex(psb_dpk_) :: zdotc
|
||||
logical :: global_
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_zdot'
|
||||
@@ -193,6 +206,12 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .true.
|
||||
end if
|
||||
|
||||
m = desc_a%get_global_rows()
|
||||
lldx = size(x,1)
|
||||
lldy = size(y,1)
|
||||
@@ -228,7 +247,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
|
||||
end if
|
||||
|
||||
! compute global sum
|
||||
call psb_sum(ictxt, res)
|
||||
if (global_) call psb_sum(ictxt, res)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -284,7 +303,7 @@ end function psb_zdot
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! 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
|
||||
implicit none
|
||||
|
||||
@@ -292,11 +311,13 @@ function psb_zdotv(x, y,desc_a, info) result(res)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_dpk_) :: res
|
||||
logical, intent(in), optional :: global
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
|
||||
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
|
||||
& lldx, lldy
|
||||
logical :: global_
|
||||
complex(psb_dpk_) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -314,6 +335,12 @@ function psb_zdotv(x, y,desc_a, info) result(res)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .true.
|
||||
end if
|
||||
|
||||
ix = ione
|
||||
iy = ione
|
||||
jx = ione
|
||||
@@ -352,7 +379,7 @@ function psb_zdotv(x, y,desc_a, info) result(res)
|
||||
end if
|
||||
|
||||
! compute global sum
|
||||
call psb_sum(ictxt, res)
|
||||
if (global_) call psb_sum(ictxt, res)
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -409,7 +436,7 @@ end function psb_zdotv
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! 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
|
||||
implicit none
|
||||
|
||||
@@ -417,11 +444,13 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
|
||||
complex(psb_dpk_), intent(out) :: res
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: global
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
|
||||
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
|
||||
& lldx, lldy
|
||||
logical :: global_
|
||||
complex(psb_dpk_) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -439,6 +468,12 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .true.
|
||||
end if
|
||||
|
||||
ix = ione
|
||||
iy = ione
|
||||
m = desc_a%get_global_rows()
|
||||
@@ -475,7 +510,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
|
||||
end if
|
||||
|
||||
! compute global sum
|
||||
call psb_sum(ictxt, res)
|
||||
if (global_) call psb_sum(ictxt, res)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -532,7 +567,7 @@ end subroutine psb_zdotvs
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! 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
|
||||
implicit none
|
||||
|
||||
@@ -540,11 +575,13 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
|
||||
complex(psb_dpk_), intent(out) :: res(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: global
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
|
||||
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
|
||||
& lldx, lldy
|
||||
logical :: global_
|
||||
complex(psb_dpk_) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -562,6 +599,11 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .true.
|
||||
end if
|
||||
ix = ione
|
||||
iy = ione
|
||||
|
||||
@@ -611,7 +653,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
|
||||
|
||||
|
||||
! compute global sum
|
||||
call psb_sum(ictxt, res(1:k))
|
||||
if (global_) call psb_sum(ictxt, res(1:k))
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
Reference in New Issue
Block a user