Added psb_minquotient function with C interface

base/modules/psblas/psb_d_psblas_mod.F90

@@ -599,5 +599,17 @@ module psb_d_psblas_mod
       integer(psb_ipk_), intent(out)          :: info
     end subroutine psb_dmask_vect
   end interface
+  interface psb_minquotient
+    function psb_dminquotient_vect(x,y,desc_a,info,global) result(res)
+      import :: psb_desc_type, psb_ipk_, &
+           & psb_d_vect_type, psb_dpk_
+      real(psb_dpk_)                        :: res
+      type(psb_d_vect_type), intent (inout) :: x
+      type(psb_d_vect_type), intent (inout) :: y
+      type(psb_desc_type), intent (in)        :: desc_a
+      integer(psb_ipk_), intent(out)          :: info
+      logical, intent(in), optional           :: global
+    end function
+  end interface
 
 end module psb_d_psblas_mod

base/modules/psblas/psb_s_psblas_mod.F90

@@ -599,5 +599,17 @@ module psb_s_psblas_mod
       integer(psb_ipk_), intent(out)          :: info
     end subroutine psb_smask_vect
   end interface
+  interface psb_minquotient
+    function psb_sminquotient_vect(x,y,desc_a,info,global) result(res)
+      import :: psb_desc_type, psb_ipk_, &
+           & psb_s_vect_type, psb_spk_
+      real(psb_spk_)                        :: res
+      type(psb_s_vect_type), intent (inout) :: x
+      type(psb_s_vect_type), intent (inout) :: y
+      type(psb_desc_type), intent (in)        :: desc_a
+      integer(psb_ipk_), intent(out)          :: info
+      logical, intent(in), optional           :: global
+    end function
+  end interface
 
 end module psb_s_psblas_mod

base/modules/serial/psb_d_base_vect_mod.f90

@@ -211,6 +211,9 @@ 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
+    procedure, pass(x) :: minquotient_v  => d_base_minquotient_v
+    procedure, pass(x) :: minquotient_a2 => d_base_minquotient_a2
+    generic, public    :: minquotient    => minquotient_v, minquotient_a2
 
 
 
@@ -1649,6 +1652,62 @@ contains
 
   end function d_base_min
 
+  !
+  !> Function  base_minquotient_v
+  !! \memberof  psb_d_base_vect_type
+  !! \brief Minimum entry of the vector entry-by-entry divide  x/y
+  !! \param x The numerator vector
+  !! \param y The denumerator vector
+  !! \param info   return code
+  !!
+  function d_base_minquotient_v(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_d_base_vect_type), intent(inout)  :: x
+    class(psb_d_base_vect_type), intent(inout)  :: y
+    real(psb_dpk_)                              :: z
+    integer(psb_ipk_), intent(out)                :: info
+
+    info = 0
+    if (x%is_dev()) call x%sync()
+    if (y%is_dev()) call y%sync()
+
+    z = x%minquotient(y%v,info)
+
+  end function d_base_minquotient_v
+
+  !
+  !> Function  base_minquotient_a2
+  !! \memberof  psb_d_base_vect_type
+  !! \brief Minimum entry of the array entry-by-entry divide  x/y
+  !! \param x The numerator array
+  !! \param y The denumerator array
+  !! \param info   return code
+  !!
+  function d_base_minquotient_a2(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_d_base_vect_type), intent(inout) :: x
+    real(psb_dpk_), intent(in)                 :: y(:)
+    real(psb_dpk_)                             :: z
+    integer(psb_ipk_), intent(out)               :: info
+    integer(psb_ipk_) :: i, n
+    real(psb_dpk_)                             :: temp
+
+    info = 0
+
+    z = huge(z)
+    n = min(size(y), size(x%v))
+    do i=1, n
+      if ( y(i) /= dzero ) then
+        temp = x%v(i)/y(i)
+        if (temp <= z)  z = temp
+      end if
+    end do
+
+  end function d_base_minquotient_a2
+
+
   !
   !> Function  base_asum
   !! \memberof  psb_d_base_vect_type

base/modules/serial/psb_d_vect_mod.F90

@@ -131,6 +131,9 @@ module psb_d_vect_mod
     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
