Added minimum of realtype distributed vectors

base/modules/psblas/psb_c_psblas_mod.F90

@@ -183,6 +183,7 @@ module psb_c_psblas_mod
     end subroutine psb_cmamaxs
   end interface
 
+
   interface psb_geasum
     function psb_casum_vect(x, desc_a, info,global) result(res)
       import :: psb_desc_type, psb_spk_, psb_ipk_, &

base/modules/psblas/psb_d_psblas_mod.F90

@@ -183,6 +183,18 @@ module psb_d_psblas_mod
     end subroutine psb_dmamaxs
   end interface
 
+  interface psb_gemin
+    function psb_dmin_vect(x, desc_a, info,global) result(res)
+      import :: psb_desc_type, psb_dpk_, psb_ipk_, &
+           & psb_d_vect_type, psb_dspmat_type
+      real(psb_dpk_)                        :: res
+      type(psb_d_vect_type), intent (inout) :: x
+      type(psb_desc_type), intent (in)     :: desc_a
+      integer(psb_ipk_), intent(out)       :: info
+      logical, intent(in), optional        :: global
+    end function psb_dmin_vect
+  end interface
+
   interface psb_geasum
     function psb_dasum_vect(x, desc_a, info,global) result(res)
       import :: psb_desc_type, psb_dpk_, psb_ipk_, &

base/modules/psblas/psb_s_psblas_mod.F90

@@ -183,6 +183,18 @@ module psb_s_psblas_mod
     end subroutine psb_smamaxs
   end interface
 
+  interface psb_gemin
+    function psb_smin_vect(x, desc_a, info,global) result(res)
+      import :: psb_desc_type, psb_spk_, psb_ipk_, &
+           & psb_s_vect_type, psb_sspmat_type
+      real(psb_spk_)                        :: res
+      type(psb_s_vect_type), intent (inout) :: x
+      type(psb_desc_type), intent (in)     :: desc_a
+      integer(psb_ipk_), intent(out)       :: info
+      logical, intent(in), optional        :: global
+    end function psb_smin_vect
+  end interface
+
   interface psb_geasum
     function psb_sasum_vect(x, desc_a, info,global) result(res)
       import :: psb_desc_type, psb_spk_, psb_ipk_, &

base/modules/psblas/psb_z_psblas_mod.F90

@@ -183,6 +183,7 @@ module psb_z_psblas_mod
     end subroutine psb_zmamaxs
   end interface
 
+
   interface psb_geasum
     function psb_zasum_vect(x, desc_a, info,global) result(res)
       import :: psb_desc_type, psb_dpk_, psb_ipk_, &

base/modules/serial/psb_c_base_vect_mod.f90

@@ -1519,6 +1519,7 @@ contains
 
   end function c_base_amax
 
+
   !
   !> Function  base_asum
   !! \memberof  psb_c_base_vect_type

base/modules/serial/psb_c_vect_mod.F90

@@ -988,6 +988,7 @@ contains
 
   end function c_vect_amax
 
+
   function c_vect_asum(n,x) result(res)
     implicit none
     class(psb_c_vect_type), intent(inout) :: x

base/modules/serial/psb_d_base_vect_mod.f90

@@ -194,6 +194,7 @@ module psb_d_base_vect_mod
     procedure, pass(z) :: acmp_v2   => d_base_acmp_v2
     generic, public    :: acmp      => acmp_a2,acmp_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
@@ -1522,6 +1523,22 @@ contains
 
   end function d_base_amax
 
+  !
+  !> Function  base_min
+  !! \memberof  psb_d_base_vect_type
+  !! \brief min x(1:n)
+  !! \param n  how many entries to consider
+  function d_base_min(n,x) result(res)
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)           :: n
+    real(psb_dpk_)                :: res
+
+    if (x%is_dev()) call x%sync()
+    res =  minval(x%v(1:n))
+
+  end function d_base_min
+
   !
   !> Function  base_asum
   !! \memberof  psb_d_base_vect_type

