fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Additional fixes for psi_serial_impl

Browse Source
new-context
Salvatore Filippone 4 years ago
parent eb513e45c6
commit 23f69f58d4
4 changed files with 864 additions and 40 deletions
Show Stats Download Patch File Download Diff File

239
base/serial/psi_c_serial_impl.F90
Unescape Escape View File

@ -40,9 +40,9 @@ subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
complex(psb_spk_), intent (in) :: alpha, beta complex(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
info=psb_success_ info=psb_success_
@ -101,7 +101,8 @@ subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err integer(psb_ipk_) :: i
character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
info=psb_success_ info=psb_success_
@ -131,7 +132,106 @@ subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if (m>0) call caxpby(m,ione,alpha,x,lx,beta,y,ly,info) ! if (m>0) call caxpby(m,ione,alpha,x,lx,beta,y,ly,info)
if (alpha.eq.czero) then
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
y(i) = czero
enddo
else if (beta.eq.cone) then
!
! Do nothing!
!
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = beta*y(i)
enddo
endif
else if (alpha.eq.cone) then
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i)
enddo
else if (beta.eq.cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) + y(i)
enddo
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-cone) then
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i)
enddo
else if (beta.eq.cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) + y(i)
enddo
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i)
enddo
else if (beta.eq.cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -154,7 +254,7 @@ subroutine psi_caxpbyv2(m,alpha, x, beta, y, z, info)
complex(psb_spk_), intent (in) :: alpha, beta complex(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly, lz integer(psb_ipk_) :: lx, ly, lz, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -193,7 +293,105 @@ subroutine psi_caxpbyv2(m,alpha, x, beta, y, z, info)
goto 9999 goto 9999
end if end if
if (m>0) call caxpbyv2(m,ione,alpha,x,lx,beta,y,ly,z,lz,info) if (alpha.eq.czero) then
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = czero
enddo
else if (beta.eq.cone) then
!
! Do nothing!
!
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = beta*y(i)
enddo
endif
else if (alpha.eq.cone) then
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i)
enddo
else if (beta.eq.cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + y(i)
enddo
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-cone) then
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i)
enddo
else if (beta.eq.cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + y(i)
enddo
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.czero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i)
enddo
else if (beta.eq.cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-cone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -541,6 +739,7 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.czero) then if (alpha.eq.czero) then
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1, n do j=1, n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = czero y(i,j) = czero
enddo enddo
@ -552,12 +751,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = - y(i,j) y(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = beta*y(i,j) y(i,j) = beta*y(i,j)
enddo enddo
@ -568,12 +769,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) y(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.cone) then else if (beta.eq.cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + y(i,j) y(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -581,12 +784,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) - y(i,j) y(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + beta*y(i,j) y(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -597,12 +802,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) y(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.cone) then else if (beta.eq.cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + y(i,j) y(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -610,12 +817,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) - y(i,j) y(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j) y(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -626,12 +835,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) y(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.cone) then else if (beta.eq.cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j) y(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -639,12 +850,14 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j) y(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j) y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo
@ -730,12 +943,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = - y(i,j) Z(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = beta*y(i,j) Z(i,j) = beta*y(i,j)
enddo enddo
@ -746,12 +961,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) Z(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.cone) then else if (beta.eq.cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + y(i,j) Z(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -759,12 +976,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) - y(i,j) Z(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + beta*y(i,j) Z(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -775,12 +994,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) Z(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.cone) then else if (beta.eq.cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + y(i,j) Z(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -788,12 +1009,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) - y(i,j) Z(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + beta*y(i,j) Z(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -804,12 +1027,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.czero) then if (beta.eq.czero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) Z(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.cone) then else if (beta.eq.cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + y(i,j) Z(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -817,12 +1042,14 @@ subroutine caxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-cone) then else if (beta.eq.-cone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) - y(i,j) Z(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + beta*y(i,j) Z(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo

187
base/serial/psi_d_serial_impl.F90
Unescape Escape View File

@ -40,7 +40,7 @@ subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
real(psb_dpk_), intent (in) :: alpha, beta real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -78,8 +78,7 @@ subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if (m>0) call daxpby(m,ione,alpha,x,lx,beta,y,ly,info) if ((m>0).and.(n>0)) call daxpby(m,n,alpha,x,lx,beta,y,ly,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -100,8 +99,9 @@ subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
real(psb_dpk_), intent (in) :: alpha, beta real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly, i integer(psb_ipk_) :: lx, ly
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: i
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
@ -132,63 +132,75 @@ subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
! if (m>0) call daxpby(m,ione,alpha,x,lx,beta,y,ly,info)
if (alpha.eq.@XZERO@) then if (alpha.eq.dzero) then
if (beta.eq.@XZERO@) then if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = @XZERO@ y(i) = dzero
enddo enddo
else if (beta.eq.@XONE@) then else if (beta.eq.done) then
! !
! Do nothing! ! Do nothing!
! !
else if (beta.eq.-@XONE@) then else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = - y(i) y(i) = - y(i)
enddo enddo
else else
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = beta*y(i) y(i) = beta*y(i)
enddo enddo
endif endif
else if (alpha.eq.@XONE@) then else if (alpha.eq.done) then
if (beta.eq.@XZERO@) then if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = x(i) y(i) = x(i)
enddo enddo
else if (beta.eq.@XONE@) then else if (beta.eq.done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = x(i) + y(i) y(i) = x(i) + y(i)
enddo enddo
else if (beta.eq.-@XONE@) then else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = x(i) - y(i) y(i) = x(i) - y(i)
enddo enddo
else else
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = x(i) + beta*y(i) y(i) = x(i) + beta*y(i)
enddo enddo
endif endif
else if (alpha.eq.-@XONE@) then else if (alpha.eq.-done) then
if (beta.eq.@XZERO@) then if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = -x(i) y(i) = -x(i)
enddo enddo
else if (beta.eq.@XONE@) then else if (beta.eq.done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = -x(i) + y(i) y(i) = -x(i) + y(i)
enddo enddo
else if (beta.eq.-@XONE@) then else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = -x(i) - y(i) y(i) = -x(i) - y(i)
enddo enddo
else else
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = -x(i) + beta*y(i) y(i) = -x(i) + beta*y(i)
enddo enddo
@ -196,19 +208,23 @@ subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
else else
if (beta.eq.@XZERO@) then if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i) y(i) = alpha*x(i)
enddo enddo
else if (beta.eq.@XONE@) then else if (beta.eq.done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i) + y(i) y(i) = alpha*x(i) + y(i)
enddo enddo
else if (beta.eq.-@XONE@) then else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i) = alpha*x(i) - y(i) y(i) = alpha*x(i) - y(i)
enddo enddo
else else
!$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)
enddo enddo
@ -238,7 +254,7 @@ subroutine psi_daxpbyv2(m,alpha, x, beta, y, z, info)
real(psb_dpk_), intent (in) :: alpha, beta real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly, lz integer(psb_ipk_) :: lx, ly, lz, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -277,7 +293,105 @@ subroutine psi_daxpbyv2(m,alpha, x, beta, y, z, info)
goto 9999 goto 9999
end if end if
if (m>0) call daxpbyv2(m,ione,alpha,x,lx,beta,y,ly,z,lz,info) if (alpha.eq.dzero) then
if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = dzero
enddo
else if (beta.eq.done) then
!
! Do nothing!
!
else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = beta*y(i)
enddo
endif
else if (alpha.eq.done) then
if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i)
enddo
else if (beta.eq.done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + y(i)
enddo
else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-done) then
if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i)
enddo
else if (beta.eq.done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + y(i)
enddo
else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.dzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i)
enddo
else if (beta.eq.done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-done) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -625,6 +739,7 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.dzero) then if (alpha.eq.dzero) then
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1, n do j=1, n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = dzero y(i,j) = dzero
enddo enddo
@ -636,12 +751,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = - y(i,j) y(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = beta*y(i,j) y(i,j) = beta*y(i,j)
enddo enddo
@ -652,12 +769,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) y(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.done) then else if (beta.eq.done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + y(i,j) y(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -665,12 +784,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) - y(i,j) y(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + beta*y(i,j) y(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -681,12 +802,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) y(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.done) then else if (beta.eq.done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + y(i,j) y(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -694,12 +817,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) - y(i,j) y(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j) y(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -710,12 +835,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) y(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.done) then else if (beta.eq.done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j) y(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -723,12 +850,14 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j) y(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j) y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo
@ -814,12 +943,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = - y(i,j) Z(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = beta*y(i,j) Z(i,j) = beta*y(i,j)
enddo enddo
@ -830,12 +961,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) Z(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.done) then else if (beta.eq.done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + y(i,j) Z(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -843,12 +976,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) - y(i,j) Z(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + beta*y(i,j) Z(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -859,12 +994,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) Z(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.done) then else if (beta.eq.done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + y(i,j) Z(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -872,12 +1009,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) - y(i,j) Z(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + beta*y(i,j) Z(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -888,12 +1027,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.dzero) then if (beta.eq.dzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) Z(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.done) then else if (beta.eq.done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + y(i,j) Z(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -901,12 +1042,14 @@ subroutine daxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-done) then else if (beta.eq.-done) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) - y(i,j) Z(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + beta*y(i,j) Z(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo

239
base/serial/psi_s_serial_impl.F90
Unescape Escape View File

@ -40,9 +40,9 @@ subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
real(psb_spk_), intent (in) :: alpha, beta real(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
info=psb_success_ info=psb_success_
@ -101,7 +101,8 @@ subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err integer(psb_ipk_) :: i
character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
info=psb_success_ info=psb_success_
@ -131,7 +132,106 @@ subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if (m>0) call saxpby(m,ione,alpha,x,lx,beta,y,ly,info) ! if (m>0) call saxpby(m,ione,alpha,x,lx,beta,y,ly,info)
if (alpha.eq.szero) then
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
y(i) = szero
enddo
else if (beta.eq.sone) then
!
! Do nothing!
!
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = beta*y(i)
enddo
endif
else if (alpha.eq.sone) then
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i)
enddo
else if (beta.eq.sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) + y(i)
enddo
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-sone) then
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i)
enddo
else if (beta.eq.sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) + y(i)
enddo
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i)
enddo
else if (beta.eq.sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -154,7 +254,7 @@ subroutine psi_saxpbyv2(m,alpha, x, beta, y, z, info)
real(psb_spk_), intent (in) :: alpha, beta real(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly, lz integer(psb_ipk_) :: lx, ly, lz, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -193,7 +293,105 @@ subroutine psi_saxpbyv2(m,alpha, x, beta, y, z, info)
goto 9999 goto 9999
end if end if
if (m>0) call saxpbyv2(m,ione,alpha,x,lx,beta,y,ly,z,lz,info) if (alpha.eq.szero) then
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = szero
enddo
else if (beta.eq.sone) then
!
! Do nothing!
!
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = beta*y(i)
enddo
endif
else if (alpha.eq.sone) then
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i)
enddo
else if (beta.eq.sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + y(i)
enddo
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-sone) then
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i)
enddo
else if (beta.eq.sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + y(i)
enddo
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.szero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i)
enddo
else if (beta.eq.sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-sone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -541,6 +739,7 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.szero) then if (alpha.eq.szero) then
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1, n do j=1, n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = szero y(i,j) = szero
enddo enddo
@ -552,12 +751,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = - y(i,j) y(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = beta*y(i,j) y(i,j) = beta*y(i,j)
enddo enddo
@ -568,12 +769,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) y(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.sone) then else if (beta.eq.sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + y(i,j) y(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -581,12 +784,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) - y(i,j) y(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + beta*y(i,j) y(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -597,12 +802,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) y(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.sone) then else if (beta.eq.sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + y(i,j) y(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -610,12 +817,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) - y(i,j) y(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j) y(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -626,12 +835,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) y(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.sone) then else if (beta.eq.sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j) y(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -639,12 +850,14 @@ subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j) y(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j) y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo
@ -730,12 +943,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = - y(i,j) Z(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = beta*y(i,j) Z(i,j) = beta*y(i,j)
enddo enddo
@ -746,12 +961,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) Z(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.sone) then else if (beta.eq.sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + y(i,j) Z(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -759,12 +976,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) - y(i,j) Z(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + beta*y(i,j) Z(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -775,12 +994,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) Z(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.sone) then else if (beta.eq.sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + y(i,j) Z(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -788,12 +1009,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) - y(i,j) Z(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + beta*y(i,j) Z(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -804,12 +1027,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.szero) then if (beta.eq.szero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) Z(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.sone) then else if (beta.eq.sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + y(i,j) Z(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -817,12 +1042,14 @@ subroutine saxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-sone) then else if (beta.eq.-sone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) - y(i,j) Z(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + beta*y(i,j) Z(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo

239
base/serial/psi_z_serial_impl.F90
Unescape Escape View File

@ -40,9 +40,9 @@ subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
complex(psb_dpk_), intent (in) :: alpha, beta complex(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
info=psb_success_ info=psb_success_
@ -101,7 +101,8 @@ subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err integer(psb_ipk_) :: i
character(len=20) :: name, ch_err
name='psb_geaxpby' name='psb_geaxpby'
info=psb_success_ info=psb_success_
@ -131,7 +132,106 @@ subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if (m>0) call zaxpby(m,ione,alpha,x,lx,beta,y,ly,info) ! if (m>0) call zaxpby(m,ione,alpha,x,lx,beta,y,ly,info)
if (alpha.eq.zzero) then
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
y(i) = zzero
enddo
else if (beta.eq.zone) then
!
! Do nothing!
!
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = beta*y(i)
enddo
endif
else if (alpha.eq.zone) then
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i)
enddo
else if (beta.eq.zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) + y(i)
enddo
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-zone) then
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i)
enddo
else if (beta.eq.zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) + y(i)
enddo
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i)
enddo
else if (beta.eq.zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
y(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -154,7 +254,7 @@ subroutine psi_zaxpbyv2(m,alpha, x, beta, y, z, info)
complex(psb_dpk_), intent (in) :: alpha, beta complex(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly, lz integer(psb_ipk_) :: lx, ly, lz, i
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -193,7 +293,105 @@ subroutine psi_zaxpbyv2(m,alpha, x, beta, y, z, info)
goto 9999 goto 9999
end if end if
if (m>0) call zaxpbyv2(m,ione,alpha,x,lx,beta,y,ly,z,lz,info) if (alpha.eq.zzero) then
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = zzero
enddo
else if (beta.eq.zone) then
!
! Do nothing!
!
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = beta*y(i)
enddo
endif
else if (alpha.eq.zone) then
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i)
enddo
else if (beta.eq.zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + y(i)
enddo
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = x(i) + beta*y(i)
enddo
endif
else if (alpha.eq.-zone) then
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i)
enddo
else if (beta.eq.zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + y(i)
enddo
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = -x(i) + beta*y(i)
enddo
endif
else
if (beta.eq.zzero) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i)
enddo
else if (beta.eq.zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + y(i)
enddo
else if (beta.eq.-zone) then
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) - y(i)
enddo
else
!$omp parallel do private(i)
do i=1,m
Z(i) = alpha*x(i) + beta*y(i)
enddo
endif
endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -541,6 +739,7 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (alpha.eq.zzero) then if (alpha.eq.zzero) then
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1, n do j=1, n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = zzero y(i,j) = zzero
enddo enddo
@ -552,12 +751,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = - y(i,j) y(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = beta*y(i,j) y(i,j) = beta*y(i,j)
enddo enddo
@ -568,12 +769,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) y(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.zone) then else if (beta.eq.zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + y(i,j) y(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -581,12 +784,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) - y(i,j) y(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = x(i,j) + beta*y(i,j) y(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -597,12 +802,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) y(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.zone) then else if (beta.eq.zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + y(i,j) y(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -610,12 +817,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) - y(i,j) y(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j) y(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -626,12 +835,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) y(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.zone) then else if (beta.eq.zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j) y(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -639,12 +850,14 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j) y(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j) y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo
@ -730,12 +943,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = - y(i,j) Z(i,j) = - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = beta*y(i,j) Z(i,j) = beta*y(i,j)
enddo enddo
@ -746,12 +961,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) Z(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.zone) then else if (beta.eq.zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + y(i,j) Z(i,j) = x(i,j) + y(i,j)
enddo enddo
@ -759,12 +976,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) - y(i,j) Z(i,j) = x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = x(i,j) + beta*y(i,j) Z(i,j) = x(i,j) + beta*y(i,j)
enddo enddo
@ -775,12 +994,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) Z(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.zone) then else if (beta.eq.zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + y(i,j) Z(i,j) = -x(i,j) + y(i,j)
enddo enddo
@ -788,12 +1009,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) - y(i,j) Z(i,j) = -x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = -x(i,j) + beta*y(i,j) Z(i,j) = -x(i,j) + beta*y(i,j)
enddo enddo
@ -804,12 +1027,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
if (beta.eq.zzero) then if (beta.eq.zzero) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) Z(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.zone) then else if (beta.eq.zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + y(i,j) Z(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
@ -817,12 +1042,14 @@ subroutine zaxpbyv2(m, n, alpha, X, lldx, beta, Y, lldy, Z, lldz, info)
else if (beta.eq.-zone) then else if (beta.eq.-zone) then
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) - y(i,j) Z(i,j) = alpha*x(i,j) - y(i,j)
enddo enddo
enddo enddo
else else
do j=1,n do j=1,n
!$omp parallel do private(i)
do i=1,m do i=1,m
Z(i,j) = alpha*x(i,j) + beta*y(i,j) Z(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo enddo

Write Preview
Loading…
Cancel
Save