fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added psb_minquotient function with C interface

Browse Source
This commit is contained in:
Cirdans-Home
2020-02-26 23:37:15 +01:00
parent fd89f2f1bf
commit 8bf0ff673b
13 changed files with 463 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psblas/psb_d_psblas_mod.F90
+12
View File
@@ -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
+12
View File
@@ -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
+63 -4
View File
@@ -207,10 +207,13 @@ module psb_d_base_vect_mod
procedure, pass(z) :: addconst_v2 => d_base_addconst_v2
generic, public :: addconst => addconst_a2,addconst_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
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
+33
View File
@@ -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
+63 -4
View File
@@ -207,10 +207,13 @@ module psb_s_base_vect_mod
procedure, pass(z) :: addconst_v2 => s_base_addconst_v2
generic, public :: addconst => addconst_a2,addconst_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
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
+33
View File
@@ -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