mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
Fixes for vector methods and sync()
This commit is contained in:
sfilippone
@@ -1,6 +1,6 @@
|
||||
|
||||
subroutine c_oacc_mlt_v(x, y, info)
|
||||
use psb_c_oacc_vect_mod, psb_protect_name => c_oacc_mlt_v
|
||||
subroutine psb_c_oacc_mlt_v(x, y, info)
|
||||
use psb_c_oacc_vect_mod, psb_protect_name => psb_c_oacc_mlt_v
|
||||
|
||||
implicit none
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
@@ -9,16 +9,19 @@ subroutine c_oacc_mlt_v(x, y, info)
|
||||
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
select type(xx => x)
|
||||
class is (psb_c_vect_oacc)
|
||||
if (y%is_host()) call y%sync()
|
||||
if (xx%is_host()) call xx%sync()
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
y%v(i) = y%v(i) * xx%v(i)
|
||||
end do
|
||||
call c_inner_oacc_mlt_v(n,xx%v, y%v)
|
||||
!!$ !$acc parallel loop
|
||||
!!$ do i = 1, n
|
||||
!!$ y%v(i) = y%v(i) * xx%v(i)
|
||||
!!$ end do
|
||||
call y%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
@@ -28,4 +31,16 @@ subroutine c_oacc_mlt_v(x, y, info)
|
||||
end do
|
||||
call y%set_host()
|
||||
end select
|
||||
end subroutine c_oacc_mlt_v
|
||||
contains
|
||||
subroutine c_inner_oacc_mlt_v(n,x, y)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
complex(psb_spk_), intent(inout) :: x(:), y(:)
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
!$acc parallel loop present(x,y)
|
||||
do i = 1, n
|
||||
y(i) = (x(i)) * (y(i))
|
||||
end do
|
||||
end subroutine c_inner_oacc_mlt_v
|
||||
end subroutine psb_c_oacc_mlt_v
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
subroutine c_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_c_oacc_vect_mod, psb_protect_name => c_oacc_mlt_v_2
|
||||
subroutine psb_c_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_c_oacc_vect_mod, psb_protect_name => psb_c_oacc_mlt_v_2
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
complex(psb_spk_), intent(in) :: alpha, beta
|
||||
@@ -25,33 +25,13 @@ subroutine c_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (xx%is_host()) call xx%sync()
|
||||
if (yy%is_host()) call yy%sync()
|
||||
if ((beta /= czero) .and. (z%is_host())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(xx%v(i)) * conjg(yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * conjg(yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
|
||||
end if
|
||||
call c_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
call z%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
if (yy%is_dev()) call yy%sync()
|
||||
if ((beta /= czero) .and. (z%is_dev())) call z%sync()
|
||||
!call c_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(xx%v(i)) * conjg(yy%v(i)) + beta * z%v(i)
|
||||
@@ -67,7 +47,7 @@ subroutine c_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
@@ -75,24 +55,56 @@ subroutine c_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (x%is_dev()) call x%sync()
|
||||
if (y%is_dev()) call y%sync()
|
||||
if ((beta /= czero) .and. (z%is_dev())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
end subroutine c_oacc_mlt_v_2
|
||||
contains
|
||||
subroutine c_inner_oacc_mlt_v_2(n,alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
complex(psb_spk_), intent(in) :: alpha, beta
|
||||
complex(psb_spk_), intent(inout) :: x(:), y(:), z(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in) :: conjgx, conjgy
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
if (conjgx.and.conjgy) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * conjg(x(i)) * conjg(y(i)) + beta * z(i)
|
||||
end do
|
||||
else if (conjgx.and.(.not.conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * conjg(x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else if ((.not.conjgx).and.(conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * conjg(y(i)) + beta * z(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
end if
|
||||
end subroutine c_inner_oacc_mlt_v_2
|
||||
end subroutine psb_c_oacc_mlt_v_2
|
||||
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
|
||||
subroutine d_oacc_mlt_v(x, y, info)
|
||||
use psb_d_oacc_vect_mod, psb_protect_name => d_oacc_mlt_v
|
||||
subroutine psb_d_oacc_mlt_v(x, y, info)
|
||||
use psb_d_oacc_vect_mod, psb_protect_name => psb_d_oacc_mlt_v
|
||||
|
||||
implicit none
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
@@ -9,16 +9,19 @@ subroutine d_oacc_mlt_v(x, y, info)
|
||||
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
select type(xx => x)
|
||||
class is (psb_d_vect_oacc)
|
||||
if (y%is_host()) call y%sync()
|
||||
if (xx%is_host()) call xx%sync()
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
y%v(i) = y%v(i) * xx%v(i)
|
||||
end do
|
||||
call d_inner_oacc_mlt_v(n,xx%v, y%v)
|
||||
!!$ !$acc parallel loop
|
||||
!!$ do i = 1, n
|
||||
!!$ y%v(i) = y%v(i) * xx%v(i)
|
||||
!!$ end do
|
||||
call y%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
@@ -28,4 +31,16 @@ subroutine d_oacc_mlt_v(x, y, info)
|
||||
end do
|
||||
call y%set_host()
|
||||
end select
|
||||
end subroutine d_oacc_mlt_v
|
||||
contains
|
||||
subroutine d_inner_oacc_mlt_v(n,x, y)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
real(psb_dpk_), intent(inout) :: x(:), y(:)
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
!$acc parallel loop present(x,y)
|
||||
do i = 1, n
|
||||
y(i) = (x(i)) * (y(i))
|
||||
end do
|
||||
end subroutine d_inner_oacc_mlt_v
|
||||
end subroutine psb_d_oacc_mlt_v
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
subroutine d_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_d_oacc_vect_mod, psb_protect_name => d_oacc_mlt_v_2
|
||||
subroutine psb_d_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_d_oacc_vect_mod, psb_protect_name => psb_d_oacc_mlt_v_2
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
@@ -25,33 +25,13 @@ subroutine d_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (xx%is_host()) call xx%sync()
|
||||
if (yy%is_host()) call yy%sync()
|
||||
if ((beta /= dzero) .and. (z%is_host())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
|
||||
end if
|
||||
call d_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
call z%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
if (yy%is_dev()) call yy%sync()
|
||||
if ((beta /= dzero) .and. (z%is_dev())) call z%sync()
|
||||
!call d_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
@@ -67,7 +47,7 @@ subroutine d_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
@@ -75,24 +55,56 @@ subroutine d_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (x%is_dev()) call x%sync()
|
||||
if (y%is_dev()) call y%sync()
|
||||
if ((beta /= dzero) .and. (z%is_dev())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
end subroutine d_oacc_mlt_v_2
|
||||
contains
|
||||
subroutine d_inner_oacc_mlt_v_2(n,alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
real(psb_dpk_), intent(inout) :: x(:), y(:), z(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in) :: conjgx, conjgy
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
if (conjgx.and.conjgy) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else if (conjgx.and.(.not.conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else if ((.not.conjgx).and.(conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
end if
|
||||
end subroutine d_inner_oacc_mlt_v_2
|
||||
end subroutine psb_d_oacc_mlt_v_2
|
||||
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
|
||||
subroutine s_oacc_mlt_v(x, y, info)
|
||||
use psb_s_oacc_vect_mod, psb_protect_name => s_oacc_mlt_v
|
||||
subroutine psb_s_oacc_mlt_v(x, y, info)
|
||||
use psb_s_oacc_vect_mod, psb_protect_name => psb_s_oacc_mlt_v
|
||||
|
||||
implicit none
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
@@ -9,16 +9,19 @@ subroutine s_oacc_mlt_v(x, y, info)
|
||||
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
select type(xx => x)
|
||||
class is (psb_s_vect_oacc)
|
||||
if (y%is_host()) call y%sync()
|
||||
if (xx%is_host()) call xx%sync()
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
y%v(i) = y%v(i) * xx%v(i)
|
||||
end do
|
||||
call s_inner_oacc_mlt_v(n,xx%v, y%v)
|
||||
!!$ !$acc parallel loop
|
||||
!!$ do i = 1, n
|
||||
!!$ y%v(i) = y%v(i) * xx%v(i)
|
||||
!!$ end do
|
||||
call y%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
@@ -28,4 +31,16 @@ subroutine s_oacc_mlt_v(x, y, info)
|
||||
end do
|
||||
call y%set_host()
|
||||
end select
|
||||
end subroutine s_oacc_mlt_v
|
||||
contains
|
||||
subroutine s_inner_oacc_mlt_v(n,x, y)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
real(psb_spk_), intent(inout) :: x(:), y(:)
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
!$acc parallel loop present(x,y)
|
||||
do i = 1, n
|
||||
y(i) = (x(i)) * (y(i))
|
||||
end do
|
||||
end subroutine s_inner_oacc_mlt_v
|
||||
end subroutine psb_s_oacc_mlt_v
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
subroutine s_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_s_oacc_vect_mod, psb_protect_name => s_oacc_mlt_v_2
|
||||
subroutine psb_s_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_s_oacc_vect_mod, psb_protect_name => psb_s_oacc_mlt_v_2
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
real(psb_spk_), intent(in) :: alpha, beta
|
||||
@@ -25,33 +25,13 @@ subroutine s_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (xx%is_host()) call xx%sync()
|
||||
if (yy%is_host()) call yy%sync()
|
||||
if ((beta /= szero) .and. (z%is_host())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
|
||||
end if
|
||||
call s_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
call z%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
if (yy%is_dev()) call yy%sync()
|
||||
if ((beta /= szero) .and. (z%is_dev())) call z%sync()
|
||||
!call s_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
@@ -67,7 +47,7 @@ subroutine s_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
@@ -75,24 +55,56 @@ subroutine s_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (x%is_dev()) call x%sync()
|
||||
if (y%is_dev()) call y%sync()
|
||||
if ((beta /= szero) .and. (z%is_dev())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
end subroutine s_oacc_mlt_v_2
|
||||
contains
|
||||
subroutine s_inner_oacc_mlt_v_2(n,alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
real(psb_spk_), intent(in) :: alpha, beta
|
||||
real(psb_spk_), intent(inout) :: x(:), y(:), z(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in) :: conjgx, conjgy
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
if (conjgx.and.conjgy) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else if (conjgx.and.(.not.conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else if ((.not.conjgx).and.(conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
end if
|
||||
end subroutine s_inner_oacc_mlt_v_2
|
||||
end subroutine psb_s_oacc_mlt_v_2
|
||||
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
|
||||
subroutine z_oacc_mlt_v(x, y, info)
|
||||
use psb_z_oacc_vect_mod, psb_protect_name => z_oacc_mlt_v
|
||||
subroutine psb_z_oacc_mlt_v(x, y, info)
|
||||
use psb_z_oacc_vect_mod, psb_protect_name => psb_z_oacc_mlt_v
|
||||
|
||||
implicit none
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
@@ -9,16 +9,19 @@ subroutine z_oacc_mlt_v(x, y, info)
|
||||
|
||||
integer(psb_ipk_) :: i, n
|
||||
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
info = 0
|
||||
n = min(x%get_nrows(), y%get_nrows())
|
||||
select type(xx => x)
|
||||
class is (psb_z_vect_oacc)
|
||||
if (y%is_host()) call y%sync()
|
||||
if (xx%is_host()) call xx%sync()
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
y%v(i) = y%v(i) * xx%v(i)
|
||||
end do
|
||||
call z_inner_oacc_mlt_v(n,xx%v, y%v)
|
||||
!!$ !$acc parallel loop
|
||||
!!$ do i = 1, n
|
||||
!!$ y%v(i) = y%v(i) * xx%v(i)
|
||||
!!$ end do
|
||||
call y%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
@@ -28,4 +31,16 @@ subroutine z_oacc_mlt_v(x, y, info)
|
||||
end do
|
||||
call y%set_host()
|
||||
end select
|
||||
end subroutine z_oacc_mlt_v
|
||||
contains
|
||||
subroutine z_inner_oacc_mlt_v(n,x, y)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
complex(psb_dpk_), intent(inout) :: x(:), y(:)
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
!$acc parallel loop present(x,y)
|
||||
do i = 1, n
|
||||
y(i) = (x(i)) * (y(i))
|
||||
end do
|
||||
end subroutine z_inner_oacc_mlt_v
|
||||
end subroutine psb_z_oacc_mlt_v
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
subroutine z_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_z_oacc_vect_mod, psb_protect_name => z_oacc_mlt_v_2
|
||||
subroutine psb_z_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
use psb_z_oacc_vect_mod, psb_protect_name => psb_z_oacc_mlt_v_2
|
||||
use psb_string_mod
|
||||
implicit none
|
||||
complex(psb_dpk_), intent(in) :: alpha, beta
|
||||
@@ -25,33 +25,13 @@ subroutine z_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (xx%is_host()) call xx%sync()
|
||||
if (yy%is_host()) call yy%sync()
|
||||
if ((beta /= zzero) .and. (z%is_host())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(xx%v(i)) * conjg(yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * conjg(yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
|
||||
end if
|
||||
call z_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
call z%set_dev()
|
||||
class default
|
||||
if (xx%is_dev()) call xx%sync()
|
||||
if (yy%is_dev()) call yy%sync()
|
||||
if ((beta /= zzero) .and. (z%is_dev())) call z%sync()
|
||||
!call z_inner_oacc_mlt_v_2(n,alpha, xx%v, yy%v, beta, z%v, info, conjgx_, conjgy_)
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(xx%v(i)) * conjg(yy%v(i)) + beta * z%v(i)
|
||||
@@ -67,7 +47,7 @@ subroutine z_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (xx%v(i)) * (yy%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
@@ -75,24 +55,56 @@ subroutine z_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
if (x%is_dev()) call x%sync()
|
||||
if (y%is_dev()) call y%sync()
|
||||
if ((beta /= zzero) .and. (z%is_dev())) call z%sync()
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
if (conjgx_.and.conjgy_) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if (conjgx_.and.(.not.conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * conjg(x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else if ((.not.conjgx_).and.(conjgy_)) then
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * conjg(y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, n
|
||||
z%v(i) = alpha * (x%v(i)) * (y%v(i)) + beta * z%v(i)
|
||||
end do
|
||||
end if
|
||||
call z%set_host()
|
||||
end select
|
||||
end subroutine z_oacc_mlt_v_2
|
||||
contains
|
||||
subroutine z_inner_oacc_mlt_v_2(n,alpha, x, y, beta, z, info, conjgx, conjgy)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
complex(psb_dpk_), intent(in) :: alpha, beta
|
||||
complex(psb_dpk_), intent(inout) :: x(:), y(:), z(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in) :: conjgx, conjgy
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
if (conjgx.and.conjgy) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * conjg(x(i)) * conjg(y(i)) + beta * z(i)
|
||||
end do
|
||||
else if (conjgx.and.(.not.conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * conjg(x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
else if ((.not.conjgx).and.(conjgy)) then
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * conjg(y(i)) + beta * z(i)
|
||||
end do
|
||||
else
|
||||
!$acc parallel loop present(x,y,z)
|
||||
do i = 1, n
|
||||
z(i) = alpha * (x(i)) * (y(i)) + beta * z(i)
|
||||
end do
|
||||
end if
|
||||
end subroutine z_inner_oacc_mlt_v_2
|
||||
end subroutine psb_z_oacc_mlt_v_2
|
||||
|
||||
|
||||
Reference in New Issue
Block a user