fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

entrywise divide with zero check

Browse Source
merge-paraggr-newops
cirdans-home 5 years ago
parent ce6383b7ff
commit db7b882e9c
16 changed files with 724 additions and 20 deletions
Show Stats Download Patch File Download Diff File

9
base/modules/psblas/psb_c_psblas_mod.F90
Unescape Escape View File

@ -448,6 +448,15 @@ module psb_c_psblas_mod
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdiv_vect end subroutine psb_cdiv_vect
subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_c_vect_type
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_cdiv_vect_check
end interface end interface
end module psb_c_psblas_mod end module psb_c_psblas_mod

9
base/modules/psblas/psb_d_psblas_mod.F90
Unescape Escape View File

@ -448,6 +448,15 @@ module psb_d_psblas_mod
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_ddiv_vect end subroutine psb_ddiv_vect
subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_d_vect_type
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) :: flag
end subroutine psb_ddiv_vect_check
end interface end interface
end module psb_d_psblas_mod end module psb_d_psblas_mod

9
base/modules/psblas/psb_s_psblas_mod.F90
Unescape Escape View File

@ -448,6 +448,15 @@ module psb_s_psblas_mod
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_sdiv_vect end subroutine psb_sdiv_vect
subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_s_vect_type
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) :: flag
end subroutine psb_sdiv_vect_check
end interface end interface
end module psb_s_psblas_mod end module psb_s_psblas_mod

9
base/modules/psblas/psb_z_psblas_mod.F90
Unescape Escape View File

@ -448,6 +448,15 @@ module psb_z_psblas_mod
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_zdiv_vect end subroutine psb_zdiv_vect
subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag)
import :: psb_desc_type, psb_ipk_, &
& psb_z_vect_type
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
end subroutine psb_zdiv_vect_check
end interface end interface
end module psb_z_psblas_mod end module psb_z_psblas_mod

