diff --git a/base/modules/serial/psb_serial_mod.f90 b/base/modules/serial/psb_serial_mod.f90 index 7cfd85e9..e46ee807 100644 --- a/base/modules/serial/psb_serial_mod.f90 +++ b/base/modules/serial/psb_serial_mod.f90 @@ -68,6 +68,16 @@ module psb_serial_mod end subroutine psb_d_nspaxpby end interface psb_nspaxpby + interface symbmm + subroutine symbmm (n, m, l, ia, ja, diaga, & + & ib, jb, diagb, ic, jc, diagc, index) + import :: psb_ipk_ + integer(psb_ipk_) :: n,m,l, ia(*), ja(*), diaga, ib(*), jb(*), diagb,& + & diagc, index(*) + integer(psb_ipk_), allocatable :: ic(:),jc(:) + end subroutine symbmm + end interface + contains diff --git a/base/serial/psb_csymbmm.f90 b/base/serial/psb_csymbmm.f90 index fa26c2d2..3343c61d 100644 --- a/base/serial/psb_csymbmm.f90 +++ b/base/serial/psb_csymbmm.f90 @@ -153,15 +153,6 @@ contains type(psb_c_csr_sparse_mat), intent(out) :: c integer(psb_ipk_) :: itemp(:) integer(psb_ipk_), intent(out) :: info - interface - subroutine symbmm (n, m, l, ia, ja, diaga, & - & ib, jb, diagb, ic, jc, diagc, index) - import :: psb_ipk_ - integer(psb_ipk_) :: n,m,l, ia(*), ja(*), diaga, ib(*), jb(*), diagb,& - & diagc, index(*) - integer(psb_ipk_), allocatable :: ic(:),jc(:) - end subroutine symbmm - end interface integer(psb_ipk_) :: nze, ma,na,mb,nb info = psb_success_ diff --git a/base/serial/psb_dsymbmm.f90 b/base/serial/psb_dsymbmm.f90 index 4bad9cc9..848a5cfd 100644 --- a/base/serial/psb_dsymbmm.f90 +++ b/base/serial/psb_dsymbmm.f90 @@ -153,15 +153,6 @@ contains type(psb_d_csr_sparse_mat), intent(out) :: c integer(psb_ipk_) :: itemp(:) integer(psb_ipk_), intent(out) :: info - interface - subroutine symbmm (n, m, l, ia, ja, diaga, & - & ib, jb, diagb, ic, jc, diagc, index) - import :: psb_ipk_ - integer(psb_ipk_) :: n,m,l, ia(*), ja(*), diaga, ib(*), jb(*), diagb,& - & diagc, index(*) - integer(psb_ipk_), allocatable :: ic(:),jc(:) - end subroutine symbmm - end interface integer(psb_ipk_) :: nze, ma,na,mb,nb info = psb_success_ diff --git a/base/serial/psb_ssymbmm.f90 b/base/serial/psb_ssymbmm.f90 index 44d406c8..e9d10c0b 100644 --- a/base/serial/psb_ssymbmm.f90 +++ b/base/serial/psb_ssymbmm.f90 @@ -153,15 +153,6 @@ contains type(psb_s_csr_sparse_mat), intent(out) :: c integer(psb_ipk_) :: itemp(:) integer(psb_ipk_), intent(out) :: info - interface - subroutine symbmm (n, m, l, ia, ja, diaga, & - & ib, jb, diagb, ic, jc, diagc, index) - import :: psb_ipk_ - integer(psb_ipk_) :: n,m,l, ia(*), ja(*), diaga, ib(*), jb(*), diagb,& - & diagc, index(*) - integer(psb_ipk_), allocatable :: ic(:),jc(:) - end subroutine symbmm - end interface integer(psb_ipk_) :: nze, ma,na,mb,nb info = psb_success_ diff --git a/base/serial/psb_zsymbmm.f90 b/base/serial/psb_zsymbmm.f90 index 2f721ae9..67094aaf 100644 --- a/base/serial/psb_zsymbmm.f90 +++ b/base/serial/psb_zsymbmm.f90 @@ -153,15 +153,6 @@ contains type(psb_z_csr_sparse_mat), intent(out) :: c integer(psb_ipk_) :: itemp(:) integer(psb_ipk_), intent(out) :: info - interface - subroutine symbmm (n, m, l, ia, ja, diaga, & - & ib, jb, diagb, ic, jc, diagc, index) - import :: psb_ipk_ - integer(psb_ipk_) :: n,m,l, ia(*), ja(*), diaga, ib(*), jb(*), diagb,& - & diagc, index(*) - integer(psb_ipk_), allocatable :: ic(:),jc(:) - end subroutine symbmm - end interface integer(psb_ipk_) :: nze, ma,na,mb,nb info = psb_success_ diff --git a/base/serial/psi_c_serial_impl.f90 b/base/serial/psi_c_serial_impl.f90 index 0324ed36..6faa5248 100644 --- a/base/serial/psi_c_serial_impl.f90 +++ b/base/serial/psi_c_serial_impl.f90 @@ -1,34 +1,3 @@ -! -! 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_caxpby(m,n,alpha, x, beta, y, info) use psb_const_mod @@ -425,174 +394,3 @@ 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 - integer(psb_ipk_) :: i, j - integer(psb_ipk_) :: int_err(5) - character name*20 - name='caxpby' - - - ! - ! 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.zero) then - if (beta.eq.zero) then - do j=1, n - do i=1,m - y(i,j) = zero - enddo - enddo - else if (beta.eq.one) then - !$$$ - !$$$ Do nothing! - !$$$ - - else if (beta.eq.-one) 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.one) then - - if (beta.eq.zero) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) - enddo - enddo - else if (beta.eq.one) 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 - 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.-one) then - - if (beta.eq.zero) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) - enddo - enddo - else if (beta.eq.one) 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 - 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.zero) then - do j=1,n - do i=1,m - y(i,j) = alpha*x(i,j) - enddo - enddo - else if (beta.eq.one) 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 - 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 caxpby diff --git a/base/serial/psi_d_serial_impl.f90 b/base/serial/psi_d_serial_impl.f90 index 2764e970..87de71d4 100644 --- a/base/serial/psi_d_serial_impl.f90 +++ b/base/serial/psi_d_serial_impl.f90 @@ -1,34 +1,3 @@ -! -! 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_daxpby(m,n,alpha, x, beta, y, info) use psb_const_mod @@ -425,172 +394,3 @@ 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 - implicit none - integer(psb_ipk_) :: n, m, lldx, lldy, info - real(psb_dpk_) X(lldx,*), Y(lldy,*) - real(psb_dpk_) alpha, beta - integer(psb_ipk_) :: i, j - integer(psb_ipk_) :: int_err(5) - character name*20 - name='daxpby' - - - ! - ! 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.dzero) then - if (beta.eq.dzero) then - do j=1, n - do i=1,m - y(i,j) = dzero - enddo - enddo - else if (beta.eq.done) then - ! - ! Do nothing! - ! - - else if (beta.eq.-done) 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.done) then - - if (beta.eq.dzero) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) - enddo - enddo - else if (beta.eq.done) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) + y(i,j) - enddo - enddo - - else if (beta.eq.-done) 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.-done) then - - if (beta.eq.dzero) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) - enddo - enddo - else if (beta.eq.done) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) + y(i,j) - enddo - enddo - - else if (beta.eq.-done) 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.dzero) then - do j=1,n - do i=1,m - y(i,j) = alpha*x(i,j) - enddo - enddo - else if (beta.eq.done) 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.-done) 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 daxpby diff --git a/base/serial/psi_i_serial_impl.f90 b/base/serial/psi_i_serial_impl.f90 index 9cb757e6..c5113eef 100644 --- a/base/serial/psi_i_serial_impl.f90 +++ b/base/serial/psi_i_serial_impl.f90 @@ -1,34 +1,3 @@ -! -! 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_iaxpby(m,n,alpha, x, beta, y, info) use psb_const_mod @@ -425,172 +394,3 @@ 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_) X(lldx,*), Y(lldy,*) - integer(psb_ipk_) alpha, beta - integer(psb_ipk_) :: i, j - integer(psb_ipk_) :: int_err(5) - character name*20 - name='iaxpby' - - - ! - ! 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.izero) then - if (beta.eq.izero) then - do j=1, n - do i=1,m - y(i,j) = izero - enddo - enddo - else if (beta.eq.ione) then - ! - ! Do nothing! - ! - - else if (beta.eq.-ione) 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.ione) then - - if (beta.eq.izero) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) - enddo - enddo - else if (beta.eq.ione) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) + y(i,j) - enddo - enddo - - else if (beta.eq.-ione) 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.-ione) then - - if (beta.eq.izero) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) - enddo - enddo - else if (beta.eq.ione) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) + y(i,j) - enddo - enddo - - else if (beta.eq.-ione) 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.izero) then - do j=1,n - do i=1,m - y(i,j) = alpha*x(i,j) - enddo - enddo - else if (beta.eq.ione) 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.-ione) 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 iaxpby diff --git a/base/serial/psi_s_serial_impl.f90 b/base/serial/psi_s_serial_impl.f90 index a94675f9..1687405b 100644 --- a/base/serial/psi_s_serial_impl.f90 +++ b/base/serial/psi_s_serial_impl.f90 @@ -1,34 +1,3 @@ -! -! 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_saxpby(m,n,alpha, x, beta, y, info) use psb_const_mod @@ -425,170 +394,3 @@ 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 - real(psb_spk_) X(lldx,*), Y(lldy,*) - real(psb_spk_) alpha, beta - integer(psb_ipk_) :: i, j - integer(psb_ipk_) :: int_err(5) - character name*20 - name='saxpby' - - - ! - ! 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.szero) then - if (beta.eq.szero) then - do j=1, n - do i=1,m - y(i,j) = szero - enddo - enddo - else if (beta.eq.sone) then - ! - ! Do nothing! - ! - - else if (beta.eq.-sone) 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.sone) then - - if (beta.eq.szero) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) - enddo - enddo - else if (beta.eq.sone) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) + y(i,j) - enddo - enddo - - else if (beta.eq.-sone) 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.-sone) then - - if (beta.eq.szero) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) - enddo - enddo - else if (beta.eq.sone) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) + y(i,j) - enddo - enddo - - else if (beta.eq.-sone) 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.szero) then - do j=1,n - do i=1,m - y(i,j) = alpha*x(i,j) - enddo - enddo - else if (beta.eq.sone) 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.-sone) 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 saxpby diff --git a/base/serial/psi_z_serial_impl.f90 b/base/serial/psi_z_serial_impl.f90 index ae6989ed..791b4f05 100644 --- a/base/serial/psi_z_serial_impl.f90 +++ b/base/serial/psi_z_serial_impl.f90 @@ -1,34 +1,3 @@ -! -! 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_zaxpby(m,n,alpha, x, beta, y, info) use psb_const_mod @@ -425,174 +394,3 @@ 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 - integer(psb_ipk_) :: i, j - integer(psb_ipk_) :: int_err(5) - character name*20 - name='zaxpby' - - - ! - ! 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.zero) then - if (beta.eq.zero) then - do j=1, n - do i=1,m - y(i,j) = zero - enddo - enddo - else if (beta.eq.one) then - ! - ! Do nothing! - ! - - else if (beta.eq.-one) 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.one) then - - if (beta.eq.zero) then - do j=1,n - do i=1,m - y(i,j) = x(i,j) - enddo - enddo - else if (beta.eq.one) 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 - 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.-one) then - - if (beta.eq.zero) then - do j=1,n - do i=1,m - y(i,j) = -x(i,j) - enddo - enddo - else if (beta.eq.one) 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 - 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.zero) then - do j=1,n - do i=1,m - y(i,j) = alpha*x(i,j) - enddo - enddo - else if (beta.eq.one) 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 - 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 zaxpby diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index 927553e3..79077feb 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -267,7 +267,9 @@ program psb_cf_sample write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A : ",a)')& + write(psb_out_unit,'("Storage format for A : ",a)')& + & a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A : ",a)')& & desc_a%get_fmt() end if diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index 6414b904..59356726 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -269,7 +269,9 @@ program psb_df_sample write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A : ",a)')& + write(psb_out_unit,'("Storage format for A : ",a)')& + & a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A : ",a)')& & desc_a%get_fmt() end if diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index 66746daa..fb8d5982 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -269,7 +269,9 @@ program psb_sf_sample write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A : ",a)')& + write(psb_out_unit,'("Storage format for A : ",a)')& + & a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A : ",a)')& & desc_a%get_fmt() end if diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index 39c11a1e..fef3be2f 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -267,7 +267,9 @@ program psb_zf_sample write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A : ",a)')& + write(psb_out_unit,'("Storage format for A : ",a)')& + & a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A : ",a)')& & desc_a%get_fmt() end if diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index a1d82c2b..4a080ed0 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -604,10 +604,11 @@ program psb_d_pde2d write(psb_out_unit,'("Number of iterations : ",i0)')iter write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)')err write(psb_out_unit,'("Info on exit : ",i0)')info - write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize - write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize + write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize + write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() + write(psb_out_unit,'("Storage format for A: ",a)') a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index 9104277d..84641c04 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -632,10 +632,11 @@ program psb_d_pde3d write(psb_out_unit,'("Number of iterations : ",i0)')iter write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)')err write(psb_out_unit,'("Info on exit : ",i0)')info - write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize - write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize + write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize + write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() + write(psb_out_unit,'("Storage format for A: ",a)') a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index 76128d7c..d06bba5e 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -604,10 +604,11 @@ program psb_s_pde2d write(psb_out_unit,'("Number of iterations : ",i0)')iter write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)')err write(psb_out_unit,'("Info on exit : ",i0)')info - write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize - write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize + write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize + write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() + write(psb_out_unit,'("Storage format for A: ",a)') a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index 56ca4b01..c8ed829b 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -632,10 +632,11 @@ program psb_s_pde3d write(psb_out_unit,'("Number of iterations : ",i0)')iter write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)')err write(psb_out_unit,'("Info on exit : ",i0)')info - write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize - write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize + write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize + write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() + write(psb_out_unit,'("Storage format for A: ",a)') a%get_fmt() + write(psb_out_unit,'("Storage format for DESC_A: ",a)') desc_a%get_fmt() end if