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

Added psb_geaddconst subroutine to add constant value to vector with C-interfaces

Browse Source
merge-paraggr-newops
Cirdans-Home 5 years ago
parent 439246e643
commit ea9c469159
28 changed files with 990 additions and 140 deletions
Show Stats Download Patch File Download Diff File

11
base/modules/psblas/psb_c_psblas_mod.F90
Unescape Escape View File

@ -553,6 +553,17 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ccmp_vect
end interface
interface psb_geaddconst
subroutine psb_caddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type, psb_spk_
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caddconst_vect
end interface
end module psb_c_psblas_mod

11
base/modules/psblas/psb_d_psblas_mod.F90
Unescape Escape View File

@ -564,6 +564,17 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dcmp_vect
end interface
interface psb_geaddconst
subroutine psb_daddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type, psb_dpk_
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daddconst_vect
end interface
interface psb_mask
subroutine psb_dmask_vect(c,x,m,t,desc_a,info)

11
base/modules/psblas/psb_s_psblas_mod.F90
Unescape Escape View File

@ -564,6 +564,17 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_scmp_vect
end interface
interface psb_geaddconst
subroutine psb_saddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type, psb_spk_
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saddconst_vect
end interface
interface psb_mask
subroutine psb_smask_vect(c,x,m,t,desc_a,info)

11
base/modules/psblas/psb_z_psblas_mod.F90
Unescape Escape View File

@ -553,6 +553,17 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zcmp_vect
end interface
interface psb_geaddconst
subroutine psb_zaddconst_vect(x,b,z,desc_a,info)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type, psb_dpk_
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaddconst_vect
end interface
end module psb_z_psblas_mod

56
base/modules/serial/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -197,6 +197,14 @@ module psb_c_base_vect_mod
procedure, pass(z) :: acmp_a2 => c_base_acmp_a2
procedure, pass(z) :: acmp_v2 => c_base_acmp_v2
generic, public :: acmp => acmp_a2,acmp_v2
!
! Add constant value to all entry of a vector
!
procedure, pass(z) :: addconst_a2 => c_base_addconst_a2
procedure, pass(z) :: addconst_v2 => c_base_addconst_v2
generic, public :: addconst => addconst_a2,addconst_v2
end type psb_c_base_vect_type
@ -1770,6 +1778,54 @@ contains
end subroutine c_base_sctb_buf
!
!> Function _base_addconst_a2
!! \memberof psb_c_base_vect_type
!! \brief Add the constant b to every entry of the array x
!! \param x The input array
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine c_base_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: b
complex(psb_spk_), intent(inout) :: x(:)
class(psb_c_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
if (z%is_dev()) call z%sync()
n = size(x)
do i = 1, n, 1
z%v(i) = x(i) + b
end do
info = 0
end subroutine c_base_addconst_a2
!
!> Function _base_addconst_v2
!! \memberof psb_c_base_vect_type
!! \briefAdd the constant b to every entry of the vector x
!! \param x The input vector
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine c_base_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: b
class(psb_c_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%is_dev()) call x%sync()
call z%addconst(x%v,b,info)
end subroutine c_base_addconst_v2
end module psb_c_base_vect_mod

37
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -120,6 +120,9 @@ module psb_c_vect_mod
procedure, pass(z) :: acmp_a2 => c_vect_acmp_a2
procedure, pass(z) :: acmp_v2 => c_vect_acmp_v2
generic, public :: acmp => acmp_a2, acmp_v2
procedure, pass(z) :: addconst_a2 => c_vect_addconst_a2
procedure, pass(z) :: addconst_v2 => c_vect_addconst_v2
generic, public :: addconst => addconst_a2, addconst_v2
end type psb_c_vect_type
@ -146,12 +149,6 @@ module psb_c_vect_mod
& c_vect_absval2, c_vect_nrm2, c_vect_amax, c_vect_asum
! @NOTCPLXS@
! @NOTINTS@
! private :: c_vect_acmp_a2, c_vect_acmp_v2
! @NOTINTE@
! @NOTCPLXE@
class(psb_c_base_vect_type), allocatable, target,&
& save, private :: psb_c_base_vect_default
@ -1039,6 +1036,34 @@ contains
subroutine c_vect_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: b
complex(psb_spk_), intent(inout) :: x(:)
class(psb_c_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(z%v)) &
& call z%addconst(x,b,info)
end subroutine c_vect_addconst_a2
subroutine c_vect_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: b
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v).and.allocated(z%v)) &
& call z%v%addconst(x%v,b,info)
end subroutine c_vect_addconst_v2
end module psb_c_vect_mod

