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

psblas3:

Browse Source 
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.
psblas-3.4-maint
Salvatore Filippone 10 years ago
parent 95e8be9af8
commit 6792410749
8 changed files with 176 additions and 44 deletions
Show Stats Download Patch File Download Diff File

37
base/modules/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -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

18
base/modules/psb_c_vect_mod.F90
Unescape Escape View File

@ -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

37
base/modules/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -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

18
base/modules/psb_d_vect_mod.F90
Unescape Escape View File

@ -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

37
base/modules/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -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

18
base/modules/psb_s_vect_mod.F90
Unescape Escape View File

@ -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

37
base/modules/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -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

18
base/modules/psb_z_vect_mod.F90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save