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

Changes for remote build interfaces. Implementation to be completed.

Browse Source
remotebuild
Salvatore Filippone 3 years ago
parent b4c27ec4eb
commit fc81367fef
58 changed files with 1276 additions and 938 deletions
Show Stats Download Patch File Download Diff File

87
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -53,8 +53,10 @@ module psb_c_vect_mod
procedure, pass(x) :: get_nrows => c_vect_get_nrows
procedure, pass(x) :: sizeof => c_vect_sizeof
procedure, pass(x) :: get_fmt => c_vect_get_fmt
procedure, pass(x) :: is_remote_build => psb_c_is_remote_build
procedure, pass(x) :: set_remote_build => psb_c_set_remote_build
procedure, pass(x) :: is_remote_build => c_vect_is_remote_build
procedure, pass(x) :: set_remote_build => c_vect_set_remote_build
procedure, pass(x) :: get_dupl => c_vect_get_dupl
procedure, pass(x) :: set_dupl => c_vect_set_dupl
procedure, pass(x) :: all => c_vect_all
procedure, pass(x) :: reall => c_vect_reall
procedure, pass(x) :: zero => c_vect_zero
@ -152,7 +154,9 @@ module psb_c_vect_mod
& c_vect_cnv, c_vect_set_scal, &
& c_vect_set_vect, c_vect_clone, c_vect_sync, c_vect_is_host, &
& c_vect_is_dev, c_vect_is_sync, c_vect_set_host, &
& c_vect_set_dev, c_vect_set_sync
& c_vect_set_dev, c_vect_set_sync, &
& c_vect_set_remote_build, c_is_remote_build, &
& c_vect_set_dupl, c_get_dupl
private :: c_vect_dot_v, c_vect_dot_a, c_vect_axpby_v, c_vect_axpby_a, &
& c_vect_mlt_v, c_vect_mlt_a, c_vect_mlt_a_2, c_vect_mlt_v_2, &
@ -175,14 +179,34 @@ module psb_c_vect_mod
contains
function psb_c_is_remote_build(x) result(res)
function c_vect_get_dupl(x) result(res)
implicit none
class(psb_c_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function c_vect_get_dupl
subroutine c_vect_set_dupl(x,val)
implicit none
class(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine c_vect_set_dupl
function c_vect_is_remote_build(x) result(res)
implicit none
class(psb_c_vect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function psb_c_is_remote_build
end function c_vect_is_remote_build
subroutine psb_c_set_remote_build(x,val)
subroutine c_vect_set_remote_build(x,val)
implicit none
class(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
@ -192,7 +216,7 @@ contains
else
x%remote_build = psb_matbld_remote_
end if
end subroutine psb_c_set_remote_build
end subroutine c_vect_set_remote_build
subroutine psb_c_set_vect_default(v)
implicit none
@ -1211,7 +1235,6 @@ contains
end module psb_c_vect_mod
module psb_c_multivect_mod
use psb_c_base_multivect_mod
@ -1223,11 +1246,19 @@ module psb_c_multivect_mod
type psb_c_multivect_type
class(psb_c_base_multivect_type), allocatable :: v
integer(psb_ipk_) :: nrmv = 0
integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
integer(psb_ipk_) :: dupl = psb_dupl_add_
complex(psb_spk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => c_vect_get_nrows
procedure, pass(x) :: get_ncols => c_vect_get_ncols
procedure, pass(x) :: sizeof => c_vect_sizeof
procedure, pass(x) :: get_fmt => c_vect_get_fmt
procedure, pass(x) :: is_remote_build => c_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => c_mvect_set_remote_build
procedure, pass(x) :: get_dupl => c_mvect_get_dupl
procedure, pass(x) :: set_dupl => c_mvect_set_dupl
procedure, pass(x) :: all => c_vect_all
procedure, pass(x) :: reall => c_vect_reall
@ -1296,6 +1327,46 @@ module psb_c_multivect_mod
contains
function c_mvect_get_dupl(x) result(res)
implicit none
class(psb_c_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function c_mvect_get_dupl
subroutine c_mvect_set_dupl(x,val)
implicit none
class(psb_c_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine c_mvect_set_dupl
function c_mvect_is_remote_build(x) result(res)
implicit none
class(psb_c_multivect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function c_mvect_is_remote_build
subroutine c_mvect_set_remote_build(x,val)
implicit none
class(psb_c_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%remote_build = val
else
x%remote_build = psb_matbld_remote_
end if
end subroutine c_mvect_set_remote_build
subroutine psb_c_set_multivect_default(v)
implicit none
class(psb_c_base_multivect_type), intent(in) :: v

87
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -53,8 +53,10 @@ module psb_d_vect_mod
procedure, pass(x) :: get_nrows => d_vect_get_nrows
procedure, pass(x) :: sizeof => d_vect_sizeof
procedure, pass(x) :: get_fmt => d_vect_get_fmt
procedure, pass(x) :: is_remote_build => psb_d_is_remote_build
procedure, pass(x) :: set_remote_build => psb_d_set_remote_build
procedure, pass(x) :: is_remote_build => d_vect_is_remote_build
procedure, pass(x) :: set_remote_build => d_vect_set_remote_build
procedure, pass(x) :: get_dupl => d_vect_get_dupl
procedure, pass(x) :: set_dupl => d_vect_set_dupl
procedure, pass(x) :: all => d_vect_all
procedure, pass(x) :: reall => d_vect_reall
procedure, pass(x) :: zero => d_vect_zero
@ -159,7 +161,9 @@ module psb_d_vect_mod
& d_vect_cnv, d_vect_set_scal, &
& d_vect_set_vect, d_vect_clone, d_vect_sync, d_vect_is_host, &
& d_vect_is_dev, d_vect_is_sync, d_vect_set_host, &
& d_vect_set_dev, d_vect_set_sync
& d_vect_set_dev, d_vect_set_sync, &
& d_vect_set_remote_build, d_is_remote_build, &
& d_vect_set_dupl, d_get_dupl
private :: d_vect_dot_v, d_vect_dot_a, d_vect_axpby_v, d_vect_axpby_a, &
& d_vect_mlt_v, d_vect_mlt_a, d_vect_mlt_a_2, d_vect_mlt_v_2, &
@ -182,14 +186,34 @@ module psb_d_vect_mod
contains
function psb_d_is_remote_build(x) result(res)
function d_vect_get_dupl(x) result(res)
implicit none
class(psb_d_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function d_vect_get_dupl
subroutine d_vect_set_dupl(x,val)
implicit none
class(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine d_vect_set_dupl
function d_vect_is_remote_build(x) result(res)
implicit none
class(psb_d_vect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function psb_d_is_remote_build
end function d_vect_is_remote_build
subroutine psb_d_set_remote_build(x,val)
subroutine d_vect_set_remote_build(x,val)
implicit none
class(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
@ -199,7 +223,7 @@ contains
else
x%remote_build = psb_matbld_remote_
end if
end subroutine psb_d_set_remote_build
end subroutine d_vect_set_remote_build
subroutine psb_d_set_vect_default(v)
implicit none
@ -1290,7 +1314,6 @@ contains
end module psb_d_vect_mod
module psb_d_multivect_mod
use psb_d_base_multivect_mod
@ -1302,11 +1325,19 @@ module psb_d_multivect_mod
type psb_d_multivect_type
class(psb_d_base_multivect_type), allocatable :: v
integer(psb_ipk_) :: nrmv = 0
integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
integer(psb_ipk_) :: dupl = psb_dupl_add_
real(psb_dpk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => d_vect_get_nrows
procedure, pass(x) :: get_ncols => d_vect_get_ncols
procedure, pass(x) :: sizeof => d_vect_sizeof
procedure, pass(x) :: get_fmt => d_vect_get_fmt
procedure, pass(x) :: is_remote_build => d_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => d_mvect_set_remote_build
procedure, pass(x) :: get_dupl => d_mvect_get_dupl
procedure, pass(x) :: set_dupl => d_mvect_set_dupl
procedure, pass(x) :: all => d_vect_all
procedure, pass(x) :: reall => d_vect_reall
@ -1375,6 +1406,46 @@ module psb_d_multivect_mod
contains
function d_mvect_get_dupl(x) result(res)
implicit none
class(psb_d_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function d_mvect_get_dupl
subroutine d_mvect_set_dupl(x,val)
implicit none
class(psb_d_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine d_mvect_set_dupl
function d_mvect_is_remote_build(x) result(res)
implicit none
class(psb_d_multivect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function d_mvect_is_remote_build
subroutine d_mvect_set_remote_build(x,val)
implicit none
class(psb_d_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%remote_build = val
else
x%remote_build = psb_matbld_remote_
end if
end subroutine d_mvect_set_remote_build
subroutine psb_d_set_multivect_default(v)
implicit none
class(psb_d_base_multivect_type), intent(in) :: v

87
base/modules/serial/psb_i_vect_mod.F90
Unescape Escape View File

@ -52,8 +52,10 @@ module psb_i_vect_mod
procedure, pass(x) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: sizeof => i_vect_sizeof
procedure, pass(x) :: get_fmt => i_vect_get_fmt
procedure, pass(x) :: is_remote_build => psb_i_is_remote_build
procedure, pass(x) :: set_remote_build => psb_i_set_remote_build
procedure, pass(x) :: is_remote_build => i_vect_is_remote_build
procedure, pass(x) :: set_remote_build => i_vect_set_remote_build
procedure, pass(x) :: get_dupl => i_vect_get_dupl
procedure, pass(x) :: set_dupl => i_vect_set_dupl
procedure, pass(x) :: all => i_vect_all
procedure, pass(x) :: reall => i_vect_reall
procedure, pass(x) :: zero => i_vect_zero
@ -104,7 +106,9 @@ module psb_i_vect_mod
& i_vect_cnv, i_vect_set_scal, &
& i_vect_set_vect, i_vect_clone, i_vect_sync, i_vect_is_host, &
& i_vect_is_dev, i_vect_is_sync, i_vect_set_host, &
& i_vect_set_dev, i_vect_set_sync
& i_vect_set_dev, i_vect_set_sync, &
& i_vect_set_remote_build, i_is_remote_build, &
& i_vect_set_dupl, i_get_dupl
class(psb_i_base_vect_type), allocatable, target,&
@ -122,14 +126,34 @@ module psb_i_vect_mod
contains
function psb_i_is_remote_build(x) result(res)
function i_vect_get_dupl(x) result(res)
implicit none
class(psb_i_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function i_vect_get_dupl
subroutine i_vect_set_dupl(x,val)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine i_vect_set_dupl
function i_vect_is_remote_build(x) result(res)
implicit none
class(psb_i_vect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function psb_i_is_remote_build
end function i_vect_is_remote_build
subroutine psb_i_set_remote_build(x,val)
subroutine i_vect_set_remote_build(x,val)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
@ -139,7 +163,7 @@ contains
else
x%remote_build = psb_matbld_remote_
end if
end subroutine psb_i_set_remote_build
end subroutine i_vect_set_remote_build
subroutine psb_i_set_vect_default(v)
implicit none
@ -586,7 +610,6 @@ contains
end module psb_i_vect_mod
module psb_i_multivect_mod
use psb_i_base_multivect_mod
@ -598,11 +621,19 @@ module psb_i_multivect_mod
type psb_i_multivect_type
class(psb_i_base_multivect_type), allocatable :: v
integer(psb_ipk_) :: nrmv = 0
integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
integer(psb_ipk_) :: dupl = psb_dupl_add_
integer(psb_ipk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: get_ncols => i_vect_get_ncols
procedure, pass(x) :: sizeof => i_vect_sizeof
procedure, pass(x) :: get_fmt => i_vect_get_fmt
procedure, pass(x) :: is_remote_build => i_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => i_mvect_set_remote_build
procedure, pass(x) :: get_dupl => i_mvect_get_dupl
procedure, pass(x) :: set_dupl => i_mvect_set_dupl
procedure, pass(x) :: all => i_vect_all
procedure, pass(x) :: reall => i_vect_reall
@ -653,6 +684,46 @@ module psb_i_multivect_mod
contains
function i_mvect_get_dupl(x) result(res)
implicit none
class(psb_i_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function i_mvect_get_dupl
subroutine i_mvect_set_dupl(x,val)
implicit none
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine i_mvect_set_dupl
function i_mvect_is_remote_build(x) result(res)
implicit none
class(psb_i_multivect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function i_mvect_is_remote_build
subroutine i_mvect_set_remote_build(x,val)
implicit none
class(psb_i_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%remote_build = val
else
x%remote_build = psb_matbld_remote_
end if
end subroutine i_mvect_set_remote_build
subroutine psb_i_set_multivect_default(v)
implicit none
class(psb_i_base_multivect_type), intent(in) :: v

87
base/modules/serial/psb_l_vect_mod.F90
Unescape Escape View File

@ -53,8 +53,10 @@ module psb_l_vect_mod
procedure, pass(x) :: get_nrows => l_vect_get_nrows
procedure, pass(x) :: sizeof => l_vect_sizeof
procedure, pass(x) :: get_fmt => l_vect_get_fmt
procedure, pass(x) :: is_remote_build => psb_l_is_remote_build
procedure, pass(x) :: set_remote_build => psb_l_set_remote_build
procedure, pass(x) :: is_remote_build => l_vect_is_remote_build
procedure, pass(x) :: set_remote_build => l_vect_set_remote_build
procedure, pass(x) :: get_dupl => l_vect_get_dupl
procedure, pass(x) :: set_dupl => l_vect_set_dupl
procedure, pass(x) :: all => l_vect_all
procedure, pass(x) :: reall => l_vect_reall
procedure, pass(x) :: zero => l_vect_zero
@ -105,7 +107,9 @@ module psb_l_vect_mod
& l_vect_cnv, l_vect_set_scal, &
& l_vect_set_vect, l_vect_clone, l_vect_sync, l_vect_is_host, &
& l_vect_is_dev, l_vect_is_sync, l_vect_set_host, &
& l_vect_set_dev, l_vect_set_sync
& l_vect_set_dev, l_vect_set_sync, &
& l_vect_set_remote_build, l_is_remote_build, &
& l_vect_set_dupl, l_get_dupl
class(psb_l_base_vect_type), allocatable, target,&
@ -123,14 +127,34 @@ module psb_l_vect_mod
contains
function psb_l_is_remote_build(x) result(res)
function l_vect_get_dupl(x) result(res)
implicit none
class(psb_l_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function l_vect_get_dupl
subroutine l_vect_set_dupl(x,val)
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine l_vect_set_dupl
function l_vect_is_remote_build(x) result(res)
implicit none
class(psb_l_vect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function psb_l_is_remote_build
end function l_vect_is_remote_build
subroutine psb_l_set_remote_build(x,val)
subroutine l_vect_set_remote_build(x,val)
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
@ -140,7 +164,7 @@ contains
else
x%remote_build = psb_matbld_remote_
end if
end subroutine psb_l_set_remote_build
end subroutine l_vect_set_remote_build
subroutine psb_l_set_vect_default(v)
implicit none
@ -587,7 +611,6 @@ contains
end module psb_l_vect_mod
module psb_l_multivect_mod
use psb_l_base_multivect_mod
@ -599,11 +622,19 @@ module psb_l_multivect_mod
type psb_l_multivect_type
class(psb_l_base_multivect_type), allocatable :: v
integer(psb_ipk_) :: nrmv = 0
integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
integer(psb_ipk_) :: dupl = psb_dupl_add_
integer(psb_lpk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => l_vect_get_nrows
procedure, pass(x) :: get_ncols => l_vect_get_ncols
procedure, pass(x) :: sizeof => l_vect_sizeof
procedure, pass(x) :: get_fmt => l_vect_get_fmt
procedure, pass(x) :: is_remote_build => l_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => l_mvect_set_remote_build
procedure, pass(x) :: get_dupl => l_mvect_get_dupl
procedure, pass(x) :: set_dupl => l_mvect_set_dupl
procedure, pass(x) :: all => l_vect_all
procedure, pass(x) :: reall => l_vect_reall
@ -654,6 +685,46 @@ module psb_l_multivect_mod
contains
function l_mvect_get_dupl(x) result(res)
implicit none
class(psb_l_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function l_mvect_get_dupl
subroutine l_mvect_set_dupl(x,val)
implicit none
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine l_mvect_set_dupl
function l_mvect_is_remote_build(x) result(res)
implicit none
class(psb_l_multivect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function l_mvect_is_remote_build
subroutine l_mvect_set_remote_build(x,val)
implicit none
class(psb_l_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%remote_build = val
else
x%remote_build = psb_matbld_remote_
end if
end subroutine l_mvect_set_remote_build
subroutine psb_l_set_multivect_default(v)
implicit none
class(psb_l_base_multivect_type), intent(in) :: v

87
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -53,8 +53,10 @@ module psb_s_vect_mod
procedure, pass(x) :: get_nrows => s_vect_get_nrows
procedure, pass(x) :: sizeof => s_vect_sizeof
procedure, pass(x) :: get_fmt => s_vect_get_fmt
procedure, pass(x) :: is_remote_build => psb_s_is_remote_build
procedure, pass(x) :: set_remote_build => psb_s_set_remote_build
procedure, pass(x) :: is_remote_build => s_vect_is_remote_build
procedure, pass(x) :: set_remote_build => s_vect_set_remote_build
procedure, pass(x) :: get_dupl => s_vect_get_dupl
procedure, pass(x) :: set_dupl => s_vect_set_dupl
procedure, pass(x) :: all => s_vect_all
procedure, pass(x) :: reall => s_vect_reall
procedure, pass(x) :: zero => s_vect_zero
@ -159,7 +161,9 @@ module psb_s_vect_mod
& s_vect_cnv, s_vect_set_scal, &
& s_vect_set_vect, s_vect_clone, s_vect_sync, s_vect_is_host, &
& s_vect_is_dev, s_vect_is_sync, s_vect_set_host, &
& s_vect_set_dev, s_vect_set_sync
& s_vect_set_dev, s_vect_set_sync, &
& s_vect_set_remote_build, s_is_remote_build, &
& s_vect_set_dupl, s_get_dupl
private :: s_vect_dot_v, s_vect_dot_a, s_vect_axpby_v, s_vect_axpby_a, &
& s_vect_mlt_v, s_vect_mlt_a, s_vect_mlt_a_2, s_vect_mlt_v_2, &
@ -182,14 +186,34 @@ module psb_s_vect_mod
contains
function psb_s_is_remote_build(x) result(res)
function s_vect_get_dupl(x) result(res)
implicit none
class(psb_s_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function s_vect_get_dupl
subroutine s_vect_set_dupl(x,val)
implicit none
class(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine s_vect_set_dupl
function s_vect_is_remote_build(x) result(res)
implicit none
class(psb_s_vect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function psb_s_is_remote_build
end function s_vect_is_remote_build
subroutine psb_s_set_remote_build(x,val)
subroutine s_vect_set_remote_build(x,val)
implicit none
class(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
@ -199,7 +223,7 @@ contains
else
x%remote_build = psb_matbld_remote_
end if
end subroutine psb_s_set_remote_build
end subroutine s_vect_set_remote_build
subroutine psb_s_set_vect_default(v)
implicit none
@ -1290,7 +1314,6 @@ contains
end module psb_s_vect_mod
module psb_s_multivect_mod
use psb_s_base_multivect_mod
@ -1302,11 +1325,19 @@ module psb_s_multivect_mod
type psb_s_multivect_type
class(psb_s_base_multivect_type), allocatable :: v
integer(psb_ipk_) :: nrmv = 0
integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
integer(psb_ipk_) :: dupl = psb_dupl_add_
real(psb_spk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => s_vect_get_nrows
procedure, pass(x) :: get_ncols => s_vect_get_ncols
procedure, pass(x) :: sizeof => s_vect_sizeof
procedure, pass(x) :: get_fmt => s_vect_get_fmt
procedure, pass(x) :: is_remote_build => s_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => s_mvect_set_remote_build
procedure, pass(x) :: get_dupl => s_mvect_get_dupl
procedure, pass(x) :: set_dupl => s_mvect_set_dupl
procedure, pass(x) :: all => s_vect_all
procedure, pass(x) :: reall => s_vect_reall
@ -1375,6 +1406,46 @@ module psb_s_multivect_mod
contains
function s_mvect_get_dupl(x) result(res)
implicit none
class(psb_s_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function s_mvect_get_dupl
subroutine s_mvect_set_dupl(x,val)
implicit none
class(psb_s_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine s_mvect_set_dupl
function s_mvect_is_remote_build(x) result(res)
implicit none
class(psb_s_multivect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function s_mvect_is_remote_build
subroutine s_mvect_set_remote_build(x,val)
implicit none
class(psb_s_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%remote_build = val
else
x%remote_build = psb_matbld_remote_
end if
end subroutine s_mvect_set_remote_build
subroutine psb_s_set_multivect_default(v)
implicit none
class(psb_s_base_multivect_type), intent(in) :: v

87
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -53,8 +53,10 @@ module psb_z_vect_mod
procedure, pass(x) :: get_nrows => z_vect_get_nrows
procedure, pass(x) :: sizeof => z_vect_sizeof
procedure, pass(x) :: get_fmt => z_vect_get_fmt
procedure, pass(x) :: is_remote_build => psb_z_is_remote_build
procedure, pass(x) :: set_remote_build => psb_z_set_remote_build
procedure, pass(x) :: is_remote_build => z_vect_is_remote_build
procedure, pass(x) :: set_remote_build => z_vect_set_remote_build
procedure, pass(x) :: get_dupl => z_vect_get_dupl
procedure, pass(x) :: set_dupl => z_vect_set_dupl
procedure, pass(x) :: all => z_vect_all
procedure, pass(x) :: reall => z_vect_reall
procedure, pass(x) :: zero => z_vect_zero
@ -152,7 +154,9 @@ module psb_z_vect_mod
& z_vect_cnv, z_vect_set_scal, &
& z_vect_set_vect, z_vect_clone, z_vect_sync, z_vect_is_host, &
& z_vect_is_dev, z_vect_is_sync, z_vect_set_host, &
& z_vect_set_dev, z_vect_set_sync
& z_vect_set_dev, z_vect_set_sync, &
& z_vect_set_remote_build, z_is_remote_build, &
& z_vect_set_dupl, z_get_dupl
private :: z_vect_dot_v, z_vect_dot_a, z_vect_axpby_v, z_vect_axpby_a, &
& z_vect_mlt_v, z_vect_mlt_a, z_vect_mlt_a_2, z_vect_mlt_v_2, &
@ -175,14 +179,34 @@ module psb_z_vect_mod
contains
function psb_z_is_remote_build(x) result(res)
function z_vect_get_dupl(x) result(res)
implicit none
class(psb_z_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function z_vect_get_dupl
subroutine z_vect_set_dupl(x,val)
implicit none
class(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine z_vect_set_dupl
function z_vect_is_remote_build(x) result(res)
implicit none
class(psb_z_vect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function psb_z_is_remote_build
end function z_vect_is_remote_build
subroutine psb_z_set_remote_build(x,val)
subroutine z_vect_set_remote_build(x,val)
implicit none
class(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
@ -192,7 +216,7 @@ contains
else
x%remote_build = psb_matbld_remote_
end if
end subroutine psb_z_set_remote_build
end subroutine z_vect_set_remote_build
subroutine psb_z_set_vect_default(v)
implicit none
@ -1211,7 +1235,6 @@ contains
end module psb_z_vect_mod
module psb_z_multivect_mod
use psb_z_base_multivect_mod
@ -1223,11 +1246,19 @@ module psb_z_multivect_mod
type psb_z_multivect_type
class(psb_z_base_multivect_type), allocatable :: v
integer(psb_ipk_) :: nrmv = 0
integer(psb_ipk_) :: remote_build=psb_matbld_noremote_
integer(psb_ipk_) :: dupl = psb_dupl_add_
complex(psb_dpk_), allocatable :: rmtv(:,:)
contains
procedure, pass(x) :: get_nrows => z_vect_get_nrows
procedure, pass(x) :: get_ncols => z_vect_get_ncols
procedure, pass(x) :: sizeof => z_vect_sizeof
procedure, pass(x) :: get_fmt => z_vect_get_fmt
procedure, pass(x) :: is_remote_build => z_mvect_is_remote_build
procedure, pass(x) :: set_remote_build => z_mvect_set_remote_build
procedure, pass(x) :: get_dupl => z_mvect_get_dupl
procedure, pass(x) :: set_dupl => z_mvect_set_dupl
procedure, pass(x) :: all => z_vect_all
procedure, pass(x) :: reall => z_vect_reall
@ -1296,6 +1327,46 @@ module psb_z_multivect_mod
contains
function z_mvect_get_dupl(x) result(res)
implicit none
class(psb_z_multivect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = x%dupl
end function z_mvect_get_dupl
subroutine z_mvect_set_dupl(x,val)
implicit none
class(psb_z_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%dupl = val
else
x%dupl = psb_dupl_def_
end if
end subroutine z_mvect_set_dupl
function z_mvect_is_remote_build(x) result(res)
implicit none
class(psb_z_multivect_type), intent(in) :: x
logical :: res
res = (x%remote_build == psb_matbld_remote_)
end function z_mvect_is_remote_build
subroutine z_mvect_set_remote_build(x,val)
implicit none
class(psb_z_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (present(val)) then
x%remote_build = val
else
x%remote_build = psb_matbld_remote_
end if
end subroutine z_mvect_set_remote_build
subroutine psb_z_set_multivect_default(v)
implicit none
class(psb_z_base_multivect_type), intent(in) :: v

42
base/modules/tools/psb_c_tools_mod.F90
Unescape Escape View File

@ -40,41 +40,43 @@ Module psb_c_tools_mod
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_calloc_vect(x, desc_a,info)
subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode)
import
implicit none
type(psb_c_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_calloc_vect
subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
import
implicit none
type(psb_c_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_calloc_vect_r2
subroutine psb_calloc_multivect(x, desc_a,info,n)
subroutine psb_calloc_multivect(x, desc_a,info,n, dupl, bldmode)
import
implicit none
type(psb_c_multivect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_calloc_multivect
end interface
interface psb_geasb
subroutine psb_casb_vect(x, desc_a, info,mold, dupl,scratch)
subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
end subroutine psb_casb_vect
subroutine psb_casb_vect_r2(x, desc_a, info,mold, scratch)
@ -124,7 +126,7 @@ Module psb_c_tools_mod
interface psb_geins
subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_cins_vect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -133,10 +135,9 @@ Module psb_c_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cins_vect
subroutine psb_cins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_cins_vect_v(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -145,10 +146,9 @@ Module psb_c_tools_mod
type(psb_l_vect_type), intent(inout) :: irw
type(psb_c_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cins_vect_v
subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -157,10 +157,9 @@ Module psb_c_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
complex(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cins_vect_r2
subroutine psb_cins_multivect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_cins_multivect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -169,7 +168,6 @@ Module psb_c_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
complex(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cins_multivect
end interface
@ -240,36 +238,36 @@ Module psb_c_tools_mod
interface psb_spall
subroutine psb_cspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_cspalloc(a, desc_a, info, nnz, dupl, bldmode)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
integer(psb_ipk_), optional, intent(in) :: dupl
end subroutine psb_cspalloc
end interface
interface psb_spasb
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold)
subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold)
import
implicit none
type(psb_cspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
integer(psb_ipk_),optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_c_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_cspasb
end interface
interface psb_remote_vect
subroutine psb_c_remote_vect(v,desc_a, dupl, info)
subroutine psb_c_remote_vect(v,desc_a, info)
import
implicit none
type(psb_c_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: dupl
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_remote_vect
end interface psb_remote_vect

42
base/modules/tools/psb_d_tools_mod.F90
Unescape Escape View File

@ -40,41 +40,43 @@ Module psb_d_tools_mod
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_dalloc_vect(x, desc_a,info)
subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
import
implicit none
type(psb_d_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_dalloc_vect
subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
import
implicit none
type(psb_d_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_dalloc_vect_r2
subroutine psb_dalloc_multivect(x, desc_a,info,n)
subroutine psb_dalloc_multivect(x, desc_a,info,n, dupl, bldmode)
import
implicit none
type(psb_d_multivect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_dalloc_multivect
end interface
interface psb_geasb
subroutine psb_dasb_vect(x, desc_a, info,mold, dupl,scratch)
subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
end subroutine psb_dasb_vect
subroutine psb_dasb_vect_r2(x, desc_a, info,mold, scratch)
@ -124,7 +126,7 @@ Module psb_d_tools_mod
interface psb_geins
subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_dins_vect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -133,10 +135,9 @@ Module psb_d_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect
subroutine psb_dins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_dins_vect_v(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -145,10 +146,9 @@ Module psb_d_tools_mod
type(psb_l_vect_type), intent(inout) :: irw
type(psb_d_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect_v
subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -157,10 +157,9 @@ Module psb_d_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
real(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect_r2
subroutine psb_dins_multivect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_dins_multivect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -169,7 +168,6 @@ Module psb_d_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
real(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_multivect
end interface
@ -240,36 +238,36 @@ Module psb_d_tools_mod
interface psb_spall
subroutine psb_dspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_dspalloc(a, desc_a, info, nnz, dupl, bldmode)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
integer(psb_ipk_), optional, intent(in) :: dupl
end subroutine psb_dspalloc
end interface
interface psb_spasb
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold)
subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold)
import
implicit none
type(psb_dspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
integer(psb_ipk_),optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_d_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_dspasb
end interface
interface psb_remote_vect
subroutine psb_d_remote_vect(v,desc_a, dupl, info)
subroutine psb_d_remote_vect(v,desc_a, info)
import
implicit none
type(psb_d_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: dupl
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_remote_vect
end interface psb_remote_vect

24
base/modules/tools/psb_i_tools_mod.F90
Unescape Escape View File

@ -37,41 +37,43 @@ Module psb_i_tools_mod
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_ialloc_vect(x, desc_a,info)
subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode)
import
implicit none
type(psb_i_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_ialloc_vect
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
import
implicit none
type(psb_i_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_ialloc_vect_r2
subroutine psb_ialloc_multivect(x, desc_a,info,n)
subroutine psb_ialloc_multivect(x, desc_a,info,n, dupl, bldmode)
import
implicit none
type(psb_i_multivect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_ialloc_multivect
end interface
interface psb_geasb
subroutine psb_iasb_vect(x, desc_a, info,mold, dupl,scratch)
subroutine psb_iasb_vect(x, desc_a, info,mold, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
end subroutine psb_iasb_vect
subroutine psb_iasb_vect_r2(x, desc_a, info,mold, scratch)
@ -121,7 +123,7 @@ Module psb_i_tools_mod
interface psb_geins
subroutine psb_iins_vect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_iins_vect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -130,10 +132,9 @@ Module psb_i_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_iins_vect
subroutine psb_iins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_iins_vect_v(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -142,10 +143,9 @@ Module psb_i_tools_mod
type(psb_l_vect_type), intent(inout) :: irw
type(psb_i_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_iins_vect_v
subroutine psb_iins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_iins_vect_r2(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -154,10 +154,9 @@ Module psb_i_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
integer(psb_ipk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_iins_vect_r2
subroutine psb_iins_multivect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_iins_multivect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -166,7 +165,6 @@ Module psb_i_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
integer(psb_ipk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_iins_multivect
end interface

24
base/modules/tools/psb_l_tools_mod.F90
Unescape Escape View File

@ -37,41 +37,43 @@ Module psb_l_tools_mod
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_lalloc_vect(x, desc_a,info)
subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode)
import
implicit none
type(psb_l_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_lalloc_vect
subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
import
implicit none
type(psb_l_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_lalloc_vect_r2
subroutine psb_lalloc_multivect(x, desc_a,info,n)
subroutine psb_lalloc_multivect(x, desc_a,info,n, dupl, bldmode)
import
implicit none
type(psb_l_multivect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_lalloc_multivect
end interface
interface psb_geasb
subroutine psb_lasb_vect(x, desc_a, info,mold, dupl,scratch)
subroutine psb_lasb_vect(x, desc_a, info,mold, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_l_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
end subroutine psb_lasb_vect
subroutine psb_lasb_vect_r2(x, desc_a, info,mold, scratch)
@ -121,7 +123,7 @@ Module psb_l_tools_mod
interface psb_geins
subroutine psb_lins_vect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_lins_vect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -130,10 +132,9 @@ Module psb_l_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
integer(psb_lpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_lins_vect
subroutine psb_lins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_lins_vect_v(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -142,10 +143,9 @@ Module psb_l_tools_mod
type(psb_l_vect_type), intent(inout) :: irw
type(psb_l_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_lins_vect_v
subroutine psb_lins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_lins_vect_r2(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -154,10 +154,9 @@ Module psb_l_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
integer(psb_lpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_lins_vect_r2
subroutine psb_lins_multivect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_lins_multivect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -166,7 +165,6 @@ Module psb_l_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
integer(psb_lpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_lins_multivect
end interface

42
base/modules/tools/psb_s_tools_mod.F90
Unescape Escape View File

@ -40,41 +40,43 @@ Module psb_s_tools_mod
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_salloc_vect(x, desc_a,info)
subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode)
import
implicit none
type(psb_s_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_salloc_vect
subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
import
implicit none
type(psb_s_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_salloc_vect_r2
subroutine psb_salloc_multivect(x, desc_a,info,n)
subroutine psb_salloc_multivect(x, desc_a,info,n, dupl, bldmode)
import
implicit none
type(psb_s_multivect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_salloc_multivect
end interface
interface psb_geasb
subroutine psb_sasb_vect(x, desc_a, info,mold, dupl,scratch)
subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
end subroutine psb_sasb_vect
subroutine psb_sasb_vect_r2(x, desc_a, info,mold, scratch)
@ -124,7 +126,7 @@ Module psb_s_tools_mod
interface psb_geins
subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_sins_vect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -133,10 +135,9 @@ Module psb_s_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sins_vect
subroutine psb_sins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_sins_vect_v(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -145,10 +146,9 @@ Module psb_s_tools_mod
type(psb_l_vect_type), intent(inout) :: irw
type(psb_s_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sins_vect_v
subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -157,10 +157,9 @@ Module psb_s_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
real(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sins_vect_r2
subroutine psb_sins_multivect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_sins_multivect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -169,7 +168,6 @@ Module psb_s_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
real(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sins_multivect
end interface
@ -240,36 +238,36 @@ Module psb_s_tools_mod
interface psb_spall
subroutine psb_sspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_sspalloc(a, desc_a, info, nnz, dupl, bldmode)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
integer(psb_ipk_), optional, intent(in) :: dupl
end subroutine psb_sspalloc
end interface
interface psb_spasb
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl,mold)
subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold)
import
implicit none
type(psb_sspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
integer(psb_ipk_),optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_s_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_sspasb
end interface
interface psb_remote_vect
subroutine psb_s_remote_vect(v,desc_a, dupl, info)
subroutine psb_s_remote_vect(v,desc_a, info)
import
implicit none
type(psb_s_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: dupl
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_remote_vect
end interface psb_remote_vect

42
base/modules/tools/psb_z_tools_mod.F90
Unescape Escape View File

@ -40,41 +40,43 @@ Module psb_z_tools_mod
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_zalloc_vect(x, desc_a,info)
subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode)
import
implicit none
type(psb_z_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_zalloc_vect
subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
import
implicit none
type(psb_z_vect_type), allocatable, intent(out) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n, lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_zalloc_vect_r2
subroutine psb_zalloc_multivect(x, desc_a,info,n)
subroutine psb_zalloc_multivect(x, desc_a,info,n, dupl, bldmode)
import
implicit none
type(psb_z_multivect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
end subroutine psb_zalloc_multivect
end interface
interface psb_geasb
subroutine psb_zasb_vect(x, desc_a, info,mold, dupl,scratch)
subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
end subroutine psb_zasb_vect
subroutine psb_zasb_vect_r2(x, desc_a, info,mold, scratch)
@ -124,7 +126,7 @@ Module psb_z_tools_mod
interface psb_geins
subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_zins_vect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -133,10 +135,9 @@ Module psb_z_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zins_vect
subroutine psb_zins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_zins_vect_v(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -145,10 +146,9 @@ Module psb_z_tools_mod
type(psb_l_vect_type), intent(inout) :: irw
type(psb_z_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zins_vect_v
subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -157,10 +157,9 @@ Module psb_z_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
complex(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zins_vect_r2
subroutine psb_zins_multivect(m,irw,val,x,desc_a,info,dupl,local)
subroutine psb_zins_multivect(m,irw,val,x,desc_a,info,local)
import
implicit none
integer(psb_ipk_), intent(in) :: m
@ -169,7 +168,6 @@ Module psb_z_tools_mod
integer(psb_lpk_), intent(in) :: irw(:)
complex(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zins_multivect
end interface
@ -240,36 +238,36 @@ Module psb_z_tools_mod
interface psb_spall
subroutine psb_zspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_zspalloc(a, desc_a, info, nnz, dupl, bldmode)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
integer(psb_ipk_), optional, intent(in) :: dupl
end subroutine psb_zspalloc
end interface
interface psb_spasb
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl,mold)
subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold)
import
implicit none
type(psb_zspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
integer(psb_ipk_),optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_z_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_zspasb
end interface
interface psb_remote_vect
subroutine psb_z_remote_vect(v,desc_a, dupl, info)
subroutine psb_z_remote_vect(v,desc_a, info)
import
implicit none
type(psb_z_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: dupl
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_remote_vect
end interface psb_remote_vect

14
base/tools/psb_c_remote_mat.F90
Unescape Escape View File

@ -277,7 +277,7 @@ Subroutine psb_lc_remote_mat(a,desc_a,b,info)
End Subroutine psb_lc_remote_mat
subroutine psb_c_remote_vect(v,desc_a, info, dupl)
subroutine psb_c_remote_vect(v,desc_a, info)
use psb_base_mod, psb_protect_name => psb_c_remote_vect
#ifdef MPI_MOD
@ -291,7 +291,6 @@ subroutine psb_c_remote_vect(v,desc_a, info, dupl)
type(psb_c_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl
! ...local scalars....
type(psb_ctxt_type) :: ctxt
@ -323,21 +322,12 @@ subroutine psb_c_remote_vect(v,desc_a, info, dupl)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (present(dupl)) then
dupl_ = dupl
else
if (v%is_remote_build()) then
dupl_ = psb_dupl_add_
else
dupl_ = psb_dupl_def_
end if
endif
ctxt = desc_a%get_context()
icomm = desc_a%get_mpic()
Call psb_info(ctxt, me, np)
dupl_ = v%get_dupl()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': Start'
write(0,*) me, 'X_remote_vect implementation to be completed '

66
base/tools/psb_callc.f90
Unescape Escape View File

@ -40,7 +40,7 @@
! x - the vector to be allocated.
! desc_a - the communication descriptor.
! info - Return code
subroutine psb_calloc_vect(x, desc_a,info)
subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_calloc_vect
use psi_mod
implicit none
@ -49,9 +49,11 @@ subroutine psb_calloc_vect(x, desc_a,info)
type(psb_c_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -102,6 +104,23 @@ subroutine psb_calloc_vect(x, desc_a,info)
endif
call x%zero()
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_))
end if
call psb_erractionrestore(err_act)
return
@ -121,7 +140,7 @@ end subroutine psb_calloc_vect
! n - optional number of columns.
! lb - optional lower bound on column indices
subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_calloc_vect_r2
use psi_mod
implicit none
@ -131,10 +150,12 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n,lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -208,6 +229,26 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
if (info /= 0) exit
end do
end if
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
do i=lb_, lb_+n_-1
call x(i)%set_dupl(dupl_)
call x(i)%set_remote_build(bldmode_)
if (x(i)%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x(i)%rmtv(nrmt_))
end if
end do
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
@ -224,7 +265,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
end subroutine psb_calloc_vect_r2
subroutine psb_calloc_multivect(x, desc_a,info,n)
subroutine psb_calloc_multivect(x, desc_a,info,n, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_calloc_multivect
use psi_mod
implicit none
@ -234,10 +275,12 @@ subroutine psb_calloc_multivect(x, desc_a,info,n)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -306,6 +349,23 @@ subroutine psb_calloc_multivect(x, desc_a,info,n)
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
goto 9999
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_,n_))
end if
call psb_erractionrestore(err_act)
return

19
base/tools/psb_casb.f90
Unescape Escape View File

@ -51,7 +51,7 @@
! scratch - logical, optional If true, allocate without checking/zeroing contents.
! default: .false.
!
subroutine psb_casb_vect(x, desc_a, info, mold, dupl,scratch)
subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_casb_vect
implicit none
@ -59,7 +59,6 @@ subroutine psb_casb_vect(x, desc_a, info, mold, dupl,scratch)
type(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
! local variables
@ -83,13 +82,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold, dupl,scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
call psb_info(ctxt, me, np)
dupl_ = x%get_dupl()
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -110,7 +104,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, dupl,scratch)
call x%free(info)
call x%bld(ncol,mold=mold)
else
if (x%is_remote_build()) call psb_c_remote_vect(x,desc_a,dupl_, info)
if (x%is_remote_build()) call psb_c_remote_vect(x,desc_a,info)
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
@ -147,7 +141,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, i, n
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -166,7 +160,6 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ctxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -192,6 +185,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
else
do i=1, n
dupl_ = x(i)%get_dupl()
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
@ -232,7 +226,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
@ -278,6 +272,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)

52
base/tools/psb_cins.f90
Unescape Escape View File

@ -42,10 +42,7 @@
! x - type(psb_c_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_cins_vect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_cins_vect
use psi_mod
implicit none
@ -57,14 +54,14 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_,err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -119,11 +116,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -165,10 +158,7 @@ end subroutine psb_cins_vect
! x - type(psb_c_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_cins_vect_v
use psi_mod
implicit none
@ -184,7 +174,6 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
type(psb_c_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -238,14 +227,7 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -274,7 +256,7 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_cins_vect_v
subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_cins_vect_r2
use psi_mod
implicit none
@ -290,14 +272,14 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
type(psb_c_vect_type), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols, n
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_, err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -352,11 +334,6 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
@ -370,7 +347,9 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end if
do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
if (info == 0) dupl_ = x(i)%get_dupl()
if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info)
if (info /= 0) exit
end do
@ -389,7 +368,7 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_cins_vect_r2
subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_cins_multivect
use psi_mod
implicit none
@ -405,7 +384,6 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_c_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -468,11 +446,7 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else

48
base/tools/psb_cspalloc.f90
Unescape Escape View File

@ -41,20 +41,22 @@
! nnz - integer(optional). The number of nonzeroes in the matrix.
! (local, user estimate)
!
subroutine psb_cspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_cspalloc(a, desc_a, info, nnz, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_cspalloc
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype, bldmode_
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype
integer(psb_ipk_) :: dupl_, bldmode_
integer(psb_lpk_) :: m, n, nnzrmt_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -96,11 +98,6 @@ subroutine psb_cspalloc(a, desc_a, info, nnz, bldmode)
else
nnz_ = max(1,5*loc_row)
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name), &
@ -114,8 +111,17 @@ subroutine psb_cspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call a%set_dupl(dupl_)
call a%set_remote_build(bldmode_)
if (a%is_remote_build()) then
allocate(a%rmta)
@ -123,22 +129,6 @@ subroutine psb_cspalloc(a, desc_a, info, nnz, bldmode)
call a%rmta%allocate(m,n,nnzrmt_)
end if
!!$ a%remote_build = bldmode_
!!$ select case(a%remote_build)
!!$ case (psb_matbld_noremote_)
!!$ ! nothing needed
!!$ !write(0,*) name,' matbld_noremote_ nothing needed'
!!$ case (psb_matbld_remote_)
!!$ !write(0,*) name,' matbld_remote_ start '
!!$ allocate(a%rmta)
!!$ nnzrmt_ = max(100,(nnz_/100))
!!$ call a%rmta%allocate(m,n,nnzrmt_)
!!$
!!$ case default
!!$ write(0,*) name,'Invalid value for remote_build '
!!$ a%remote_build = psb_matbld_noremote_
!!$ end select
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': ', &
& desc_a%get_dectype(),psb_desc_bld_

20
base/tools/psb_cspasb.f90
Unescape Escape View File

@ -42,13 +42,9 @@
! upd - character(optional). How will the matrix be updated?
! psb_upd_srch_ Simple strategy
! psb_upd_perm_ Permutation(more memory)
! dupl - integer(optional). Duplicate coefficient handling:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
! psb_dupl_err_ raise an error.
!
!
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold)
use psb_base_mod, psb_protect_name => psb_cspasb
use psb_sort_mod
use psi_mod
@ -56,16 +52,16 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
!...Parameters....
type(psb_cspmat_type), intent (inout) :: a
type(psb_cspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_c_base_sparse_mat), intent(in), optional :: mold
!....Locals....
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, err_act
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col, dupl_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
class(psb_i_base_vect_type), allocatable :: ivm
@ -100,8 +96,8 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
!check on errors encountered in psdspins
if (a%is_bld()) then
dupl_ = a%get_dupl()
!
! First case: we come from a fresh build.
!
@ -140,7 +136,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
end block
end if
call a%set_ncols(desc_a%get_local_cols())
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
call a%cscnv(info,type=afmt,mold=mold,dupl=dupl_)
else if (a%is_upd()) then
if (a%is_remote_build()) then
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()

14
base/tools/psb_d_remote_mat.F90
Unescape Escape View File

@ -277,7 +277,7 @@ Subroutine psb_ld_remote_mat(a,desc_a,b,info)
End Subroutine psb_ld_remote_mat
subroutine psb_d_remote_vect(v,desc_a, info, dupl)
subroutine psb_d_remote_vect(v,desc_a, info)
use psb_base_mod, psb_protect_name => psb_d_remote_vect
#ifdef MPI_MOD
@ -291,7 +291,6 @@ subroutine psb_d_remote_vect(v,desc_a, info, dupl)
type(psb_d_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl
! ...local scalars....
type(psb_ctxt_type) :: ctxt
@ -323,21 +322,12 @@ subroutine psb_d_remote_vect(v,desc_a, info, dupl)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (present(dupl)) then
dupl_ = dupl
else
if (v%is_remote_build()) then
dupl_ = psb_dupl_add_
else
dupl_ = psb_dupl_def_
end if
endif
ctxt = desc_a%get_context()
icomm = desc_a%get_mpic()
Call psb_info(ctxt, me, np)
dupl_ = v%get_dupl()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': Start'
write(0,*) me, 'X_remote_vect implementation to be completed '

66
base/tools/psb_dallc.f90
Unescape Escape View File

@ -40,7 +40,7 @@
! x - the vector to be allocated.
! desc_a - the communication descriptor.
! info - Return code
subroutine psb_dalloc_vect(x, desc_a,info)
subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_dalloc_vect
use psi_mod
implicit none
@ -49,9 +49,11 @@ subroutine psb_dalloc_vect(x, desc_a,info)
type(psb_d_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -102,6 +104,23 @@ subroutine psb_dalloc_vect(x, desc_a,info)
endif
call x%zero()
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_))
end if
call psb_erractionrestore(err_act)
return
@ -121,7 +140,7 @@ end subroutine psb_dalloc_vect
! n - optional number of columns.
! lb - optional lower bound on column indices
subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_dalloc_vect_r2
use psi_mod
implicit none
@ -131,10 +150,12 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n,lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -208,6 +229,26 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
if (info /= 0) exit
end do
end if
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
do i=lb_, lb_+n_-1
call x(i)%set_dupl(dupl_)
call x(i)%set_remote_build(bldmode_)
if (x(i)%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x(i)%rmtv(nrmt_))
end if
end do
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
@ -224,7 +265,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
end subroutine psb_dalloc_vect_r2
subroutine psb_dalloc_multivect(x, desc_a,info,n)
subroutine psb_dalloc_multivect(x, desc_a,info,n, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_dalloc_multivect
use psi_mod
implicit none
@ -234,10 +275,12 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -306,6 +349,23 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n)
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
goto 9999
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_,n_))
end if
call psb_erractionrestore(err_act)
return

19
base/tools/psb_dasb.f90
Unescape Escape View File

@ -51,7 +51,7 @@
! scratch - logical, optional If true, allocate without checking/zeroing contents.
! default: .false.
!
subroutine psb_dasb_vect(x, desc_a, info, mold, dupl,scratch)
subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_dasb_vect
implicit none
@ -59,7 +59,6 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, dupl,scratch)
type(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
! local variables
@ -83,13 +82,8 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, dupl,scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
call psb_info(ctxt, me, np)
dupl_ = x%get_dupl()
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -110,7 +104,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, dupl,scratch)
call x%free(info)
call x%bld(ncol,mold=mold)
else
if (x%is_remote_build()) call psb_d_remote_vect(x,desc_a,dupl_, info)
if (x%is_remote_build()) call psb_d_remote_vect(x,desc_a,info)
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
@ -147,7 +141,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, i, n
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -166,7 +160,6 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ctxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -192,6 +185,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
else
do i=1, n
dupl_ = x(i)%get_dupl()
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
@ -232,7 +226,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
@ -278,6 +272,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)

52
base/tools/psb_dins.f90
Unescape Escape View File

@ -42,10 +42,7 @@
! x - type(psb_d_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_dins_vect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_dins_vect
use psi_mod
implicit none
@ -57,14 +54,14 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_,err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -119,11 +116,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -165,10 +158,7 @@ end subroutine psb_dins_vect
! x - type(psb_d_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_dins_vect_v
use psi_mod
implicit none
@ -184,7 +174,6 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -238,14 +227,7 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -274,7 +256,7 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_dins_vect_v
subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_dins_vect_r2
use psi_mod
implicit none
@ -290,14 +272,14 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
type(psb_d_vect_type), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols, n
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_, err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -352,11 +334,6 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
@ -370,7 +347,9 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end if
do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
if (info == 0) dupl_ = x(i)%get_dupl()
if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info)
if (info /= 0) exit
end do
@ -389,7 +368,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_dins_vect_r2
subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_dins_multivect
use psi_mod
implicit none
@ -405,7 +384,6 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_d_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -468,11 +446,7 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else

48
base/tools/psb_dspalloc.f90
Unescape Escape View File

@ -41,20 +41,22 @@
! nnz - integer(optional). The number of nonzeroes in the matrix.
! (local, user estimate)
!
subroutine psb_dspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_dspalloc(a, desc_a, info, nnz, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_dspalloc
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype, bldmode_
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype
integer(psb_ipk_) :: dupl_, bldmode_
integer(psb_lpk_) :: m, n, nnzrmt_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -96,11 +98,6 @@ subroutine psb_dspalloc(a, desc_a, info, nnz, bldmode)
else
nnz_ = max(1,5*loc_row)
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name), &
@ -114,8 +111,17 @@ subroutine psb_dspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call a%set_dupl(dupl_)
call a%set_remote_build(bldmode_)
if (a%is_remote_build()) then
allocate(a%rmta)
@ -123,22 +129,6 @@ subroutine psb_dspalloc(a, desc_a, info, nnz, bldmode)
call a%rmta%allocate(m,n,nnzrmt_)
end if
!!$ a%remote_build = bldmode_
!!$ select case(a%remote_build)
!!$ case (psb_matbld_noremote_)
!!$ ! nothing needed
!!$ !write(0,*) name,' matbld_noremote_ nothing needed'
!!$ case (psb_matbld_remote_)
!!$ !write(0,*) name,' matbld_remote_ start '
!!$ allocate(a%rmta)
!!$ nnzrmt_ = max(100,(nnz_/100))
!!$ call a%rmta%allocate(m,n,nnzrmt_)
!!$
!!$ case default
!!$ write(0,*) name,'Invalid value for remote_build '
!!$ a%remote_build = psb_matbld_noremote_
!!$ end select
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': ', &
& desc_a%get_dectype(),psb_desc_bld_

20
base/tools/psb_dspasb.f90
Unescape Escape View File

@ -42,13 +42,9 @@
! upd - character(optional). How will the matrix be updated?
! psb_upd_srch_ Simple strategy
! psb_upd_perm_ Permutation(more memory)
! dupl - integer(optional). Duplicate coefficient handling:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
! psb_dupl_err_ raise an error.
!
!
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold)
use psb_base_mod, psb_protect_name => psb_dspasb
use psb_sort_mod
use psi_mod
@ -56,16 +52,16 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
!...Parameters....
type(psb_dspmat_type), intent (inout) :: a
type(psb_dspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_d_base_sparse_mat), intent(in), optional :: mold
!....Locals....
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, err_act
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col, dupl_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
class(psb_i_base_vect_type), allocatable :: ivm
@ -100,8 +96,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
!check on errors encountered in psdspins
if (a%is_bld()) then
dupl_ = a%get_dupl()
!
! First case: we come from a fresh build.
!
@ -140,7 +136,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
end block
end if
call a%set_ncols(desc_a%get_local_cols())
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
call a%cscnv(info,type=afmt,mold=mold,dupl=dupl_)
else if (a%is_upd()) then
if (a%is_remote_build()) then
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()

66
base/tools/psb_iallc.f90
Unescape Escape View File

@ -40,7 +40,7 @@
! x - the vector to be allocated.
! desc_a - the communication descriptor.
! info - Return code
subroutine psb_ialloc_vect(x, desc_a,info)
subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_ialloc_vect
use psi_mod
implicit none
@ -49,9 +49,11 @@ subroutine psb_ialloc_vect(x, desc_a,info)
type(psb_i_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -102,6 +104,23 @@ subroutine psb_ialloc_vect(x, desc_a,info)
endif
call x%zero()
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_))
end if
call psb_erractionrestore(err_act)
return
@ -121,7 +140,7 @@ end subroutine psb_ialloc_vect
! n - optional number of columns.
! lb - optional lower bound on column indices
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_ialloc_vect_r2
use psi_mod
implicit none
@ -131,10 +150,12 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n,lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -208,6 +229,26 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
if (info /= 0) exit
end do
end if
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
do i=lb_, lb_+n_-1
call x(i)%set_dupl(dupl_)
call x(i)%set_remote_build(bldmode_)
if (x(i)%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x(i)%rmtv(nrmt_))
end if
end do
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
@ -224,7 +265,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
end subroutine psb_ialloc_vect_r2
subroutine psb_ialloc_multivect(x, desc_a,info,n)
subroutine psb_ialloc_multivect(x, desc_a,info,n, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_ialloc_multivect
use psi_mod
implicit none
@ -234,10 +275,12 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -306,6 +349,23 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n)
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
goto 9999
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_,n_))
end if
call psb_erractionrestore(err_act)
return

19
base/tools/psb_iasb.f90
Unescape Escape View File

@ -51,7 +51,7 @@
! scratch - logical, optional If true, allocate without checking/zeroing contents.
! default: .false.
!
subroutine psb_iasb_vect(x, desc_a, info, mold, dupl,scratch)
subroutine psb_iasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_iasb_vect
implicit none
@ -59,7 +59,6 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, dupl,scratch)
type(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
! local variables
@ -83,13 +82,8 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, dupl,scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
call psb_info(ctxt, me, np)
dupl_ = x%get_dupl()
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -110,7 +104,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, dupl,scratch)
call x%free(info)
call x%bld(ncol,mold=mold)
else
if (x%is_remote_build()) call psb_i_remote_vect(x,desc_a,dupl_, info)
if (x%is_remote_build()) call psb_i_remote_vect(x,desc_a,info)
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
@ -147,7 +141,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, i, n
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -166,7 +160,6 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ctxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -192,6 +185,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch)
else
do i=1, n
dupl_ = x(i)%get_dupl()
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
@ -232,7 +226,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
@ -278,6 +272,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)

52
base/tools/psb_iins.f90
Unescape Escape View File

@ -42,10 +42,7 @@
! x - type(psb_i_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_iins_vect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_iins_vect
use psi_mod
implicit none
@ -57,14 +54,14 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_,err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -119,11 +116,7 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -165,10 +158,7 @@ end subroutine psb_iins_vect
! x - type(psb_i_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_iins_vect_v
use psi_mod
implicit none
@ -184,7 +174,6 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -238,14 +227,7 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -274,7 +256,7 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_iins_vect_v
subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_iins_vect_r2
use psi_mod
implicit none
@ -290,14 +272,14 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
type(psb_i_vect_type), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols, n
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_, err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -352,11 +334,6 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
@ -370,7 +347,9 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end if
do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
if (info == 0) dupl_ = x(i)%get_dupl()
if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info)
if (info /= 0) exit
end do
@ -389,7 +368,7 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_iins_vect_r2
subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_iins_multivect
use psi_mod
implicit none
@ -405,7 +384,6 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_i_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -468,11 +446,7 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else

66
base/tools/psb_lallc.f90
Unescape Escape View File

@ -40,7 +40,7 @@
! x - the vector to be allocated.
! desc_a - the communication descriptor.
! info - Return code
subroutine psb_lalloc_vect(x, desc_a,info)
subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_lalloc_vect
use psi_mod
implicit none
@ -49,9 +49,11 @@ subroutine psb_lalloc_vect(x, desc_a,info)
type(psb_l_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -102,6 +104,23 @@ subroutine psb_lalloc_vect(x, desc_a,info)
endif
call x%zero()
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_))
end if
call psb_erractionrestore(err_act)
return
@ -121,7 +140,7 @@ end subroutine psb_lalloc_vect
! n - optional number of columns.
! lb - optional lower bound on column indices
subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_lalloc_vect_r2
use psi_mod
implicit none
@ -131,10 +150,12 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n,lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -208,6 +229,26 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
if (info /= 0) exit
end do
end if
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
do i=lb_, lb_+n_-1
call x(i)%set_dupl(dupl_)
call x(i)%set_remote_build(bldmode_)
if (x(i)%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x(i)%rmtv(nrmt_))
end if
end do
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
@ -224,7 +265,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
end subroutine psb_lalloc_vect_r2
subroutine psb_lalloc_multivect(x, desc_a,info,n)
subroutine psb_lalloc_multivect(x, desc_a,info,n, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_lalloc_multivect
use psi_mod
implicit none
@ -234,10 +275,12 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -306,6 +349,23 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n)
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
goto 9999
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_,n_))
end if
call psb_erractionrestore(err_act)
return

19
base/tools/psb_lasb.f90
Unescape Escape View File

@ -51,7 +51,7 @@
! scratch - logical, optional If true, allocate without checking/zeroing contents.
! default: .false.
!
subroutine psb_lasb_vect(x, desc_a, info, mold, dupl,scratch)
subroutine psb_lasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_lasb_vect
implicit none
@ -59,7 +59,6 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, dupl,scratch)
type(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_l_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
! local variables
@ -83,13 +82,8 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, dupl,scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
call psb_info(ctxt, me, np)
dupl_ = x%get_dupl()
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -110,7 +104,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, dupl,scratch)
call x%free(info)
call x%bld(ncol,mold=mold)
else
if (x%is_remote_build()) call psb_l_remote_vect(x,desc_a,dupl_, info)
if (x%is_remote_build()) call psb_l_remote_vect(x,desc_a,info)
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
@ -147,7 +141,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, i, n
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -166,7 +160,6 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ctxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -192,6 +185,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch)
else
do i=1, n
dupl_ = x(i)%get_dupl()
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
@ -232,7 +226,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
@ -278,6 +272,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)

52
base/tools/psb_lins.f90
Unescape Escape View File

@ -42,10 +42,7 @@
! x - type(psb_l_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_lins_vect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_lins_vect
use psi_mod
implicit none
@ -57,14 +54,14 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_l_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_,err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -119,11 +116,7 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -165,10 +158,7 @@ end subroutine psb_lins_vect
! x - type(psb_l_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_lins_vect_v
use psi_mod
implicit none
@ -184,7 +174,6 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
type(psb_l_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -238,14 +227,7 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -274,7 +256,7 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_lins_vect_v
subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_lins_vect_r2
use psi_mod
implicit none
@ -290,14 +272,14 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
type(psb_l_vect_type), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols, n
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_, err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -352,11 +334,6 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
@ -370,7 +347,9 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end if
do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
if (info == 0) dupl_ = x(i)%get_dupl()
if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info)
if (info /= 0) exit
end do
@ -389,7 +368,7 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_lins_vect_r2
subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_lins_multivect
use psi_mod
implicit none
@ -405,7 +384,6 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_l_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -468,11 +446,7 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else

14
base/tools/psb_s_remote_mat.F90
Unescape Escape View File

@ -277,7 +277,7 @@ Subroutine psb_ls_remote_mat(a,desc_a,b,info)
End Subroutine psb_ls_remote_mat
subroutine psb_s_remote_vect(v,desc_a, info, dupl)
subroutine psb_s_remote_vect(v,desc_a, info)
use psb_base_mod, psb_protect_name => psb_s_remote_vect
#ifdef MPI_MOD
@ -291,7 +291,6 @@ subroutine psb_s_remote_vect(v,desc_a, info, dupl)
type(psb_s_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl
! ...local scalars....
type(psb_ctxt_type) :: ctxt
@ -323,21 +322,12 @@ subroutine psb_s_remote_vect(v,desc_a, info, dupl)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (present(dupl)) then
dupl_ = dupl
else
if (v%is_remote_build()) then
dupl_ = psb_dupl_add_
else
dupl_ = psb_dupl_def_
end if
endif
ctxt = desc_a%get_context()
icomm = desc_a%get_mpic()
Call psb_info(ctxt, me, np)
dupl_ = v%get_dupl()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': Start'
write(0,*) me, 'X_remote_vect implementation to be completed '

66
base/tools/psb_sallc.f90
Unescape Escape View File

@ -40,7 +40,7 @@
! x - the vector to be allocated.
! desc_a - the communication descriptor.
! info - Return code
subroutine psb_salloc_vect(x, desc_a,info)
subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_salloc_vect
use psi_mod
implicit none
@ -49,9 +49,11 @@ subroutine psb_salloc_vect(x, desc_a,info)
type(psb_s_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -102,6 +104,23 @@ subroutine psb_salloc_vect(x, desc_a,info)
endif
call x%zero()
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_))
end if
call psb_erractionrestore(err_act)
return
@ -121,7 +140,7 @@ end subroutine psb_salloc_vect
! n - optional number of columns.
! lb - optional lower bound on column indices
subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_salloc_vect_r2
use psi_mod
implicit none
@ -131,10 +150,12 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n,lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -208,6 +229,26 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
if (info /= 0) exit
end do
end if
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
do i=lb_, lb_+n_-1
call x(i)%set_dupl(dupl_)
call x(i)%set_remote_build(bldmode_)
if (x(i)%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x(i)%rmtv(nrmt_))
end if
end do
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
@ -224,7 +265,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
end subroutine psb_salloc_vect_r2
subroutine psb_salloc_multivect(x, desc_a,info,n)
subroutine psb_salloc_multivect(x, desc_a,info,n, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_salloc_multivect
use psi_mod
implicit none
@ -234,10 +275,12 @@ subroutine psb_salloc_multivect(x, desc_a,info,n)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -306,6 +349,23 @@ subroutine psb_salloc_multivect(x, desc_a,info,n)
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
goto 9999
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_,n_))
end if
call psb_erractionrestore(err_act)
return

19
base/tools/psb_sasb.f90
Unescape Escape View File

@ -51,7 +51,7 @@
! scratch - logical, optional If true, allocate without checking/zeroing contents.
! default: .false.
!
subroutine psb_sasb_vect(x, desc_a, info, mold, dupl,scratch)
subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_sasb_vect
implicit none
@ -59,7 +59,6 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, dupl,scratch)
type(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
! local variables
@ -83,13 +82,8 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, dupl,scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
call psb_info(ctxt, me, np)
dupl_ = x%get_dupl()
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -110,7 +104,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, dupl,scratch)
call x%free(info)
call x%bld(ncol,mold=mold)
else
if (x%is_remote_build()) call psb_s_remote_vect(x,desc_a,dupl_, info)
if (x%is_remote_build()) call psb_s_remote_vect(x,desc_a,info)
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
@ -147,7 +141,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, i, n
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -166,7 +160,6 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ctxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -192,6 +185,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
else
do i=1, n
dupl_ = x(i)%get_dupl()
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
@ -232,7 +226,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
@ -278,6 +272,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)

52
base/tools/psb_sins.f90
Unescape Escape View File

@ -42,10 +42,7 @@
! x - type(psb_s_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_sins_vect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_sins_vect
use psi_mod
implicit none
@ -57,14 +54,14 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_s_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_,err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -119,11 +116,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -165,10 +158,7 @@ end subroutine psb_sins_vect
! x - type(psb_s_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_sins_vect_v
use psi_mod
implicit none
@ -184,7 +174,6 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
type(psb_s_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -238,14 +227,7 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -274,7 +256,7 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_sins_vect_v
subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_sins_vect_r2
use psi_mod
implicit none
@ -290,14 +272,14 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
type(psb_s_vect_type), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols, n
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_, err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -352,11 +334,6 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
@ -370,7 +347,9 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end if
do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
if (info == 0) dupl_ = x(i)%get_dupl()
if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info)
if (info /= 0) exit
end do
@ -389,7 +368,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_sins_vect_r2
subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_sins_multivect
use psi_mod
implicit none
@ -405,7 +384,6 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_s_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -468,11 +446,7 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else

48
base/tools/psb_sspalloc.f90
Unescape Escape View File

@ -41,20 +41,22 @@
! nnz - integer(optional). The number of nonzeroes in the matrix.
! (local, user estimate)
!
subroutine psb_sspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_sspalloc(a, desc_a, info, nnz, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_sspalloc
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype, bldmode_
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype
integer(psb_ipk_) :: dupl_, bldmode_
integer(psb_lpk_) :: m, n, nnzrmt_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -96,11 +98,6 @@ subroutine psb_sspalloc(a, desc_a, info, nnz, bldmode)
else
nnz_ = max(1,5*loc_row)
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name), &
@ -114,8 +111,17 @@ subroutine psb_sspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call a%set_dupl(dupl_)
call a%set_remote_build(bldmode_)
if (a%is_remote_build()) then
allocate(a%rmta)
@ -123,22 +129,6 @@ subroutine psb_sspalloc(a, desc_a, info, nnz, bldmode)
call a%rmta%allocate(m,n,nnzrmt_)
end if
!!$ a%remote_build = bldmode_
!!$ select case(a%remote_build)
!!$ case (psb_matbld_noremote_)
!!$ ! nothing needed
!!$ !write(0,*) name,' matbld_noremote_ nothing needed'
!!$ case (psb_matbld_remote_)
!!$ !write(0,*) name,' matbld_remote_ start '
!!$ allocate(a%rmta)
!!$ nnzrmt_ = max(100,(nnz_/100))
!!$ call a%rmta%allocate(m,n,nnzrmt_)
!!$
!!$ case default
!!$ write(0,*) name,'Invalid value for remote_build '
!!$ a%remote_build = psb_matbld_noremote_
!!$ end select
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': ', &
& desc_a%get_dectype(),psb_desc_bld_

20
base/tools/psb_sspasb.f90
Unescape Escape View File

@ -42,13 +42,9 @@
! upd - character(optional). How will the matrix be updated?
! psb_upd_srch_ Simple strategy
! psb_upd_perm_ Permutation(more memory)
! dupl - integer(optional). Duplicate coefficient handling:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
! psb_dupl_err_ raise an error.
!
!
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold)
use psb_base_mod, psb_protect_name => psb_sspasb
use psb_sort_mod
use psi_mod
@ -56,16 +52,16 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
!...Parameters....
type(psb_sspmat_type), intent (inout) :: a
type(psb_sspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_s_base_sparse_mat), intent(in), optional :: mold
!....Locals....
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, err_act
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col, dupl_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
class(psb_i_base_vect_type), allocatable :: ivm
@ -100,8 +96,8 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
!check on errors encountered in psdspins
if (a%is_bld()) then
dupl_ = a%get_dupl()
!
! First case: we come from a fresh build.
!
@ -140,7 +136,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
end block
end if
call a%set_ncols(desc_a%get_local_cols())
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
call a%cscnv(info,type=afmt,mold=mold,dupl=dupl_)
else if (a%is_upd()) then
if (a%is_remote_build()) then
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()

14
base/tools/psb_z_remote_mat.F90
Unescape Escape View File

@ -277,7 +277,7 @@ Subroutine psb_lz_remote_mat(a,desc_a,b,info)
End Subroutine psb_lz_remote_mat
subroutine psb_z_remote_vect(v,desc_a, info, dupl)
subroutine psb_z_remote_vect(v,desc_a, info)
use psb_base_mod, psb_protect_name => psb_z_remote_vect
#ifdef MPI_MOD
@ -291,7 +291,6 @@ subroutine psb_z_remote_vect(v,desc_a, info, dupl)
type(psb_z_vect_type),Intent(inout) :: v
type(psb_desc_type),intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl
! ...local scalars....
type(psb_ctxt_type) :: ctxt
@ -323,21 +322,12 @@ subroutine psb_z_remote_vect(v,desc_a, info, dupl)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (present(dupl)) then
dupl_ = dupl
else
if (v%is_remote_build()) then
dupl_ = psb_dupl_add_
else
dupl_ = psb_dupl_def_
end if
endif
ctxt = desc_a%get_context()
icomm = desc_a%get_mpic()
Call psb_info(ctxt, me, np)
dupl_ = v%get_dupl()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': Start'
write(0,*) me, 'X_remote_vect implementation to be completed '

66
base/tools/psb_zallc.f90
Unescape Escape View File

@ -40,7 +40,7 @@
! x - the vector to be allocated.
! desc_a - the communication descriptor.
! info - Return code
subroutine psb_zalloc_vect(x, desc_a,info)
subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_zalloc_vect
use psi_mod
implicit none
@ -49,9 +49,11 @@ subroutine psb_zalloc_vect(x, desc_a,info)
type(psb_z_vect_type), intent(out) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -102,6 +104,23 @@ subroutine psb_zalloc_vect(x, desc_a,info)
endif
call x%zero()
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_))
end if
call psb_erractionrestore(err_act)
return
@ -121,7 +140,7 @@ end subroutine psb_zalloc_vect
! n - optional number of columns.
! lb - optional lower bound on column indices
subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_zalloc_vect_r2
use psi_mod
implicit none
@ -131,10 +150,12 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n,lb
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -208,6 +229,26 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
if (info /= 0) exit
end do
end if
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
do i=lb_, lb_+n_-1
call x(i)%set_dupl(dupl_)
call x(i)%set_remote_build(bldmode_)
if (x(i)%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x(i)%rmtv(nrmt_))
end if
end do
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
@ -224,7 +265,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
end subroutine psb_zalloc_vect_r2
subroutine psb_zalloc_multivect(x, desc_a,info,n)
subroutine psb_zalloc_multivect(x, desc_a,info,n, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_zalloc_multivect
use psi_mod
implicit none
@ -234,10 +275,12 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: exch(1)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -306,6 +349,23 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n)
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
goto 9999
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call x%set_dupl(dupl_)
call x%set_remote_build(bldmode_)
if (x%is_remote_build()) then
nrmt_ = max(100,(desc_a%get_local_cols()-desc_a%get_local_rows()))
allocate(x%rmtv(nrmt_,n_))
end if
call psb_erractionrestore(err_act)
return

19
base/tools/psb_zasb.f90
Unescape Escape View File

@ -51,7 +51,7 @@
! scratch - logical, optional If true, allocate without checking/zeroing contents.
! default: .false.
!
subroutine psb_zasb_vect(x, desc_a, info, mold, dupl,scratch)
subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_zasb_vect
implicit none
@ -59,7 +59,6 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, dupl,scratch)
type(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: scratch
! local variables
@ -83,13 +82,8 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, dupl,scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
call psb_info(ctxt, me, np)
dupl_ = x%get_dupl()
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -110,7 +104,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, dupl,scratch)
call x%free(info)
call x%bld(ncol,mold=mold)
else
if (x%is_remote_build()) call psb_z_remote_vect(x,desc_a,dupl_, info)
if (x%is_remote_build()) call psb_z_remote_vect(x,desc_a,info)
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
@ -147,7 +141,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, i, n
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -166,7 +160,6 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ctxt, me, np)
! ....verify blacs grid correctness..
if (np == -1) then
info = psb_err_context_error_
@ -192,6 +185,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
else
do i=1, n
dupl_ = x(i)%get_dupl()
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
@ -232,7 +226,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_
integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_, dupl_
logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit
@ -278,6 +272,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)

52
base/tools/psb_zins.f90
Unescape Escape View File

@ -42,10 +42,7 @@
! x - type(psb_z_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_zins_vect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_zins_vect
use psi_mod
implicit none
@ -57,14 +54,14 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_z_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_,err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -119,11 +116,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -165,10 +158,7 @@ end subroutine psb_zins_vect
! x - type(psb_z_vect_type) The destination vector
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_zins_vect_v
use psi_mod
implicit none
@ -184,7 +174,6 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
type(psb_z_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -238,14 +227,7 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else
@ -274,7 +256,7 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_zins_vect_v
subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_zins_vect_r2
use psi_mod
implicit none
@ -290,14 +272,14 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
type(psb_z_vect_type), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: i, loc_rows,loc_cols, n
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: dupl_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, dupl_, err_act
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name
@ -352,11 +334,6 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
@ -370,7 +347,9 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end if
do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_
if (info == 0) dupl_ = x(i)%get_dupl()
if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info)
if (info /= 0) exit
end do
@ -389,7 +368,7 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_zins_vect_r2
subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local)
subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, local)
use psb_base_mod, psb_protect_name => psb_zins_multivect
use psi_mod
implicit none
@ -405,7 +384,6 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local)
type(psb_z_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
@ -468,11 +446,7 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
dupl_ = x%get_dupl()
if (present(local)) then
local_ = local
else

48
base/tools/psb_zspalloc.f90
Unescape Escape View File

@ -41,20 +41,22 @@
! nnz - integer(optional). The number of nonzeroes in the matrix.
! (local, user estimate)
!
subroutine psb_zspalloc(a, desc_a, info, nnz, bldmode)
subroutine psb_zspalloc(a, desc_a, info, nnz, dupl, bldmode)
use psb_base_mod, psb_protect_name => psb_zspalloc
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz, bldmode
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nnz
integer(psb_ipk_), optional, intent(in) :: dupl, bldmode
!locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype, bldmode_
integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype
integer(psb_ipk_) :: dupl_, bldmode_
integer(psb_lpk_) :: m, n, nnzrmt_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -96,11 +98,6 @@ subroutine psb_zspalloc(a, desc_a, info, nnz, bldmode)
else
nnz_ = max(1,5*loc_row)
endif
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name), &
@ -114,8 +111,17 @@ subroutine psb_zspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
if (present(bldmode)) then
bldmode_ = bldmode
else
bldmode_ = psb_matbld_noremote_
end if
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_def_
end if
call a%set_dupl(dupl_)
call a%set_remote_build(bldmode_)
if (a%is_remote_build()) then
allocate(a%rmta)
@ -123,22 +129,6 @@ subroutine psb_zspalloc(a, desc_a, info, nnz, bldmode)
call a%rmta%allocate(m,n,nnzrmt_)
end if
!!$ a%remote_build = bldmode_
!!$ select case(a%remote_build)
!!$ case (psb_matbld_noremote_)
!!$ ! nothing needed
!!$ !write(0,*) name,' matbld_noremote_ nothing needed'
!!$ case (psb_matbld_remote_)
!!$ !write(0,*) name,' matbld_remote_ start '
!!$ allocate(a%rmta)
!!$ nnzrmt_ = max(100,(nnz_/100))
!!$ call a%rmta%allocate(m,n,nnzrmt_)
!!$
!!$ case default
!!$ write(0,*) name,'Invalid value for remote_build '
!!$ a%remote_build = psb_matbld_noremote_
!!$ end select
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': ', &
& desc_a%get_dectype(),psb_desc_bld_

20
base/tools/psb_zspasb.f90
Unescape Escape View File

@ -42,13 +42,9 @@
! upd - character(optional). How will the matrix be updated?
! psb_upd_srch_ Simple strategy
! psb_upd_perm_ Permutation(more memory)
! dupl - integer(optional). Duplicate coefficient handling:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
! psb_dupl_err_ raise an error.
!
!
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold)
use psb_base_mod, psb_protect_name => psb_zspasb
use psb_sort_mod
use psi_mod
@ -56,16 +52,16 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
!...Parameters....
type(psb_zspmat_type), intent (inout) :: a
type(psb_zspmat_type), intent (inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_),optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: upd
character(len=*), optional, intent(in) :: afmt
class(psb_z_base_sparse_mat), intent(in), optional :: mold
!....Locals....
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me, err_act
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col, dupl_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
class(psb_i_base_vect_type), allocatable :: ivm
@ -100,8 +96,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
!check on errors encountered in psdspins
if (a%is_bld()) then
dupl_ = a%get_dupl()
!
! First case: we come from a fresh build.
!
@ -140,7 +136,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
end block
end if
call a%set_ncols(desc_a%get_local_cols())
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
call a%cscnv(info,type=afmt,mold=mold,dupl=dupl_)
else if (a%is_upd()) then
if (a%is_remote_build()) then
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()

58
cbind/base/psb_c_tools_cbind_mod.F90
Unescape Escape View File

@ -8,7 +8,8 @@ module psb_c_tools_cbind_mod
contains
function psb_c_cgeall(xh,cdh) bind(c) result(res)
! Should define geall_opt with DUPL argument
function psb_c_cgeall(xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -101,7 +102,7 @@ contains
end function psb_c_cgefree
function psb_c_cgeins(nz,irw,val,xh,cdh) bind(c) result(res)
function psb_c_cgeins(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -131,10 +132,10 @@ contains
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
end if
res = min(0,info)
@ -142,47 +143,6 @@ contains
return
end function psb_c_cgeins
function psb_c_cgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nz
integer(psb_c_lpk_) :: irw(*)
complex(c_float_complex) :: val(*)
type(psb_c_cvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_c_vect_type), pointer :: xp
integer(psb_c_ipk_) :: ixb, info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info)
return
end function psb_c_cgeins_add
function psb_c_cspall(mh,cdh) bind(c) result(res)
implicit none
@ -301,7 +261,7 @@ contains
#if 0
function psb_c_cspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
function psb_c_cspasb_opt(mh,cdh,afmt,upd) bind(c) result(res)
#ifdef HAVE_LIBRSB
use psb_c_rsb_mat_mod
@ -310,7 +270,7 @@ contains
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cdh, mh,upd,dupl
character(c_char) :: afmt(*)
integer(psb_c_ipk_) :: info,n, fdupl
integer(psb_c_ipk_) :: info,n
character(len=5) :: fafmt
#ifdef HAVE_LIBRSB
type(psb_c_rsb_sparse_mat) :: arsb
@ -327,11 +287,11 @@ contains
#ifdef HAVE_LIBRSB
case('RSB')
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& upd=upd,dupl=dupl,mold=arsb)
& upd=upd,mold=arsb)
#endif
case default
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& afmt=fafmt,upd=upd,dupl=dupl)
& afmt=fafmt,upd=upd)
end select
res = min(0,info)

58
cbind/base/psb_d_tools_cbind_mod.F90
Unescape Escape View File

@ -8,7 +8,8 @@ module psb_d_tools_cbind_mod
contains
function psb_c_dgeall(xh,cdh) bind(c) result(res)
! Should define geall_opt with DUPL argument
function psb_c_dgeall(xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -101,7 +102,7 @@ contains
end function psb_c_dgefree
function psb_c_dgeins(nz,irw,val,xh,cdh) bind(c) result(res)
function psb_c_dgeins(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -131,10 +132,10 @@ contains
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
end if
res = min(0,info)
@ -142,47 +143,6 @@ contains
return
end function psb_c_dgeins
function psb_c_dgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nz
integer(psb_c_lpk_) :: irw(*)
real(c_double) :: val(*)
type(psb_c_dvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp
integer(psb_c_ipk_) :: ixb, info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info)
return
end function psb_c_dgeins_add
function psb_c_dspall(mh,cdh) bind(c) result(res)
implicit none
@ -301,7 +261,7 @@ contains
#if 0
function psb_c_dspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
function psb_c_dspasb_opt(mh,cdh,afmt,upd) bind(c) result(res)
#ifdef HAVE_LIBRSB
use psb_d_rsb_mat_mod
@ -310,7 +270,7 @@ contains
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cdh, mh,upd,dupl
character(c_char) :: afmt(*)
integer(psb_c_ipk_) :: info,n, fdupl
integer(psb_c_ipk_) :: info,n
character(len=5) :: fafmt
#ifdef HAVE_LIBRSB
type(psb_d_rsb_sparse_mat) :: arsb
@ -327,11 +287,11 @@ contains
#ifdef HAVE_LIBRSB
case('RSB')
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& upd=upd,dupl=dupl,mold=arsb)
& upd=upd,mold=arsb)
#endif
case default
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& afmt=fafmt,upd=upd,dupl=dupl)
& afmt=fafmt,upd=upd)
end select
res = min(0,info)

58
cbind/base/psb_s_tools_cbind_mod.F90
Unescape Escape View File

@ -8,7 +8,8 @@ module psb_s_tools_cbind_mod
contains
function psb_c_sgeall(xh,cdh) bind(c) result(res)
! Should define geall_opt with DUPL argument
function psb_c_sgeall(xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -101,7 +102,7 @@ contains
end function psb_c_sgefree
function psb_c_sgeins(nz,irw,val,xh,cdh) bind(c) result(res)
function psb_c_sgeins(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -131,10 +132,10 @@ contains
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
end if
res = min(0,info)
@ -142,47 +143,6 @@ contains
return
end function psb_c_sgeins
function psb_c_sgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nz
integer(psb_c_lpk_) :: irw(*)
real(c_float) :: val(*)
type(psb_c_svector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_s_vect_type), pointer :: xp
integer(psb_c_ipk_) :: ixb, info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info)
return
end function psb_c_sgeins_add
function psb_c_sspall(mh,cdh) bind(c) result(res)
implicit none
@ -301,7 +261,7 @@ contains
#if 0
function psb_c_sspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
function psb_c_sspasb_opt(mh,cdh,afmt,upd) bind(c) result(res)
#ifdef HAVE_LIBRSB
use psb_s_rsb_mat_mod
@ -310,7 +270,7 @@ contains
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cdh, mh,upd,dupl
character(c_char) :: afmt(*)
integer(psb_c_ipk_) :: info,n, fdupl
integer(psb_c_ipk_) :: info,n
character(len=5) :: fafmt
#ifdef HAVE_LIBRSB
type(psb_s_rsb_sparse_mat) :: arsb
@ -327,11 +287,11 @@ contains
#ifdef HAVE_LIBRSB
case('RSB')
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& upd=upd,dupl=dupl,mold=arsb)
& upd=upd,mold=arsb)
#endif
case default
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& afmt=fafmt,upd=upd,dupl=dupl)
& afmt=fafmt,upd=upd)
end select
res = min(0,info)

58
cbind/base/psb_z_tools_cbind_mod.F90
Unescape Escape View File

@ -8,7 +8,8 @@ module psb_z_tools_cbind_mod
contains
function psb_c_zgeall(xh,cdh) bind(c) result(res)
! Should define geall_opt with DUPL argument
function psb_c_zgeall(xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -101,7 +102,7 @@ contains
end function psb_c_zgefree
function psb_c_zgeins(nz,irw,val,xh,cdh) bind(c) result(res)
function psb_c_zgeins(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
@ -131,10 +132,10 @@ contains
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
& xp,descp,info)
end if
res = min(0,info)
@ -142,47 +143,6 @@ contains
return
end function psb_c_zgeins
function psb_c_zgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nz
integer(psb_c_lpk_) :: irw(*)
complex(c_double_complex) :: val(*)
type(psb_c_zvector) :: xh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_z_vect_type), pointer :: xp
integer(psb_c_ipk_) :: ixb, info
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(xh%item)) then
call c_f_pointer(xh%item,xp)
else
return
end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info)
return
end function psb_c_zgeins_add
function psb_c_zspall(mh,cdh) bind(c) result(res)
implicit none
@ -301,7 +261,7 @@ contains
#if 0
function psb_c_zspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
function psb_c_zspasb_opt(mh,cdh,afmt,upd) bind(c) result(res)
#ifdef HAVE_LIBRSB
use psb_z_rsb_mat_mod
@ -310,7 +270,7 @@ contains
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cdh, mh,upd,dupl
character(c_char) :: afmt(*)
integer(psb_c_ipk_) :: info,n, fdupl
integer(psb_c_ipk_) :: info,n
character(len=5) :: fafmt
#ifdef HAVE_LIBRSB
type(psb_z_rsb_sparse_mat) :: arsb
@ -327,11 +287,11 @@ contains
#ifdef HAVE_LIBRSB
case('RSB')
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& upd=upd,dupl=dupl,mold=arsb)
& upd=upd,mold=arsb)
#endif
case default
call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,&
& afmt=fafmt,upd=upd,dupl=dupl)
& afmt=fafmt,upd=upd)
end select
res = min(0,info)

10
test/pargen/psb_d_pde2d.F90
Unescape Escape View File

@ -401,10 +401,12 @@ contains
end select
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz)
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz,&
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
! define rhs from boundary conditions; also build initial guess
if (info == psb_success_) call psb_geall(xv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info,&
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
call psb_barrier(ctxt)
talc = psb_wtime()-t0
@ -522,9 +524,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)

9
test/pargen/psb_d_pde3d.F90
Unescape Escape View File

@ -431,10 +431,11 @@ contains
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz, &
& bldmode=psb_matbld_remote_)
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
! define rhs from boundary conditions; also build initial guess
if (info == psb_success_) call psb_geall(xv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info,&
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
call psb_barrier(ctxt)
talc = psb_wtime()-t0
@ -679,9 +680,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)

10
test/pargen/psb_s_pde2d.F90
Unescape Escape View File

@ -401,10 +401,12 @@ contains
end select
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz)
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz,&
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
! define rhs from boundary conditions; also build initial guess
if (info == psb_success_) call psb_geall(xv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info,&
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
call psb_barrier(ctxt)
talc = psb_wtime()-t0
@ -522,9 +524,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)

9
test/pargen/psb_s_pde3d.F90
Unescape Escape View File

@ -431,10 +431,11 @@ contains
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz, &
& bldmode=psb_matbld_remote_)
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
! define rhs from boundary conditions; also build initial guess
if (info == psb_success_) call psb_geall(xv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info)
if (info == psb_success_) call psb_geall(bv,desc_a,info,&
& bldmode=psb_matbld_remote_,dupl=psb_dupl_add_)
call psb_barrier(ctxt)
talc = psb_wtime()-t0
@ -679,9 +680,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)

8
util/psb_c_mat_dist_impl.f90
Unescape Escape View File

@ -170,7 +170,7 @@ subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np))
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np),dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -332,7 +332,7 @@ subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_
@ -507,7 +507,7 @@ subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,&
goto 9999
end if
inz = ((nnzero+np-1)/np)
call psb_spall(a,desc_a,info,nnz=inz)
call psb_spall(a,desc_a,info,nnz=inz,dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -671,7 +671,7 @@ subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_

8
util/psb_d_mat_dist_impl.f90
Unescape Escape View File

@ -170,7 +170,7 @@ subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np))
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np),dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -332,7 +332,7 @@ subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_
@ -507,7 +507,7 @@ subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,&
goto 9999
end if
inz = ((nnzero+np-1)/np)
call psb_spall(a,desc_a,info,nnz=inz)
call psb_spall(a,desc_a,info,nnz=inz,dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -671,7 +671,7 @@ subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_

8
util/psb_s_mat_dist_impl.f90
Unescape Escape View File

@ -170,7 +170,7 @@ subroutine psb_smatdist(a_glob, a, ctxt, desc_a,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np))
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np),dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -332,7 +332,7 @@ subroutine psb_smatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_
@ -507,7 +507,7 @@ subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,&
goto 9999
end if
inz = ((nnzero+np-1)/np)
call psb_spall(a,desc_a,info,nnz=inz)
call psb_spall(a,desc_a,info,nnz=inz,dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -671,7 +671,7 @@ subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_

8
util/psb_z_mat_dist_impl.f90
Unescape Escape View File

@ -170,7 +170,7 @@ subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np))
call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np),dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -332,7 +332,7 @@ subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_
@ -507,7 +507,7 @@ subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,&
goto 9999
end if
inz = ((nnzero+np-1)/np)
call psb_spall(a,desc_a,info,nnz=inz)
call psb_spall(a,desc_a,info,nnz=inz,dupl=psb_dupl_err_)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_spall'
@ -671,7 +671,7 @@ subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,&
call psb_barrier(ctxt)
t2 = psb_wtime()
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold)
call psb_spasb(a,desc_a,info,afmt=fmt,mold=mold)
t3 = psb_wtime()
if(info /= psb_success_)then
info=psb_err_from_subroutine_

Write Preview
Loading…
Cancel
Save