From 1c19da7b77bc359dc14f8b59ddc9e5f821e3d16c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 12 Mar 2018 18:33:52 +0000 Subject: [PATCH] Fixed psi_X_serial_impl. --- base/serial/Makefile | 2 +- base/serial/psi_c_serial_impl.f90 | 41 +- base/serial/psi_d_serial_impl.f90 | 7 +- base/serial/psi_i_serial_impl.f90 | 9 +- base/serial/psi_l_serial_impl.f90 | 597 ++++++++++++++++++++++++++++++ base/serial/psi_s_serial_impl.f90 | 5 +- base/serial/psi_z_serial_impl.f90 | 35 +- 7 files changed, 648 insertions(+), 48 deletions(-) create mode 100644 base/serial/psi_l_serial_impl.f90 diff --git a/base/serial/Makefile b/base/serial/Makefile index 7322ef2f..5ee1b946 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -1,7 +1,7 @@ include ../../Make.inc -FOBJS = psb_lsame.o psi_i_serial_impl.o \ +FOBJS = psb_lsame.o psi_i_serial_impl.o psi_l_serial_impl.o \ psi_s_serial_impl.o psi_d_serial_impl.o \ psi_c_serial_impl.o psi_z_serial_impl.o \ psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o \ diff --git a/base/serial/psi_c_serial_impl.f90 b/base/serial/psi_c_serial_impl.f90 index 0324ed36..4794c38e 100644 --- a/base/serial/psi_c_serial_impl.f90 +++ b/base/serial/psi_c_serial_impl.f90 @@ -425,12 +425,11 @@ subroutine psi_csctv(n,idx,x,beta,y) end do end if end subroutine psi_csctv + subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) use psb_const_mod use psb_error_mod implicit none - complex(psb_spk_), parameter :: one=(1.0,0.0) - complex(psb_spk_), parameter :: zero=(0.0,0.0) integer(psb_ipk_) :: n, m, lldx, lldy, info complex(psb_spk_) X(lldx,*), Y(lldy,*) complex(psb_spk_) alpha, beta @@ -474,19 +473,19 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) goto 9999 endif - if (alpha.eq.zero) then - if (beta.eq.zero) then + if (alpha.eq.czero) then + if (beta.eq.czero) then do j=1, n do i=1,m - y(i,j) = zero + y(i,j) = czero enddo enddo - else if (beta.eq.one) then - !$$$ - !$$$ Do nothing! - !$$$ + else if (beta.eq.cone) then + ! + ! Do nothing! + ! - else if (beta.eq.-one) then + else if (beta.eq.-cone) then do j=1,n do i=1,m y(i,j) = - y(i,j) @@ -500,22 +499,22 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) enddo endif - else if (alpha.eq.one) then + else if (alpha.eq.cone) then - if (beta.eq.zero) then + if (beta.eq.czero) then do j=1,n do i=1,m y(i,j) = x(i,j) enddo enddo - else if (beta.eq.one) then + else if (beta.eq.cone) then do j=1,n do i=1,m y(i,j) = x(i,j) + y(i,j) enddo enddo - else if (beta.eq.-one) then + else if (beta.eq.-cone) then do j=1,n do i=1,m y(i,j) = x(i,j) - y(i,j) @@ -529,22 +528,22 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) enddo endif - else if (alpha.eq.-one) then + else if (alpha.eq.-cone) then - if (beta.eq.zero) then + if (beta.eq.czero) then do j=1,n do i=1,m y(i,j) = -x(i,j) enddo enddo - else if (beta.eq.one) then + else if (beta.eq.cone) then do j=1,n do i=1,m y(i,j) = -x(i,j) + y(i,j) enddo enddo - else if (beta.eq.-one) then + else if (beta.eq.-cone) then do j=1,n do i=1,m y(i,j) = -x(i,j) - y(i,j) @@ -560,20 +559,20 @@ subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) else - if (beta.eq.zero) then + if (beta.eq.czero) then do j=1,n do i=1,m y(i,j) = alpha*x(i,j) enddo enddo - else if (beta.eq.one) then + else if (beta.eq.cone) then do j=1,n do i=1,m y(i,j) = alpha*x(i,j) + y(i,j) enddo enddo - else if (beta.eq.-one) then + else if (beta.eq.-cone) then do j=1,n do i=1,m y(i,j) = alpha*x(i,j) - y(i,j) diff --git a/base/serial/psi_d_serial_impl.f90 b/base/serial/psi_d_serial_impl.f90 index 2764e970..71f62cd5 100644 --- a/base/serial/psi_d_serial_impl.f90 +++ b/base/serial/psi_d_serial_impl.f90 @@ -425,6 +425,7 @@ subroutine psi_dsctv(n,idx,x,beta,y) end do end if end subroutine psi_dsctv + subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) use psb_const_mod use psb_error_mod @@ -480,9 +481,9 @@ subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) enddo enddo else if (beta.eq.done) then - ! - ! Do nothing! - ! + ! + ! Do nothing! + ! else if (beta.eq.-done) then do j=1,n diff --git a/base/serial/psi_i_serial_impl.f90 b/base/serial/psi_i_serial_impl.f90 index 9cb757e6..90d2cdea 100644 --- a/base/serial/psi_i_serial_impl.f90 +++ b/base/serial/psi_i_serial_impl.f90 @@ -425,11 +425,12 @@ subroutine psi_isctv(n,idx,x,beta,y) end do end if end subroutine psi_isctv + subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) use psb_const_mod use psb_error_mod implicit none - integer n, m, lldx, lldy, info + integer(psb_ipk_) :: n, m, lldx, lldy, info integer(psb_ipk_) X(lldx,*), Y(lldy,*) integer(psb_ipk_) alpha, beta integer(psb_ipk_) :: i, j @@ -480,9 +481,9 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) enddo enddo else if (beta.eq.ione) then - ! - ! Do nothing! - ! + ! + ! Do nothing! + ! else if (beta.eq.-ione) then do j=1,n diff --git a/base/serial/psi_l_serial_impl.f90 b/base/serial/psi_l_serial_impl.f90 new file mode 100644 index 00000000..12462fd7 --- /dev/null +++ b/base/serial/psi_l_serial_impl.f90 @@ -0,0 +1,597 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine psi_laxpby(m,n,alpha, x, beta, y, info) + + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: m, n + integer(psb_lpk_), intent (in) :: x(:,:) + integer(psb_lpk_), intent (inout) :: y(:,:) + integer(psb_lpk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psb_geaxpby' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + if (m < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (n < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 2; ierr(2) = n + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 4; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 6; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + + if ((m>0).and.(n>0)) call laxpby(m,n,alpha,x,lx,beta,y,ly,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psi_laxpby + +subroutine psi_laxpbyv(m,alpha, x, beta, y, info) + + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: m + integer(psb_lpk_), intent (in) :: x(:) + integer(psb_lpk_), intent (inout) :: y(:) + integer(psb_lpk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name, ch_err + + name='psb_geaxpby' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + if (m < 0) then + info = psb_err_iarg_neg_ + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) + goto 9999 + end if + + if (m>0) call laxpby(m,ione,alpha,x,lx,beta,y,ly,info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psi_laxpbyv + + +subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_lpk_) :: x(:,:), y(:),alpha,beta + + ! Locals + integer(psb_ipk_) :: i, j, pt + + if (beta == lzero) then + if (alpha == lzero) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = lzero + end do + end do + else if (alpha == lone) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = x(idx(i),j) + end do + end do + else if (alpha == -lone) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = -x(idx(i),j) + end do + end do + else + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = alpha*x(idx(i),j) + end do + end do + end if + else + if (beta == lone) then + ! Do nothing + else if (beta == -lone) then + y(1:n*k) = -y(1:n*k) + else + y(1:n*k) = beta*y(1:n*k) + end if + + if (alpha == lzero) then + ! do nothing + else if (alpha == lone) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = y(pt) + x(idx(i),j) + end do + end do + else if (alpha == -lone) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = y(pt) - x(idx(i),j) + end do + end do + else + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt) = y(pt) + alpha*x(idx(i),j) + end do + end do + end if + end if + +end subroutine psi_lgthmv + +subroutine psi_lgthv(n,idx,alpha,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_lpk_) :: x(:), y(:),alpha,beta + + ! Locals + integer(psb_ipk_) :: i + if (beta == lzero) then + if (alpha == lzero) then + do i=1,n + y(i) = lzero + end do + else if (alpha == lone) then + do i=1,n + y(i) = x(idx(i)) + end do + else if (alpha == -lone) then + do i=1,n + y(i) = -x(idx(i)) + end do + else + do i=1,n + y(i) = alpha*x(idx(i)) + end do + end if + else + if (beta == lone) then + ! Do nothing + else if (beta == -lone) then + y(1:n) = -y(1:n) + else + y(1:n) = beta*y(1:n) + end if + + if (alpha == lzero) then + ! do nothing + else if (alpha == lone) then + do i=1,n + y(i) = y(i) + x(idx(i)) + end do + else if (alpha == -lone) then + do i=1,n + y(i) = y(i) - x(idx(i)) + end do + else + do i=1,n + y(i) = y(i) + alpha*x(idx(i)) + end do + end if + end if + +end subroutine psi_lgthv + +subroutine psi_lgthzmm(n,k,idx,x,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_lpk_) :: x(:,:), y(:,:) + + ! Locals + integer(psb_ipk_) :: i + + + do i=1,n + y(i,1:k)=x(idx(i),1:k) + end do + +end subroutine psi_lgthzmm + +subroutine psi_lgthzmv(n,k,idx,x,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_lpk_) :: x(:,:), y(:) + + ! Locals + integer(psb_ipk_) :: i, j, pt + + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(pt)=x(idx(i),j) + end do + end do + +end subroutine psi_lgthzmv + +subroutine psi_lgthzv(n,idx,x,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_lpk_) :: x(:), y(:) + + ! Locals + integer(psb_ipk_) :: i + + do i=1,n + y(i)=x(idx(i)) + end do + +end subroutine psi_lgthzv + +subroutine psi_lsctmm(n,k,idx,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_lpk_) :: beta, x(:,:), y(:,:) + + ! Locals + integer(psb_ipk_) :: i, j + + if (beta == lzero) then + do i=1,n + y(idx(i),1:k) = x(i,1:k) + end do + else if (beta == lone) then + do i=1,n + y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k) + end do + else + do i=1,n + y(idx(i),1:k) = beta*y(idx(i),1:k)+x(i,1:k) + end do + end if +end subroutine psi_lsctmm + +subroutine psi_lsctmv(n,k,idx,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, k, idx(:) + integer(psb_lpk_) :: beta, x(:), y(:,:) + + ! Locals + integer(psb_ipk_) :: i, j, pt + + if (beta == lzero) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(idx(i),j) = x(pt) + end do + end do + else if (beta == lone) then + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(idx(i),j) = y(idx(i),j)+x(pt) + end do + end do + else + pt=0 + do j=1,k + do i=1,n + pt=pt+1 + y(idx(i),j) = beta*y(idx(i),j)+x(pt) + end do + end do + end if +end subroutine psi_lsctmv + +subroutine psi_lsctv(n,idx,x,beta,y) + + use psb_const_mod + implicit none + + integer(psb_ipk_) :: n, idx(:) + integer(psb_lpk_) :: beta, x(:), y(:) + + ! Locals + integer(psb_ipk_) :: i + + if (beta == lzero) then + do i=1,n + y(idx(i)) = x(i) + end do + else if (beta == lone) then + do i=1,n + y(idx(i)) = y(idx(i))+x(i) + end do + else + do i=1,n + y(idx(i)) = beta*y(idx(i))+x(i) + end do + end if +end subroutine psi_lsctv + +subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) + use psb_const_mod + use psb_error_mod + implicit none + integer(psb_ipk_) :: n, m, lldx, lldy, info + integer(psb_lpk_) X(lldx,*), Y(lldy,*) + integer(psb_lpk_) alpha, beta + integer(psb_ipk_) :: i, j + integer(psb_ipk_) :: int_err(5) + character name*20 + name='laxpby' + + + ! + ! Error handling + ! + info = psb_success_ + if (m.lt.0) then + info=psb_err_iarg_neg_ + int_err(1)=1 + int_err(2)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (n.lt.0) then + info=psb_err_iarg_neg_ + int_err(1)=1 + int_err(2)=n + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldx.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=5 + int_err(2)=1 + int_err(3)=lldx + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + else if (lldy.lt.max(1,m)) then + info=psb_err_iarg_not_gtia_ii_ + int_err(1)=8 + int_err(2)=1 + int_err(3)=lldy + int_err(4)=m + call fcpsb_errpush(info,name,int_err) + goto 9999 + endif + + if (alpha.eq.lzero) then + if (beta.eq.lzero) then + do j=1, n + do i=1,m + y(i,j) = lzero + enddo + enddo + else if (beta.eq.lone) then + ! + ! Do nothing! + ! + + else if (beta.eq.-lone) then + do j=1,n + do i=1,m + y(i,j) = - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = beta*y(i,j) + enddo + enddo + endif + + else if (alpha.eq.lone) then + + if (beta.eq.lzero) then + do j=1,n + do i=1,m + y(i,j) = x(i,j) + enddo + enddo + else if (beta.eq.lone) then + do j=1,n + do i=1,m + y(i,j) = x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-lone) then + do j=1,n + do i=1,m + y(i,j) = x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = x(i,j) + beta*y(i,j) + enddo + enddo + endif + + else if (alpha.eq.-lone) then + + if (beta.eq.lzero) then + do j=1,n + do i=1,m + y(i,j) = -x(i,j) + enddo + enddo + else if (beta.eq.lone) then + do j=1,n + do i=1,m + y(i,j) = -x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-lone) then + do j=1,n + do i=1,m + y(i,j) = -x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = -x(i,j) + beta*y(i,j) + enddo + enddo + endif + + else + + if (beta.eq.lzero) then + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) + enddo + enddo + else if (beta.eq.lone) then + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) + y(i,j) + enddo + enddo + + else if (beta.eq.-lone) then + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) - y(i,j) + enddo + enddo + else + do j=1,n + do i=1,m + y(i,j) = alpha*x(i,j) + beta*y(i,j) + enddo + enddo + endif + + endif + + return + +9999 continue + call fcpsb_serror() + return + +end subroutine laxpby diff --git a/base/serial/psi_s_serial_impl.f90 b/base/serial/psi_s_serial_impl.f90 index a94675f9..cba56128 100644 --- a/base/serial/psi_s_serial_impl.f90 +++ b/base/serial/psi_s_serial_impl.f90 @@ -425,9 +425,12 @@ subroutine psi_ssctv(n,idx,x,beta,y) end do end if end subroutine psi_ssctv + subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) use psb_const_mod - integer n, m, lldx, lldy, info + use psb_error_mod + implicit none + integer(psb_ipk_) :: n, m, lldx, lldy, info real(psb_spk_) X(lldx,*), Y(lldy,*) real(psb_spk_) alpha, beta integer(psb_ipk_) :: i, j diff --git a/base/serial/psi_z_serial_impl.f90 b/base/serial/psi_z_serial_impl.f90 index ae6989ed..9444f6c5 100644 --- a/base/serial/psi_z_serial_impl.f90 +++ b/base/serial/psi_z_serial_impl.f90 @@ -425,12 +425,11 @@ subroutine psi_zsctv(n,idx,x,beta,y) end do end if end subroutine psi_zsctv + subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) use psb_const_mod use psb_error_mod implicit none - complex(psb_dpk_), parameter :: one=(1.0d0,0.0d0) - complex(psb_dpk_), parameter :: zero=(0.0d0,0.0d0) integer(psb_ipk_) :: n, m, lldx, lldy, info complex(psb_dpk_) X(lldx,*), Y(lldy,*) complex(psb_dpk_) alpha, beta @@ -474,19 +473,19 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) goto 9999 endif - if (alpha.eq.zero) then - if (beta.eq.zero) then + if (alpha.eq.zzero) then + if (beta.eq.zzero) then do j=1, n do i=1,m - y(i,j) = zero + y(i,j) = zzero enddo enddo - else if (beta.eq.one) then + else if (beta.eq.zone) then ! ! Do nothing! ! - else if (beta.eq.-one) then + else if (beta.eq.-zone) then do j=1,n do i=1,m y(i,j) = - y(i,j) @@ -500,22 +499,22 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) enddo endif - else if (alpha.eq.one) then + else if (alpha.eq.zone) then - if (beta.eq.zero) then + if (beta.eq.zzero) then do j=1,n do i=1,m y(i,j) = x(i,j) enddo enddo - else if (beta.eq.one) then + else if (beta.eq.zone) then do j=1,n do i=1,m y(i,j) = x(i,j) + y(i,j) enddo enddo - else if (beta.eq.-one) then + else if (beta.eq.-zone) then do j=1,n do i=1,m y(i,j) = x(i,j) - y(i,j) @@ -529,22 +528,22 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) enddo endif - else if (alpha.eq.-one) then + else if (alpha.eq.-zone) then - if (beta.eq.zero) then + if (beta.eq.zzero) then do j=1,n do i=1,m y(i,j) = -x(i,j) enddo enddo - else if (beta.eq.one) then + else if (beta.eq.zone) then do j=1,n do i=1,m y(i,j) = -x(i,j) + y(i,j) enddo enddo - else if (beta.eq.-one) then + else if (beta.eq.-zone) then do j=1,n do i=1,m y(i,j) = -x(i,j) - y(i,j) @@ -560,20 +559,20 @@ subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) else - if (beta.eq.zero) then + if (beta.eq.zzero) then do j=1,n do i=1,m y(i,j) = alpha*x(i,j) enddo enddo - else if (beta.eq.one) then + else if (beta.eq.zone) then do j=1,n do i=1,m y(i,j) = alpha*x(i,j) + y(i,j) enddo enddo - else if (beta.eq.-one) then + else if (beta.eq.-zone) then do j=1,n do i=1,m y(i,j) = alpha*x(i,j) - y(i,j)