Enable psi_abgdxyz

nond-rep
Salvatore Filippone 10 months ago
parent 9ced67634d
commit 4e611bb078

@ -1155,10 +1155,17 @@ contains
complex(psb_spk_), intent (in) :: alpha, beta, gamma, delta complex(psb_spk_), intent (in) :: alpha, beta, gamma, delta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (x%is_dev()) call x%sync() if (.false.) then
if (x%is_dev()) call x%sync()
call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info) call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info)
else
if (x%is_dev().and.(alpha/=czero))) call x%sync()
if (y%is_dev().and.(beta/=czero)) call y%sync()
if (z%is_dev().and.(delta/=czero)) call z%sync()
call psi_cabgdxyz(m,alpha, beta, gamma,delta,x%v, y%v, z%v, info)
end if
end subroutine c_base_abgdxyz end subroutine c_base_abgdxyz

@ -1152,7 +1152,7 @@ contains
end if end if
end function c_vect_nrm2_weight end function c_vect_nrm2_weight
function c_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res) function c_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

@ -1162,10 +1162,17 @@ contains
real(psb_dpk_), intent (in) :: alpha, beta, gamma, delta real(psb_dpk_), intent (in) :: alpha, beta, gamma, delta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (x%is_dev()) call x%sync() if (.false.) then
if (x%is_dev()) call x%sync()
call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info) call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info)
else
if (x%is_dev().and.(alpha/=dzero))) call x%sync()
if (y%is_dev().and.(beta/=dzero)) call y%sync()
if (z%is_dev().and.(delta/=dzero)) call z%sync()
call psi_dabgdxyz(m,alpha, beta, gamma,delta,x%v, y%v, z%v, info)
end if
end subroutine d_base_abgdxyz end subroutine d_base_abgdxyz

@ -1159,7 +1159,7 @@ contains
end if end if
end function d_vect_nrm2_weight end function d_vect_nrm2_weight
function d_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res) function d_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

@ -1162,10 +1162,17 @@ contains
real(psb_spk_), intent (in) :: alpha, beta, gamma, delta real(psb_spk_), intent (in) :: alpha, beta, gamma, delta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (x%is_dev()) call x%sync() if (.false.) then
if (x%is_dev()) call x%sync()
call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info) call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info)
else
if (x%is_dev().and.(alpha/=szero))) call x%sync()
if (y%is_dev().and.(beta/=szero)) call y%sync()
if (z%is_dev().and.(delta/=szero)) call z%sync()
call psi_sabgdxyz(m,alpha, beta, gamma,delta,x%v, y%v, z%v, info)
end if
end subroutine s_base_abgdxyz end subroutine s_base_abgdxyz

@ -1159,7 +1159,7 @@ contains
end if end if
end function s_vect_nrm2_weight end function s_vect_nrm2_weight
function s_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res) function s_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

@ -1155,10 +1155,17 @@ contains
complex(psb_dpk_), intent (in) :: alpha, beta, gamma, delta complex(psb_dpk_), intent (in) :: alpha, beta, gamma, delta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (x%is_dev()) call x%sync() if (.false.) then
if (x%is_dev()) call x%sync()
call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info) call y%axpby(m,alpha,x,beta,info)
call z%axpby(m,gamma,y,delta,info)
else
if (x%is_dev().and.(alpha/=zzero))) call x%sync()
if (y%is_dev().and.(beta/=zzero)) call y%sync()
if (z%is_dev().and.(delta/=zzero)) call z%sync()
call psi_zabgdxyz(m,alpha, beta, gamma,delta,x%v, y%v, z%v, info)
end if
end subroutine z_base_abgdxyz end subroutine z_base_abgdxyz

@ -1152,7 +1152,7 @@ contains
end if end if
end function z_vect_nrm2_weight end function z_vect_nrm2_weight
function z_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res) function z_vect_nrm2_weight_mask(n,x,w,id,info,aux) result(res)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

@ -1616,7 +1616,7 @@ subroutine psi_cabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == czero) then if (beta == czero) then
if (gamma == czero) then if (gamma == czero) then
if (alpha == czero) then if (alpha == czero) then
@ -1773,7 +1773,7 @@ subroutine psi_cabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= czero) then else if (delta /= czero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

@ -1616,7 +1616,7 @@ subroutine psi_dabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == dzero) then if (beta == dzero) then
if (gamma == dzero) then if (gamma == dzero) then
if (alpha == dzero) then if (alpha == dzero) then
@ -1773,7 +1773,7 @@ subroutine psi_dabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= dzero) then else if (delta /= dzero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

@ -1616,7 +1616,7 @@ subroutine psi_eabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == ezero) then if (beta == ezero) then
if (gamma == ezero) then if (gamma == ezero) then
if (alpha == ezero) then if (alpha == ezero) then
@ -1773,7 +1773,7 @@ subroutine psi_eabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= ezero) then else if (delta /= ezero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

@ -1616,7 +1616,7 @@ subroutine psi_i2abgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == i2zero) then if (beta == i2zero) then
if (gamma == i2zero) then if (gamma == i2zero) then
if (alpha == i2zero) then if (alpha == i2zero) then
@ -1773,7 +1773,7 @@ subroutine psi_i2abgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= i2zero) then else if (delta /= i2zero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

@ -1616,7 +1616,7 @@ subroutine psi_mabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == mzero) then if (beta == mzero) then
if (gamma == mzero) then if (gamma == mzero) then
if (alpha == mzero) then if (alpha == mzero) then
@ -1773,7 +1773,7 @@ subroutine psi_mabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= mzero) then else if (delta /= mzero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

@ -1616,7 +1616,7 @@ subroutine psi_sabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == szero) then if (beta == szero) then
if (gamma == szero) then if (gamma == szero) then
if (alpha == szero) then if (alpha == szero) then
@ -1773,7 +1773,7 @@ subroutine psi_sabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= szero) then else if (delta /= szero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

@ -1616,7 +1616,7 @@ subroutine psi_zabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
call fcpsb_errpush(info,name,int_err) call fcpsb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (beta == zzero) then if (beta == zzero) then
if (gamma == zzero) then if (gamma == zzero) then
if (alpha == zzero) then if (alpha == zzero) then
@ -1773,7 +1773,7 @@ subroutine psi_zabgdxyz(m,alpha, beta, gamma,delta,x, y, z, info)
end do end do
else if (delta /= zzero) then else if (delta /= zzero) then
! a n b n g n d 0 ! a n b n g n d n
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i)+beta*y(i) y(i) = alpha*x(i)+beta*y(i)

Loading…
Cancel
Save