Added vector/scalar comparison routine

base/modules/psblas/psb_c_psblas_mod.F90

@@ -479,4 +479,5 @@ module psb_c_psblas_mod
     end subroutine psb_cinv_vect_check
   end interface
 
+
 end module psb_c_psblas_mod

base/modules/psblas/psb_d_psblas_mod.F90

@@ -479,4 +479,16 @@ module psb_d_psblas_mod
     end subroutine psb_dinv_vect_check
   end interface
 
+  interface psb_gecmp
+    subroutine psb_dcmp_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_dcmp_vect
+  end interface
+
 end module psb_d_psblas_mod

base/modules/psblas/psb_s_psblas_mod.F90

@@ -479,4 +479,16 @@ module psb_s_psblas_mod
     end subroutine psb_sinv_vect_check
   end interface
 
+  interface psb_gecmp
+    subroutine psb_scmp_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_scmp_vect
+  end interface
+
 end module psb_s_psblas_mod

base/modules/psblas/psb_z_psblas_mod.F90

@@ -479,4 +479,5 @@ module psb_z_psblas_mod
     end subroutine psb_zinv_vect_check
   end interface
 
+
 end module psb_z_psblas_mod

base/modules/serial/psb_c_base_vect_mod.f90

@@ -187,6 +187,7 @@ module psb_c_base_vect_mod
     procedure, pass(x) :: amax     => c_base_amax
     procedure, pass(x) :: asum     => c_base_asum
 
+
   end type psb_c_base_vect_type
 
   public  :: psb_c_base_vect
@@ -1401,8 +1402,6 @@ contains
 
 
   end subroutine c_base_inv_a2_check
-
-
   !
   ! Simple scaling
   !

base/modules/serial/psb_c_vect_mod.F90

@@ -135,6 +135,11 @@ module psb_c_vect_mod
        & c_vect_absval2, c_vect_nrm2, c_vect_amax, c_vect_asum
 
 
+!  @NOTCPLXS@
+!  @NOTINTS@
+!  private :: c_vect_cmp_a2, c_vect_cmp_v2
+!  @NOTINTE@
+!  @NOTCPLXE@
 
   class(psb_c_base_vect_type), allocatable, target,&
        & save, private :: psb_c_base_vect_default
@@ -855,6 +860,7 @@ contains
 
   end subroutine c_vect_inv_a2_check
 
+
   subroutine c_vect_scal(alpha, x)
     use psi_serial_mod
     implicit none

base/modules/serial/psb_d_base_vect_mod.f90

@@ -187,6 +187,13 @@ module psb_d_base_vect_mod
     procedure, pass(x) :: amax     => d_base_amax
     procedure, pass(x) :: asum     => d_base_asum
 
+    !
+    ! Comparison and mask operation
+    !
+    procedure, pass(z) :: cmp_a2   => d_base_cmp_a2
+    procedure, pass(z) :: cmp_v2   => d_base_cmp_v2
+    generic, public    :: cmp      => cmp_a2,cmp_v2
+
   end type psb_d_base_vect_type
 
   public  :: psb_d_base_vect
@@ -1401,8 +1408,58 @@ contains
 
 
   end subroutine d_base_inv_a2_check
+  !
+  !> Function  base_inv_a2_check
+  !! \memberof  psb_d_base_vect_type
+  !! \brief Compare entry-by-entry the vector x with the scalar c
+  !! \param x The array to be compared
+  !! \param z The vector containing in position i 1 if |x(i)| > c, 0 otherwise
+  !! \param c The comparison term
+  !! \param info return code
+  !
+  subroutine d_base_cmp_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
+      if ( abs(x(i)).ge.c ) then
+        z%v(i) = 1_psb_dpk_
+      else
+        z%v(i) = 0_psb_dpk_
+      end if
+    end do
+    info = 0
 
+  end subroutine d_base_cmp_a2
+  !
+  !> Function  base_cmp_v2
+  !! \memberof  psb_d_base_vect_type
+  !! \brief Compare entry-by-entry the vector x with the scalar c
+  !! \param x The vector to be compared
+  !! \param z The vector containing in position i 1 if |x(i)| > c, 0 otherwise
+  !! \param c The comparison term
+  !! \param info return code
+  !
+  subroutine d_base_cmp_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%cmp(x%v,c,info)
+  end subroutine d_base_cmp_v2
   !
   ! Simple scaling
   !

base/modules/serial/psb_d_vect_mod.F90

@@ -111,6 +111,9 @@ module psb_d_vect_mod
     procedure, pass(x) :: nrm2     => d_vect_nrm2
     procedure, pass(x) :: amax     => d_vect_amax
     procedure, pass(x) :: asum     => d_vect_asum
+    procedure, pass(z) :: cmp_a2   => d_vect_cmp_a2
+    procedure, pass(z) :: cmp_v2   => d_vect_cmp_v2
+    generic, public    :: cmp      => cmp_a2, cmp_v2
   end type psb_d_vect_type
 
   public  :: psb_d_vect
