added weighted 2-norm function

This commit is contained in:
Cirdans-Home
2020-02-21 09:56:10 +01:00
parent 63885c36c7
commit 1b214f3f00
13 changed files with 704 additions and 154 deletions
+11 -1
View File
@@ -273,11 +273,21 @@ module psb_c_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2_vect
function psb_cnrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_vect_type, psb_cspmat_type
real(psb_spk_) :: res
type(psb_c_vect_type), intent (inout) :: x
type(psb_c_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_cnrm2_weight_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_cnrm2, psb_cnrm2v, psb_cnrm2_vect
procedure psb_cnrm2, psb_cnrm2v, psb_cnrm2_vect, psb_cnrm2_weight_vect
end interface
#endif
+11 -1
View File
@@ -273,11 +273,21 @@ module psb_d_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2_vect
function psb_dnrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_vect_type, psb_dspmat_type
real(psb_dpk_) :: res
type(psb_d_vect_type), intent (inout) :: x
type(psb_d_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_dnrm2_weight_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_dnrm2, psb_dnrm2v, psb_dnrm2_vect
procedure psb_dnrm2, psb_dnrm2v, psb_dnrm2_vect, psb_dnrm2_weight_vect
end interface
#endif
+11 -1
View File
@@ -273,11 +273,21 @@ module psb_s_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2_vect
function psb_snrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_vect_type, psb_sspmat_type
real(psb_spk_) :: res
type(psb_s_vect_type), intent (inout) :: x
type(psb_s_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_snrm2_weight_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_snrm2, psb_snrm2v, psb_snrm2_vect
procedure psb_snrm2, psb_snrm2v, psb_snrm2_vect, psb_snrm2_weight_vect
end interface
#endif
+11 -1
View File
@@ -273,11 +273,21 @@ module psb_z_psblas_mod
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2_vect
function psb_znrm2_weight_vect(x,w, desc_a, info,global) result(res)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_vect_type, psb_zspmat_type
real(psb_dpk_) :: res
type(psb_z_vect_type), intent (inout) :: x
type(psb_z_vect_type), intent (inout) :: w
type(psb_desc_type), intent (in) :: desc_a
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: global
end function psb_znrm2_weight_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_znrm2, psb_znrm2v, psb_znrm2_vect
procedure psb_znrm2, psb_znrm2v, psb_znrm2_vect, psb_znrm2_weight_vect
end interface
#endif
+20 -1
View File
@@ -108,7 +108,9 @@ module psb_c_vect_mod
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) :: nrm2std => c_vect_nrm2
procedure, pass(x) :: nrm2weight => c_vect_nrm2_weight
generic, public :: nrm2 => nrm2std, nrm2weight
procedure, pass(x) :: amax => c_vect_amax
procedure, pass(x) :: asum => c_vect_asum
end type psb_c_vect_type
@@ -903,6 +905,23 @@ contains
end function c_vect_nrm2
function c_vect_nrm2_weight(n,x,w) result(res)
implicit none
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: w
integer(psb_ipk_), intent(in) :: n
real(psb_spk_) :: res
integer(psb_ipk_) :: info
if (allocated(x%v).and.allocated(w%v)) then
call w%v%mlt(x%v,info)
res = w%v%nrm2(n)
else
res = szero
end if
end function c_vect_nrm2_weight
function c_vect_amax(n,x) result(res)
implicit none
class(psb_c_vect_type), intent(inout) :: x
+20 -1
View File
@@ -108,7 +108,9 @@ module psb_d_vect_mod
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) :: nrm2std => d_vect_nrm2
procedure, pass(x) :: nrm2weight => d_vect_nrm2_weight
generic, public :: nrm2 => nrm2std, nrm2weight
procedure, pass(x) :: amax => d_vect_amax
procedure, pass(x) :: asum => d_vect_asum
procedure, pass(z) :: cmp_a2 => d_vect_cmp_a2
@@ -933,6 +935,23 @@ contains
end function d_vect_nrm2
function d_vect_nrm2_weight(n,x,w) result(res)
implicit none
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: w
integer(psb_ipk_), intent(in) :: n
real(psb_dpk_) :: res
integer(psb_ipk_) :: info
if (allocated(x%v).and.allocated(w%v)) then
call w%v%mlt(x%v,info)
res = w%v%nrm2(n)
else
res = dzero
end if
end function d_vect_nrm2_weight
function d_vect_amax(n,x) result(res)
implicit none
class(psb_d_vect_type), intent(inout) :: x
+20 -1
View File
@@ -108,7 +108,9 @@ module psb_s_vect_mod
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) :: nrm2std => s_vect_nrm2
procedure, pass(x) :: nrm2weight => s_vect_nrm2_weight
generic, public :: nrm2 => nrm2std, nrm2weight
procedure, pass(x) :: amax => s_vect_amax
procedure, pass(x) :: asum => s_vect_asum
procedure, pass(z) :: cmp_a2 => s_vect_cmp_a2
@@ -933,6 +935,23 @@ contains
end function s_vect_nrm2
function s_vect_nrm2_weight(n,x,w) result(res)
implicit none
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: w
integer(psb_ipk_), intent(in) :: n
real(psb_spk_) :: res
integer(psb_ipk_) :: info
if (allocated(x%v).and.allocated(w%v)) then
call w%v%mlt(x%v,info)
res = w%v%nrm2(n)
else
res = szero
end if
end function s_vect_nrm2_weight
function s_vect_amax(n,x) result(res)
implicit none
class(psb_s_vect_type), intent(inout) :: x
+20 -1
View File
@@ -108,7 +108,9 @@ module psb_z_vect_mod
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) :: nrm2std => z_vect_nrm2
procedure, pass(x) :: nrm2weight => z_vect_nrm2_weight
generic, public :: nrm2 => nrm2std, nrm2weight
procedure, pass(x) :: amax => z_vect_amax
procedure, pass(x) :: asum => z_vect_asum
end type psb_z_vect_type
@@ -903,6 +905,23 @@ contains
end function z_vect_nrm2
function z_vect_nrm2_weight(n,x,w) result(res)
implicit none
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(inout) :: w
integer(psb_ipk_), intent(in) :: n
real(psb_dpk_) :: res
integer(psb_ipk_) :: info
if (allocated(x%v).and.allocated(w%v)) then
call w%v%mlt(x%v,info)
res = w%v%nrm2(n)
else
res = dzero
end if
end function z_vect_nrm2_weight
function z_vect_amax(n,x) result(res)
implicit none
class(psb_z_vect_type), intent(inout) :: x