+    procedure, pass(x) :: minquotient_v  => d_vect_minquotient_v
+    procedure, pass(x) :: minquotient_a2 => d_vect_minquotient_a2
+    generic, public    :: minquotient    => minquotient_v, minquotient_a2
 
   end type psb_d_vect_type
 
@@ -1113,6 +1116,36 @@ contains
 
   end subroutine d_vect_mask_v
 
+  function d_vect_minquotient_v(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_d_vect_type), intent(inout)  :: x
+    class(psb_d_vect_type), intent(inout)  :: y
+    real(psb_dpk_)                         :: z
+    integer(psb_ipk_), intent(out)           :: info
+
+
+    info = 0
+    if (allocated(x%v).and.allocated(y%v)) &
+         & z = x%v%minquotient(y%v,info)
+
+  end function d_vect_minquotient_v
+
+  function d_vect_minquotient_a2(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_d_vect_type), intent(inout)  :: x
+    real(psb_dpk_), intent(inout)           :: y(:)
+    integer(psb_ipk_), intent(out)           :: info
+    real(psb_dpk_)                         :: z
+
+    info = 0
+    z =  x%v%minquotient(y,info)
+
+  end function d_vect_minquotient_a2
+
+
+
   subroutine d_vect_addconst_a2(x,b,z,info)
     use psi_serial_mod
     implicit none

base/modules/serial/psb_s_base_vect_mod.f90

@@ -211,6 +211,9 @@ 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
+    procedure, pass(x) :: minquotient_v  => s_base_minquotient_v
+    procedure, pass(x) :: minquotient_a2 => s_base_minquotient_a2
+    generic, public    :: minquotient    => minquotient_v, minquotient_a2
 
 
 
@@ -1649,6 +1652,62 @@ contains
 
   end function s_base_min
 
+  !
+  !> Function  base_minquotient_v
+  !! \memberof  psb_s_base_vect_type
+  !! \brief Minimum entry of the vector entry-by-entry divide  x/y
+  !! \param x The numerator vector
+  !! \param y The denumerator vector
+  !! \param info   return code
+  !!
+  function s_base_minquotient_v(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_s_base_vect_type), intent(inout)  :: x
+    class(psb_s_base_vect_type), intent(inout)  :: y
+    real(psb_spk_)                              :: z
+    integer(psb_ipk_), intent(out)                :: info
+
+    info = 0
+    if (x%is_dev()) call x%sync()
+    if (y%is_dev()) call y%sync()
+
+    z = x%minquotient(y%v,info)
+
+  end function s_base_minquotient_v
+
+  !
+  !> Function  base_minquotient_a2
+  !! \memberof  psb_s_base_vect_type
+  !! \brief Minimum entry of the array entry-by-entry divide  x/y
+  !! \param x The numerator array
+  !! \param y The denumerator array
+  !! \param info   return code
+  !!
+  function s_base_minquotient_a2(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_s_base_vect_type), intent(inout) :: x
+    real(psb_spk_), intent(in)                 :: y(:)
+    real(psb_spk_)                             :: z
+    integer(psb_ipk_), intent(out)               :: info
+    integer(psb_ipk_) :: i, n
+    real(psb_spk_)                             :: temp
+
+    info = 0
+
+    z = huge(z)
+    n = min(size(y), size(x%v))
+    do i=1, n
+      if ( y(i) /= szero ) then
+        temp = x%v(i)/y(i)
+        if (temp <= z)  z = temp
+      end if
+    end do
+
+  end function s_base_minquotient_a2
+
+
   !
   !> Function  base_asum
   !! \memberof  psb_s_base_vect_type

base/modules/serial/psb_s_vect_mod.F90

@@ -131,6 +131,9 @@ module psb_s_vect_mod
     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
+    procedure, pass(x) :: minquotient_v  => s_vect_minquotient_v
+    procedure, pass(x) :: minquotient_a2 => s_vect_minquotient_a2
+    generic, public    :: minquotient    => minquotient_v, minquotient_a2
 
   end type psb_s_vect_type
 
@@ -1113,6 +1116,36 @@ contains
 
   end subroutine s_vect_mask_v
 