@@ -135,6 +138,11 @@ module psb_d_vect_mod
        & d_vect_absval2, d_vect_nrm2, d_vect_amax, d_vect_asum
 
 
+!  @NOTCPLXS@
+!  @NOTINTS@
+!  private :: d_vect_cmp_a2, d_vect_cmp_v2
+!  @NOTINTE@
+!  @NOTCPLXE@
 
   class(psb_d_base_vect_type), allocatable, target,&
        & save, private :: psb_d_base_vect_default
@@ -855,6 +863,34 @@ contains
 
   end subroutine d_vect_inv_a2_check
 
+  subroutine d_vect_cmp_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%cmp(x,c,info)
+
+  end subroutine d_vect_cmp_a2
+
+  subroutine d_vect_cmp_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%cmp(x%v,c,info)
+
+  end subroutine d_vect_cmp_v2
+
   subroutine d_vect_scal(alpha, x)
     use psi_serial_mod
     implicit none

base/modules/serial/psb_i_base_vect_mod.f90

@@ -142,6 +142,7 @@ module psb_i_base_vect_mod
 
 
 
+
   end type psb_i_base_vect_type
 
   public  :: psb_i_base_vect

base/modules/serial/psb_i_vect_mod.F90

@@ -98,6 +98,11 @@ module psb_i_vect_mod
        & i_vect_set_dev, i_vect_set_sync
 
 
+!  @NOTCPLXS@
+!  @NOTINTS@
+!  private :: i_vect_cmp_a2, i_vect_cmp_v2
+!  @NOTINTE@
+!  @NOTCPLXE@
 
   class(psb_i_base_vect_type), allocatable, target,&
        & save, private :: psb_i_base_vect_default

base/modules/serial/psb_l_base_vect_mod.f90

@@ -143,6 +143,7 @@ module psb_l_base_vect_mod
 
 
 
+
   end type psb_l_base_vect_type
 
   public  :: psb_l_base_vect

base/modules/serial/psb_l_vect_mod.F90

@@ -99,6 +99,11 @@ module psb_l_vect_mod
        & l_vect_set_dev, l_vect_set_sync
 
 
+!  @NOTCPLXS@
+!  @NOTINTS@
+!  private :: l_vect_cmp_a2, l_vect_cmp_v2
+!  @NOTINTE@
+!  @NOTCPLXE@
 
   class(psb_l_base_vect_type), allocatable, target,&
        & save, private :: psb_l_base_vect_default

base/modules/serial/psb_s_base_vect_mod.f90

@@ -187,6 +187,13 @@ module psb_s_base_vect_mod
     procedure, pass(x) :: amax     => s_base_amax
     procedure, pass(x) :: asum     => s_base_asum
 
+    !
+    ! Comparison and mask operation
+    !
+    procedure, pass(z) :: cmp_a2   => s_base_cmp_a2
+    procedure, pass(z) :: cmp_v2   => s_base_cmp_v2
+    generic, public    :: cmp      => cmp_a2,cmp_v2
+
   end type psb_s_base_vect_type
 
   public  :: psb_s_base_vect
@@ -1401,8 +1408,58 @@ contains
 
 
   end subroutine s_base_inv_a2_check
+  !
+  !> Function  base_inv_a2_check
+  !! \memberof  psb_s_base_vect_type
+  !! \brief Compare entry-by-entry the vector x with the scalar c
+  !! \param x The array to be compared
+  !! \param z The vector containing in position i 1 if |x(i)| > c, 0 otherwise
+  !! \param c The comparison term
+  !! \param info return code
+  !
+  subroutine s_base_cmp_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
+      if ( abs(x(i)).ge.c ) then
+        z%v(i) = 1_psb_spk_
+      else
+        z%v(i) = 0_psb_spk_
+      end if
+    end do
+    info = 0
 
+  end subroutine s_base_cmp_a2
+  !
+  !> Function  base_cmp_v2
+  !! \memberof  psb_s_base_vect_type
+  !! \brief Compare entry-by-entry the vector x with the scalar c
+  !! \param x The vector to be compared
+  !! \param z The vector containing in position i 1 if |x(i)| > c, 0 otherwise
+  !! \param c The comparison term
+  !! \param info return code
+  !
+  subroutine s_base_cmp_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%cmp(x%v,c,info)
+  end subroutine s_base_cmp_v2
   !
   ! Simple scaling
   !

base/modules/serial/psb_s_vect_mod.F90

@@ -111,6 +111,9 @@ module psb_s_vect_mod
     procedure, pass(x) :: nrm2     => s_vect_nrm2
     procedure, pass(x) :: amax     => s_vect_amax
     procedure, pass(x) :: asum     => s_vect_asum
+    procedure, pass(z) :: cmp_a2   => s_vect_cmp_a2
+    procedure, pass(z) :: cmp_v2   => s_vect_cmp_v2
+    generic, public    :: cmp      => cmp_a2, cmp_v2
   end type psb_s_vect_type
 
   public  :: psb_s_vect
