From 9cf678a3ea5f1b9b560c218da0e7012fcd33133d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 26 Mar 2015 16:29:42 +0000 Subject: [PATCH] psblas3: base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_csc_mat_mod.f90 base/modules/psb_c_csr_mat_mod.f90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_csc_mat_mod.f90 base/modules/psb_d_csr_mat_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_csc_mat_mod.f90 base/modules/psb_s_csr_mat_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_csc_mat_mod.f90 base/modules/psb_z_csr_mat_mod.f90 base/serial/impl/psb_c_base_mat_impl.F90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_c_csc_impl.f90 base/serial/impl/psb_c_csr_impl.f90 base/serial/impl/psb_d_base_mat_impl.F90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_d_csc_impl.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_s_base_mat_impl.F90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_s_csc_impl.f90 base/serial/impl/psb_s_csr_impl.f90 base/serial/impl/psb_z_base_mat_impl.F90 base/serial/impl/psb_z_coo_impl.f90 base/serial/impl/psb_z_csc_impl.f90 base/serial/impl/psb_z_csr_impl.f90 Fix use of is_by_rows/is_by_cols MV|CP FROM_COO and select type COO in FROM|TO_FMT --- base/modules/psb_c_base_mat_mod.f90 | 17 +++++++--- base/modules/psb_c_csc_mat_mod.f90 | 2 +- base/modules/psb_c_csr_mat_mod.f90 | 2 +- base/modules/psb_d_base_mat_mod.f90 | 17 +++++++--- base/modules/psb_d_csc_mat_mod.f90 | 2 +- base/modules/psb_d_csr_mat_mod.f90 | 2 +- base/modules/psb_s_base_mat_mod.f90 | 17 +++++++--- base/modules/psb_s_csc_mat_mod.f90 | 2 +- base/modules/psb_s_csr_mat_mod.f90 | 2 +- base/modules/psb_z_base_mat_mod.f90 | 17 +++++++--- base/modules/psb_z_csc_mat_mod.f90 | 2 +- base/modules/psb_z_csr_mat_mod.f90 | 2 +- base/serial/impl/psb_c_base_mat_impl.F90 | 40 +++++++++++++++++------- base/serial/impl/psb_c_coo_impl.f90 | 32 ++++++++++--------- base/serial/impl/psb_c_csc_impl.f90 | 3 +- base/serial/impl/psb_c_csr_impl.f90 | 6 ++-- base/serial/impl/psb_d_base_mat_impl.F90 | 40 +++++++++++++++++------- base/serial/impl/psb_d_coo_impl.f90 | 32 ++++++++++--------- base/serial/impl/psb_d_csc_impl.f90 | 3 +- base/serial/impl/psb_d_csr_impl.f90 | 6 ++-- base/serial/impl/psb_s_base_mat_impl.F90 | 40 +++++++++++++++++------- base/serial/impl/psb_s_coo_impl.f90 | 32 ++++++++++--------- base/serial/impl/psb_s_csc_impl.f90 | 3 +- base/serial/impl/psb_s_csr_impl.f90 | 6 ++-- base/serial/impl/psb_z_base_mat_impl.F90 | 40 +++++++++++++++++------- base/serial/impl/psb_z_coo_impl.f90 | 32 ++++++++++--------- base/serial/impl/psb_z_csc_impl.f90 | 3 +- base/serial/impl/psb_z_csr_impl.f90 | 6 ++-- 28 files changed, 260 insertions(+), 148 deletions(-) diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index ae4e4698..a032db7c 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -133,7 +133,7 @@ module psb_c_base_mat_mod !> Coefficient values. complex(psb_spk_), allocatable :: val(:) - integer, private :: sort_status=psb_unsorted_ + integer, private :: sort_status=psb_unsorted_ contains ! @@ -170,6 +170,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: set_by_rows => c_coo_set_by_rows procedure, pass(a) :: set_by_cols => c_coo_set_by_cols procedure, pass(a) :: set_sort_status => c_coo_set_sort_status + procedure, pass(a) :: get_sort_status => c_coo_get_sort_status ! ! This is COO specific @@ -586,7 +587,7 @@ module psb_c_base_mat_mod subroutine psb_c_base_cp_from_coo(a,b,info) import :: psb_ipk_, psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_ class(psb_c_base_sparse_mat), intent(inout) :: a - class(psb_c_coo_sparse_mat), intent(in) :: b + class(psb_c_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_c_base_cp_from_coo end interface @@ -656,7 +657,7 @@ module psb_c_base_mat_mod subroutine psb_c_base_mv_from_coo(a,b,info) import :: psb_ipk_, psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_ class(psb_c_base_sparse_mat), intent(inout) :: a - class(psb_c_coo_sparse_mat), intent(inout) :: b + class(psb_c_coo_sparse_mat), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_c_base_mv_from_coo end interface @@ -1367,7 +1368,7 @@ module psb_c_base_mat_mod import :: psb_ipk_, psb_c_coo_sparse_mat class(psb_c_coo_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_c_cp_coo_from_coo end interface @@ -1812,6 +1813,14 @@ contains end subroutine c_coo_set_nzeros + function c_coo_get_sort_status(a) result(res) + implicit none + integer(psb_ipk_) :: res + class(psb_c_coo_sparse_mat), intent(in) :: a + + res = a%sort_status + end function c_coo_get_sort_status + subroutine c_coo_set_sort_status(ist,a) implicit none integer(psb_ipk_), intent(in) :: ist diff --git a/base/modules/psb_c_csc_mat_mod.f90 b/base/modules/psb_c_csc_mat_mod.f90 index 72930360..ed5d1e44 100644 --- a/base/modules/psb_c_csc_mat_mod.f90 +++ b/base/modules/psb_c_csc_mat_mod.f90 @@ -186,7 +186,7 @@ module psb_c_csc_mat_mod import :: psb_ipk_, psb_c_csc_sparse_mat, psb_c_coo_sparse_mat class(psb_c_csc_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_c_cp_csc_from_coo end interface diff --git a/base/modules/psb_c_csr_mat_mod.f90 b/base/modules/psb_c_csr_mat_mod.f90 index 4819eaf5..730eafa4 100644 --- a/base/modules/psb_c_csr_mat_mod.f90 +++ b/base/modules/psb_c_csr_mat_mod.f90 @@ -189,7 +189,7 @@ module psb_c_csr_mat_mod import :: psb_ipk_, psb_c_csr_sparse_mat, psb_c_coo_sparse_mat class(psb_c_csr_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_c_cp_csr_from_coo end interface diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index baf63596..ed60940f 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -133,7 +133,7 @@ module psb_d_base_mat_mod !> Coefficient values. real(psb_dpk_), allocatable :: val(:) - integer, private :: sort_status=psb_unsorted_ + integer, private :: sort_status=psb_unsorted_ contains ! @@ -170,6 +170,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: set_by_rows => d_coo_set_by_rows procedure, pass(a) :: set_by_cols => d_coo_set_by_cols procedure, pass(a) :: set_sort_status => d_coo_set_sort_status + procedure, pass(a) :: get_sort_status => d_coo_get_sort_status ! ! This is COO specific @@ -586,7 +587,7 @@ module psb_d_base_mat_mod subroutine psb_d_base_cp_from_coo(a,b,info) import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_ class(psb_d_base_sparse_mat), intent(inout) :: a - class(psb_d_coo_sparse_mat), intent(in) :: b + class(psb_d_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_d_base_cp_from_coo end interface @@ -656,7 +657,7 @@ module psb_d_base_mat_mod subroutine psb_d_base_mv_from_coo(a,b,info) import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_ class(psb_d_base_sparse_mat), intent(inout) :: a - class(psb_d_coo_sparse_mat), intent(inout) :: b + class(psb_d_coo_sparse_mat), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_d_base_mv_from_coo end interface @@ -1367,7 +1368,7 @@ module psb_d_base_mat_mod import :: psb_ipk_, psb_d_coo_sparse_mat class(psb_d_coo_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_d_cp_coo_from_coo end interface @@ -1812,6 +1813,14 @@ contains end subroutine d_coo_set_nzeros + function d_coo_get_sort_status(a) result(res) + implicit none + integer(psb_ipk_) :: res + class(psb_d_coo_sparse_mat), intent(in) :: a + + res = a%sort_status + end function d_coo_get_sort_status + subroutine d_coo_set_sort_status(ist,a) implicit none integer(psb_ipk_), intent(in) :: ist diff --git a/base/modules/psb_d_csc_mat_mod.f90 b/base/modules/psb_d_csc_mat_mod.f90 index 102afe30..559d9e4e 100644 --- a/base/modules/psb_d_csc_mat_mod.f90 +++ b/base/modules/psb_d_csc_mat_mod.f90 @@ -186,7 +186,7 @@ module psb_d_csc_mat_mod import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_coo_sparse_mat class(psb_d_csc_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_d_cp_csc_from_coo end interface diff --git a/base/modules/psb_d_csr_mat_mod.f90 b/base/modules/psb_d_csr_mat_mod.f90 index bd16b958..de1c8955 100644 --- a/base/modules/psb_d_csr_mat_mod.f90 +++ b/base/modules/psb_d_csr_mat_mod.f90 @@ -189,7 +189,7 @@ module psb_d_csr_mat_mod import :: psb_ipk_, psb_d_csr_sparse_mat, psb_d_coo_sparse_mat class(psb_d_csr_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_d_cp_csr_from_coo end interface diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 6aec7c8b..640d61e2 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -133,7 +133,7 @@ module psb_s_base_mat_mod !> Coefficient values. real(psb_spk_), allocatable :: val(:) - integer, private :: sort_status=psb_unsorted_ + integer, private :: sort_status=psb_unsorted_ contains ! @@ -170,6 +170,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: set_by_rows => s_coo_set_by_rows procedure, pass(a) :: set_by_cols => s_coo_set_by_cols procedure, pass(a) :: set_sort_status => s_coo_set_sort_status + procedure, pass(a) :: get_sort_status => s_coo_get_sort_status ! ! This is COO specific @@ -586,7 +587,7 @@ module psb_s_base_mat_mod subroutine psb_s_base_cp_from_coo(a,b,info) import :: psb_ipk_, psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_ class(psb_s_base_sparse_mat), intent(inout) :: a - class(psb_s_coo_sparse_mat), intent(in) :: b + class(psb_s_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_s_base_cp_from_coo end interface @@ -656,7 +657,7 @@ module psb_s_base_mat_mod subroutine psb_s_base_mv_from_coo(a,b,info) import :: psb_ipk_, psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_ class(psb_s_base_sparse_mat), intent(inout) :: a - class(psb_s_coo_sparse_mat), intent(inout) :: b + class(psb_s_coo_sparse_mat), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_s_base_mv_from_coo end interface @@ -1367,7 +1368,7 @@ module psb_s_base_mat_mod import :: psb_ipk_, psb_s_coo_sparse_mat class(psb_s_coo_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_s_cp_coo_from_coo end interface @@ -1812,6 +1813,14 @@ contains end subroutine s_coo_set_nzeros + function s_coo_get_sort_status(a) result(res) + implicit none + integer(psb_ipk_) :: res + class(psb_s_coo_sparse_mat), intent(in) :: a + + res = a%sort_status + end function s_coo_get_sort_status + subroutine s_coo_set_sort_status(ist,a) implicit none integer(psb_ipk_), intent(in) :: ist diff --git a/base/modules/psb_s_csc_mat_mod.f90 b/base/modules/psb_s_csc_mat_mod.f90 index b7850006..9616238d 100644 --- a/base/modules/psb_s_csc_mat_mod.f90 +++ b/base/modules/psb_s_csc_mat_mod.f90 @@ -186,7 +186,7 @@ module psb_s_csc_mat_mod import :: psb_ipk_, psb_s_csc_sparse_mat, psb_s_coo_sparse_mat class(psb_s_csc_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_s_cp_csc_from_coo end interface diff --git a/base/modules/psb_s_csr_mat_mod.f90 b/base/modules/psb_s_csr_mat_mod.f90 index e9d3c63f..d1e14658 100644 --- a/base/modules/psb_s_csr_mat_mod.f90 +++ b/base/modules/psb_s_csr_mat_mod.f90 @@ -189,7 +189,7 @@ module psb_s_csr_mat_mod import :: psb_ipk_, psb_s_csr_sparse_mat, psb_s_coo_sparse_mat class(psb_s_csr_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_s_cp_csr_from_coo end interface diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index ab39c6f8..81727804 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -133,7 +133,7 @@ module psb_z_base_mat_mod !> Coefficient values. complex(psb_dpk_), allocatable :: val(:) - integer, private :: sort_status=psb_unsorted_ + integer, private :: sort_status=psb_unsorted_ contains ! @@ -170,6 +170,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: set_by_rows => z_coo_set_by_rows procedure, pass(a) :: set_by_cols => z_coo_set_by_cols procedure, pass(a) :: set_sort_status => z_coo_set_sort_status + procedure, pass(a) :: get_sort_status => z_coo_get_sort_status ! ! This is COO specific @@ -586,7 +587,7 @@ module psb_z_base_mat_mod subroutine psb_z_base_cp_from_coo(a,b,info) import :: psb_ipk_, psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_ class(psb_z_base_sparse_mat), intent(inout) :: a - class(psb_z_coo_sparse_mat), intent(in) :: b + class(psb_z_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_z_base_cp_from_coo end interface @@ -656,7 +657,7 @@ module psb_z_base_mat_mod subroutine psb_z_base_mv_from_coo(a,b,info) import :: psb_ipk_, psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_ class(psb_z_base_sparse_mat), intent(inout) :: a - class(psb_z_coo_sparse_mat), intent(inout) :: b + class(psb_z_coo_sparse_mat), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_z_base_mv_from_coo end interface @@ -1367,7 +1368,7 @@ module psb_z_base_mat_mod import :: psb_ipk_, psb_z_coo_sparse_mat class(psb_z_coo_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_z_cp_coo_from_coo end interface @@ -1812,6 +1813,14 @@ contains end subroutine z_coo_set_nzeros + function z_coo_get_sort_status(a) result(res) + implicit none + integer(psb_ipk_) :: res + class(psb_z_coo_sparse_mat), intent(in) :: a + + res = a%sort_status + end function z_coo_get_sort_status + subroutine z_coo_set_sort_status(ist,a) implicit none integer(psb_ipk_), intent(in) :: ist diff --git a/base/modules/psb_z_csc_mat_mod.f90 b/base/modules/psb_z_csc_mat_mod.f90 index 9eadcb19..ce06407f 100644 --- a/base/modules/psb_z_csc_mat_mod.f90 +++ b/base/modules/psb_z_csc_mat_mod.f90 @@ -186,7 +186,7 @@ module psb_z_csc_mat_mod import :: psb_ipk_, psb_z_csc_sparse_mat, psb_z_coo_sparse_mat class(psb_z_csc_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_z_cp_csc_from_coo end interface diff --git a/base/modules/psb_z_csr_mat_mod.f90 b/base/modules/psb_z_csr_mat_mod.f90 index 0cb75281..20fde4c9 100644 --- a/base/modules/psb_z_csr_mat_mod.f90 +++ b/base/modules/psb_z_csr_mat_mod.f90 @@ -189,7 +189,7 @@ module psb_z_csr_mat_mod import :: psb_ipk_, psb_z_csr_sparse_mat, psb_z_coo_sparse_mat class(psb_z_csr_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psb_z_cp_csr_from_coo end interface diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index d08112f4..2d388290 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -113,9 +113,13 @@ subroutine psb_c_base_cp_to_fmt(a,b,info) info = psb_success_ call psb_erractionsave(err_act) - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - + select type(b) + type is (psb_c_coo_sparse_mat) + call a%cp_to_coo(b,info) + class default + call a%cp_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info,name, a_err='to/from coo') @@ -151,9 +155,14 @@ subroutine psb_c_base_cp_from_fmt(a,b,info) ! info = psb_success_ call psb_erractionsave(err_act) - - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) + + select type(b) + type is (psb_c_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ @@ -267,8 +276,13 @@ subroutine psb_c_base_mv_to_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call a%mv_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) + select type(b) + type is (psb_c_coo_sparse_mat) + call a%mv_to_coo(b,info) + class default + call a%mv_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select return @@ -293,9 +307,13 @@ subroutine psb_c_base_mv_from_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call b%mv_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - + select type(b) + type is (psb_c_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select return end subroutine psb_c_base_mv_from_fmt diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 37bbf080..55bcd171 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -466,7 +466,7 @@ function psb_c_coo_get_nz_row(idx,a) result(res) res = 0 nza = a%get_nzeros() - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. ip = psb_ibsrch(idx,nza,a%ia) if (ip /= -1) return @@ -580,7 +580,7 @@ subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans) end if if (beta == czero) then - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info) do i = 1, m @@ -594,7 +594,7 @@ subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info) do i = 1, m @@ -933,7 +933,7 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans) end if if (beta == czero) then - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,y,info) if (info /= psb_success_) then @@ -951,7 +951,7 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,tmp,info) if (info /= psb_success_) then @@ -1650,7 +1650,7 @@ function psb_c_coo_csnmi(a) result(res) res = szero nnz = a%get_nzeros() is_unit = a%is_unit() - if (a%is_sorted()) then + if (a%is_by_rows()) then i = 1 j = i res = szero @@ -2067,7 +2067,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2344,7 +2344,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2884,7 +2884,7 @@ subroutine psb_c_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat - + call b%set_sort_status(a%get_sort_status()) nz = a%get_nzeros() call b%set_nzeros(nz) call b%reallocate(nz) @@ -2894,7 +2894,7 @@ subroutine psb_c_cp_coo_to_coo(a,b,info) b%val(1:nz) = a%val(1:nz) - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -2912,7 +2912,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) use psb_c_base_mat_mod, psb_protect_name => psb_c_cp_coo_from_coo implicit none class(psb_c_coo_sparse_mat), intent(inout) :: a - class(psb_c_coo_sparse_mat), intent(in) :: b + class(psb_c_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -2925,7 +2925,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat - + call a%set_sort_status(b%get_sort_status()) nz = b%get_nzeros() call a%set_nzeros(nz) call a%reallocate(nz) @@ -2934,7 +2934,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) a%ja(1:nz) = b%ja(1:nz) a%val(1:nz) = b%val(1:nz) - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 @@ -3036,6 +3036,7 @@ subroutine psb_c_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat + call b%set_sort_status(a%get_sort_status()) call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia, b%ia) @@ -3043,7 +3044,7 @@ subroutine psb_c_mv_coo_to_coo(a,b,info) call move_alloc(a%val, b%val) call a%free() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -3077,13 +3078,14 @@ subroutine psb_c_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat + call a%set_sort_status(b%get_sort_status()) call a%set_nzeros(b%get_nzeros()) call move_alloc(b%ia , a%ia ) call move_alloc(b%ja , a%ja ) call move_alloc(b%val, a%val ) call b%free() - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index a30508ca..ddc93c5c 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -2139,8 +2139,7 @@ subroutine psb_c_cp_csc_from_coo(a,b,info) class(psb_c_csc_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_), intent(out) :: info type(psb_c_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) !locals diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 981118bc..a1982a62 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -2658,7 +2658,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info) class(psb_c_csr_sparse_mat), intent(inout) :: a class(psb_c_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info type(psb_c_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) @@ -2673,7 +2673,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) then + if (.not.b%is_by_rows()) then ! This is to have fix_coo called behind the scenes call tmp%cp_from_coo(b,info) if (info /= psb_success_) return @@ -2871,7 +2871,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info) debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) return nr = b%get_nrows() diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index 716e4168..804372cc 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -113,9 +113,13 @@ subroutine psb_d_base_cp_to_fmt(a,b,info) info = psb_success_ call psb_erractionsave(err_act) - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - + select type(b) + type is (psb_d_coo_sparse_mat) + call a%cp_to_coo(b,info) + class default + call a%cp_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info,name, a_err='to/from coo') @@ -151,9 +155,14 @@ subroutine psb_d_base_cp_from_fmt(a,b,info) ! info = psb_success_ call psb_erractionsave(err_act) - - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) + + select type(b) + type is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ @@ -267,8 +276,13 @@ subroutine psb_d_base_mv_to_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call a%mv_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) + select type(b) + type is (psb_d_coo_sparse_mat) + call a%mv_to_coo(b,info) + class default + call a%mv_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select return @@ -293,9 +307,13 @@ subroutine psb_d_base_mv_from_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call b%mv_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - + select type(b) + type is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select return end subroutine psb_d_base_mv_from_fmt diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 897c919f..fd874173 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -466,7 +466,7 @@ function psb_d_coo_get_nz_row(idx,a) result(res) res = 0 nza = a%get_nzeros() - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. ip = psb_ibsrch(idx,nza,a%ia) if (ip /= -1) return @@ -580,7 +580,7 @@ subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans) end if if (beta == dzero) then - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info) do i = 1, m @@ -594,7 +594,7 @@ subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info) do i = 1, m @@ -933,7 +933,7 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans) end if if (beta == dzero) then - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,y,info) if (info /= psb_success_) then @@ -951,7 +951,7 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,tmp,info) if (info /= psb_success_) then @@ -1650,7 +1650,7 @@ function psb_d_coo_csnmi(a) result(res) res = dzero nnz = a%get_nzeros() is_unit = a%is_unit() - if (a%is_sorted()) then + if (a%is_by_rows()) then i = 1 j = i res = dzero @@ -2067,7 +2067,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2344,7 +2344,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2884,7 +2884,7 @@ subroutine psb_d_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat - + call b%set_sort_status(a%get_sort_status()) nz = a%get_nzeros() call b%set_nzeros(nz) call b%reallocate(nz) @@ -2894,7 +2894,7 @@ subroutine psb_d_cp_coo_to_coo(a,b,info) b%val(1:nz) = a%val(1:nz) - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -2912,7 +2912,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) use psb_d_base_mat_mod, psb_protect_name => psb_d_cp_coo_from_coo implicit none class(psb_d_coo_sparse_mat), intent(inout) :: a - class(psb_d_coo_sparse_mat), intent(in) :: b + class(psb_d_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -2925,7 +2925,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat - + call a%set_sort_status(b%get_sort_status()) nz = b%get_nzeros() call a%set_nzeros(nz) call a%reallocate(nz) @@ -2934,7 +2934,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) a%ja(1:nz) = b%ja(1:nz) a%val(1:nz) = b%val(1:nz) - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 @@ -3036,6 +3036,7 @@ subroutine psb_d_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat + call b%set_sort_status(a%get_sort_status()) call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia, b%ia) @@ -3043,7 +3044,7 @@ subroutine psb_d_mv_coo_to_coo(a,b,info) call move_alloc(a%val, b%val) call a%free() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -3077,13 +3078,14 @@ subroutine psb_d_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call a%set_sort_status(b%get_sort_status()) call a%set_nzeros(b%get_nzeros()) call move_alloc(b%ia , a%ia ) call move_alloc(b%ja , a%ja ) call move_alloc(b%val, a%val ) call b%free() - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index c07b5b1b..84d5e705 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -2139,8 +2139,7 @@ subroutine psb_d_cp_csc_from_coo(a,b,info) class(psb_d_csc_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_), intent(out) :: info type(psb_d_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) !locals diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 1585ddf2..a8635ff0 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -2658,7 +2658,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info) class(psb_d_csr_sparse_mat), intent(inout) :: a class(psb_d_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info type(psb_d_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) @@ -2673,7 +2673,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) then + if (.not.b%is_by_rows()) then ! This is to have fix_coo called behind the scenes call tmp%cp_from_coo(b,info) if (info /= psb_success_) return @@ -2871,7 +2871,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info) debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) return nr = b%get_nrows() diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index 238a2e65..288ae128 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -113,9 +113,13 @@ subroutine psb_s_base_cp_to_fmt(a,b,info) info = psb_success_ call psb_erractionsave(err_act) - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - + select type(b) + type is (psb_s_coo_sparse_mat) + call a%cp_to_coo(b,info) + class default + call a%cp_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info,name, a_err='to/from coo') @@ -151,9 +155,14 @@ subroutine psb_s_base_cp_from_fmt(a,b,info) ! info = psb_success_ call psb_erractionsave(err_act) - - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) + + select type(b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ @@ -267,8 +276,13 @@ subroutine psb_s_base_mv_to_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call a%mv_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) + select type(b) + type is (psb_s_coo_sparse_mat) + call a%mv_to_coo(b,info) + class default + call a%mv_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select return @@ -293,9 +307,13 @@ subroutine psb_s_base_mv_from_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call b%mv_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - + select type(b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select return end subroutine psb_s_base_mv_from_fmt diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index f1436e0f..e06fc148 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -466,7 +466,7 @@ function psb_s_coo_get_nz_row(idx,a) result(res) res = 0 nza = a%get_nzeros() - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. ip = psb_ibsrch(idx,nza,a%ia) if (ip /= -1) return @@ -580,7 +580,7 @@ subroutine psb_s_coo_cssm(alpha,a,x,beta,y,info,trans) end if if (beta == szero) then - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info) do i = 1, m @@ -594,7 +594,7 @@ subroutine psb_s_coo_cssm(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info) do i = 1, m @@ -933,7 +933,7 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans) end if if (beta == szero) then - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,y,info) if (info /= psb_success_) then @@ -951,7 +951,7 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,tmp,info) if (info /= psb_success_) then @@ -1650,7 +1650,7 @@ function psb_s_coo_csnmi(a) result(res) res = szero nnz = a%get_nzeros() is_unit = a%is_unit() - if (a%is_sorted()) then + if (a%is_by_rows()) then i = 1 j = i res = szero @@ -2067,7 +2067,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2344,7 +2344,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2884,7 +2884,7 @@ subroutine psb_s_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat - + call b%set_sort_status(a%get_sort_status()) nz = a%get_nzeros() call b%set_nzeros(nz) call b%reallocate(nz) @@ -2894,7 +2894,7 @@ subroutine psb_s_cp_coo_to_coo(a,b,info) b%val(1:nz) = a%val(1:nz) - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -2912,7 +2912,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) use psb_s_base_mat_mod, psb_protect_name => psb_s_cp_coo_from_coo implicit none class(psb_s_coo_sparse_mat), intent(inout) :: a - class(psb_s_coo_sparse_mat), intent(in) :: b + class(psb_s_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -2925,7 +2925,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat - + call a%set_sort_status(b%get_sort_status()) nz = b%get_nzeros() call a%set_nzeros(nz) call a%reallocate(nz) @@ -2934,7 +2934,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) a%ja(1:nz) = b%ja(1:nz) a%val(1:nz) = b%val(1:nz) - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 @@ -3036,6 +3036,7 @@ subroutine psb_s_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat + call b%set_sort_status(a%get_sort_status()) call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia, b%ia) @@ -3043,7 +3044,7 @@ subroutine psb_s_mv_coo_to_coo(a,b,info) call move_alloc(a%val, b%val) call a%free() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -3077,13 +3078,14 @@ subroutine psb_s_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat + call a%set_sort_status(b%get_sort_status()) call a%set_nzeros(b%get_nzeros()) call move_alloc(b%ia , a%ia ) call move_alloc(b%ja , a%ja ) call move_alloc(b%val, a%val ) call b%free() - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index d13020ed..ec4685fb 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -2139,8 +2139,7 @@ subroutine psb_s_cp_csc_from_coo(a,b,info) class(psb_s_csc_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_), intent(out) :: info type(psb_s_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) !locals diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 172c459f..fadbcf84 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -2658,7 +2658,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info) class(psb_s_csr_sparse_mat), intent(inout) :: a class(psb_s_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info type(psb_s_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) @@ -2673,7 +2673,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) then + if (.not.b%is_by_rows()) then ! This is to have fix_coo called behind the scenes call tmp%cp_from_coo(b,info) if (info /= psb_success_) return @@ -2871,7 +2871,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info) debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) return nr = b%get_nrows() diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index 27db9345..42e72e5d 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -113,9 +113,13 @@ subroutine psb_z_base_cp_to_fmt(a,b,info) info = psb_success_ call psb_erractionsave(err_act) - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - + select type(b) + type is (psb_z_coo_sparse_mat) + call a%cp_to_coo(b,info) + class default + call a%cp_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info,name, a_err='to/from coo') @@ -151,9 +155,14 @@ subroutine psb_z_base_cp_from_fmt(a,b,info) ! info = psb_success_ call psb_erractionsave(err_act) - - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) + + select type(b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select if (info /= psb_success_) then info = psb_err_from_subroutine_ @@ -267,8 +276,13 @@ subroutine psb_z_base_mv_to_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call a%mv_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) + select type(b) + type is (psb_z_coo_sparse_mat) + call a%mv_to_coo(b,info) + class default + call a%mv_to_coo(tmp,info) + if (info == psb_success_) call b%mv_from_coo(tmp,info) + end select return @@ -293,9 +307,13 @@ subroutine psb_z_base_mv_from_fmt(a,b,info) ! Default implementation ! info = psb_success_ - call b%mv_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - + select type(b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select return end subroutine psb_z_base_mv_from_fmt diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index a894eb64..cd926959 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -466,7 +466,7 @@ function psb_z_coo_get_nz_row(idx,a) result(res) res = 0 nza = a%get_nzeros() - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. ip = psb_ibsrch(idx,nza,a%ia) if (ip /= -1) return @@ -580,7 +580,7 @@ subroutine psb_z_coo_cssm(alpha,a,x,beta,y,info,trans) end if if (beta == zzero) then - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info) do i = 1, m @@ -594,7 +594,7 @@ subroutine psb_z_coo_cssm(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & m,nc,nnz,a%ia,a%ja,a%val,& & x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info) do i = 1, m @@ -933,7 +933,7 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans) end if if (beta == zzero) then - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,y,info) if (info /= psb_success_) then @@ -951,7 +951,7 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if - call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),& + call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),& & a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,& & x,tmp,info) if (info /= psb_success_) then @@ -1650,7 +1650,7 @@ function psb_z_coo_csnmi(a) result(res) res = dzero nnz = a%get_nzeros() is_unit = a%is_unit() - if (a%is_sorted()) then + if (a%is_by_rows()) then i = 1 j = i res = dzero @@ -2067,7 +2067,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2344,7 +2344,7 @@ contains nzin_ = 0 endif - if (a%is_sorted()) then + if (a%is_by_rows()) then ! In this case we can do a binary search. if (debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name), ': srtdcoo ' @@ -2884,7 +2884,7 @@ subroutine psb_z_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat - + call b%set_sort_status(a%get_sort_status()) nz = a%get_nzeros() call b%set_nzeros(nz) call b%reallocate(nz) @@ -2894,7 +2894,7 @@ subroutine psb_z_cp_coo_to_coo(a,b,info) b%val(1:nz) = a%val(1:nz) - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -2912,7 +2912,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) use psb_z_base_mat_mod, psb_protect_name => psb_z_cp_coo_from_coo implicit none class(psb_z_coo_sparse_mat), intent(inout) :: a - class(psb_z_coo_sparse_mat), intent(in) :: b + class(psb_z_coo_sparse_mat), intent(in) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -2925,7 +2925,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat - + call a%set_sort_status(b%get_sort_status()) nz = b%get_nzeros() call a%set_nzeros(nz) call a%reallocate(nz) @@ -2934,7 +2934,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) a%ja(1:nz) = b%ja(1:nz) a%val(1:nz) = b%val(1:nz) - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 @@ -3036,6 +3036,7 @@ subroutine psb_z_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat + call b%set_sort_status(a%get_sort_status()) call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia, b%ia) @@ -3043,7 +3044,7 @@ subroutine psb_z_mv_coo_to_coo(a,b,info) call move_alloc(a%val, b%val) call a%free() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) goto 9999 @@ -3077,13 +3078,14 @@ subroutine psb_z_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat + call a%set_sort_status(b%get_sort_status()) call a%set_nzeros(b%get_nzeros()) call move_alloc(b%ia , a%ia ) call move_alloc(b%ja , a%ja ) call move_alloc(b%val, a%val ) call b%free() - if (.not.a%is_sorted()) call a%fix(info) + if (.not.a%is_by_rows()) call a%fix(info) if (info /= psb_success_) goto 9999 diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 8dc1c8a2..c9acff5f 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -2139,8 +2139,7 @@ subroutine psb_z_cp_csc_from_coo(a,b,info) class(psb_z_csc_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_), intent(out) :: info type(psb_z_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) !locals diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index ff1ab064..bd77634e 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -2658,7 +2658,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info) class(psb_z_csr_sparse_mat), intent(inout) :: a class(psb_z_coo_sparse_mat), intent(in) :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info type(psb_z_coo_sparse_mat) :: tmp integer(psb_ipk_), allocatable :: itemp(:) @@ -2673,7 +2673,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) then + if (.not.b%is_by_rows()) then ! This is to have fix_coo called behind the scenes call tmp%cp_from_coo(b,info) if (info /= psb_success_) return @@ -2871,7 +2871,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info) debug_level = psb_get_debug_level() - if (.not.b%is_sorted()) call b%fix(info) + if (.not.b%is_by_rows()) call b%fix(info) if (info /= psb_success_) return nr = b%get_nrows()