From 5504e34161b2220f77aae72282b6f0492555e8dd Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 30 Mar 2020 21:48:26 +0200 Subject: [PATCH] Removed the out-interface for vector scaling --- base/modules/psblas/psb_c_psblas_mod.F90 | 11 -- base/modules/psblas/psb_d_psblas_mod.F90 | 11 -- base/modules/psblas/psb_s_psblas_mod.F90 | 11 -- base/modules/psblas/psb_z_psblas_mod.F90 | 11 -- base/modules/serial/psb_c_base_vect_mod.f90 | 55 +-------- base/modules/serial/psb_c_vect_mod.F90 | 33 +----- base/modules/serial/psb_d_base_vect_mod.f90 | 55 +-------- base/modules/serial/psb_d_vect_mod.F90 | 33 +----- base/modules/serial/psb_s_base_vect_mod.f90 | 55 +-------- base/modules/serial/psb_s_vect_mod.F90 | 33 +----- base/modules/serial/psb_z_base_vect_mod.f90 | 55 +-------- base/modules/serial/psb_z_vect_mod.F90 | 33 +----- base/psblas/psb_caxpby.f90 | 85 -------------- base/psblas/psb_daxpby.f90 | 85 -------------- base/psblas/psb_saxpby.f90 | 85 -------------- base/psblas/psb_zaxpby.f90 | 85 -------------- cbind/base/psb_base_tools_cbind_mod.F90 | 123 ++++++++++---------- cbind/base/psb_c_base.c | 15 +-- cbind/base/psb_c_cbase.h | 1 - cbind/base/psb_c_dbase.h | 1 - cbind/base/psb_c_psblas_cbind_mod.f90 | 36 ------ cbind/base/psb_c_sbase.h | 1 - cbind/base/psb_c_zbase.h | 1 - cbind/base/psb_d_psblas_cbind_mod.f90 | 36 ------ cbind/base/psb_s_psblas_cbind_mod.f90 | 36 ------ cbind/base/psb_z_psblas_cbind_mod.f90 | 36 ------ 26 files changed, 78 insertions(+), 944 deletions(-) diff --git a/base/modules/psblas/psb_c_psblas_mod.F90 b/base/modules/psblas/psb_c_psblas_mod.F90 index 632bc043..ad52858e 100644 --- a/base/modules/psblas/psb_c_psblas_mod.F90 +++ b/base/modules/psblas/psb_c_psblas_mod.F90 @@ -586,17 +586,6 @@ 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 diff --git a/base/modules/psblas/psb_d_psblas_mod.F90 b/base/modules/psblas/psb_d_psblas_mod.F90 index aafe6931..57055e73 100644 --- a/base/modules/psblas/psb_d_psblas_mod.F90 +++ b/base/modules/psblas/psb_d_psblas_mod.F90 @@ -597,17 +597,6 @@ 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) diff --git a/base/modules/psblas/psb_s_psblas_mod.F90 b/base/modules/psblas/psb_s_psblas_mod.F90 index 48ccc212..5dc5e642 100644 --- a/base/modules/psblas/psb_s_psblas_mod.F90 +++ b/base/modules/psblas/psb_s_psblas_mod.F90 @@ -597,17 +597,6 @@ 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) diff --git a/base/modules/psblas/psb_z_psblas_mod.F90 b/base/modules/psblas/psb_z_psblas_mod.F90 index 3e920f83..02a45e03 100644 --- a/base/modules/psblas/psb_z_psblas_mod.F90 +++ b/base/modules/psblas/psb_z_psblas_mod.F90 @@ -586,17 +586,6 @@ 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 diff --git a/base/modules/serial/psb_c_base_vect_mod.f90 b/base/modules/serial/psb_c_base_vect_mod.f90 index 249f533d..4facf536 100644 --- a/base/modules/serial/psb_c_base_vect_mod.f90 +++ b/base/modules/serial/psb_c_base_vect_mod.f90 @@ -185,10 +185,7 @@ module psb_c_base_vect_mod ! ! Scaling and norms ! - 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) :: scal => c_base_scal procedure, pass(x) :: absval1 => c_base_absval1 procedure, pass(x) :: absval2 => c_base_absval2 generic, public :: absval => absval1, absval2 @@ -1608,56 +1605,6 @@ 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 ! diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index 0e4ffab1..8beb57a1 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -109,10 +109,7 @@ 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_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) :: scal => c_vect_scal procedure, pass(x) :: absval1 => c_vect_absval1 procedure, pass(x) :: absval2 => c_vect_absval2 generic, public :: absval => absval1, absval2 @@ -974,34 +971,6 @@ 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 diff --git a/base/modules/serial/psb_d_base_vect_mod.f90 b/base/modules/serial/psb_d_base_vect_mod.f90 index 7d74b322..72759110 100644 --- a/base/modules/serial/psb_d_base_vect_mod.f90 +++ b/base/modules/serial/psb_d_base_vect_mod.f90 @@ -185,10 +185,7 @@ module psb_d_base_vect_mod ! ! Scaling and norms ! - 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) :: scal => d_base_scal procedure, pass(x) :: absval1 => d_base_absval1 procedure, pass(x) :: absval2 => d_base_absval2 generic, public :: absval => absval1, absval2 @@ -1615,56 +1612,6 @@ 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 ! diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index 6097d0b6..99198a3d 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -109,10 +109,7 @@ 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_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) :: scal => d_vect_scal procedure, pass(x) :: absval1 => d_vect_absval1 procedure, pass(x) :: absval2 => d_vect_absval2 generic, public :: absval => absval1, absval2 @@ -981,34 +978,6 @@ 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 diff --git a/base/modules/serial/psb_s_base_vect_mod.f90 b/base/modules/serial/psb_s_base_vect_mod.f90 index 5969749c..6aab6497 100644 --- a/base/modules/serial/psb_s_base_vect_mod.f90 +++ b/base/modules/serial/psb_s_base_vect_mod.f90 @@ -185,10 +185,7 @@ module psb_s_base_vect_mod ! ! Scaling and norms ! - 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) :: scal => s_base_scal procedure, pass(x) :: absval1 => s_base_absval1 procedure, pass(x) :: absval2 => s_base_absval2 generic, public :: absval => absval1, absval2 @@ -1615,56 +1612,6 @@ 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 ! diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index 5703dfaf..c2a3a6d9 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -109,10 +109,7 @@ 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_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) :: scal => s_vect_scal procedure, pass(x) :: absval1 => s_vect_absval1 procedure, pass(x) :: absval2 => s_vect_absval2 generic, public :: absval => absval1, absval2 @@ -981,34 +978,6 @@ 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 diff --git a/base/modules/serial/psb_z_base_vect_mod.f90 b/base/modules/serial/psb_z_base_vect_mod.f90 index 23786535..085e9c3a 100644 --- a/base/modules/serial/psb_z_base_vect_mod.f90 +++ b/base/modules/serial/psb_z_base_vect_mod.f90 @@ -185,10 +185,7 @@ module psb_z_base_vect_mod ! ! Scaling and norms ! - 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) :: scal => z_base_scal procedure, pass(x) :: absval1 => z_base_absval1 procedure, pass(x) :: absval2 => z_base_absval2 generic, public :: absval => absval1, absval2 @@ -1608,56 +1605,6 @@ 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 ! diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index e647405b..76331b0a 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -109,10 +109,7 @@ 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_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) :: scal => z_vect_scal procedure, pass(x) :: absval1 => z_vect_absval1 procedure, pass(x) :: absval2 => z_vect_absval2 generic, public :: absval => absval1, absval2 @@ -974,34 +971,6 @@ 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 diff --git a/base/psblas/psb_caxpby.f90 b/base/psblas/psb_caxpby.f90 index 2311f3e2..6518e730 100644 --- a/base/psblas/psb_caxpby.f90 +++ b/base/psblas/psb_caxpby.f90 @@ -735,88 +735,3 @@ subroutine psb_caddconst_vect(x,b,z,desc_a,info) return end subroutine psb_caddconst_vect -! -! Subroutine: psb_cscal_vect -! Scale one distributed vector with scalar c, -! -! Z(i) := c*X(i) -! -! Arguments: -! x - type(psb_c_vect_type) The input vector containing the entries of X -! c - 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_cscal_vect(x,c,z,desc_a,info) - use psb_base_mod, psb_protect_name => psb_cscal_vect - implicit none - 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 - - ! 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_scal_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%scal(x,c,info) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return - -end subroutine psb_cscal_vect diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index c3a54f93..550711e4 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -735,88 +735,3 @@ subroutine psb_daddconst_vect(x,b,z,desc_a,info) return end subroutine psb_daddconst_vect -! -! Subroutine: psb_dscal_vect -! Scale one distributed vector with scalar c, -! -! Z(i) := c*X(i) -! -! Arguments: -! x - type(psb_d_vect_type) The input vector containing the entries of X -! c - 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_dscal_vect(x,c,z,desc_a,info) - use psb_base_mod, psb_protect_name => psb_dscal_vect - implicit none - 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 - - ! 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_scal_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%scal(x,c,info) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return - -end subroutine psb_dscal_vect diff --git a/base/psblas/psb_saxpby.f90 b/base/psblas/psb_saxpby.f90 index 6384968e..b264c3b0 100644 --- a/base/psblas/psb_saxpby.f90 +++ b/base/psblas/psb_saxpby.f90 @@ -735,88 +735,3 @@ subroutine psb_saddconst_vect(x,b,z,desc_a,info) return end subroutine psb_saddconst_vect -! -! Subroutine: psb_sscal_vect -! Scale one distributed vector with scalar c, -! -! Z(i) := c*X(i) -! -! Arguments: -! x - type(psb_s_vect_type) The input vector containing the entries of X -! c - 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_sscal_vect(x,c,z,desc_a,info) - use psb_base_mod, psb_protect_name => psb_sscal_vect - implicit none - 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 - - ! 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_scal_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%scal(x,c,info) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return - -end subroutine psb_sscal_vect diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index b5863d5a..c0cf79fd 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -735,88 +735,3 @@ subroutine psb_zaddconst_vect(x,b,z,desc_a,info) return end subroutine psb_zaddconst_vect -! -! Subroutine: psb_zscal_vect -! Scale one distributed vector with scalar c, -! -! Z(i) := c*X(i) -! -! Arguments: -! x - type(psb_z_vect_type) The input vector containing the entries of X -! c - 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_zscal_vect(x,c,z,desc_a,info) - use psb_base_mod, psb_protect_name => psb_zscal_vect - implicit none - 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 - - ! 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_scal_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%scal(x,c,info) - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return - -end subroutine psb_zscal_vect diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index af32c637..75028e27 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -4,27 +4,29 @@ module psb_base_tools_cbind_mod use psb_objhandle_mod use psb_cpenv_mod use psb_base_string_cbind_mod - + contains - + + ! Aggiungere funzione per estrarre comunicatore + function psb_c_error() bind(c) result(res) - implicit none - integer(psb_c_ipk_) :: res + implicit none + integer(psb_c_ipk_) :: res res = 0 call psb_error() end function psb_c_error - + function psb_c_clean_errstack() bind(c) result(res) - implicit none - integer(psb_c_ipk_) :: res + implicit none + integer(psb_c_ipk_) :: res res = 0 call psb_clean_errstack() end function psb_c_clean_errstack - + function psb_c_cdall_vg(ng,vg,ictxt,cdh) bind(c,name='psb_c_cdall_vg') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: ng integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_) :: vg(*) @@ -33,12 +35,12 @@ contains integer(psb_c_ipk_) :: info res = -1 - if (ng <=0) then + if (ng <=0) then write(0,*) 'Invalid size' return end if - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call descp%free(info) if (info == 0) deallocate(descp,stat=info) @@ -46,32 +48,32 @@ contains end if allocate(descp,stat=info) - if (info < 0) return - + if (info < 0) return + call psb_cdall(ictxt,descp,info,vg=vg(1:ng)) cdh%item = c_loc(descp) res = info end function psb_c_cdall_vg - - + + function psb_c_cdall_vl(nl,vl,ictxt,cdh) bind(c,name='psb_c_cdall_vl') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res integer(psb_c_ipk_), value :: nl, ictxt integer(psb_c_lpk_) :: vl(*) type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp - integer(psb_c_ipk_) :: info, ixb + integer(psb_c_ipk_) :: info, ixb res = -1 - if (nl <=0) then + if (nl <=0) then write(0,*) 'Invalid size' return end if - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call descp%free(info) if (info == 0) deallocate(descp,stat=info) @@ -79,11 +81,11 @@ contains end if allocate(descp,stat=info) - if (info < 0) return + if (info < 0) return ixb = psb_c_get_index_base() - - if (ixb == 1) then + + if (ixb == 1) then call psb_cdall(ictxt,descp,info,vl=vl(1:nl)) else call psb_cdall(ictxt,descp,info,vl=(vl(1:nl)+(1-ixb))) @@ -94,21 +96,21 @@ contains end function psb_c_cdall_vl function psb_c_cdall_nl(nl,ictxt,cdh) bind(c,name='psb_c_cdall_nl') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res integer(psb_c_ipk_), value :: nl, ictxt type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info res = -1 - if (nl <=0) then + if (nl <=0) then write(0,*) 'Invalid size' return end if - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call descp%free(info) if (info == 0) deallocate(descp,stat=info) @@ -116,8 +118,8 @@ contains end if allocate(descp,stat=info) - if (info < 0) return - + if (info < 0) return + call psb_cdall(ictxt,descp,info,nl=nl) cdh%item = c_loc(descp) res = info @@ -125,9 +127,9 @@ contains end function psb_c_cdall_nl function psb_c_cdall_repl(n,ictxt,cdh) bind(c,name='psb_c_cdall_repl') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: n integer(psb_c_ipk_), value :: ictxt type(psb_c_object_type) :: cdh @@ -135,12 +137,12 @@ contains integer(psb_c_ipk_) :: info res = -1 - if (n <=0) then + if (n <=0) then write(0,*) 'Invalid size' return end if - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call descp%free(info) if (info == 0) deallocate(descp,stat=info) @@ -148,25 +150,25 @@ contains end if allocate(descp,stat=info) - if (info < 0) return - + if (info < 0) return + call psb_cdall(ictxt,descp,info,mg=n,repl=.true.) cdh%item = c_loc(descp) res = info end function psb_c_cdall_repl - + function psb_c_cdasb(cdh) bind(c,name='psb_c_cdasb') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call psb_cdasb(descp,info) res = info @@ -177,39 +179,39 @@ contains function psb_c_cdfree(cdh) bind(c,name='psb_c_cdfree') result(res) - implicit none - integer(psb_c_ipk_) :: res + implicit none + integer(psb_c_ipk_) :: res type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call descp%free(info) if (info == 0) deallocate(descp,stat=info) if (info /= 0) return cdh%item = c_null_ptr end if - + res = info return end function psb_c_cdfree function psb_c_cdins(nz,ia,ja,cdh) bind(c,name='psb_c_cdins') result(res) - implicit none - integer(psb_c_ipk_) :: res + implicit none + integer(psb_c_ipk_) :: res integer(psb_c_ipk_), value :: nz type(psb_c_object_type) :: cdh integer(psb_c_lpk_) :: ia(*),ja(*) - + type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) call psb_cdins(nz,ia(1:nz),ja(1:nz),descp,info) res = info @@ -220,9 +222,9 @@ contains function psb_c_cd_get_local_rows(cdh) bind(c,name='psb_c_cd_get_local_rows') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp @@ -230,7 +232,7 @@ contains res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) res = descp%get_local_rows() @@ -241,9 +243,9 @@ contains function psb_c_cd_get_local_cols(cdh) bind(c,name='psb_c_cd_get_local_cols') result(res) - implicit none + implicit none - integer(psb_c_ipk_) :: res + integer(psb_c_ipk_) :: res type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp @@ -251,7 +253,7 @@ contains res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) res = descp%get_local_cols() @@ -260,9 +262,9 @@ contains end function psb_c_cd_get_local_cols function psb_c_cd_get_global_rows(cdh) bind(c,name='psb_c_cd_get_global_rows') result(res) - implicit none + implicit none - integer(psb_c_lpk_) :: res + integer(psb_c_lpk_) :: res type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp @@ -270,7 +272,7 @@ contains res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) res = descp%get_global_rows() @@ -281,9 +283,9 @@ contains function psb_c_cd_get_global_cols(cdh) bind(c,name='psb_c_cd_get_global_cols') result(res) - implicit none + implicit none - integer(psb_c_lpk_) :: res + integer(psb_c_lpk_) :: res type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp @@ -291,7 +293,7 @@ contains res = -1 - if (c_associated(cdh%item)) then + if (c_associated(cdh%item)) then call c_f_pointer(cdh%item,descp) res = descp%get_global_cols() @@ -301,4 +303,3 @@ contains end module psb_base_tools_cbind_mod - diff --git a/cbind/base/psb_c_base.c b/cbind/base/psb_c_base.c index 96a6df34..4683e49c 100644 --- a/cbind/base/psb_c_base.c +++ b/cbind/base/psb_c_base.c @@ -5,7 +5,7 @@ psb_c_descriptor* psb_c_new_descriptor() { psb_c_descriptor* temp; - + temp=(psb_c_descriptor *) malloc(sizeof(psb_c_descriptor)); temp->descriptor=NULL; return(temp); @@ -13,11 +13,11 @@ psb_c_descriptor* psb_c_new_descriptor() void psb_c_print_errmsg() -{ - char *mesg; - +{ + char *mesg; + for (mesg = psb_c_pop_errmsg(); mesg != NULL; mesg = psb_c_pop_errmsg()) { - fprintf(stderr,"%s\n",mesg); + fprintf(stderr,"%s\n",mesg); free(mesg); } @@ -28,7 +28,7 @@ void psb_c_print_errmsg() #define PSB_MAX_ERR_LINES 4 static int maxlen=PSB_MAX_ERR_LINES*(PSB_MAX_ERRLINE_LEN+2); char *psb_c_pop_errmsg() -{ +{ char *tmp; tmp = (char*) malloc(maxlen*sizeof(char)); if (psb_c_f2c_errmsg(tmp,maxlen)<=0) { @@ -36,4 +36,5 @@ char *psb_c_pop_errmsg() } return(tmp); } - + +// Convertire il comunicatore fortran in comunicatore c diff --git a/cbind/base/psb_c_cbase.h b/cbind/base/psb_c_cbase.h index 35f744a7..1fa7873e 100644 --- a/cbind/base/psb_c_cbase.h +++ b/cbind/base/psb_c_cbase.h @@ -75,7 +75,6 @@ psb_i_t psb_c_cgeinv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor 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_i_t psb_c_cgescal(psb_c_cvector *xh,psb_s_t ch,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 diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index b5b38158..cdeb0279 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -75,7 +75,6 @@ psb_i_t psb_c_dgeinv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor 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_i_t psb_c_dgescal(psb_c_dvector *xh,psb_d_t ch,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); diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 index 00f80280..cc22a124 100644 --- a/cbind/base/psb_c_psblas_cbind_mod.f90 +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -499,42 +499,6 @@ contains end function psb_c_cgeaddconst - function psb_c_cgescal(xh,ch,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) :: ch - - 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_gescal(xp,ch,zp,descp,info) - - res = info - - end function psb_c_cgescal - function psb_c_cgenrm2(xh,cdh) bind(c) result(res) implicit none diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index 7449ba51..8db2d5ac 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -75,7 +75,6 @@ psb_i_t psb_c_sgeinv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor 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_i_t psb_c_sgescal(psb_c_svector *xh,psb_s_t ch,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); diff --git a/cbind/base/psb_c_zbase.h b/cbind/base/psb_c_zbase.h index 9159b372..aebacced 100644 --- a/cbind/base/psb_c_zbase.h +++ b/cbind/base/psb_c_zbase.h @@ -75,7 +75,6 @@ psb_i_t psb_c_zgeinv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor 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_i_t psb_c_zgescal(psb_c_zvector *xh,psb_d_t ch,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 diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index 2260e09e..766175b0 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -499,42 +499,6 @@ contains end function psb_c_dgeaddconst - function psb_c_dgescal(xh,ch,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) :: ch - - 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_gescal(xp,ch,zp,descp,info) - - res = info - - end function psb_c_dgescal - function psb_c_dmask(ch,xh,mh,t,cdh) bind(c) result(res) implicit none integer(psb_c_ipk_) :: res diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 index bba8e7da..8ce42daf 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -499,42 +499,6 @@ contains end function psb_c_sgeaddconst - function psb_c_sgescal(xh,ch,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) :: ch - - 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_gescal(xp,ch,zp,descp,info) - - res = info - - end function psb_c_sgescal - function psb_c_smask(ch,xh,mh,t,cdh) bind(c) result(res) implicit none integer(psb_c_ipk_) :: res diff --git a/cbind/base/psb_z_psblas_cbind_mod.f90 b/cbind/base/psb_z_psblas_cbind_mod.f90 index 0e1dd23e..a35ee827 100644 --- a/cbind/base/psb_z_psblas_cbind_mod.f90 +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -499,42 +499,6 @@ contains end function psb_c_zgeaddconst - function psb_c_zgescal(xh,ch,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) :: ch - - 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_gescal(xp,ch,zp,descp,info) - - res = info - - end function psb_c_zgescal - function psb_c_zgenrm2(xh,cdh) bind(c) result(res) implicit none