@@ -135,6 +138,11 @@ module psb_s_vect_mod
        & s_vect_absval2, s_vect_nrm2, s_vect_amax, s_vect_asum
 
 
+!  @NOTCPLXS@
+!  @NOTINTS@
+!  private :: s_vect_cmp_a2, s_vect_cmp_v2
+!  @NOTINTE@
+!  @NOTCPLXE@
 
   class(psb_s_base_vect_type), allocatable, target,&
        & save, private :: psb_s_base_vect_default
@@ -855,6 +863,34 @@ contains
 
   end subroutine s_vect_inv_a2_check
 
+  subroutine s_vect_cmp_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%cmp(x,c,info)
+
+  end subroutine s_vect_cmp_a2
+
+  subroutine s_vect_cmp_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%cmp(x%v,c,info)
+
+  end subroutine s_vect_cmp_v2
+
   subroutine s_vect_scal(alpha, x)
     use psi_serial_mod
     implicit none

base/modules/serial/psb_z_base_vect_mod.f90

@@ -187,6 +187,7 @@ module psb_z_base_vect_mod
     procedure, pass(x) :: amax     => z_base_amax
     procedure, pass(x) :: asum     => z_base_asum
 
+
   end type psb_z_base_vect_type
 
   public  :: psb_z_base_vect
@@ -1401,8 +1402,6 @@ contains
 
 
   end subroutine z_base_inv_a2_check
-
-
   !
   ! Simple scaling
   !

base/modules/serial/psb_z_vect_mod.F90

@@ -135,6 +135,11 @@ module psb_z_vect_mod
        & z_vect_absval2, z_vect_nrm2, z_vect_amax, z_vect_asum
 
 
+!  @NOTCPLXS@
+!  @NOTINTS@
+!  private :: z_vect_cmp_a2, z_vect_cmp_v2
+!  @NOTINTE@
+!  @NOTCPLXE@
 
   class(psb_z_base_vect_type), allocatable, target,&
        & save, private :: psb_z_base_vect_default
@@ -855,6 +860,7 @@ contains
 
   end subroutine z_vect_inv_a2_check
 
+
   subroutine z_vect_scal(alpha, x)
     use psi_serial_mod
     implicit none

base/psblas/Makefile

@@ -13,6 +13,7 @@ OBJS= psb_ddot.o psb_damax.o psb_dasum.o psb_daxpby.o\
 	psb_cmlt_vect.o psb_dmlt_vect.o psb_zmlt_vect.o psb_smlt_vect.o\
 	psb_cdiv_vect.o psb_ddiv_vect.o psb_zdiv_vect.o psb_sdiv_vect.o\
 	psb_cinv_vect.o psb_dinv_vect.o psb_zinv_vect.o psb_sinv_vect.o\
+	psb_dcmp_vect.o psb_scmp_vect.o
 
 LIBDIR=..
 INCDIR=..

base/psblas/psb_dcmp_vect.f90

@@ -0,0 +1,105 @@
+!
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone
+!        Alfredo Buttari
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+! File: psb_dcmp_vect
+
+subroutine psb_dcmp_vect(x,c,z,desc_a,info)
+  use psb_base_mod, psb_protect_name => psb_dcmp_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_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%cmp(x,c,info)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+
+end subroutine psb_dcmp_vect

base/psblas/psb_scmp_vect.f90

@@ -0,0 +1,105 @@
+!
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone
+!        Alfredo Buttari
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+! File: psb_scmp_vect
+
+subroutine psb_scmp_vect(x,c,z,desc_a,info)
+  use psb_base_mod, psb_protect_name => psb_scmp_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_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%cmp(x,c,info)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+
+end subroutine psb_scmp_vect

test/kernel/vecoperation.f90

@@ -56,6 +56,7 @@ program vecoperation
   real(psb_dpk_)    :: zt(1), dotresult, norm2, norm1, norminf
   character(len=20) :: name,ch_err,readinput
   real(psb_dpk_), allocatable :: vx(:), vy(:), vz(:)
+  real(psb_dpk_) :: c
 
   info=psb_success_
 
@@ -194,7 +195,18 @@ program vecoperation
     vx = x%get_vect()
     write(psb_out_unit,'("x = ",es12.1)')vx(:)
     vz = z%get_vect()
-    write(psb_out_unit,'("z = ",es12.1)')vy(:)
+    write(psb_out_unit,'("z = ",es12.1)')vz(:)
+  end if
+
+  c = 1.0/2.0;
+  call psb_gecmp(x,c,z,desc_a,info);
+
+  if (iam == psb_root_) then
+    write(psb_out_unit,'("|z(i)| >=",es12.1)')c
+    vx = x%get_vect()
+    write(psb_out_unit,'("x = ",es12.1)')vx(:)
+    vz = z%get_vect()
+    write(psb_out_unit,'("z = ",es12.1)')vz(:)
   end if
 
   !