56
base/modules/serial/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -197,12 +197,20 @@ module psb_d_base_vect_mod
procedure, pass(z) :: acmp_a2 => d_base_acmp_a2
procedure, pass(z) :: acmp_v2 => d_base_acmp_v2
generic, public :: acmp => acmp_a2,acmp_v2
!
! Add constant value to all entry of a vector
!
procedure, pass(z) :: addconst_a2 => d_base_addconst_a2
procedure, pass(z) :: addconst_v2 => d_base_addconst_v2
generic, public :: addconst => addconst_a2,addconst_v2
procedure, pass(x) :: minreal => d_base_min
procedure, pass(m) :: mask_v => d_base_mask_v
procedure, pass(m) :: mask_a => d_base_mask_a
generic, public :: mask => mask_a, mask_v
end type psb_d_base_vect_type
public :: psb_d_base_vect
@ -1881,6 +1889,54 @@ contains
end subroutine d_base_mask_v
!
!> Function _base_addconst_a2
!! \memberof psb_d_base_vect_type
!! \brief Add the constant b to every entry of the array x
!! \param x The input array
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine d_base_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: b
real(psb_dpk_), intent(inout) :: x(:)
class(psb_d_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
if (z%is_dev()) call z%sync()
n = size(x)
do i = 1, n, 1
z%v(i) = x(i) + b
end do
info = 0
end subroutine d_base_addconst_a2
!
!> Function _base_addconst_v2
!! \memberof psb_d_base_vect_type
!! \briefAdd the constant b to every entry of the vector x
!! \param x The input vector
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine d_base_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: b
class(psb_d_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%is_dev()) call x%sync()
call z%addconst(x%v,b,info)
end subroutine d_base_addconst_v2
end module psb_d_base_vect_mod

37
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -120,6 +120,9 @@ module psb_d_vect_mod
procedure, pass(z) :: acmp_a2 => d_vect_acmp_a2
procedure, pass(z) :: acmp_v2 => d_vect_acmp_v2
generic, public :: acmp => acmp_a2, acmp_v2
procedure, pass(z) :: addconst_a2 => d_vect_addconst_a2
procedure, pass(z) :: addconst_v2 => d_vect_addconst_v2
generic, public :: addconst => addconst_a2, addconst_v2
procedure, pass(x) :: minreal => d_vect_min
procedure, pass(m) :: mask_v => d_vect_mask_v
@ -150,12 +153,6 @@ module psb_d_vect_mod
& d_vect_absval2, d_vect_nrm2, d_vect_amax, d_vect_asum
! @NOTCPLXS@
! @NOTINTS@
! private :: d_vect_acmp_a2, d_vect_acmp_v2
! @NOTINTE@
! @NOTCPLXE@
class(psb_d_base_vect_type), allocatable, target,&
& save, private :: psb_d_base_vect_default
@ -1085,6 +1082,34 @@ contains
end subroutine d_vect_mask_v
subroutine d_vect_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: b
real(psb_dpk_), intent(inout) :: x(:)
class(psb_d_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(z%v)) &
& call z%addconst(x,b,info)
end subroutine d_vect_addconst_a2
subroutine d_vect_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: b
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v).and.allocated(z%v)) &
& call z%v%addconst(x%v,b,info)
end subroutine d_vect_addconst_v2
end module psb_d_vect_mod

2
base/modules/serial/psb_i_base_vect_mod.f90
Unescape Escape View File

@ -144,6 +144,8 @@ module psb_i_base_vect_mod
end type psb_i_base_vect_type
public :: psb_i_base_vect

7
base/modules/serial/psb_i_vect_mod.F90
Unescape Escape View File