+  function s_vect_minquotient_v(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_s_vect_type), intent(inout)  :: x
+    class(psb_s_vect_type), intent(inout)  :: y
+    real(psb_spk_)                         :: z
+    integer(psb_ipk_), intent(out)           :: info
+
+
+    info = 0
+    if (allocated(x%v).and.allocated(y%v)) &
+         & z = x%v%minquotient(y%v,info)
+
+  end function s_vect_minquotient_v
+
+  function s_vect_minquotient_a2(x, y, info) result(z)
+    use psi_serial_mod
+    implicit none
+    class(psb_s_vect_type), intent(inout)  :: x
+    real(psb_spk_), intent(inout)           :: y(:)
+    integer(psb_ipk_), intent(out)           :: info
+    real(psb_spk_)                         :: z
+
+    info = 0
+    z =  x%v%minquotient(y,info)
+
+  end function s_vect_minquotient_a2
+
+
+
   subroutine s_vect_addconst_a2(x,b,z,info)
     use psi_serial_mod
     implicit none

base/psblas/psb_cdiv_vect.f90

@@ -351,3 +351,4 @@ subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag)
   return
 
 end subroutine psb_cdiv_vect2_check
+

base/psblas/psb_ddiv_vect.f90

@@ -351,3 +351,91 @@ subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag)
   return
 
 end subroutine psb_ddiv_vect2_check
+
+function psb_dminquotient_vect(x,y,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_d_vect_type), intent (inout) :: y
+  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_dminquotient_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%minquotient(y,info)
+  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_dminquotient_vect

base/psblas/psb_sdiv_vect.f90

@@ -351,3 +351,91 @@ subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag)
   return
 
 end subroutine psb_sdiv_vect2_check
+
+function psb_sminquotient_vect(x,y,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_s_vect_type), intent (inout) :: y
+  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_sminquotient_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%minquotient(y,info)
+  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_sminquotient_vect

base/psblas/psb_zdiv_vect.f90

@@ -351,3 +351,4 @@ subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag)
   return
 
 end subroutine psb_zdiv_vect2_check
+

cbind/base/psb_c_dbase.h

@@ -77,7 +77,7 @@ psb_d_t psb_c_dgenrm2_weight(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_descripto
 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);
 psb_d_t psb_c_dgemin(psb_c_dvector *xh,psb_c_descriptor *cdh);
-
+psb_d_t psb_c_dminquotient(psb_c_dvector *xh,psb_c_dvector *yh, psb_c_descriptor *cdh);
 
 #ifdef __cplusplus
 }

cbind/base/psb_d_psblas_cbind_mod.f90

@@ -536,6 +536,40 @@ contains
 
   end function psb_c_dmask
 
+  function psb_c_dminquotient(xh,yh,cdh) bind(c) result(res)
+    implicit none
+    real(psb_dpk_)       :: res
+
+    type(psb_c_dvector)  :: xh,yh
+    type(psb_c_descriptor) :: cdh
+
+    type(psb_desc_type), pointer :: descp
+    type(psb_d_vect_type), pointer :: xp,yp
+    integer(psb_c_ipk_)          :: info
+
+    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(yh%item)) then
+      call c_f_pointer(yh%item,yp)
+    else
+      return
+    end if
+
+    res = psb_minquotient(xp,yp,descp,info)
+
+
+  end function psb_c_dminquotient
+
   function psb_c_dgenrm2(xh,cdh) bind(c) result(res)
     implicit none
     real(c_double) :: res

cbind/base/psb_s_psblas_cbind_mod.f90

@@ -536,6 +536,40 @@ contains
 
   end function psb_c_smask
 
+  function psb_c_sminquotient(xh,yh,cdh) bind(c) result(res)
+    implicit none
+    real(psb_spk_)       :: res
+
+    type(psb_c_svector)  :: xh,yh
+    type(psb_c_descriptor) :: cdh
+
+    type(psb_desc_type), pointer :: descp
+    type(psb_s_vect_type), pointer :: xp,yp
+    integer(psb_c_ipk_)          :: info
+
+    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(yh%item)) then
+      call c_f_pointer(yh%item,yp)
+    else
+      return
+    end if
+
+    res = psb_minquotient(xp,yp,descp,info)
+
+
+  end function psb_c_sminquotient
+
   function psb_c_sgenrm2(xh,cdh) bind(c) result(res)
     implicit none
     real(c_float) :: res