mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 04:42:08 +00:00
added weighted 2-norm function
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user