From 67924107499a2772f4527fbc38ba24111e5572b7 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 14 Apr 2015 13:16:45 +0000 Subject: [PATCH] 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. --- base/modules/psb_c_base_vect_mod.f90 | 37 ++++++++++++++++++++++------ base/modules/psb_c_vect_mod.F90 | 18 +++++++++++--- base/modules/psb_d_base_vect_mod.f90 | 37 ++++++++++++++++++++++------ base/modules/psb_d_vect_mod.F90 | 18 +++++++++++--- base/modules/psb_s_base_vect_mod.f90 | 37 ++++++++++++++++++++++------ base/modules/psb_s_vect_mod.F90 | 18 +++++++++++--- base/modules/psb_z_base_vect_mod.f90 | 37 ++++++++++++++++++++++------ base/modules/psb_z_vect_mod.F90 | 18 +++++++++++--- 8 files changed, 176 insertions(+), 44 deletions(-) diff --git a/base/modules/psb_c_base_vect_mod.f90 b/base/modules/psb_c_base_vect_mod.f90 index 697200b9..34494e76 100644 --- a/base/modules/psb_c_base_vect_mod.f90 +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_c_vect_mod.F90 b/base/modules/psb_c_vect_mod.F90 index efc0bc94..c143ea7f 100644 --- a/base/modules/psb_c_vect_mod.F90 +++ b/base/modules/psb_c_vect_mod.F90 @@ -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 diff --git a/base/modules/psb_d_base_vect_mod.f90 b/base/modules/psb_d_base_vect_mod.f90 index 44fae99a..e857cbd5 100644 --- a/base/modules/psb_d_base_vect_mod.f90 +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_d_vect_mod.F90 b/base/modules/psb_d_vect_mod.F90 index fac012a2..164b6ae4 100644 --- a/base/modules/psb_d_vect_mod.F90 +++ b/base/modules/psb_d_vect_mod.F90 @@ -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 diff --git a/base/modules/psb_s_base_vect_mod.f90 b/base/modules/psb_s_base_vect_mod.f90 index fffff342..fd03c369 100644 --- a/base/modules/psb_s_base_vect_mod.f90 +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_s_vect_mod.F90 b/base/modules/psb_s_vect_mod.F90 index 52aa15fd..bddc7857 100644 --- a/base/modules/psb_s_vect_mod.F90 +++ b/base/modules/psb_s_vect_mod.F90 @@ -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 diff --git a/base/modules/psb_z_base_vect_mod.f90 b/base/modules/psb_z_base_vect_mod.f90 index d351d308..3ca97750 100644 --- a/base/modules/psb_z_base_vect_mod.f90 +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_z_vect_mod.F90 b/base/modules/psb_z_vect_mod.F90 index a511e6d5..ce98ed39 100644 --- a/base/modules/psb_z_vect_mod.F90 +++ b/base/modules/psb_z_vect_mod.F90 @@ -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