68
base/modules/serial/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -166,9 +166,11 @@ module psb_c_base_vect_mod
! !
! Vector-Vector operations ! Vector-Vector operations
! !
procedure, pass(x) :: div_v => c_base_div_v procedure, pass(x) :: div_v => c_base_div_v
procedure, pass(z) :: div_a2 => c_base_div_a2 procedure, pass(x) :: div_v_check => c_base_div_v_check
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2 => c_base_div_a2
procedure, pass(z) :: div_a2_check => c_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
! !
! Scaling and norms ! Scaling and norms
! !
@ -1205,10 +1207,32 @@ contains
end subroutine c_base_div_v end subroutine c_base_div_v
! !
!> Function base_div_v_check
!! \memberof psb_c_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine c_base_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (x%is_dev()) call x%sync()
call x%div(x%v,y%v,info,flag)
end subroutine c_base_div_v_check
!
!> Function base_div_a2 !> Function base_div_a2
!! \memberof psb_c_base_vect_type !! \memberof psb_c_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y !! \brief Entry-by-entry divide between normal array x=x/y
!! \param x(:) The array to be multiplied by !! \param y(:) The array to be divided by
!! \param info return code !! \param info return code
!! !!
subroutine c_base_div_a2(x, y, z, info) subroutine c_base_div_a2(x, y, z, info)
@ -1229,7 +1253,43 @@ contains
end do end do
end subroutine c_base_div_a2 end subroutine c_base_div_a2
!
!> Function base_div_a2_check
!! \memberof psb_c_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y and check if y(i)
!! is different from zero
!! \param y(:) The array to be dived by
!! \param info return code
!!
subroutine c_base_div_a2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: z
complex(psb_spk_), intent(in) :: x(:)
complex(psb_spk_), intent(in) :: y(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
integer(psb_ipk_) :: i, n
if (flag .eqv. .false.) then
call c_base_div_a2(x, y, z, info)
else
info = 0
if (z%is_dev()) call z%sync()
n = min(size(y), size(x))
do i=1, n
if (y(i) /= 0) then
z%v(i) = x(i)/y(i)
else
info = 1
exit
end if
end do
end if
end subroutine c_base_div_a2_check
! !

35
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -95,8 +95,10 @@ module psb_c_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va & mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => c_vect_div_v procedure, pass(x) :: div_v => c_vect_div_v
procedure, pass(x) :: div_v_check => c_vect_div_v_check
procedure, pass(z) :: div_a2 => c_vect_div_a2 procedure, pass(z) :: div_a2 => c_vect_div_a2
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2_check => c_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
procedure, pass(x) :: scal => c_vect_scal procedure, pass(x) :: scal => c_vect_scal
procedure, pass(x) :: absval1 => c_vect_absval1 procedure, pass(x) :: absval1 => c_vect_absval1
procedure, pass(x) :: absval2 => c_vect_absval2 procedure, pass(x) :: absval2 => c_vect_absval2
@ -744,6 +746,21 @@ contains
end subroutine c_vect_div_v end subroutine c_vect_div_v
subroutine c_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v)) &
& call x%v%div(y%v,info,flag)
end subroutine c_vect_div_v_check
subroutine c_vect_div_a2(x, y, z, info) subroutine c_vect_div_a2(x, y, z, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -759,6 +776,22 @@ contains
end subroutine c_vect_div_a2 end subroutine c_vect_div_a2
subroutine c_vect_div_a2_check(x, y, z, info,flag)
use psi_serial_mod
implicit none
complex(psb_spk_), intent(in) :: x(:)
complex(psb_spk_), intent(in) :: y(:)
class(psb_c_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(z%v)) &
& call z%v%div(x,y,info,flag)
end subroutine c_vect_div_a2_check
subroutine c_vect_scal(alpha, x) subroutine c_vect_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

68
base/modules/serial/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -166,9 +166,11 @@ module psb_d_base_vect_mod
! !
! Vector-Vector operations ! Vector-Vector operations
! !
procedure, pass(x) :: div_v => d_base_div_v procedure, pass(x) :: div_v => d_base_div_v
procedure, pass(z) :: div_a2 => d_base_div_a2 procedure, pass(x) :: div_v_check => d_base_div_v_check
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2 => d_base_div_a2
procedure, pass(z) :: div_a2_check => d_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
! !
! Scaling and norms ! Scaling and norms
! !
@ -1205,10 +1207,32 @@ contains
end subroutine d_base_div_v end subroutine d_base_div_v
! !
!> Function base_div_v_check
!! \memberof psb_d_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine d_base_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (x%is_dev()) call x%sync()
call x%div(x%v,y%v,info,flag)
end subroutine d_base_div_v_check
!
!> Function base_div_a2 !> Function base_div_a2
!! \memberof psb_d_base_vect_type !! \memberof psb_d_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y !! \brief Entry-by-entry divide between normal array x=x/y
!! \param x(:) The array to be multiplied by !! \param y(:) The array to be divided by
!! \param info return code !! \param info return code
!! !!
subroutine d_base_div_a2(x, y, z, info) subroutine d_base_div_a2(x, y, z, info)
@ -1229,7 +1253,43 @@ contains
end do end do
end subroutine d_base_div_a2 end subroutine d_base_div_a2
!
!> Function base_div_a2_check
!! \memberof psb_d_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y and check if y(i)
!! is different from zero
!! \param y(:) The array to be dived by
!! \param info return code
!!
subroutine d_base_div_a2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: z
real(psb_dpk_), intent(in) :: x(:)
real(psb_dpk_), intent(in) :: y(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
integer(psb_ipk_) :: i, n
if (flag .eqv. .false.) then
call d_base_div_a2(x, y, z, info)
else
info = 0
if (z%is_dev()) call z%sync()
n = min(size(y), size(x))
do i=1, n
if (y(i) /= 0) then
z%v(i) = x(i)/y(i)
else
info = 1
exit
end if
end do
end if
end subroutine d_base_div_a2_check
! !

35
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -95,8 +95,10 @@ module psb_d_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va & mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => d_vect_div_v procedure, pass(x) :: div_v => d_vect_div_v
procedure, pass(x) :: div_v_check => d_vect_div_v_check
procedure, pass(z) :: div_a2 => d_vect_div_a2 procedure, pass(z) :: div_a2 => d_vect_div_a2
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2_check => d_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
procedure, pass(x) :: scal => d_vect_scal procedure, pass(x) :: scal => d_vect_scal
procedure, pass(x) :: absval1 => d_vect_absval1 procedure, pass(x) :: absval1 => d_vect_absval1
procedure, pass(x) :: absval2 => d_vect_absval2 procedure, pass(x) :: absval2 => d_vect_absval2
@ -744,6 +746,21 @@ contains
end subroutine d_vect_div_v end subroutine d_vect_div_v
subroutine d_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v)) &
& call x%v%div(y%v,info,flag)
end subroutine d_vect_div_v_check
subroutine d_vect_div_a2(x, y, z, info) subroutine d_vect_div_a2(x, y, z, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -759,6 +776,22 @@ contains
end subroutine d_vect_div_a2 end subroutine d_vect_div_a2
subroutine d_vect_div_a2_check(x, y, z, info,flag)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: x(:)
real(psb_dpk_), intent(in) :: y(:)
class(psb_d_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(z%v)) &
& call z%v%div(x,y,info,flag)
end subroutine d_vect_div_a2_check
subroutine d_vect_scal(alpha, x) subroutine d_vect_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

68
base/modules/serial/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -166,9 +166,11 @@ module psb_s_base_vect_mod
! !
! Vector-Vector operations ! Vector-Vector operations
! !
procedure, pass(x) :: div_v => s_base_div_v procedure, pass(x) :: div_v => s_base_div_v
procedure, pass(z) :: div_a2 => s_base_div_a2 procedure, pass(x) :: div_v_check => s_base_div_v_check
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2 => s_base_div_a2
procedure, pass(z) :: div_a2_check => s_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
! !
! Scaling and norms ! Scaling and norms
! !
@ -1205,10 +1207,32 @@ contains
end subroutine s_base_div_v end subroutine s_base_div_v
! !
!> Function base_div_v_check
!! \memberof psb_s_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine s_base_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (x%is_dev()) call x%sync()
call x%div(x%v,y%v,info,flag)
end subroutine s_base_div_v_check
!
!> Function base_div_a2 !> Function base_div_a2
!! \memberof psb_s_base_vect_type !! \memberof psb_s_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y !! \brief Entry-by-entry divide between normal array x=x/y
!! \param x(:) The array to be multiplied by !! \param y(:) The array to be divided by
!! \param info return code !! \param info return code
!! !!
subroutine s_base_div_a2(x, y, z, info) subroutine s_base_div_a2(x, y, z, info)
@ -1229,7 +1253,43 @@ contains
end do end do
end subroutine s_base_div_a2 end subroutine s_base_div_a2
!
!> Function base_div_a2_check
!! \memberof psb_s_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y and check if y(i)
!! is different from zero
!! \param y(:) The array to be dived by
!! \param info return code
!!
subroutine s_base_div_a2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: z
real(psb_spk_), intent(in) :: x(:)
real(psb_spk_), intent(in) :: y(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
integer(psb_ipk_) :: i, n
if (flag .eqv. .false.) then
call s_base_div_a2(x, y, z, info)
else
info = 0
if (z%is_dev()) call z%sync()
n = min(size(y), size(x))
do i=1, n
if (y(i) /= 0) then
z%v(i) = x(i)/y(i)
else
info = 1
exit
end if
end do
end if
end subroutine s_base_div_a2_check
! !

35
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -95,8 +95,10 @@ module psb_s_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va & mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => s_vect_div_v procedure, pass(x) :: div_v => s_vect_div_v
procedure, pass(x) :: div_v_check => s_vect_div_v_check
procedure, pass(z) :: div_a2 => s_vect_div_a2 procedure, pass(z) :: div_a2 => s_vect_div_a2
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2_check => s_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
procedure, pass(x) :: scal => s_vect_scal procedure, pass(x) :: scal => s_vect_scal
procedure, pass(x) :: absval1 => s_vect_absval1 procedure, pass(x) :: absval1 => s_vect_absval1
procedure, pass(x) :: absval2 => s_vect_absval2 procedure, pass(x) :: absval2 => s_vect_absval2
@ -744,6 +746,21 @@ contains
end subroutine s_vect_div_v end subroutine s_vect_div_v
subroutine s_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v)) &
& call x%v%div(y%v,info,flag)
end subroutine s_vect_div_v_check
subroutine s_vect_div_a2(x, y, z, info) subroutine s_vect_div_a2(x, y, z, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -759,6 +776,22 @@ contains
end subroutine s_vect_div_a2 end subroutine s_vect_div_a2
subroutine s_vect_div_a2_check(x, y, z, info,flag)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: x(:)
real(psb_spk_), intent(in) :: y(:)
class(psb_s_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(z%v)) &
& call z%v%div(x,y,info,flag)
end subroutine s_vect_div_a2_check
subroutine s_vect_scal(alpha, x) subroutine s_vect_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

68
base/modules/serial/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -166,9 +166,11 @@ module psb_z_base_vect_mod
! !
! Vector-Vector operations ! Vector-Vector operations
! !
procedure, pass(x) :: div_v => z_base_div_v procedure, pass(x) :: div_v => z_base_div_v
procedure, pass(z) :: div_a2 => z_base_div_a2 procedure, pass(x) :: div_v_check => z_base_div_v_check
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2 => z_base_div_a2
procedure, pass(z) :: div_a2_check => z_base_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
! !
! Scaling and norms ! Scaling and norms
! !
@ -1205,10 +1207,32 @@ contains
end subroutine z_base_div_v end subroutine z_base_div_v
! !
!> Function base_div_v_check
!! \memberof psb_z_base_vect_type
!! \brief Vector entry-by-entry divide by a vector x=x/y
!! \param y The array to be divided by
!! \param info return code
!!
subroutine z_base_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (x%is_dev()) call x%sync()
call x%div(x%v,y%v,info,flag)
end subroutine z_base_div_v_check
!
!> Function base_div_a2 !> Function base_div_a2
!! \memberof psb_z_base_vect_type !! \memberof psb_z_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y !! \brief Entry-by-entry divide between normal array x=x/y
!! \param x(:) The array to be multiplied by !! \param y(:) The array to be divided by
!! \param info return code !! \param info return code
!! !!
subroutine z_base_div_a2(x, y, z, info) subroutine z_base_div_a2(x, y, z, info)
@ -1229,7 +1253,43 @@ contains
end do end do
end subroutine z_base_div_a2 end subroutine z_base_div_a2
!
!> Function base_div_a2_check
!! \memberof psb_z_base_vect_type
!! \brief Entry-by-entry divide between normal array x=x/y and check if y(i)
!! is different from zero
!! \param y(:) The array to be dived by
!! \param info return code
!!
subroutine z_base_div_a2_check(x, y, z, info, flag)
use psi_serial_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: z
complex(psb_dpk_), intent(in) :: x(:)
complex(psb_dpk_), intent(in) :: y(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
integer(psb_ipk_) :: i, n
if (flag .eqv. .false.) then
call z_base_div_a2(x, y, z, info)
else
info = 0
if (z%is_dev()) call z%sync()
n = min(size(y), size(x))
do i=1, n
if (y(i) /= 0) then
z%v(i) = x(i)/y(i)
else
info = 1
exit
end if
end do
end if
end subroutine z_base_div_a2_check
! !

35
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -95,8 +95,10 @@ module psb_z_vect_mod
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va & mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: div_v => z_vect_div_v procedure, pass(x) :: div_v => z_vect_div_v
procedure, pass(x) :: div_v_check => z_vect_div_v_check
procedure, pass(z) :: div_a2 => z_vect_div_a2 procedure, pass(z) :: div_a2 => z_vect_div_a2
generic, public :: div => div_v, div_a2 procedure, pass(z) :: div_a2_check => z_vect_div_a2_check
generic, public :: div => div_v, div_v_check, div_a2, div_a2_check
procedure, pass(x) :: scal => z_vect_scal procedure, pass(x) :: scal => z_vect_scal
procedure, pass(x) :: absval1 => z_vect_absval1 procedure, pass(x) :: absval1 => z_vect_absval1
procedure, pass(x) :: absval2 => z_vect_absval2 procedure, pass(x) :: absval2 => z_vect_absval2
@ -744,6 +746,21 @@ contains
end subroutine z_vect_div_v end subroutine z_vect_div_v
subroutine z_vect_div_v_check(x, y, info, flag)
use psi_serial_mod
implicit none
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(x%v).and.allocated(y%v)) &
& call x%v%div(y%v,info,flag)
end subroutine z_vect_div_v_check
subroutine z_vect_div_a2(x, y, z, info) subroutine z_vect_div_a2(x, y, z, info)
use psi_serial_mod use psi_serial_mod
implicit none implicit none
@ -759,6 +776,22 @@ contains
end subroutine z_vect_div_a2 end subroutine z_vect_div_a2
subroutine z_vect_div_a2_check(x, y, z, info,flag)
use psi_serial_mod
implicit none
complex(psb_dpk_), intent(in) :: x(:)
complex(psb_dpk_), intent(in) :: y(:)
class(psb_z_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
logical, intent(in) :: flag
info = 0
if (allocated(z%v)) &
& call z%v%div(x,y,info,flag)
end subroutine z_vect_div_a2_check
subroutine z_vect_scal(alpha, x) subroutine z_vect_scal(alpha, x)
use psi_serial_mod use psi_serial_mod
implicit none implicit none

74
base/psblas/psb_cdiv_vect.f90
Unescape Escape View File

@ -103,3 +103,77 @@ subroutine psb_cdiv_vect(x,y,desc_a,info)
return return
end subroutine psb_cdiv_vect end subroutine psb_cdiv_vect
subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_cdiv_vect_check
implicit none
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
! 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_div_vect_check'
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(y%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,y%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 x%div(y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cdiv_vect_check

74
base/psblas/psb_ddiv_vect.f90
Unescape Escape View File

@ -103,3 +103,77 @@ subroutine psb_ddiv_vect(x,y,desc_a,info)
return return
end subroutine psb_ddiv_vect end subroutine psb_ddiv_vect
subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_ddiv_vect_check
implicit none
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) :: flag
! 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_div_vect_check'
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(y%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,y%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 x%div(y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_ddiv_vect_check

74
base/psblas/psb_sdiv_vect.f90
Unescape Escape View File

@ -103,3 +103,77 @@ subroutine psb_sdiv_vect(x,y,desc_a,info)
return return
end subroutine psb_sdiv_vect end subroutine psb_sdiv_vect
subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_sdiv_vect_check
implicit none
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) :: flag
! 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_div_vect_check'
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(y%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,y%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 x%div(y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sdiv_vect_check

74
base/psblas/psb_zdiv_vect.f90
Unescape Escape View File

@ -103,3 +103,77 @@ subroutine psb_zdiv_vect(x,y,desc_a,info)
return return
end subroutine psb_zdiv_vect end subroutine psb_zdiv_vect
subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag)
use psb_base_mod, psb_protect_name => psb_zdiv_vect_check
implicit none
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: y
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: flag
! 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_div_vect_check'
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(y%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,y%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 x%div(y,info,flag)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zdiv_vect_check

Write Preview
Loading…
Cancel
Save