From fc81367fefaff259acc4c65e58d9bb49e835d941 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 1 Apr 2022 11:38:40 +0200 Subject: [PATCH] Changes for remote build interfaces. Implementation to be completed. --- base/modules/serial/psb_c_mat_mod.F90 | 2 +- base/modules/serial/psb_c_vect_mod.F90 | 87 +++++++++++++++++++++++--- base/modules/serial/psb_d_mat_mod.F90 | 2 +- base/modules/serial/psb_d_vect_mod.F90 | 87 +++++++++++++++++++++++--- base/modules/serial/psb_i_vect_mod.F90 | 87 +++++++++++++++++++++++--- base/modules/serial/psb_l_vect_mod.F90 | 87 +++++++++++++++++++++++--- base/modules/serial/psb_s_mat_mod.F90 | 2 +- base/modules/serial/psb_s_vect_mod.F90 | 87 +++++++++++++++++++++++--- base/modules/serial/psb_z_mat_mod.F90 | 2 +- base/modules/serial/psb_z_vect_mod.F90 | 87 +++++++++++++++++++++++--- base/modules/tools/psb_c_tools_mod.F90 | 42 ++++++------- base/modules/tools/psb_d_tools_mod.F90 | 42 ++++++------- base/modules/tools/psb_i_tools_mod.F90 | 24 ++++--- base/modules/tools/psb_l_tools_mod.F90 | 24 ++++--- base/modules/tools/psb_s_tools_mod.F90 | 42 ++++++------- base/modules/tools/psb_z_tools_mod.F90 | 42 ++++++------- base/tools/psb_c_remote_mat.F90 | 14 +---- base/tools/psb_callc.f90 | 66 ++++++++++++++++++- base/tools/psb_casb.f90 | 19 +++--- base/tools/psb_cins.f90 | 52 ++++----------- base/tools/psb_cspalloc.f90 | 48 ++++++-------- base/tools/psb_cspasb.f90 | 22 +++---- base/tools/psb_d_remote_mat.F90 | 14 +---- base/tools/psb_dallc.f90 | 66 ++++++++++++++++++- base/tools/psb_dasb.f90 | 19 +++--- base/tools/psb_dins.f90 | 52 ++++----------- base/tools/psb_dspalloc.f90 | 48 ++++++-------- base/tools/psb_dspasb.f90 | 22 +++---- base/tools/psb_iallc.f90 | 66 ++++++++++++++++++- base/tools/psb_iasb.f90 | 19 +++--- base/tools/psb_iins.f90 | 52 ++++----------- base/tools/psb_lallc.f90 | 66 ++++++++++++++++++- base/tools/psb_lasb.f90 | 19 +++--- base/tools/psb_lins.f90 | 52 ++++----------- base/tools/psb_s_remote_mat.F90 | 14 +---- base/tools/psb_sallc.f90 | 66 ++++++++++++++++++- base/tools/psb_sasb.f90 | 19 +++--- base/tools/psb_sins.f90 | 52 ++++----------- base/tools/psb_sspalloc.f90 | 48 ++++++-------- base/tools/psb_sspasb.f90 | 22 +++---- base/tools/psb_z_remote_mat.F90 | 14 +---- base/tools/psb_zallc.f90 | 66 ++++++++++++++++++- base/tools/psb_zasb.f90 | 19 +++--- base/tools/psb_zins.f90 | 52 ++++----------- base/tools/psb_zspalloc.f90 | 48 ++++++-------- base/tools/psb_zspasb.f90 | 22 +++---- cbind/base/psb_c_tools_cbind_mod.F90 | 60 +++--------------- cbind/base/psb_d_tools_cbind_mod.F90 | 60 +++--------------- cbind/base/psb_s_tools_cbind_mod.F90 | 60 +++--------------- cbind/base/psb_z_tools_cbind_mod.F90 | 60 +++--------------- test/pargen/psb_d_pde2d.F90 | 10 +-- test/pargen/psb_d_pde3d.F90 | 9 +-- test/pargen/psb_s_pde2d.F90 | 10 +-- test/pargen/psb_s_pde3d.F90 | 9 +-- util/psb_c_mat_dist_impl.f90 | 8 +-- util/psb_d_mat_dist_impl.f90 | 8 +-- util/psb_s_mat_dist_impl.f90 | 8 +-- util/psb_z_mat_dist_impl.f90 | 8 +-- 58 files changed, 1276 insertions(+), 938 deletions(-) diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index 5375ab18..fd423de3 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -84,7 +84,7 @@ module psb_c_mat_mod type :: psb_cspmat_type - class(psb_c_base_sparse_mat), allocatable :: a + class(psb_c_base_sparse_mat), allocatable :: a integer(psb_ipk_) :: remote_build=psb_matbld_noremote_ type(psb_lc_coo_sparse_mat), allocatable :: rmta diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index 6cb54e60..a2620af5 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -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 @@ -1295,6 +1326,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 diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index f9a70a66..8f967ce1 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -84,7 +84,7 @@ module psb_d_mat_mod type :: psb_dspmat_type - class(psb_d_base_sparse_mat), allocatable :: a + class(psb_d_base_sparse_mat), allocatable :: a integer(psb_ipk_) :: remote_build=psb_matbld_noremote_ type(psb_ld_coo_sparse_mat), allocatable :: rmta diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index ec96a8e1..68aba8aa 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -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 @@ -1374,6 +1405,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 diff --git a/base/modules/serial/psb_i_vect_mod.F90 b/base/modules/serial/psb_i_vect_mod.F90 index b3700203..c4cd3178 100644 --- a/base/modules/serial/psb_i_vect_mod.F90 +++ b/base/modules/serial/psb_i_vect_mod.F90 @@ -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 @@ -652,6 +683,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 diff --git a/base/modules/serial/psb_l_vect_mod.F90 b/base/modules/serial/psb_l_vect_mod.F90 index 03436d48..b3579b17 100644 --- a/base/modules/serial/psb_l_vect_mod.F90 +++ b/base/modules/serial/psb_l_vect_mod.F90 @@ -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 @@ -653,6 +684,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 diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index c1639ad5..43f1c619 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -84,7 +84,7 @@ module psb_s_mat_mod type :: psb_sspmat_type - class(psb_s_base_sparse_mat), allocatable :: a + class(psb_s_base_sparse_mat), allocatable :: a integer(psb_ipk_) :: remote_build=psb_matbld_noremote_ type(psb_ls_coo_sparse_mat), allocatable :: rmta diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index a62d3234..c15c6606 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -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 @@ -1374,6 +1405,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 diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index b84cd610..c534cad5 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -84,7 +84,7 @@ module psb_z_mat_mod type :: psb_zspmat_type - class(psb_z_base_sparse_mat), allocatable :: a + class(psb_z_base_sparse_mat), allocatable :: a integer(psb_ipk_) :: remote_build=psb_matbld_noremote_ type(psb_lz_coo_sparse_mat), allocatable :: rmta diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index 2789e58b..7d2f3b9e 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -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 @@ -1295,6 +1326,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 diff --git a/base/modules/tools/psb_c_tools_mod.F90 b/base/modules/tools/psb_c_tools_mod.F90 index 3ccd5e69..c6e06134 100644 --- a/base/modules/tools/psb_c_tools_mod.F90 +++ b/base/modules/tools/psb_c_tools_mod.F90 @@ -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 diff --git a/base/modules/tools/psb_d_tools_mod.F90 b/base/modules/tools/psb_d_tools_mod.F90 index 8756b874..2c39bffd 100644 --- a/base/modules/tools/psb_d_tools_mod.F90 +++ b/base/modules/tools/psb_d_tools_mod.F90 @@ -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 diff --git a/base/modules/tools/psb_i_tools_mod.F90 b/base/modules/tools/psb_i_tools_mod.F90 index ff4f1504..94fb04bc 100644 --- a/base/modules/tools/psb_i_tools_mod.F90 +++ b/base/modules/tools/psb_i_tools_mod.F90 @@ -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 diff --git a/base/modules/tools/psb_l_tools_mod.F90 b/base/modules/tools/psb_l_tools_mod.F90 index 3b15ffd3..61840af6 100644 --- a/base/modules/tools/psb_l_tools_mod.F90 +++ b/base/modules/tools/psb_l_tools_mod.F90 @@ -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 diff --git a/base/modules/tools/psb_s_tools_mod.F90 b/base/modules/tools/psb_s_tools_mod.F90 index df22e689..98d8dd8e 100644 --- a/base/modules/tools/psb_s_tools_mod.F90 +++ b/base/modules/tools/psb_s_tools_mod.F90 @@ -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 diff --git a/base/modules/tools/psb_z_tools_mod.F90 b/base/modules/tools/psb_z_tools_mod.F90 index 8635b24b..04960560 100644 --- a/base/modules/tools/psb_z_tools_mod.F90 +++ b/base/modules/tools/psb_z_tools_mod.F90 @@ -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 diff --git a/base/tools/psb_c_remote_mat.F90 b/base/tools/psb_c_remote_mat.F90 index bab703a5..612c92dc 100644 --- a/base/tools/psb_c_remote_mat.F90 +++ b/base/tools/psb_c_remote_mat.F90 @@ -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 ' diff --git a/base/tools/psb_callc.f90 b/base/tools/psb_callc.f90 index 530a43a2..0c41be88 100644 --- a/base/tools/psb_callc.f90 +++ b/base/tools/psb_callc.f90 @@ -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 diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index 6eba0696..c3cbe509 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -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) diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 948a596a..d3f2ea99 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -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 diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index 5d5a1f34..7bec040c 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -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_ diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index f7866eca..08f18d00 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -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 + 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() diff --git a/base/tools/psb_d_remote_mat.F90 b/base/tools/psb_d_remote_mat.F90 index dd5fd161..ad9beba1 100644 --- a/base/tools/psb_d_remote_mat.F90 +++ b/base/tools/psb_d_remote_mat.F90 @@ -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 ' diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index 7989929b..24aecfe0 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -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 diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 34bd345b..44edbf4b 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -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) diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index 5aaceec1..9a37e6df 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -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 diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index 31381bca..433d7129 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -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_ diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 2d855472..f6497aef 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -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 + 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() diff --git a/base/tools/psb_iallc.f90 b/base/tools/psb_iallc.f90 index ac4ee840..5d192706 100644 --- a/base/tools/psb_iallc.f90 +++ b/base/tools/psb_iallc.f90 @@ -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 diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index 8c3db6d6..a9244e96 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -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) diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index 3f72494e..92257905 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -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 diff --git a/base/tools/psb_lallc.f90 b/base/tools/psb_lallc.f90 index 85fd67e7..47ba201b 100644 --- a/base/tools/psb_lallc.f90 +++ b/base/tools/psb_lallc.f90 @@ -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 diff --git a/base/tools/psb_lasb.f90 b/base/tools/psb_lasb.f90 index 529dbe44..b7bfb66c 100644 --- a/base/tools/psb_lasb.f90 +++ b/base/tools/psb_lasb.f90 @@ -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) diff --git a/base/tools/psb_lins.f90 b/base/tools/psb_lins.f90 index 27478f0a..224b6f8e 100644 --- a/base/tools/psb_lins.f90 +++ b/base/tools/psb_lins.f90 @@ -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 diff --git a/base/tools/psb_s_remote_mat.F90 b/base/tools/psb_s_remote_mat.F90 index 176410f4..1cccce94 100644 --- a/base/tools/psb_s_remote_mat.F90 +++ b/base/tools/psb_s_remote_mat.F90 @@ -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 ' diff --git a/base/tools/psb_sallc.f90 b/base/tools/psb_sallc.f90 index 941ce917..13b6368e 100644 --- a/base/tools/psb_sallc.f90 +++ b/base/tools/psb_sallc.f90 @@ -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 diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index b13f095a..69bc10b2 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -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) diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 2ef44c85..2c41be7d 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -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 diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index bcaee92b..8004e742 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -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_ diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index d4bf923f..4b0c8ad4 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -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 + 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() diff --git a/base/tools/psb_z_remote_mat.F90 b/base/tools/psb_z_remote_mat.F90 index 4603580c..2c921570 100644 --- a/base/tools/psb_z_remote_mat.F90 +++ b/base/tools/psb_z_remote_mat.F90 @@ -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 ' diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index fa84827e..d40ce62a 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -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 diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 050558ac..1cca7ea2 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -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) diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 089a1da7..4d000093 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -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 diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index 741b3fb7..308774ef 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -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_ diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index f1af9661..4f516f74 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -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 + 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() diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index 4eb23742..8346dc14 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -5,10 +5,11 @@ module psb_c_tools_cbind_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_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) diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 009e7b17..eb42dcb3 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -5,10 +5,11 @@ module psb_d_tools_cbind_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_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) diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index f6cef638..fc3e57f0 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -5,10 +5,11 @@ module psb_s_tools_cbind_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_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) diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 03827a3f..13cdf3c1 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -5,10 +5,11 @@ module psb_z_tools_cbind_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_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) diff --git a/test/pargen/psb_d_pde2d.F90 b/test/pargen/psb_d_pde2d.F90 index 5fa77373..6da97828 100644 --- a/test/pargen/psb_d_pde2d.F90 +++ b/test/pargen/psb_d_pde2d.F90 @@ -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) diff --git a/test/pargen/psb_d_pde3d.F90 b/test/pargen/psb_d_pde3d.F90 index 2384d410..887c08d9 100644 --- a/test/pargen/psb_d_pde3d.F90 +++ b/test/pargen/psb_d_pde3d.F90 @@ -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) diff --git a/test/pargen/psb_s_pde2d.F90 b/test/pargen/psb_s_pde2d.F90 index ad6f0d81..664d5d08 100644 --- a/test/pargen/psb_s_pde2d.F90 +++ b/test/pargen/psb_s_pde2d.F90 @@ -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) diff --git a/test/pargen/psb_s_pde3d.F90 b/test/pargen/psb_s_pde3d.F90 index 96dbd5db..d61aba6d 100644 --- a/test/pargen/psb_s_pde3d.F90 +++ b/test/pargen/psb_s_pde3d.F90 @@ -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) diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index 970dfc47..e358bf25 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -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_ diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index c71141f0..3c683254 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -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_ diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 index 713c3d9c..6c8bd792 100644 --- a/util/psb_s_mat_dist_impl.f90 +++ b/util/psb_s_mat_dist_impl.f90 @@ -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_ diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index 2768b21e..5c83c66c 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -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_