@ -100,12 +100,6 @@ module psb_i_vect_mod
& i_vect_set_dev, i_vect_set_sync
! @NOTCPLXS@
! @NOTINTS@
! private :: i_vect_acmp_a2, i_vect_acmp_v2
! @NOTINTE@
! @NOTCPLXE@
class(psb_i_base_vect_type), allocatable, target,&
& save, private :: psb_i_base_vect_default
@ -553,6 +547,7 @@ contains
end module psb_i_vect_mod

2
base/modules/serial/psb_l_base_vect_mod.f90
Unescape Escape View File

@ -145,6 +145,8 @@ module psb_l_base_vect_mod
end type psb_l_base_vect_type
public :: psb_l_base_vect

7
base/modules/serial/psb_l_vect_mod.F90
Unescape Escape View File

@ -101,12 +101,6 @@ module psb_l_vect_mod
& l_vect_set_dev, l_vect_set_sync
! @NOTCPLXS@
! @NOTINTS@
! private :: l_vect_acmp_a2, l_vect_acmp_v2
! @NOTINTE@
! @NOTCPLXE@
class(psb_l_base_vect_type), allocatable, target,&
& save, private :: psb_l_base_vect_default
@ -554,6 +548,7 @@ contains
end module psb_l_vect_mod

56
base/modules/serial/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -197,12 +197,20 @@ module psb_s_base_vect_mod
procedure, pass(z) :: acmp_a2 => s_base_acmp_a2
procedure, pass(z) :: acmp_v2 => s_base_acmp_v2
generic, public :: acmp => acmp_a2,acmp_v2
!
! Add constant value to all entry of a vector
!
procedure, pass(z) :: addconst_a2 => s_base_addconst_a2
procedure, pass(z) :: addconst_v2 => s_base_addconst_v2
generic, public :: addconst => addconst_a2,addconst_v2
procedure, pass(x) :: minreal => s_base_min
procedure, pass(m) :: mask_v => s_base_mask_v
procedure, pass(m) :: mask_a => s_base_mask_a
generic, public :: mask => mask_a, mask_v
end type psb_s_base_vect_type
public :: psb_s_base_vect
@ -1881,6 +1889,54 @@ contains
end subroutine s_base_mask_v
!
!> Function _base_addconst_a2
!! \memberof psb_s_base_vect_type
!! \brief Add the constant b to every entry of the array x
!! \param x The input array
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine s_base_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: b
real(psb_spk_), intent(inout) :: x(:)
class(psb_s_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
if (z%is_dev()) call z%sync()
n = size(x)
do i = 1, n, 1
z%v(i) = x(i) + b
end do
info = 0
end subroutine s_base_addconst_a2
!
!> Function _base_addconst_v2
!! \memberof psb_s_base_vect_type
!! \briefAdd the constant b to every entry of the vector x
!! \param x The input vector
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine s_base_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: b
class(psb_s_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%is_dev()) call x%sync()
call z%addconst(x%v,b,info)
end subroutine s_base_addconst_v2
end module psb_s_base_vect_mod

37
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -120,6 +120,9 @@ module psb_s_vect_mod
procedure, pass(z) :: acmp_a2 => s_vect_acmp_a2
procedure, pass(z) :: acmp_v2 => s_vect_acmp_v2
generic, public :: acmp => acmp_a2, acmp_v2
procedure, pass(z) :: addconst_a2 => s_vect_addconst_a2
procedure, pass(z) :: addconst_v2 => s_vect_addconst_v2
generic, public :: addconst => addconst_a2, addconst_v2
procedure, pass(x) :: minreal => s_vect_min
procedure, pass(m) :: mask_v => s_vect_mask_v
@ -150,12 +153,6 @@ module psb_s_vect_mod
& s_vect_absval2, s_vect_nrm2, s_vect_amax, s_vect_asum
! @NOTCPLXS@
! @NOTINTS@
! private :: s_vect_acmp_a2, s_vect_acmp_v2
! @NOTINTE@
! @NOTCPLXE@
class(psb_s_base_vect_type), allocatable, target,&
& save, private :: psb_s_base_vect_default
@ -1085,6 +1082,34 @@ contains
end subroutine s_vect_mask_v
subroutine s_vect_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: b
real(psb_spk_), intent(inout) :: x(:)
class(psb_s_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(z%v)) &
& call z%addconst(x,b,info)
end subroutine s_vect_addconst_a2
subroutine s_vect_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: b
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v).and.allocated(z%v)) &
& call z%v%addconst(x%v,b,info)
end subroutine s_vect_addconst_v2
end module psb_s_vect_mod

