From cd86051656d912848db18039ecc1dbda558d169b Mon Sep 17 00:00:00 2001 From: Christoph Hansknecht Date: Fri, 21 Jun 2024 20:45:08 +0200 Subject: [PATCH] Add example for scaling of a symmetric singular matrix --- tests/scaling.f90 | 49 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/tests/scaling.f90 b/tests/scaling.f90 index 48ca4ff2..1213f8d2 100644 --- a/tests/scaling.f90 +++ b/tests/scaling.f90 @@ -647,6 +647,55 @@ end subroutine test_hungarian_unsym_singular !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine test_hungarian_sym_singular + integer :: m = 3 + integer :: n = 3 + integer :: nz = 6 + integer :: ising = 3 + type(matrix_type) :: a + + type(hungarian_options) :: options + type(hungarian_inform) :: inform + + integer, allocatable, dimension(:) :: match + real(wp), allocatable, dimension(:) :: scaling + + write(*, "(a)") + write(*, "(a)") "====================================================" + write(*, "(a)") "Testing hungarian_scale_unsym() with singular matrix" + write(*, "(a)") "====================================================" + + allocate(a%ptr(n+1)) + allocate(a%row(nz), a%val(nz)) + allocate(scaling(n), match(m)) + + ! Produce warning rather than error + options%scale_if_singular = .true. + + a%n = n + a%m = m + + a%ptr(1:n+1) = (/ 1, 2, 3, 3 /) + a%row(1:a%ptr(n+1)-1) = (/ 1, 2/) + a%val(1:a%ptr(n+1)-1) = (/ 2.0, 1.0/) + + call hungarian_scale_sym(a%n, a%ptr, a%row, a%val, scaling, & + options, inform, match=match) + + if(inform%flag .ne. 1) then + write(*, "(a, i5)") "Returned inform%flag = ", inform%flag + errors = errors + 1 + endif + + if(match(ising) >= 0) then + write(*, "(a, i5, a, i5)") "Singular column ", ising, " has value ", match(ising) + errors = errors + 1 + endif + +end subroutine test_hungarian_sym_singular + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine test_hungarian_sym_random integer :: maxn = 1000 integer :: maxnz = 1000000