base/modules/serial/psb_d_vect_mod.F90

@@ -118,6 +118,7 @@ module psb_d_vect_mod
     procedure, pass(z) :: acmp_v2   => d_vect_acmp_v2
     generic, public    :: acmp      => acmp_a2, acmp_v2
 
+    procedure, pass(x)   :: minreal   => d_vect_min
     procedure, pass(m) :: mask_v => d_vect_mask_v
     procedure, pass(m) :: mask_a => d_vect_mask_a
     generic, public    :: mask => mask_a, mask_v
@@ -991,6 +992,20 @@ contains
 
   end function d_vect_amax
 
+  function d_vect_min(n,x) result(res)
+    implicit none
+    class(psb_d_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)           :: n
+    real(psb_dpk_)                :: res
+
+    if (allocated(x%v)) then
+      res = x%v%minreal(n)
+    else
+      res = dzero
+    end if
+
+  end function d_vect_min
+
   function d_vect_asum(n,x) result(res)
     implicit none
     class(psb_d_vect_type), intent(inout) :: x

base/modules/serial/psb_s_base_vect_mod.f90

@@ -194,6 +194,7 @@ module psb_s_base_vect_mod
     procedure, pass(z) :: acmp_v2   => s_base_acmp_v2
     generic, public    :: acmp      => acmp_a2,acmp_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
@@ -1522,6 +1523,22 @@ contains
 
   end function s_base_amax
 
+  !
+  !> Function  base_min
+  !! \memberof  psb_s_base_vect_type
+  !! \brief min x(1:n)
+  !! \param n  how many entries to consider
+  function s_base_min(n,x) result(res)
+    implicit none
+    class(psb_s_base_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)           :: n
+    real(psb_spk_)                :: res
+
+    if (x%is_dev()) call x%sync()
+    res =  minval(x%v(1:n))
+
+  end function s_base_min
+
   !
   !> Function  base_asum
   !! \memberof  psb_s_base_vect_type

base/modules/serial/psb_s_vect_mod.F90

@@ -118,6 +118,7 @@ module psb_s_vect_mod
     procedure, pass(z) :: acmp_v2   => s_vect_acmp_v2
     generic, public    :: acmp      => acmp_a2, acmp_v2
 
+    procedure, pass(x)   :: minreal   => s_vect_min
     procedure, pass(m) :: mask_v => s_vect_mask_v
     procedure, pass(m) :: mask_a => s_vect_mask_a
     generic, public    :: mask => mask_a, mask_v
@@ -991,6 +992,20 @@ contains
 
   end function s_vect_amax
 
+  function s_vect_min(n,x) result(res)
+    implicit none
+    class(psb_s_vect_type), intent(inout) :: x
+    integer(psb_ipk_), intent(in)           :: n
+    real(psb_spk_)                :: res
+
+    if (allocated(x%v)) then
+      res = x%v%minreal(n)
+    else
+      res = szero
+    end if
+
+  end function s_vect_min
+
   function s_vect_asum(n,x) result(res)
     implicit none
     class(psb_s_vect_type), intent(inout) :: x

base/modules/serial/psb_z_base_vect_mod.f90

@@ -1519,6 +1519,7 @@ contains
 
   end function z_base_amax
 
+
   !
   !> Function  base_asum
   !! \memberof  psb_z_base_vect_type

base/modules/serial/psb_z_vect_mod.F90

@@ -988,6 +988,7 @@ contains
 
   end function z_vect_amax
 
+
   function z_vect_asum(n,x) result(res)
     implicit none
     class(psb_z_vect_type), intent(inout) :: x

base/psblas/psb_camax.f90

@@ -602,3 +602,4 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx,global)
 
   return
 end subroutine psb_cmamaxs
+

base/psblas/psb_damax.f90

@@ -602,3 +602,102 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx,global)
 
   return
 end subroutine psb_dmamaxs