56
base/modules/serial/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -197,6 +197,14 @@ module psb_z_base_vect_mod
procedure, pass(z) :: acmp_a2 => z_base_acmp_a2
procedure, pass(z) :: acmp_v2 => z_base_acmp_v2
generic, public :: acmp => acmp_a2,acmp_v2
!
! Add constant value to all entry of a vector
!
procedure, pass(z) :: addconst_a2 => z_base_addconst_a2
procedure, pass(z) :: addconst_v2 => z_base_addconst_v2
generic, public :: addconst => addconst_a2,addconst_v2
end type psb_z_base_vect_type
@ -1770,6 +1778,54 @@ contains
end subroutine z_base_sctb_buf
!
!> Function _base_addconst_a2
!! \memberof psb_z_base_vect_type
!! \brief Add the constant b to every entry of the array x
!! \param x The input array
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine z_base_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: b
complex(psb_dpk_), intent(inout) :: x(:)
class(psb_z_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
if (z%is_dev()) call z%sync()
n = size(x)
do i = 1, n, 1
z%v(i) = x(i) + b
end do
info = 0
end subroutine z_base_addconst_a2
!
!> Function _base_addconst_v2
!! \memberof psb_z_base_vect_type
!! \briefAdd the constant b to every entry of the vector x
!! \param x The input vector
!! \param z The vector containing the x(i) + b
!! \param b The added term
!! \param info return code
!
subroutine z_base_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: b
class(psb_z_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%is_dev()) call x%sync()
call z%addconst(x%v,b,info)
end subroutine z_base_addconst_v2
end module psb_z_base_vect_mod

37
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -120,6 +120,9 @@ module psb_z_vect_mod
procedure, pass(z) :: acmp_a2 => z_vect_acmp_a2
procedure, pass(z) :: acmp_v2 => z_vect_acmp_v2
generic, public :: acmp => acmp_a2, acmp_v2
procedure, pass(z) :: addconst_a2 => z_vect_addconst_a2
procedure, pass(z) :: addconst_v2 => z_vect_addconst_v2
generic, public :: addconst => addconst_a2, addconst_v2
end type psb_z_vect_type
@ -146,12 +149,6 @@ module psb_z_vect_mod
& z_vect_absval2, z_vect_nrm2, z_vect_amax, z_vect_asum
! @NOTCPLXS@
! @NOTINTS@
! private :: z_vect_acmp_a2, z_vect_acmp_v2
! @NOTINTE@
! @NOTCPLXE@
class(psb_z_base_vect_type), allocatable, target,&
& save, private :: psb_z_base_vect_default
@ -1039,6 +1036,34 @@ contains
subroutine z_vect_addconst_a2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: b
complex(psb_dpk_), intent(inout) :: x(:)
class(psb_z_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(z%v)) &
& call z%addconst(x,b,info)
end subroutine z_vect_addconst_a2
subroutine z_vect_addconst_v2(x,b,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: b
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v).and.allocated(z%v)) &
& call z%v%addconst(x%v,b,info)
end subroutine z_vect_addconst_v2
end module psb_z_vect_mod

137
base/psblas/psb_caxpby.f90
Unescape Escape View File

