fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 04:12:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

Lifted interface to symbmm into psb_serial_mod.

Browse Source 
Updated printouts in test programs.
This commit is contained in:
Salvatore Filippone
2018-04-06 16:19:52 +01:00
parent e37b43d45a
commit 95009f7ad5
18 changed files with 38 additions and 1054 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/serial/psb_serial_mod.f90
+10
View File
@@ -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
base/serial/psb_csymbmm.f90
-9
View File
@@ -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_
base/serial/psb_dsymbmm.f90
-9
View File
@@ -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_
base/serial/psb_ssymbmm.f90
-9
View File
@@ -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_
base/serial/psb_zsymbmm.f90
-9
View File
@@ -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_
base/serial/psi_c_serial_impl.f90
-202
View File
@@ -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
base/serial/psi_d_serial_impl.f90
-200
View File
@@ -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
base/serial/psi_i_serial_impl.f90
-200
View File
@@ -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
base/serial/psi_s_serial_impl.f90
-198
View File
@@ -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
base/serial/psi_z_serial_impl.f90
-202
View File
@@ -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
test/fileread/psb_cf_sample.f90
+3 -1
View File
@@ -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
test/fileread/psb_df_sample.f90
+3 -1
View File
@@ -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
test/fileread/psb_sf_sample.f90
+3 -1
View File
@@ -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
test/fileread/psb_zf_sample.f90
+3 -1
View File
@@ -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
test/pargen/psb_d_pde2d.f90
+4 -3
View File
@@ -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
test/pargen/psb_d_pde3d.f90
+4 -3
View File
@@ -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
test/pargen/psb_s_pde2d.f90
+4 -3
View File
@@ -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
test/pargen/psb_s_pde3d.f90
+4 -3
View File
@@ -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