+
+!
+! Function: psb_dmin_vect
+!    Computes the minimum value  of X.
+!
+!    mini := min(X(i))
+!
+! Arguments:
+!    x      - type(psb_d_vect_type) The input vector.
+!    desc_a -  type(psb_desc_type).  The communication descriptor.
+!    info   -  integer.              Return code
+!
+
+function psb_dmin_vect(x, desc_a, info,global) result(res)
+  use psb_penv_mod
+  use psb_serial_mod
+  use psb_desc_mod
+  use psb_check_mod
+  use psb_error_mod
+  use psb_d_vect_mod
+  implicit none
+
+  real(psb_dpk_)                        :: res
+  type(psb_d_vect_type), intent (inout) :: x
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)         :: info
+  logical, intent(in), optional        :: global
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, iix, jjx
+  integer(psb_lpk_) :: ix, jx, iy, ijy, m
+  logical :: global_
+  character(len=20)      :: name, ch_err
+
+  name='psb_dmin_vect'
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_ ;    goto 9999
+  end if
+
+  ictxt=desc_a%get_context()
+
+  call psb_info(ictxt, me, np)
+  if (np == -1) 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 (present(global)) then
+    global_ = global
+  else
+    global_ = .true.
+  end if
+
+  ix = 1
+  jx = 1
+
+  m = desc_a%get_global_rows()
+  call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkvect'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  if (iix /= 1) then
+    info=psb_err_ix_n1_iy_n1_unsupported_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ! compute local max
+  if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then
+    res = x%minreal(desc_a%get_local_rows())
+  else
+    res = dzero
+  end if
+
+  ! compute global min
+  if (global_) call psb_min(ictxt, res)
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+
+end function psb_dmin_vect

base/psblas/psb_samax.f90

@@ -602,3 +602,102 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx,global)
 
   return
 end subroutine psb_smamaxs
+
+!
+! Function: psb_smin_vect
+!    Computes the minimum value  of X.
+!
+!    mini := min(X(i))
+!
+! Arguments:
+!    x      - type(psb_s_vect_type) The input vector.
+!    desc_a -  type(psb_desc_type).  The communication descriptor.
+!    info   -  integer.              Return code
+!
+
+function psb_smin_vect(x, desc_a, info,global) result(res)
+  use psb_penv_mod
+  use psb_serial_mod
+  use psb_desc_mod
+  use psb_check_mod
+  use psb_error_mod
+  use psb_s_vect_mod
+  implicit none
+
+  real(psb_spk_)                        :: res
+  type(psb_s_vect_type), intent (inout) :: x
+  type(psb_desc_type), intent (in)      :: desc_a
+  integer(psb_ipk_), intent(out)         :: info
+  logical, intent(in), optional        :: global
+
+  ! locals
+  integer(psb_ipk_) :: ictxt, np, me,&
+       & err_act, iix, jjx
+  integer(psb_lpk_) :: ix, jx, iy, ijy, m
+  logical :: global_
+  character(len=20)      :: name, ch_err
+
+  name='psb_smin_vect'
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_ ;    goto 9999
+  end if
+
+  ictxt=desc_a%get_context()
+
+  call psb_info(ictxt, me, np)
+  if (np == -1) 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 (present(global)) then
+    global_ = global
+  else
+    global_ = .true.
+  end if
+
+  ix = 1
+  jx = 1
+
+  m = desc_a%get_global_rows()
+  call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chkvect'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  if (iix /= 1) then
+    info=psb_err_ix_n1_iy_n1_unsupported_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ! compute local max
+  if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then
+    res = x%minreal(desc_a%get_local_rows())
+  else
+    res = szero
+  end if
+
+  ! compute global min
+  if (global_) call psb_min(ictxt, res)
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ictxt,err_act)
+
+  return
+
+end function psb_smin_vect

base/psblas/psb_zamax.f90

@@ -602,3 +602,4 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx,global)
 
   return
 end subroutine psb_zmamaxs
+