@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! 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:
@ -15,7 +15,7 @@
! 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
@ -27,8 +27,8 @@
! 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.
!
!
!
!
! File: psb_caxpby.f90
!
@ -46,12 +46,12 @@
! info - integer Return code
!
! Note: from a functional point of view, X is input, but here
! it's declared INOUT because of the sync() methods.
! it's declared INOUT because of the sync() methods.
!
subroutine psb_caxpby_vect(alpha, x, beta, y,&
& desc_a, info)
use psb_base_mod, psb_protect_name => psb_caxpby_vect
implicit none
implicit none
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
complex(psb_spk_), intent (in) :: alpha, beta
@ -65,7 +65,7 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,&
character(len=20) :: name, ch_err
name='psb_cgeaxpby'
if (psb_errstatus_fatal()) return
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
@ -77,12 +77,12 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,&
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
@ -121,7 +121,7 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,&
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -146,13 +146,13 @@ end subroutine psb_caxpby_vect
! y(:,:) - complex,inout The input vector Y
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
!
subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
use psb_base_mod, psb_protect_name => psb_caxpby
implicit none
implicit none
integer(psb_ipk_), intent(in), optional :: n, jx, jy
integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
if (present(n)) then
if(((ijx+n) <= size(x,2)).and.&
& ((ijy+n) <= size(y,2))) then
& ((ijy+n) <= size(y,2))) then
in = n
else
in = min(size(x,2),size(y,2))
@ -242,7 +242,7 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -253,12 +253,12 @@ end subroutine psb_caxpby
!!$
!!$
!!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari
!!$
!!$ Alfredo Buttari
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
@ -270,7 +270,7 @@ end subroutine psb_caxpby
!!$ 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
@ -282,8 +282,8 @@ end subroutine psb_caxpby
!!$ 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: psb_caxpbyv
! Adds one distributed vector to another,
@ -301,7 +301,7 @@ end subroutine psb_caxpby
!
subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info)
use psb_base_mod, psb_protect_name => psb_caxpbyv
implicit none
implicit none
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
@ -366,9 +366,94 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_caxpbyv
!
! Subroutine: psb_caddconst_vect
! Adds one distributed vector to another,
!
! Z(i) := X(i) + b
!
! Arguments:
! x - type(psb_c_vect_type) The input vector containing the entries of X
! b - complex,input The scalar used to add each component of X
! z - type(psb_c_vect_type) The input/output vector Z
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
!
subroutine psb_caddconst_vect(x,b,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_caddconst_vect
implicit none
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_c_cmp_vect'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%addconst(x,b,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_caddconst_vect

137
base/psblas/psb_daxpby.f90
Unescape Escape View File

@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! 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:
@ -15,7 +15,7 @@
! 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
@ -27,8 +27,8 @@
! 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.
!
!
!
!
! File: psb_daxpby.f90
!
@ -46,12 +46,12 @@
! info - integer Return code
!
! Note: from a functional point of view, X is input, but here
! it's declared INOUT because of the sync() methods.
! it's declared INOUT because of the sync() methods.
!
subroutine psb_daxpby_vect(alpha, x, beta, y,&
& desc_a, info)
use psb_base_mod, psb_protect_name => psb_daxpby_vect
implicit none
implicit none
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: y
real(psb_dpk_), intent (in) :: alpha, beta
@ -65,7 +65,7 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,&
character(len=20) :: name, ch_err
name='psb_dgeaxpby'
if (psb_errstatus_fatal()) return
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
@ -77,12 +77,12 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,&
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
@ -121,7 +121,7 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,&
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -146,13 +146,13 @@ end subroutine psb_daxpby_vect
! y(:,:) - real,inout The input vector Y
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
!
subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
use psb_base_mod, psb_protect_name => psb_daxpby
implicit none
implicit none
integer(psb_ipk_), intent(in), optional :: n, jx, jy
integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
if (present(n)) then
if(((ijx+n) <= size(x,2)).and.&
& ((ijy+n) <= size(y,2))) then
& ((ijy+n) <= size(y,2))) then
in = n
else
in = min(size(x,2),size(y,2))
@ -242,7 +242,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -253,12 +253,12 @@ end subroutine psb_daxpby
!!$
!!$
!!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari
!!$
!!$ Alfredo Buttari
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
@ -270,7 +270,7 @@ end subroutine psb_daxpby
!!$ 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
@ -282,8 +282,8 @@ end subroutine psb_daxpby
!!$ 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: psb_daxpbyv
! Adds one distributed vector to another,
@ -301,7 +301,7 @@ end subroutine psb_daxpby
!
subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
use psb_base_mod, psb_protect_name => psb_daxpbyv
implicit none
implicit none
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
@ -366,9 +366,94 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_daxpbyv
!
! Subroutine: psb_daddconst_vect
! Adds one distributed vector to another,
!
! Z(i) := X(i) + b
!
! Arguments:
! x - type(psb_d_vect_type) The input vector containing the entries of X
! b - real,input The scalar used to add each component of X
! z - type(psb_d_vect_type) The input/output vector Z
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
!
subroutine psb_daddconst_vect(x,b,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_daddconst_vect
implicit none
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_d_cmp_vect'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%addconst(x,b,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_daddconst_vect

137
base/psblas/psb_saxpby.f90
Unescape Escape View File

@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! 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:
@ -15,7 +15,7 @@
! 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
@ -27,8 +27,8 @@
! 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.
!
!
!
!
! File: psb_saxpby.f90
!
@ -46,12 +46,12 @@
! info - integer Return code
!
! Note: from a functional point of view, X is input, but here
! it's declared INOUT because of the sync() methods.
! it's declared INOUT because of the sync() methods.
!
subroutine psb_saxpby_vect(alpha, x, beta, y,&
& desc_a, info)
use psb_base_mod, psb_protect_name => psb_saxpby_vect
implicit none
implicit none
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: y
real(psb_spk_), intent (in) :: alpha, beta
@ -65,7 +65,7 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,&
character(len=20) :: name, ch_err
name='psb_sgeaxpby'
if (psb_errstatus_fatal()) return
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
@ -77,12 +77,12 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,&
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
@ -121,7 +121,7 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,&
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -146,13 +146,13 @@ end subroutine psb_saxpby_vect
! y(:,:) - real,inout The input vector Y
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
!
subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
use psb_base_mod, psb_protect_name => psb_saxpby
implicit none
implicit none
integer(psb_ipk_), intent(in), optional :: n, jx, jy
integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
if (present(n)) then
if(((ijx+n) <= size(x,2)).and.&
& ((ijy+n) <= size(y,2))) then
& ((ijy+n) <= size(y,2))) then
in = n
else
in = min(size(x,2),size(y,2))
@ -242,7 +242,7 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -253,12 +253,12 @@ end subroutine psb_saxpby
!!$
!!$
!!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari
!!$
!!$ Alfredo Buttari
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
@ -270,7 +270,7 @@ end subroutine psb_saxpby
!!$ 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
@ -282,8 +282,8 @@ end subroutine psb_saxpby
!!$ 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: psb_saxpbyv
! Adds one distributed vector to another,
@ -301,7 +301,7 @@ end subroutine psb_saxpby
!
subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info)
use psb_base_mod, psb_protect_name => psb_saxpbyv
implicit none
implicit none
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
@ -366,9 +366,94 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_saxpbyv
!
! Subroutine: psb_saddconst_vect
! Adds one distributed vector to another,
!
! Z(i) := X(i) + b
!
! Arguments:
! x - type(psb_s_vect_type) The input vector containing the entries of X
! b - real,input The scalar used to add each component of X
! z - type(psb_s_vect_type) The input/output vector Z
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
!
subroutine psb_saddconst_vect(x,b,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_saddconst_vect
implicit none
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: z
real(psb_spk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_s_cmp_vect'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%addconst(x,b,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_saddconst_vect

137
base/psblas/psb_zaxpby.f90
Unescape Escape View File

@ -1,9 +1,9 @@
!
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! 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:
@ -15,7 +15,7 @@
! 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
@ -27,8 +27,8 @@
! 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.
!
!
!
!
! File: psb_zaxpby.f90
!
@ -46,12 +46,12 @@
! info - integer Return code
!
! Note: from a functional point of view, X is input, but here
! it's declared INOUT because of the sync() methods.
! it's declared INOUT because of the sync() methods.
!
subroutine psb_zaxpby_vect(alpha, x, beta, y,&
& desc_a, info)
use psb_base_mod, psb_protect_name => psb_zaxpby_vect
implicit none
implicit none
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
complex(psb_dpk_), intent (in) :: alpha, beta
@ -65,7 +65,7 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,&
character(len=20) :: name, ch_err
name='psb_zgeaxpby'
if (psb_errstatus_fatal()) return
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
@ -77,12 +77,12 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,&
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(y%v)) then
if (.not.allocated(y%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
@ -121,7 +121,7 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,&
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -146,13 +146,13 @@ end subroutine psb_zaxpby_vect
! y(:,:) - complex,inout The input vector Y
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
! jx - integer(optional) The column offset for X
! jy - integer(optional) The column offset for Y
!
subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
use psb_base_mod, psb_protect_name => psb_zaxpby
implicit none
implicit none
integer(psb_ipk_), intent(in), optional :: n, jx, jy
integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
if (present(n)) then
if(((ijx+n) <= size(x,2)).and.&
& ((ijy+n) <= size(y,2))) then
& ((ijy+n) <= size(y,2))) then
in = n
else
in = min(size(x,2),size(y,2))
@ -242,7 +242,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
@ -253,12 +253,12 @@ end subroutine psb_zaxpby
!!$
!!$
!!$ Parallel Sparse BLAS version 3.5
!!$ (C) Copyright 2006-2018
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari
!!$
!!$ Alfredo Buttari
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
@ -270,7 +270,7 @@ end subroutine psb_zaxpby
!!$ 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
@ -282,8 +282,8 @@ end subroutine psb_zaxpby
!!$ 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: psb_zaxpbyv
! Adds one distributed vector to another,
@ -301,7 +301,7 @@ end subroutine psb_zaxpby
!
subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
use psb_base_mod, psb_protect_name => psb_zaxpbyv
implicit none
implicit none
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
@ -366,9 +366,94 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
end if
call psb_erractionrestore(err_act)
return
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zaxpbyv
!
! Subroutine: psb_zaddconst_vect
! Adds one distributed vector to another,
!
! Z(i) := X(i) + b
!
! Arguments:
! x - type(psb_z_vect_type) The input vector containing the entries of X
! b - complex,input The scalar used to add each component of X
! z - type(psb_z_vect_type) The input/output vector Z
! desc_a - type(psb_desc_type) The communication descriptor.
! info - integer Return code
!
subroutine psb_zaddconst_vect(x,b,z,desc_a,info)
use psb_base_mod, psb_protect_name => psb_zaddconst_vect
implicit none
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: z
real(psb_dpk_), intent(in) :: b
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_z_cmp_vect'
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (.not.allocated(z%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
ix = ione
iy = ione
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,lone,z%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if(desc_a%get_local_rows() > 0) then
call z%addconst(x,b,info)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zaddconst_vect

1
cbind/base/psb_c_cbase.h
Unescape Escape View File

@ -71,6 +71,7 @@ psb_i_t psb_c_cgeinv(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgeinv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgeabs(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *cdh);
psb_i_t psb_c_cgecmp(psb_c_cvector *xh,psb_s_t ch,psb_c_cvector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_cgeaddconst(psb_c_cvector *xh,psb_c_t bh,psb_c_cvector *zh,psb_c_descriptor *cdh);
psb_s_t psb_c_cgenrm2_weight(psb_c_cvector *xh,psb_c_cvector *wh,psb_c_descriptor *cdh);
psb_s_t psb_c_cgenrm2_weightmask(psb_c_cvector *xh,psb_c_cvector *wh,psb_c_cvector *idvh,psb_c_descriptor *cdh);
#ifdef __cplusplus

1
cbind/base/psb_c_dbase.h
Unescape Escape View File

@ -71,6 +71,7 @@ psb_i_t psb_c_dgeinv(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgeinv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgeabs(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgecmp(psb_c_dvector *xh,psb_d_t ch,psb_c_dvector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_dgeaddconst(psb_c_dvector *xh,psb_d_t bh,psb_c_dvector *zh,psb_c_descriptor *cdh);
psb_d_t psb_c_dgenrm2_weight(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_descriptor *cdh);
psb_d_t psb_c_dgenrm2_weightmask(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_dvector *idvh,psb_c_descriptor *cdh);
psb_i_t psb_c_dmask(psb_c_dvector *ch,psb_c_dvector *xh,psb_c_dvector *mh, bool t, psb_c_descriptor *cdh);

36
cbind/base/psb_c_psblas_cbind_mod.f90
Unescape Escape View File

@ -420,6 +420,42 @@ contains
end function psb_c_cgecmp
function psb_c_cgeaddconst(xh,bh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cvector) :: xh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_c_vect_type), pointer :: xp,zp
integer(psb_c_ipk_) :: info
real(c_float_complex) :: bh
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_geaddconst(xp,bh,zp,descp,info)
res = info
end function psb_c_cgeaddconst
function psb_c_cgenrm2(xh,cdh) bind(c) result(res)
implicit none

1
cbind/base/psb_c_sbase.h
Unescape Escape View File

@ -71,6 +71,7 @@ psb_i_t psb_c_sgeinv(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgeinv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgeabs(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgecmp(psb_c_svector *xh,psb_s_t ch,psb_c_svector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_sgeaddconst(psb_c_svector *xh,psb_s_t bh,psb_c_svector *zh,psb_c_descriptor *cdh);
psb_s_t psb_c_sgenrm2_weight(psb_c_svector *xh,psb_c_svector *wh,psb_c_descriptor *cdh);
psb_s_t psb_c_sgenrm2_weightmask(psb_c_svector *xh,psb_c_svector *wh,psb_c_svector *idvh,psb_c_descriptor *cdh);
psb_i_t psb_c_smask(psb_c_svector *ch,psb_c_svector *xh,psb_c_svector *mh, bool t, psb_c_descriptor *cdh);

1
cbind/base/psb_c_zbase.h
Unescape Escape View File

@ -71,6 +71,7 @@ psb_i_t psb_c_zgeinv(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgeinv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgeabs(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgecmp(psb_c_zvector *xh,psb_d_t ch,psb_c_zvector *zh,psb_c_descriptor *cdh);
psb_i_t psb_c_zgeaddconst(psb_c_zvector *xh,psb_z_t bh,psb_c_zvector *zh,psb_c_descriptor *cdh);
psb_d_t psb_c_zgenrm2_weight(psb_c_zvector *xh,psb_c_zvector *wh,psb_c_descriptor *cdh);
psb_d_t psb_c_zgenrm2_weightmask(psb_c_zvector *xh,psb_c_zvector *wh,psb_c_zvector *idvh,psb_c_descriptor *cdh);
#ifdef __cplusplus

36
cbind/base/psb_d_psblas_cbind_mod.f90
Unescape Escape View File

@ -420,6 +420,42 @@ contains
end function psb_c_dgecmp
function psb_c_dgeaddconst(xh,bh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dvector) :: xh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp,zp
integer(psb_c_ipk_) :: info
real(c_double) :: bh
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_geaddconst(xp,bh,zp,descp,info)
res = info
end function psb_c_dgeaddconst
function psb_c_dmask(ch,xh,mh,t,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res

36
cbind/base/psb_s_psblas_cbind_mod.f90
Unescape Escape View File

@ -420,6 +420,42 @@ contains
end function psb_c_sgecmp
function psb_c_sgeaddconst(xh,bh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_svector) :: xh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_s_vect_type), pointer :: xp,zp
integer(psb_c_ipk_) :: info
real(c_float) :: bh
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_geaddconst(xp,bh,zp,descp,info)
res = info
end function psb_c_sgeaddconst
function psb_c_smask(ch,xh,mh,t,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res

36
cbind/base/psb_z_psblas_cbind_mod.f90
Unescape Escape View File

@ -420,6 +420,42 @@ contains
end function psb_c_zgecmp
function psb_c_zgeaddconst(xh,bh,zh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zvector) :: xh,zh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_z_vect_type), pointer :: xp,zp
integer(psb_c_ipk_) :: info
real(c_double_complex) :: bh
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
if (c_associated(zh%item)) then
call c_f_pointer(zh%item,zp)
else
return
end if
call psb_geaddconst(xp,bh,zp,descp,info)
res = info
end function psb_c_zgeaddconst
function psb_c_zgenrm2(xh,cdh) bind(c) result(res)
implicit none

Write Preview
Loading…
Cancel
Save