Initial version with OpenMP directives.

psblas-3.6-openmp
Salvatore Filippone 7 years ago
parent 00ac68739d
commit 8e7679dc02

@ -964,6 +964,7 @@ contains
info = 0
if (y%is_dev()) call y%sync()
n = min(size(y%v), size(x))
!$omp parallel do private(i)
do i=1, n
y%v(i) = y%v(i)*x(i)
end do
@ -1001,6 +1002,7 @@ contains
if (beta == cone) then
return
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i)
end do
@ -1008,42 +1010,51 @@ contains
else
if (alpha == cone) then
if (beta == czero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = y(i)*x(i)
end do
else if (beta == cone) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) + y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) + y(i)*x(i)
end do
end if
else if (alpha == -cone) then
if (beta == czero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = -y(i)*x(i)
end do
else if (beta == cone) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) - y(i)*x(i)
end do
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) - y(i)*x(i)
end do
end if
else
if (beta == czero) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = alpha*y(i)*x(i)
end do
else if (beta == cone) then
else if (beta == cone) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = z%v(i) + alpha*y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(alpha,beta)
do i=1, n
z%v(i) = beta*z%v(i) + alpha*y(i)*x(i)
end do
@ -1143,8 +1154,10 @@ contains
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), intent (in) :: alpha
if (allocated(x%v)) then
if (allocated(x%v)) then
!$OMP parallel workshare
x%v = alpha*x%v
!$OMP end parallel workshare
call x%set_host()
end if
@ -1181,8 +1194,9 @@ contains
real(psb_spk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = maxval(abs(x%v(1:n)))
!$OMP end parallel workshare
end function c_base_amax
!
@ -1197,8 +1211,9 @@ contains
real(psb_spk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = sum(abs(x%v(1:n)))
!$OMP end parallel workshare
end function c_base_asum

@ -964,6 +964,7 @@ contains
info = 0
if (y%is_dev()) call y%sync()
n = min(size(y%v), size(x))
!$omp parallel do private(i)
do i=1, n
y%v(i) = y%v(i)*x(i)
end do
@ -1001,6 +1002,7 @@ contains
if (beta == done) then
return
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i)
end do
@ -1008,42 +1010,51 @@ contains
else
if (alpha == done) then
if (beta == dzero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = y(i)*x(i)
end do
else if (beta == done) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) + y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) + y(i)*x(i)
end do
end if
else if (alpha == -done) then
if (beta == dzero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = -y(i)*x(i)
end do
else if (beta == done) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) - y(i)*x(i)
end do
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) - y(i)*x(i)
end do
end if
else
if (beta == dzero) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = alpha*y(i)*x(i)
end do
else if (beta == done) then
else if (beta == done) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = z%v(i) + alpha*y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(alpha,beta)
do i=1, n
z%v(i) = beta*z%v(i) + alpha*y(i)*x(i)
end do
@ -1143,8 +1154,10 @@ contains
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent (in) :: alpha
if (allocated(x%v)) then
if (allocated(x%v)) then
!$OMP parallel workshare
x%v = alpha*x%v
!$OMP end parallel workshare
call x%set_host()
end if
@ -1181,8 +1194,9 @@ contains
real(psb_dpk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = maxval(abs(x%v(1:n)))
!$OMP end parallel workshare
end function d_base_amax
!
@ -1197,8 +1211,9 @@ contains
real(psb_dpk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = sum(abs(x%v(1:n)))
!$OMP end parallel workshare
end function d_base_asum

@ -964,6 +964,7 @@ contains
info = 0
if (y%is_dev()) call y%sync()
n = min(size(y%v), size(x))
!$omp parallel do private(i)
do i=1, n
y%v(i) = y%v(i)*x(i)
end do
@ -1001,6 +1002,7 @@ contains
if (beta == sone) then
return
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i)
end do
@ -1008,42 +1010,51 @@ contains
else
if (alpha == sone) then
if (beta == szero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = y(i)*x(i)
end do
else if (beta == sone) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) + y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) + y(i)*x(i)
end do
end if
else if (alpha == -sone) then
if (beta == szero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = -y(i)*x(i)
end do
else if (beta == sone) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) - y(i)*x(i)
end do
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) - y(i)*x(i)
end do
end if
else
if (beta == szero) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = alpha*y(i)*x(i)
end do
else if (beta == sone) then
else if (beta == sone) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = z%v(i) + alpha*y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(alpha,beta)
do i=1, n
z%v(i) = beta*z%v(i) + alpha*y(i)*x(i)
end do
@ -1143,8 +1154,10 @@ contains
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent (in) :: alpha
if (allocated(x%v)) then
if (allocated(x%v)) then
!$OMP parallel workshare
x%v = alpha*x%v
!$OMP end parallel workshare
call x%set_host()
end if
@ -1181,8 +1194,9 @@ contains
real(psb_spk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = maxval(abs(x%v(1:n)))
!$OMP end parallel workshare
end function s_base_amax
!
@ -1197,8 +1211,9 @@ contains
real(psb_spk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = sum(abs(x%v(1:n)))
!$OMP end parallel workshare
end function s_base_asum

@ -964,6 +964,7 @@ contains
info = 0
if (y%is_dev()) call y%sync()
n = min(size(y%v), size(x))
!$omp parallel do private(i)
do i=1, n
y%v(i) = y%v(i)*x(i)
end do
@ -1001,6 +1002,7 @@ contains
if (beta == zone) then
return
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i)
end do
@ -1008,42 +1010,51 @@ contains
else
if (alpha == zone) then
if (beta == zzero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = y(i)*x(i)
end do
else if (beta == zone) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) + y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) + y(i)*x(i)
end do
end if
else if (alpha == -zone) then
if (beta == zzero) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = -y(i)*x(i)
end do
else if (beta == zone) then
!$omp parallel do private(i)
do i=1, n
z%v(i) = z%v(i) - y(i)*x(i)
end do
else
!$omp parallel do private(i) shared(beta)
do i=1, n
z%v(i) = beta*z%v(i) - y(i)*x(i)
end do
end if
else
if (beta == zzero) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = alpha*y(i)*x(i)
end do
else if (beta == zone) then
else if (beta == zone) then
!$omp parallel do private(i) shared(alpha)
do i=1, n
z%v(i) = z%v(i) + alpha*y(i)*x(i)
end do
else
else
!$omp parallel do private(i) shared(alpha,beta)
do i=1, n
z%v(i) = beta*z%v(i) + alpha*y(i)*x(i)
end do
@ -1143,8 +1154,10 @@ contains
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), intent (in) :: alpha
if (allocated(x%v)) then
if (allocated(x%v)) then
!$OMP parallel workshare
x%v = alpha*x%v
!$OMP end parallel workshare
call x%set_host()
end if
@ -1181,8 +1194,9 @@ contains
real(psb_dpk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = maxval(abs(x%v(1:n)))
!$OMP end parallel workshare
end function z_base_amax
!
@ -1197,8 +1211,9 @@ contains
real(psb_dpk_) :: res
if (x%is_dev()) call x%sync()
!$OMP parallel workshare
res = sum(abs(x%v(1:n)))
!$OMP end parallel workshare
end function z_base_asum

@ -131,10 +131,12 @@ contains
if (alpha == czero) then
if (beta == czero) then
!$omp parallel do private(i)
do i = 1, m
y(i) = czero
enddo
else
!$omp parallel do private(i)
do i = 1, m
y(i) = beta*y(i)
end do
@ -148,6 +150,7 @@ contains
if (beta == czero) then
if (alpha == cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -158,6 +161,7 @@ contains
else if (alpha == -cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -168,6 +172,7 @@ contains
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -181,7 +186,8 @@ contains
else if (beta == cone) then
if (alpha == cone) then
if (alpha == cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -192,7 +198,8 @@ contains
else if (alpha == -cone) then
do i=1,m
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j))
@ -200,8 +207,9 @@ contains
y(i) = y(i) -acc
end do
else
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -214,7 +222,8 @@ contains
else if (beta == -cone) then
if (alpha == cone) then
if (alpha == cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -224,7 +233,7 @@ contains
end do
else if (alpha == -cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -234,7 +243,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -247,7 +256,8 @@ contains
else
if (alpha == cone) then
if (alpha == cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -257,7 +267,7 @@ contains
end do
else if (alpha == -cone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1
@ -267,7 +277,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = czero
do j=irp(i), irp(i+1)-1

@ -131,10 +131,12 @@ contains
if (alpha == dzero) then
if (beta == dzero) then
!$omp parallel do private(i)
do i = 1, m
y(i) = dzero
enddo
else
!$omp parallel do private(i)
do i = 1, m
y(i) = beta*y(i)
end do
@ -148,6 +150,7 @@ contains
if (beta == dzero) then
if (alpha == done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -158,6 +161,7 @@ contains
else if (alpha == -done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -168,6 +172,7 @@ contains
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -181,7 +186,8 @@ contains
else if (beta == done) then
if (alpha == done) then
if (alpha == done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -192,7 +198,8 @@ contains
else if (alpha == -done) then
do i=1,m
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j))
@ -200,8 +207,9 @@ contains
y(i) = y(i) -acc
end do
else
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -214,7 +222,8 @@ contains
else if (beta == -done) then
if (alpha == done) then
if (alpha == done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -224,7 +233,7 @@ contains
end do
else if (alpha == -done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -234,7 +243,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -247,7 +256,8 @@ contains
else
if (alpha == done) then
if (alpha == done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -257,7 +267,7 @@ contains
end do
else if (alpha == -done) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1
@ -267,7 +277,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = dzero
do j=irp(i), irp(i+1)-1

@ -131,10 +131,12 @@ contains
if (alpha == szero) then
if (beta == szero) then
!$omp parallel do private(i)
do i = 1, m
y(i) = szero
enddo
else
!$omp parallel do private(i)
do i = 1, m
y(i) = beta*y(i)
end do
@ -148,6 +150,7 @@ contains
if (beta == szero) then
if (alpha == sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -158,6 +161,7 @@ contains
else if (alpha == -sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -168,6 +172,7 @@ contains
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -181,7 +186,8 @@ contains
else if (beta == sone) then
if (alpha == sone) then
if (alpha == sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -192,7 +198,8 @@ contains
else if (alpha == -sone) then
do i=1,m
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j))
@ -200,8 +207,9 @@ contains
y(i) = y(i) -acc
end do
else
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -214,7 +222,8 @@ contains
else if (beta == -sone) then
if (alpha == sone) then
if (alpha == sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -224,7 +233,7 @@ contains
end do
else if (alpha == -sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -234,7 +243,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -247,7 +256,8 @@ contains
else
if (alpha == sone) then
if (alpha == sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -257,7 +267,7 @@ contains
end do
else if (alpha == -sone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1
@ -267,7 +277,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = szero
do j=irp(i), irp(i+1)-1

@ -131,10 +131,12 @@ contains
if (alpha == zzero) then
if (beta == zzero) then
!$omp parallel do private(i)
do i = 1, m
y(i) = zzero
enddo
else
!$omp parallel do private(i)
do i = 1, m
y(i) = beta*y(i)
end do
@ -148,6 +150,7 @@ contains
if (beta == zzero) then
if (alpha == zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -158,6 +161,7 @@ contains
else if (alpha == -zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -168,6 +172,7 @@ contains
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -181,7 +186,8 @@ contains
else if (beta == zone) then
if (alpha == zone) then
if (alpha == zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -192,7 +198,8 @@ contains
else if (alpha == -zone) then
do i=1,m
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
acc = acc + val(j) * x(ja(j))
@ -200,8 +207,9 @@ contains
y(i) = y(i) -acc
end do
else
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -214,7 +222,8 @@ contains
else if (beta == -zone) then
if (alpha == zone) then
if (alpha == zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -224,7 +233,7 @@ contains
end do
else if (alpha == -zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -234,7 +243,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -247,7 +256,8 @@ contains
else
if (alpha == zone) then
if (alpha == zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -257,7 +267,7 @@ contains
end do
else if (alpha == -zone) then
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1
@ -267,7 +277,7 @@ contains
end do
else
!$omp parallel do private(i,j,acc)
do i=1,m
acc = zzero
do j=irp(i), irp(i+1)-1

@ -476,6 +476,7 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.czero) then
if (beta.eq.czero) then
do j=1, n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = czero
enddo
@ -487,12 +488,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = beta*y(i,j)
enddo
@ -503,12 +506,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.czero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
@ -516,12 +521,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
@ -532,12 +539,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.czero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
@ -545,12 +554,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
@ -561,12 +572,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.czero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
@ -574,12 +587,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo

@ -476,6 +476,7 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.dzero) then
if (beta.eq.dzero) then
do j=1, n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = dzero
enddo
@ -487,12 +488,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = beta*y(i,j)
enddo
@ -503,12 +506,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.dzero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
@ -516,12 +521,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
@ -532,12 +539,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.dzero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
@ -545,12 +554,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
@ -561,12 +572,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.dzero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
@ -574,12 +587,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo

@ -476,6 +476,7 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.izero) then
if (beta.eq.izero) then
do j=1, n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = izero
enddo
@ -487,12 +488,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = beta*y(i,j)
enddo
@ -503,12 +506,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.izero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
@ -516,12 +521,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
@ -532,12 +539,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.izero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
@ -545,12 +554,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
@ -561,12 +572,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.izero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
@ -574,12 +587,14 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-ione) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo

@ -476,6 +476,7 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.szero) then
if (beta.eq.szero) then
do j=1, n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = szero
enddo
@ -487,12 +488,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = beta*y(i,j)
enddo
@ -503,12 +506,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.szero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
@ -516,12 +521,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
@ -532,12 +539,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.szero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
@ -545,12 +554,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
@ -561,12 +572,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.szero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
@ -574,12 +587,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo

@ -476,6 +476,7 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.zzero) then
if (beta.eq.zzero) then
do j=1, n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = zzero
enddo
@ -487,12 +488,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = beta*y(i,j)
enddo
@ -503,12 +506,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.zzero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
@ -516,12 +521,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
@ -532,12 +539,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.zzero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
@ -545,12 +554,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
@ -561,12 +572,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.zzero) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
@ -574,12 +587,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
!$omp parallel do private(i) shared(j)
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo

@ -255,6 +255,7 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
end if
call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=cone)
!$omp parallel do private(i)
do i=1,nrow
if (prec%d(i) == dzero) then
prec%d(i) = cone

@ -255,6 +255,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
end if
call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=done)
!$omp parallel do private(i)
do i=1,nrow
if (prec%d(i) == dzero) then
prec%d(i) = done

@ -255,6 +255,7 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
end if
call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=sone)
!$omp parallel do private(i)
do i=1,nrow
if (prec%d(i) == dzero) then
prec%d(i) = sone

@ -255,6 +255,7 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
end if
call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=zone)
!$omp parallel do private(i)
do i=1,nrow
if (prec%d(i) == dzero) then
prec%d(i) = zone

Loading…
Cancel
Save