mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 21:02:26 +00:00
psblas3:
base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_vect_mod.F90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_vect_mod.F90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_vect_mod.F90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_vect_mod.F90 New absval method for vectors.
This commit is contained in:
Salvatore Filippone
@@ -135,7 +135,9 @@ module psb_c_base_vect_mod
|
||||
! Scaling and norms
|
||||
!
|
||||
procedure, pass(x) :: scal => c_base_scal
|
||||
procedure, pass(x) :: absval => c_base_absval
|
||||
procedure, pass(x) :: absval1 => c_base_absval1
|
||||
procedure, pass(x) :: absval2 => c_base_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => c_base_nrm2
|
||||
procedure, pass(x) :: amax => c_base_amax
|
||||
procedure, pass(x) :: asum => c_base_asum
|
||||
@@ -398,7 +400,7 @@ contains
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) x%v=czero
|
||||
|
||||
call x%set_host()
|
||||
end subroutine c_base_zero
|
||||
|
||||
|
||||
@@ -614,7 +616,7 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (.not.allocated(x%v)) return
|
||||
call x%sync()
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
allocate(res(x%get_nrows()),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
|
||||
@@ -637,8 +639,10 @@ contains
|
||||
complex(psb_spk_), intent(in) :: val
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
x%v = val
|
||||
|
||||
call x%set_host()
|
||||
|
||||
end subroutine c_base_set_scal
|
||||
|
||||
!
|
||||
@@ -649,13 +653,29 @@ contains
|
||||
!! \memberof psb_c_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine c_base_absval(x)
|
||||
subroutine c_base_absval1(x)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& x%v = abs(x%v)
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine c_base_absval
|
||||
end subroutine c_base_absval1
|
||||
|
||||
subroutine c_base_absval2(x,y)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine c_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -675,6 +695,7 @@ contains
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
call x%set_host()
|
||||
|
||||
end subroutine c_base_set_vect
|
||||
|
||||
|
||||
@@ -63,7 +63,9 @@ module psb_c_vect_mod
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => c_vect_scal
|
||||
procedure, pass(x) :: absval => c_vect_absval
|
||||
procedure, pass(x) :: absval1 => c_vect_absval1
|
||||
procedure, pass(x) :: absval2 => c_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => c_vect_nrm2
|
||||
procedure, pass(x) :: amax => c_vect_amax
|
||||
procedure, pass(x) :: asum => c_vect_asum
|
||||
@@ -458,14 +460,24 @@ contains
|
||||
|
||||
end subroutine c_vect_scal
|
||||
|
||||
subroutine c_vect_absval(x)
|
||||
subroutine c_vect_absval1(x)
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%absval()
|
||||
|
||||
end subroutine c_vect_absval
|
||||
end subroutine c_vect_absval1
|
||||
|
||||
subroutine c_vect_absval2(x,y)
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_vect_type), intent(inout) :: y
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.allocated(y%v)) call y%bld(size(x%v%v))
|
||||
call x%v%absval(y%v)
|
||||
end if
|
||||
end subroutine c_vect_absval2
|
||||
|
||||
function c_vect_nrm2(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
@@ -135,7 +135,9 @@ module psb_d_base_vect_mod
|
||||
! Scaling and norms
|
||||
!
|
||||
procedure, pass(x) :: scal => d_base_scal
|
||||
procedure, pass(x) :: absval => d_base_absval
|
||||
procedure, pass(x) :: absval1 => d_base_absval1
|
||||
procedure, pass(x) :: absval2 => d_base_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => d_base_nrm2
|
||||
procedure, pass(x) :: amax => d_base_amax
|
||||
procedure, pass(x) :: asum => d_base_asum
|
||||
@@ -398,7 +400,7 @@ contains
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) x%v=dzero
|
||||
|
||||
call x%set_host()
|
||||
end subroutine d_base_zero
|
||||
|
||||
|
||||
@@ -614,7 +616,7 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (.not.allocated(x%v)) return
|
||||
call x%sync()
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
allocate(res(x%get_nrows()),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
|
||||
@@ -637,8 +639,10 @@ contains
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
x%v = val
|
||||
|
||||
call x%set_host()
|
||||
|
||||
end subroutine d_base_set_scal
|
||||
|
||||
!
|
||||
@@ -649,13 +653,29 @@ contains
|
||||
!! \memberof psb_d_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine d_base_absval(x)
|
||||
subroutine d_base_absval1(x)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& x%v = abs(x%v)
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine d_base_absval
|
||||
end subroutine d_base_absval1
|
||||
|
||||
subroutine d_base_absval2(x,y)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine d_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -675,6 +695,7 @@ contains
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
call x%set_host()
|
||||
|
||||
end subroutine d_base_set_vect
|
||||
|
||||
|
||||
@@ -63,7 +63,9 @@ module psb_d_vect_mod
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => d_vect_scal
|
||||
procedure, pass(x) :: absval => d_vect_absval
|
||||
procedure, pass(x) :: absval1 => d_vect_absval1
|
||||
procedure, pass(x) :: absval2 => d_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => d_vect_nrm2
|
||||
procedure, pass(x) :: amax => d_vect_amax
|
||||
procedure, pass(x) :: asum => d_vect_asum
|
||||
@@ -458,14 +460,24 @@ contains
|
||||
|
||||
end subroutine d_vect_scal
|
||||
|
||||
subroutine d_vect_absval(x)
|
||||
subroutine d_vect_absval1(x)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%absval()
|
||||
|
||||
end subroutine d_vect_absval
|
||||
end subroutine d_vect_absval1
|
||||
|
||||
subroutine d_vect_absval2(x,y)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
class(psb_d_vect_type), intent(inout) :: y
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.allocated(y%v)) call y%bld(size(x%v%v))
|
||||
call x%v%absval(y%v)
|
||||
end if
|
||||
end subroutine d_vect_absval2
|
||||
|
||||
function d_vect_nrm2(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
@@ -135,7 +135,9 @@ module psb_s_base_vect_mod
|
||||
! Scaling and norms
|
||||
!
|
||||
procedure, pass(x) :: scal => s_base_scal
|
||||
procedure, pass(x) :: absval => s_base_absval
|
||||
procedure, pass(x) :: absval1 => s_base_absval1
|
||||
procedure, pass(x) :: absval2 => s_base_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => s_base_nrm2
|
||||
procedure, pass(x) :: amax => s_base_amax
|
||||
procedure, pass(x) :: asum => s_base_asum
|
||||
@@ -398,7 +400,7 @@ contains
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) x%v=szero
|
||||
|
||||
call x%set_host()
|
||||
end subroutine s_base_zero
|
||||
|
||||
|
||||
@@ -614,7 +616,7 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (.not.allocated(x%v)) return
|
||||
call x%sync()
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
allocate(res(x%get_nrows()),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
|
||||
@@ -637,8 +639,10 @@ contains
|
||||
real(psb_spk_), intent(in) :: val
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
x%v = val
|
||||
|
||||
call x%set_host()
|
||||
|
||||
end subroutine s_base_set_scal
|
||||
|
||||
!
|
||||
@@ -649,13 +653,29 @@ contains
|
||||
!! \memberof psb_s_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine s_base_absval(x)
|
||||
subroutine s_base_absval1(x)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& x%v = abs(x%v)
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine s_base_absval
|
||||
end subroutine s_base_absval1
|
||||
|
||||
subroutine s_base_absval2(x,y)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine s_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -675,6 +695,7 @@ contains
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
call x%set_host()
|
||||
|
||||
end subroutine s_base_set_vect
|
||||
|
||||
|
||||
@@ -63,7 +63,9 @@ module psb_s_vect_mod
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => s_vect_scal
|
||||
procedure, pass(x) :: absval => s_vect_absval
|
||||
procedure, pass(x) :: absval1 => s_vect_absval1
|
||||
procedure, pass(x) :: absval2 => s_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => s_vect_nrm2
|
||||
procedure, pass(x) :: amax => s_vect_amax
|
||||
procedure, pass(x) :: asum => s_vect_asum
|
||||
@@ -458,14 +460,24 @@ contains
|
||||
|
||||
end subroutine s_vect_scal
|
||||
|
||||
subroutine s_vect_absval(x)
|
||||
subroutine s_vect_absval1(x)
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%absval()
|
||||
|
||||
end subroutine s_vect_absval
|
||||
end subroutine s_vect_absval1
|
||||
|
||||
subroutine s_vect_absval2(x,y)
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_vect_type), intent(inout) :: y
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.allocated(y%v)) call y%bld(size(x%v%v))
|
||||
call x%v%absval(y%v)
|
||||
end if
|
||||
end subroutine s_vect_absval2
|
||||
|
||||
function s_vect_nrm2(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
@@ -135,7 +135,9 @@ module psb_z_base_vect_mod
|
||||
! Scaling and norms
|
||||
!
|
||||
procedure, pass(x) :: scal => z_base_scal
|
||||
procedure, pass(x) :: absval => z_base_absval
|
||||
procedure, pass(x) :: absval1 => z_base_absval1
|
||||
procedure, pass(x) :: absval2 => z_base_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => z_base_nrm2
|
||||
procedure, pass(x) :: amax => z_base_amax
|
||||
procedure, pass(x) :: asum => z_base_asum
|
||||
@@ -398,7 +400,7 @@ contains
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) x%v=zzero
|
||||
|
||||
call x%set_host()
|
||||
end subroutine z_base_zero
|
||||
|
||||
|
||||
@@ -614,7 +616,7 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (.not.allocated(x%v)) return
|
||||
call x%sync()
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
allocate(res(x%get_nrows()),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
|
||||
@@ -637,8 +639,10 @@ contains
|
||||
complex(psb_dpk_), intent(in) :: val
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
x%v = val
|
||||
|
||||
call x%set_host()
|
||||
|
||||
end subroutine z_base_set_scal
|
||||
|
||||
!
|
||||
@@ -649,13 +653,29 @@ contains
|
||||
!! \memberof psb_z_base_vect_type
|
||||
!! \brief Set all entries to their respective absolute values.
|
||||
!!
|
||||
subroutine z_base_absval(x)
|
||||
subroutine z_base_absval1(x)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& x%v = abs(x%v)
|
||||
if (allocated(x%v)) then
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
x%v = abs(x%v)
|
||||
call x%set_host()
|
||||
end if
|
||||
|
||||
end subroutine z_base_absval
|
||||
end subroutine z_base_absval1
|
||||
|
||||
subroutine z_base_absval2(x,y)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(inout) :: y
|
||||
|
||||
if (.not.x%is_host()) call x%sync()
|
||||
if (allocated(x%v)) then
|
||||
call y%bld(x%v)
|
||||
call y%absval()
|
||||
call y%set_host()
|
||||
end if
|
||||
|
||||
end subroutine z_base_absval2
|
||||
|
||||
!
|
||||
!> Function base_set_vect
|
||||
@@ -675,6 +695,7 @@ contains
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
call x%set_host()
|
||||
|
||||
end subroutine z_base_set_vect
|
||||
|
||||
|
||||
@@ -63,7 +63,9 @@ module psb_z_vect_mod
|
||||
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
|
||||
& mlt_v_2, mlt_av, mlt_va
|
||||
procedure, pass(x) :: scal => z_vect_scal
|
||||
procedure, pass(x) :: absval => z_vect_absval
|
||||
procedure, pass(x) :: absval1 => z_vect_absval1
|
||||
procedure, pass(x) :: absval2 => z_vect_absval2
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => z_vect_nrm2
|
||||
procedure, pass(x) :: amax => z_vect_amax
|
||||
procedure, pass(x) :: asum => z_vect_asum
|
||||
@@ -458,14 +460,24 @@ contains
|
||||
|
||||
end subroutine z_vect_scal
|
||||
|
||||
subroutine z_vect_absval(x)
|
||||
subroutine z_vect_absval1(x)
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%absval()
|
||||
|
||||
end subroutine z_vect_absval
|
||||
end subroutine z_vect_absval1
|
||||
|
||||
subroutine z_vect_absval2(x,y)
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_vect_type), intent(inout) :: y
|
||||
|
||||
if (allocated(x%v)) then
|
||||
if (.not.allocated(y%v)) call y%bld(size(x%v%v))
|
||||
call x%v%absval(y%v)
|
||||
end if
|
||||
end subroutine z_vect_absval2
|
||||
|
||||
function z_vect_nrm2(n,x) result(res)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
Reference in New Issue
Block a user