Added psb_gescal subroutine to entrywise scale distributed vector with C interface

This commit is contained in:
Cirdans-Home
2020-02-26 19:34:14 +01:00
parent ea9c469159
commit fd89f2f1bf
24 changed files with 880 additions and 12 deletions
+11
View File
@@ -564,6 +564,17 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_caddconst_vect
end interface
interface psb_gescal
subroutine psb_cscal_vect(x,c,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) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cscal_vect
end interface
end module psb_c_psblas_mod
+11
View File
@@ -575,6 +575,17 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_daddconst_vect
end interface
interface psb_gescal
subroutine psb_dscal_vect(x,c,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) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dscal_vect
end interface
interface psb_mask
subroutine psb_dmask_vect(c,x,m,t,desc_a,info)
+11
View File
@@ -575,6 +575,17 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_saddconst_vect
end interface
interface psb_gescal
subroutine psb_sscal_vect(x,c,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) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sscal_vect
end interface
interface psb_mask
subroutine psb_smask_vect(c,x,m,t,desc_a,info)
+11
View File
@@ -564,6 +564,17 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zaddconst_vect
end interface
interface psb_gescal
subroutine psb_zscal_vect(x,c,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) :: c
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zscal_vect
end interface
end module psb_z_psblas_mod
+54 -1
View File
@@ -183,7 +183,10 @@ module psb_c_base_vect_mod
!
! Scaling and norms
!
procedure, pass(x) :: scal => c_base_scal
procedure, pass(x) :: scal_v => c_base_scal
procedure, pass(z) :: scal_v2 => c_base_scal_v2
procedure, pass(z) :: scal_a2 => c_base_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => c_base_absval1
procedure, pass(x) :: absval2 => c_base_absval2
generic, public :: absval => absval1, absval2
@@ -1541,6 +1544,56 @@ contains
end subroutine c_base_scal
!
!> Function base_scal_a2
!! \memberof psb_c_base_vect_type
!! \brief Out of place scaling of the array x
!! \param x The array to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine c_base_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: c
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) = c*x(i)
end do
info = 0
end subroutine c_base_scal_a2
!
!> Function base_cmp_v2
!! \memberof psb_c_base_vect_type
!! \brief Out of place scaling of the vector x
!! \param x The vector to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine c_base_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine c_base_scal_v2
!
! Norms 1, 2 and infinity
!
+32 -1
View File
@@ -107,7 +107,10 @@ module psb_c_vect_mod
procedure, pass(y) :: inv_a2 => c_vect_inv_a2
procedure, pass(y) :: inv_a2_check => c_vect_inv_a2_check
generic, public :: inv => inv_v, inv_v_check, inv_a2, inv_a2_check
procedure, pass(x) :: scal => c_vect_scal
procedure, pass(x) :: scal_v => c_vect_scal
procedure, pass(z) :: scal_v2 => c_vect_scal_v2
procedure, pass(z) :: scal_a2 => c_vect_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => c_vect_absval1
procedure, pass(x) :: absval2 => c_vect_absval2
generic, public :: absval => absval1, absval2
@@ -937,6 +940,34 @@ contains
end subroutine c_vect_scal
subroutine c_vect_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: c
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%scal(x,c,info)
end subroutine c_vect_scal_a2
subroutine c_vect_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine c_vect_scal_v2
subroutine c_vect_absval1(x)
class(psb_c_vect_type), intent(inout) :: x
+54 -1
View File
@@ -183,7 +183,10 @@ module psb_d_base_vect_mod
!
! Scaling and norms
!
procedure, pass(x) :: scal => d_base_scal
procedure, pass(x) :: scal_v => d_base_scal
procedure, pass(z) :: scal_v2 => d_base_scal_v2
procedure, pass(z) :: scal_a2 => d_base_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => d_base_absval1
procedure, pass(x) :: absval2 => d_base_absval2
generic, public :: absval => absval1, absval2
@@ -1545,6 +1548,56 @@ contains
end subroutine d_base_scal
!
!> Function base_scal_a2
!! \memberof psb_d_base_vect_type
!! \brief Out of place scaling of the array x
!! \param x The array to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine d_base_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: c
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) = c*x(i)
end do
info = 0
end subroutine d_base_scal_a2
!
!> Function base_cmp_v2
!! \memberof psb_d_base_vect_type
!! \brief Out of place scaling of the vector x
!! \param x The vector to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine d_base_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine d_base_scal_v2
!
! Norms 1, 2 and infinity
!
+32 -1
View File
@@ -107,7 +107,10 @@ module psb_d_vect_mod
procedure, pass(y) :: inv_a2 => d_vect_inv_a2
procedure, pass(y) :: inv_a2_check => d_vect_inv_a2_check
generic, public :: inv => inv_v, inv_v_check, inv_a2, inv_a2_check
procedure, pass(x) :: scal => d_vect_scal
procedure, pass(x) :: scal_v => d_vect_scal
procedure, pass(z) :: scal_v2 => d_vect_scal_v2
procedure, pass(z) :: scal_a2 => d_vect_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => d_vect_absval1
procedure, pass(x) :: absval2 => d_vect_absval2
generic, public :: absval => absval1, absval2
@@ -941,6 +944,34 @@ contains
end subroutine d_vect_scal
subroutine d_vect_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: c
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%scal(x,c,info)
end subroutine d_vect_scal_a2
subroutine d_vect_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine d_vect_scal_v2
subroutine d_vect_absval1(x)
class(psb_d_vect_type), intent(inout) :: x
+54 -1
View File
@@ -183,7 +183,10 @@ module psb_s_base_vect_mod
!
! Scaling and norms
!
procedure, pass(x) :: scal => s_base_scal
procedure, pass(x) :: scal_v => s_base_scal
procedure, pass(z) :: scal_v2 => s_base_scal_v2
procedure, pass(z) :: scal_a2 => s_base_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => s_base_absval1
procedure, pass(x) :: absval2 => s_base_absval2
generic, public :: absval => absval1, absval2
@@ -1545,6 +1548,56 @@ contains
end subroutine s_base_scal
!
!> Function base_scal_a2
!! \memberof psb_s_base_vect_type
!! \brief Out of place scaling of the array x
!! \param x The array to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine s_base_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: c
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) = c*x(i)
end do
info = 0
end subroutine s_base_scal_a2
!
!> Function base_cmp_v2
!! \memberof psb_s_base_vect_type
!! \brief Out of place scaling of the vector x
!! \param x The vector to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine s_base_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine s_base_scal_v2
!
! Norms 1, 2 and infinity
!
+32 -1
View File
@@ -107,7 +107,10 @@ module psb_s_vect_mod
procedure, pass(y) :: inv_a2 => s_vect_inv_a2
procedure, pass(y) :: inv_a2_check => s_vect_inv_a2_check
generic, public :: inv => inv_v, inv_v_check, inv_a2, inv_a2_check
procedure, pass(x) :: scal => s_vect_scal
procedure, pass(x) :: scal_v => s_vect_scal
procedure, pass(z) :: scal_v2 => s_vect_scal_v2
procedure, pass(z) :: scal_a2 => s_vect_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => s_vect_absval1
procedure, pass(x) :: absval2 => s_vect_absval2
generic, public :: absval => absval1, absval2
@@ -941,6 +944,34 @@ contains
end subroutine s_vect_scal
subroutine s_vect_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: c
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%scal(x,c,info)
end subroutine s_vect_scal_a2
subroutine s_vect_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine s_vect_scal_v2
subroutine s_vect_absval1(x)
class(psb_s_vect_type), intent(inout) :: x
+54 -1
View File
@@ -183,7 +183,10 @@ module psb_z_base_vect_mod
!
! Scaling and norms
!
procedure, pass(x) :: scal => z_base_scal
procedure, pass(x) :: scal_v => z_base_scal
procedure, pass(z) :: scal_v2 => z_base_scal_v2
procedure, pass(z) :: scal_a2 => z_base_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => z_base_absval1
procedure, pass(x) :: absval2 => z_base_absval2
generic, public :: absval => absval1, absval2
@@ -1541,6 +1544,56 @@ contains
end subroutine z_base_scal
!
!> Function base_scal_a2
!! \memberof psb_z_base_vect_type
!! \brief Out of place scaling of the array x
!! \param x The array to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine z_base_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: c
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) = c*x(i)
end do
info = 0
end subroutine z_base_scal_a2
!
!> Function base_cmp_v2
!! \memberof psb_z_base_vect_type
!! \brief Out of place scaling of the vector x
!! \param x The vector to be scaled
!! \param z The scaled vector z = c*x
!! \param c The scaling term
!! \param info return code
!
subroutine z_base_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine z_base_scal_v2
!
! Norms 1, 2 and infinity
!
+32 -1
View File
@@ -107,7 +107,10 @@ module psb_z_vect_mod
procedure, pass(y) :: inv_a2 => z_vect_inv_a2
procedure, pass(y) :: inv_a2_check => z_vect_inv_a2_check
generic, public :: inv => inv_v, inv_v_check, inv_a2, inv_a2_check
procedure, pass(x) :: scal => z_vect_scal
procedure, pass(x) :: scal_v => z_vect_scal
procedure, pass(z) :: scal_v2 => z_vect_scal_v2
procedure, pass(z) :: scal_a2 => z_vect_scal_a2
generic, public :: scal => scal_v, scal_v2, scal_a2
procedure, pass(x) :: absval1 => z_vect_absval1
procedure, pass(x) :: absval2 => z_vect_absval2
generic, public :: absval => absval1, absval2
@@ -937,6 +940,34 @@ contains
end subroutine z_vect_scal
subroutine z_vect_scal_a2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: c
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%scal(x,c,info)
end subroutine z_vect_scal_a2
subroutine z_vect_scal_v2(x,c,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: c
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%scal(x%v,c,info)
end subroutine z_vect_scal_v2
subroutine z_vect_absval1(x)
class(psb_z_vect_type), intent(inout) :: x