From 3d86036b79d743c54543f1cd170dfe41138a12ce Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sat, 21 Aug 2021 17:57:50 -0500 Subject: [PATCH 01/33] Add all single input chekcs --- src/stdlib_linalg.fypp | 183 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 183 insertions(+) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 5e0388c0b..31fcfeaf8 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -10,6 +10,13 @@ module stdlib_linalg public :: diag public :: eye + public :: is_square + public :: is_diagonal + public :: is_symmetric + public :: is_skew_symmetric + public :: is_hermitian + !public :: is_triangular + !public :: is_hessenberg public :: trace public :: outer_product @@ -80,8 +87,70 @@ module stdlib_linalg #:endfor end interface outer_product + + ! Check for squareness + interface is_square + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is square. + !! ([Specification](../page/specs/stdlib_linalg.html#description_4)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure is_square_${t1[0]}$${k1}$ + #:endfor + end interface is_square + + + ! Check for diagonality + interface is_diagonal + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is diagonal. + !! ([Specification](../page/specs/stdlib_linalg.html#description_5)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure is_diagonal_${t1[0]}$${k1}$ + #:endfor + end interface is_diagonal + + + ! Check for symmetry + interface is_symmetric + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is symmetric. + !! ([Specification](../page/specs/stdlib_linalg.html#description_6)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure is_symmetric_${t1[0]}$${k1}$ + #:endfor + end interface is_symmetric + + + ! Check for skew-symmetry + interface is_skew_symmetric + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is skew-symmetric. + !! ([Specification](../page/specs/stdlib_linalg.html#description_7)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure is_skew_symmetric_${t1[0]}$${k1}$ + #:endfor + end interface is_skew_symmetric + + + ! Check for Hermiticity + interface is_hermitian + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is Hermitian. + !! ([Specification](../page/specs/stdlib_linalg.html#description_8)) + #:for k1, t1 in CMPLX_KINDS_TYPES + module procedure is_hermitian_${t1[0]}$${k1}$ + #:endfor + end interface is_hermitian + + contains + function eye(n) result(res) !! version: experimental !! @@ -108,4 +177,118 @@ contains end do end function trace_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in RCI_KINDS_TYPES + pure function is_square_${t1[0]}$${k1}$(A) result(res) + ${t1}$, intent(in) :: A(:,:) + logical :: res + integer :: A_shape(2) + A_shape = shape(A) + res = (A_shape(1) .eq. A_shape(2)) + end function is_square_${t1[0]}$${k1}$ + #:endfor + + + #:for k1, t1 in RCI_KINDS_TYPES + pure function is_diagonal_${t1[0]}$${k1}$(A) result(res) + ${t1}$, intent(in) :: A(:,:) + logical :: res + ${t1}$ :: zero + integer :: A_shape(2), m, n, o, i, j + zero = 0 !zero of relevant type + A_shape = shape(A) + m = A_shape(1) + n = A_shape(2) + o = min(m,n) !minimum/lower dimension + do i=1,n !loop over all columns + do j=1,o-1 !loop over rows above diagonal + if (.not. (A(i,j) .eq. zero)) then + res = .false. + return + end if + end do + do j=o+1,m !loop over rows below diagonal + if (.not. (A(i,j) .eq. zero)) then + res = .false. + return + end if + end do + end do + res = .true. !otherwise A is diagonal + end function is_diagonal_${t1[0]}$${k1}$ + #:endfor + + + #:for k1, t1 in RCI_KINDS_TYPES + pure function is_symmetric_${t1[0]}$${k1}$(A) result(res) + ${t1}$, intent(in) :: A(:,:) + logical :: res + integer :: A_shape(2), n, i, j + if (.not. is_square(A)) then + res = .false. + return !nonsquare matrices cannot be symmetric + end if + A_shape = shape(A) + n = A_shape(1) !symmetric dimension of A + do i=1,n !loop over all rows + do j=j+1,n !loop over all columns right of diagonal + if (.not. (A(i,j) .eq. A(j,i))) then + res = .false. + return + end if + end do + end do + res = .true. !otherwise A is symmetric + end function is_symmetric_${t1[0]}$${k1}$ + #:endfor + + + #:for k1, t1 in RCI_KINDS_TYPES + pure function is_skew_symmetric_${t1[0]}$${k1}$(A) result(res) + ${t1}$, intent(in) :: A(:,:) + logical :: res + integer :: A_shape(2), n, i, j + if (.not. is_square(A)) then + res = .false. + return !nonsquare matrices cannot be skew-symmetric + end if + A_shape = shape(A) + n = A_shape(1) !symmetric dimension of A + do i=1,n !loop over all rows + do j=j,n !loop over all columns right of diagonal (including diagonal) + if (.not. (A(i,j) .eq. -A(j,i))) then + res = .false. + return + end if + end do + end do + res = .true. !otherwise A is skew-symmetric + end function is_skew_symmetric_${t1[0]}$${k1}$ + #:endfor + + + #:for k1, t1 in CMPLX_KINDS_TYPES + pure function is_hermitian_${t1[0]}$${k1}$(A) result(res) + ${t1}$, intent(in) :: A(:,:) + logical :: res + integer :: A_shape(2), n, i, j + if (.not. is_square(A)) then + res = .false. + return !nonsquare matrices cannot be Hermitian + end if + A_shape = shape(A) + n = A_shape(1) !symmetric dimension of A + do i=1,n !loop over all rows + do j=j+1,n !loop over all columns right of diagonal + if (.not. (A(i,j) .eq. conjg(A(j,i)))) then + res = .false. + return + end if + end do + end do + res = .true. !otherwise A is Hermitian + end function is_hermitian_${t1[0]}$${k1}$ + #:endfor + end module From 6d9848f98dd33efcdab5c2e2c134c5561898621d Mon Sep 17 00:00:00 2001 From: GHBrown Date: Tue, 24 Aug 2021 16:03:21 -0500 Subject: [PATCH 02/33] Fix is_diagonal and add some tests --- src/stdlib_linalg.fypp | 130 ++++++++++++++-- src/tests/linalg/test_linalg.f90 | 256 ++++++++++++++++++++++++++++++- 2 files changed, 370 insertions(+), 16 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 31fcfeaf8..ba7a29b5a 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -10,15 +10,15 @@ module stdlib_linalg public :: diag public :: eye + public :: trace + public :: outer_product public :: is_square public :: is_diagonal public :: is_symmetric public :: is_skew_symmetric public :: is_hermitian - !public :: is_triangular - !public :: is_hessenberg - public :: trace - public :: outer_product + public :: is_triangular + public :: is_hessenberg interface diag !! version: experimental @@ -146,8 +146,31 @@ module stdlib_linalg module procedure is_hermitian_${t1[0]}$${k1}$ #:endfor end interface is_hermitian + + + ! Check for triangularity + interface is_triangular + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is triangular. + !! ([Specification](../page/specs/stdlib_linalg.html#description_9)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure is_triangular_${t1[0]}$${k1}$ + #:endfor + end interface is_triangular + ! Check for matrix being Hessenberg + interface is_hessenberg + !! version: experimental + !! + !! Checks if a matrix (rank-2 array) is Hessenberg + !! ([Specification](../page/specs/stdlib_linalg.html#description_10)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure is_Hessenberg_${t1[0]}$${k1}$ + #:endfor + end interface is_hessenberg + contains @@ -200,15 +223,15 @@ contains A_shape = shape(A) m = A_shape(1) n = A_shape(2) - o = min(m,n) !minimum/lower dimension - do i=1,n !loop over all columns - do j=1,o-1 !loop over rows above diagonal + do j=1,n !loop over all columns + o = min(j-1,m) !index of row above diagonal (or last row) + do i=1,o !loop over rows above diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return end if end do - do j=o+1,m !loop over rows below diagonal + do i=o+2,m !loop over rows below diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return @@ -231,8 +254,8 @@ contains end if A_shape = shape(A) n = A_shape(1) !symmetric dimension of A - do i=1,n !loop over all rows - do j=j+1,n !loop over all columns right of diagonal + do j=1,n !loop over all columns + do i=1,j-1 !loop over all rows above diagonal if (.not. (A(i,j) .eq. A(j,i))) then res = .false. return @@ -255,8 +278,8 @@ contains end if A_shape = shape(A) n = A_shape(1) !symmetric dimension of A - do i=1,n !loop over all rows - do j=j,n !loop over all columns right of diagonal (including diagonal) + do j=1,n !loop over all columns + do i=1,j !loop over all rows above diagonal (and diagonal) if (.not. (A(i,j) .eq. -A(j,i))) then res = .false. return @@ -279,8 +302,8 @@ contains end if A_shape = shape(A) n = A_shape(1) !symmetric dimension of A - do i=1,n !loop over all rows - do j=j+1,n !loop over all columns right of diagonal + do j=1,n !loop over all columns + do i=1,j !loop over all rows above diagonal (and diagonal) if (.not. (A(i,j) .eq. conjg(A(j,i)))) then res = .false. return @@ -291,4 +314,83 @@ contains end function is_hermitian_${t1[0]}$${k1}$ #:endfor + + #:for k1, t1 in RCI_KINDS_TYPES + pure function is_triangular_${t1[0]}$${k1}$(A,uplo) result(res) + ${t1}$, intent(in) :: A(:,:) + character, intent(in) :: uplo + logical :: res + ${t1}$ :: zero + integer :: A_shape(2), m, n, o, i, j + zero = 0 !zero of relevant type + A_shape = shape(A) + m = A_shape(1) + n = A_shape(2) + if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper triangularity + do j=1,n !loop over all columns + o = min(j-1,m) !index of row above diagonal (or last row) + do i=o+2,m !loop over rows below diagonal + if (.not. (A(i,j) .eq. zero)) then + res = .false. + return + end if + end do + end do + else if ((uplo .eq. 'l') .or. (uplo .eq. 'L')) then !check for lower triangularity + do j=1,n !loop over all columns + o = min(j-1,m) !index of row above diagonal (or last row) + do i=1,o !loop over rows above diagonal + if (.not. (A(i,j) .eq. zero)) then + res = .false. + return + end if + end do + end do + else + !return error on uplo parameter needing to be in {u,U,l,L} + end if + + res = .true. !otherwise A is triangular of the requested type + end function is_triangular_${t1[0]}$${k1}$ + #:endfor + + + #:for k1, t1 in RCI_KINDS_TYPES + pure function is_hessenberg_${t1[0]}$${k1}$(A,uplo) result(res) + ${t1}$, intent(in) :: A(:,:) + character, intent(in) :: uplo + logical :: res + ${t1}$ :: zero + integer :: A_shape(2), m, n, o, i, j + zero = 0 !zero of relevant type + A_shape = shape(A) + m = A_shape(1) + n = A_shape(2) + if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper Hessenberg + do j=1,n !loop over all columns + o = min(j-2,m) !index of row two above diagonal (or last row) + do i=o+4,m !loop over rows two or more below main diagonal + if (.not. (A(i,j) .eq. zero)) then + res = .false. + return + end if + end do + end do + else if ((uplo .eq. 'l') .or. (uplo .eq. 'L')) then !check for lower Hessenberg + do j=1,n !loop over all columns + o = min(j-2,m) !index of row two above diagonal (or last row) + do i=1,o !loop over rows one or more above main diagonal + if (.not. (A(i,j) .eq. zero)) then + res = .false. + return + end if + end do + end do + else + !return error on uplo parameter needing to be in {u,U,l,L} + end if + res = .true. !otherwise A is Hessenberg of the requested type + end function is_hessenberg_${t1[0]}$${k1}$ + #:endfor + end module diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index cc8d0db68..01298d3a8 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -2,7 +2,7 @@ program test_linalg use stdlib_error, only: check use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 - use stdlib_linalg, only: diag, eye, trace, outer_product + use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal!, is_symmetric implicit none @@ -57,7 +57,7 @@ program test_linalg call test_trace_int64 ! - ! outer product + ! outer_product ! call test_outer_product_rsp call test_outer_product_rdp @@ -72,6 +72,37 @@ program test_linalg call test_outer_product_int32 call test_outer_product_int64 + ! + ! is_square + ! + call test_is_square_rsp + call test_is_square_rdp + call test_is_square_rqp + + call test_is_square_csp + call test_is_square_cdp + call test_is_square_cqp + + call test_is_square_int8 + call test_is_square_int16 + call test_is_square_int32 + call test_is_square_int64 + + ! + ! is_diagonal + ! + call test_is_diagonal_rsp + call test_is_diagonal_rdp + call test_is_diagonal_rqp + + !call test_is_diagonal_csp + !call test_is_diagonal_cdp + !call test_is_diagonal_cqp + + !call test_is_diagonal_int8 + !call test_is_diagonal_int16 + !call test_is_diagonal_int32 + !call test_is_diagonal_int64 contains @@ -564,6 +595,227 @@ subroutine test_outer_product_int64 end subroutine test_outer_product_int64 + subroutine test_is_square_rsp + real(sp) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_rsp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_rsp + + subroutine test_is_square_rdp + real(dp) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_rdp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_rdp + + subroutine test_is_square_rqp + real(qp) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_rqp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_rqp + + subroutine test_is_square_csp + complex(sp) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_csp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_csp + + subroutine test_is_square_cdp + complex(dp) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_cdp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_cdp + + subroutine test_is_square_cqp + complex(qp) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_cqp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_cqp + + subroutine test_is_square_int8 + integer(int8) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_int8" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_int8 + + subroutine test_is_square_int16 + integer(int16) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_int16" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_int16 + + subroutine test_is_square_int32 + integer(int32) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_int32" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_int32 + + subroutine test_is_square_int64 + integer(int64) :: A_true(2,2), A_false(2,3) + logical :: should_be_true, should_be_false, true_when_working + write(*,*) "test_is_square_int64" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + should_be_true = is_square(A_true) + should_be_false = is_square(A_false) + true_when_working = (should_be_true .and. (.not. should_be_false)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_square_int64 + + subroutine test_is_diagonal_rsp + real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_rsp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !compress results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_rsp + + subroutine test_is_diagonal_rdp + real(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_rdp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !compress results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_rdp + + subroutine test_is_diagonal_rqp + real(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_rqp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !compress results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_rqp + + pure recursive function catalan_number(n) result(value) integer, intent(in) :: n integer :: value From 4c5fdf17177287563c8e347a855308561e1f4634 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Tue, 24 Aug 2021 21:11:08 -0500 Subject: [PATCH 03/33] Add is_symmetric and is_skew_symmetric tests --- src/tests/linalg/test_linalg.f90 | 632 ++++++++++++++++++++++++++++++- 1 file changed, 621 insertions(+), 11 deletions(-) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index 01298d3a8..113bd21b8 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -2,7 +2,8 @@ program test_linalg use stdlib_error, only: check use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 - use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal!, is_symmetric + use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal, & + is_symmetric, is_skew_symmetric implicit none @@ -95,14 +96,46 @@ program test_linalg call test_is_diagonal_rdp call test_is_diagonal_rqp - !call test_is_diagonal_csp - !call test_is_diagonal_cdp - !call test_is_diagonal_cqp + call test_is_diagonal_csp + call test_is_diagonal_cdp + call test_is_diagonal_cqp - !call test_is_diagonal_int8 - !call test_is_diagonal_int16 - !call test_is_diagonal_int32 - !call test_is_diagonal_int64 + call test_is_diagonal_int8 + call test_is_diagonal_int16 + call test_is_diagonal_int32 + call test_is_diagonal_int64 + + ! + ! is_symmetric + ! + call test_is_symmetric_rsp + call test_is_symmetric_rdp + call test_is_symmetric_rqp + + call test_is_symmetric_csp + call test_is_symmetric_cdp + call test_is_symmetric_cqp + + call test_is_symmetric_int8 + call test_is_symmetric_int16 + call test_is_symmetric_int32 + call test_is_symmetric_int64 + + ! + ! is_skew_symmetric + ! + call test_is_skew_symmetric_rsp + call test_is_skew_symmetric_rdp + call test_is_skew_symmetric_rqp + + call test_is_skew_symmetric_csp + call test_is_skew_symmetric_cdp + call test_is_skew_symmetric_cqp + + !call test_is_skew_symmetric_int8 + !call test_is_skew_symmetric_int16 + !call test_is_skew_symmetric_int32 + !call test_is_skew_symmetric_int64 contains @@ -728,6 +761,7 @@ subroutine test_is_square_int64 msg="true_when_working failed.",warn=warn) end subroutine test_is_square_int64 + subroutine test_is_diagonal_rsp real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices @@ -749,7 +783,7 @@ subroutine test_is_diagonal_rsp should_be_false_sf = is_diagonal(A_false_sf) should_be_true_ts = is_diagonal(A_true_ts) should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !compress results + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) @@ -778,7 +812,7 @@ subroutine test_is_diagonal_rdp should_be_false_sf = is_diagonal(A_false_sf) should_be_true_ts = is_diagonal(A_true_ts) should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !compress results + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) @@ -807,7 +841,7 @@ subroutine test_is_diagonal_rqp should_be_false_sf = is_diagonal(A_false_sf) should_be_true_ts = is_diagonal(A_true_ts) should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !compress results + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) @@ -815,6 +849,582 @@ subroutine test_is_diagonal_rqp msg="true_when_working failed.",warn=warn) end subroutine test_is_diagonal_rqp + subroutine test_is_diagonal_csp + complex(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_csp" + !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + !test generated matrices + should_be_true_s = is_diagonal(A_true_s) + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + !combine results + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_csp + + subroutine test_is_diagonal_cdp + complex(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_cdp" + !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + !test generated matrices + should_be_true_s = is_diagonal(A_true_s) + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + !combine results + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_cdp + + subroutine test_is_diagonal_cqp + complex(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_cqp" + !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + !test generated matrices + should_be_true_s = is_diagonal(A_true_s) + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + !combine results + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_cqp + + subroutine test_is_diagonal_int8 + integer(int8) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int8) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int8) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_int8" + A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_int8 + + subroutine test_is_diagonal_int16 + integer(int16) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int16) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int16) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_int16" + A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_int16 + + subroutine test_is_diagonal_int32 + integer(int32) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int32) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int32) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_int32" + A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_int32 + + subroutine test_is_diagonal_int64 + integer(int64) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int64) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int64) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + logical :: should_be_true_s, should_be_false_s, true_when_working_s + logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf + logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts + logical :: true_when_working + write(*,*) "test_is_diagonal_int64" + A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + should_be_true_s = is_diagonal(A_true_s) !test generated matrices + should_be_false_s = is_diagonal(A_false_s) + should_be_true_sf = is_diagonal(A_true_sf) + should_be_false_sf = is_diagonal(A_false_sf) + should_be_true_ts = is_diagonal(A_true_ts) + should_be_false_ts = is_diagonal(A_false_ts) + true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results + true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) + true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) + true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_diagonal_int64 + + + subroutine test_is_symmetric_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_rsp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_rsp + + subroutine test_is_symmetric_rdp + real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_rdp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_rdp + + subroutine test_is_symmetric_rqp + real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_rqp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_rqp + + subroutine test_is_symmetric_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_csp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_csp + + subroutine test_is_symmetric_cdp + complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_cdp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_cdp + + subroutine test_is_symmetric_cqp + complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_cqp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_cqp + + subroutine test_is_symmetric_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_int8" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_int8 + + subroutine test_is_symmetric_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_int16" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_int16 + + subroutine test_is_symmetric_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_int32" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_int32 + + subroutine test_is_symmetric_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_symmetric_int64" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + should_be_true = is_symmetric(A_true) + should_be_false_1 = is_symmetric(A_false_1) + should_be_false_2 = is_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_symmetric_int64 + + + subroutine test_is_skew_symmetric_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_rsp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_rsp + + subroutine test_is_skew_symmetric_rdp + real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_rdp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_rdp + + subroutine test_is_skew_symmetric_rqp + real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_rqp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_rqp + + subroutine test_is_skew_symmetric_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_csp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_csp + + subroutine test_is_skew_symmetric_cdp + complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_cdp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_cdp + + subroutine test_is_skew_symmetric_cqp + complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_cqp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_cqp + + subroutine test_is_skew_symmetric_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_int8" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_int8 + + subroutine test_is_skew_symmetric_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_int16" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_int16 + + subroutine test_is_skew_symmetric_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_int32" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_int32 + + subroutine test_is_skew_symmetric_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working + write(*,*) "test_is_skew_symmetric_int64" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + should_be_true = is_skew_symmetric(A_true) + should_be_false_1 = is_skew_symmetric(A_false_1) + should_be_false_2 = is_skew_symmetric(A_false_2) + true_when_working = (should_be_true .and. (.not. should_be_false_1) & + .and. (.not. should_be_false_2)) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_skew_symmetric_int64 + pure recursive function catalan_number(n) result(value) integer, intent(in) :: n From f28bb47fcbb441bb33ee487a6df771bc25046b62 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Thu, 26 Aug 2021 17:07:06 -0500 Subject: [PATCH 04/33] Add tests for is_skew_symmetric and start is_triangular tests --- src/tests/linalg/test_linalg.f90 | 83 ++++++++++++++++++++++++++++++-- 1 file changed, 78 insertions(+), 5 deletions(-) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index 113bd21b8..9431863fd 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -3,7 +3,7 @@ program test_linalg use stdlib_error, only: check use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal, & - is_symmetric, is_skew_symmetric + is_symmetric, is_skew_symmetric, is_triangular!, is_hessenberg implicit none @@ -132,10 +132,27 @@ program test_linalg call test_is_skew_symmetric_cdp call test_is_skew_symmetric_cqp - !call test_is_skew_symmetric_int8 - !call test_is_skew_symmetric_int16 - !call test_is_skew_symmetric_int32 - !call test_is_skew_symmetric_int64 + call test_is_skew_symmetric_int8 + call test_is_skew_symmetric_int16 + call test_is_skew_symmetric_int32 + call test_is_skew_symmetric_int64 + + + ! + ! is_triangular + ! + call test_is_triangular_rsp + !call test_is_triangular_rdp + !call test_is_triangular_rqp + + !call test_is_triangular_csp + !call test_is_triangular_cdp + !call test_is_triangular_cqp + + !call test_is_triangular_int8 + !call test_is_triangular_int16 + !call test_is_triangular_int32 + !call test_is_triangular_int64 contains @@ -1426,6 +1443,62 @@ subroutine test_is_skew_symmetric_int64 end subroutine test_is_skew_symmetric_int64 + subroutine test_is_triangular_rsp + real(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_rsp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_rsp + + pure recursive function catalan_number(n) result(value) integer, intent(in) :: n integer :: value From 857a9bb2041bf1fbd4c7dca8012c2847697bf8de Mon Sep 17 00:00:00 2001 From: GHBrown Date: Thu, 26 Aug 2021 21:42:10 -0500 Subject: [PATCH 05/33] Start complex is_triangular tests --- src/tests/linalg/test_linalg.f90 | 185 ++++++++++++++++++++++++++++++- 1 file changed, 183 insertions(+), 2 deletions(-) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index 9431863fd..0d415baf6 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -142,8 +142,8 @@ program test_linalg ! is_triangular ! call test_is_triangular_rsp - !call test_is_triangular_rdp - !call test_is_triangular_rqp + call test_is_triangular_rdp + call test_is_triangular_rqp !call test_is_triangular_csp !call test_is_triangular_cdp @@ -1498,6 +1498,187 @@ subroutine test_is_triangular_rsp msg="true_when_working failed.",warn=warn) end subroutine test_is_triangular_rsp + subroutine test_is_triangular_rdp + real(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_rdp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_rdp + + subroutine test_is_triangular_rqp + real(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_rqp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_rqp + + subroutine test_is_triangular_csp + complex(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_csp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_csp + pure recursive function catalan_number(n) result(value) integer, intent(in) :: n From a14af3bd151d4d57a6fa5408d4b45a7d86fb3ac0 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Fri, 27 Aug 2021 19:07:29 -0500 Subject: [PATCH 06/33] Add final tests --- src/tests/linalg/test_linalg.f90 | 1075 +++++++++++++++++++++++++++++- 1 file changed, 1052 insertions(+), 23 deletions(-) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index 0d415baf6..c1b132805 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -3,7 +3,7 @@ program test_linalg use stdlib_error, only: check use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal, & - is_symmetric, is_skew_symmetric, is_triangular!, is_hessenberg + is_symmetric, is_skew_symmetric, is_triangular, is_hessenberg implicit none @@ -145,14 +145,30 @@ program test_linalg call test_is_triangular_rdp call test_is_triangular_rqp - !call test_is_triangular_csp - !call test_is_triangular_cdp - !call test_is_triangular_cqp + call test_is_triangular_csp + call test_is_triangular_cdp + call test_is_triangular_cqp - !call test_is_triangular_int8 - !call test_is_triangular_int16 - !call test_is_triangular_int32 - !call test_is_triangular_int64 + call test_is_triangular_int8 + call test_is_triangular_int16 + call test_is_triangular_int32 + call test_is_triangular_int64 + + ! + ! is_hessenberg + ! + call test_is_hessenberg_rsp + call test_is_hessenberg_rdp + call test_is_hessenberg_rqp + + call test_is_hessenberg_csp + call test_is_hessenberg_cdp + call test_is_hessenberg_cqp + + call test_is_hessenberg_int8 + call test_is_hessenberg_int16 + call test_is_hessenberg_int32 + call test_is_hessenberg_int64 contains @@ -355,8 +371,19 @@ subroutine test_diag_int64 call check(all(diag(a,-2) == diag(a,2)), & msg="all(diag(a,-2) == diag(a,2))", warn=warn) end subroutine test_diag_int64 - - + pure recursive function catalan_number(n) result(value) + integer, intent(in) :: n + integer :: value + integer :: i + if (n <= 1) then + value = 1 + else + value = 0 + do i = 0, n-1 + value = value + catalan_number(i)*catalan_number(n-i-1) + end do + end if + end function subroutine test_trace_rsp @@ -1679,19 +1706,1021 @@ subroutine test_is_triangular_csp msg="true_when_working failed.",warn=warn) end subroutine test_is_triangular_csp + subroutine test_is_triangular_cdp + complex(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_cdp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_cdp + + subroutine test_is_triangular_cqp + complex(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_cqp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_cqp + + subroutine test_is_triangular_int8 + integer(int8) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int8) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int8) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int8) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int8) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int8) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_int8" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_int8 + + subroutine test_is_triangular_int16 + integer(int16) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int16) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int16) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int16) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int16) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int16) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_int16" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_int16 + + subroutine test_is_triangular_int32 + integer(int32) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int32) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int32) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int32) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int32) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int32) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_int32" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_int32 + + subroutine test_is_triangular_int64 + integer(int64) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int64) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int64) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int64) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int64) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int64) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_triangular_int64" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_triangular(A_false_s_u,'u') + should_be_true_sf_u = is_triangular(A_true_sf_u,'u') + should_be_false_sf_u = is_triangular(A_false_sf_u,'u') + should_be_true_ts_u = is_triangular(A_true_ts_u,'U') + should_be_false_ts_u = is_triangular(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_triangular(A_false_s_l,'l') + should_be_true_sf_l = is_triangular(A_true_sf_l,'l') + should_be_false_sf_l = is_triangular(A_false_sf_l,'l') + should_be_true_ts_l = is_triangular(A_true_ts_l,'L') + should_be_false_ts_l = is_triangular(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_triangular_int64 + - pure recursive function catalan_number(n) result(value) - integer, intent(in) :: n - integer :: value - integer :: i - if (n <= 1) then - value = 1 - else - value = 0 - do i = 0, n-1 - value = value + catalan_number(i)*catalan_number(n-i-1) - end do - end if - end function + subroutine test_is_hessenberg_rsp + real(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_rsp" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_rsp + + subroutine test_is_hessenberg_rdp + real(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_rdp" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_rdp + + subroutine test_is_hessenberg_rqp + real(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_rqp" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_rqp + + subroutine test_is_hessenberg_csp + complex(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_csp" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_csp + + subroutine test_is_hessenberg_cdp + complex(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_cdp" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_cdp + + subroutine test_is_hessenberg_cqp + complex(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_cqp" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_cqp + + subroutine test_is_hessenberg_int8 + integer(int8) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int8) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int8) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int8) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int8) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int8) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_int8" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_int8 + + subroutine test_is_hessenberg_int16 + integer(int16) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int16) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int16) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int16) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int16) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int16) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_int16" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_int16 + + subroutine test_is_hessenberg_int32 + integer(int32) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int32) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int32) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int32) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int32) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int32) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_int32" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_int32 + + subroutine test_is_hessenberg_int64 + integer(int64) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int64) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int64) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int64) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int64) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int64) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals + logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u + logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u + logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals + logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l + logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l + logical :: true_when_working_u, true_when_working_l, true_when_working + write(*,*) "test_is_hessenberg_int64" + !upper hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices + should_be_false_s_u = is_hessenberg(A_false_s_u,'u') + should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') + should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') + should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') + should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') + true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results + true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) + true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) + true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + !lower hessenberg + !generate hessenberg and non-hessenberg matrices of 3 types + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices + should_be_false_s_l = is_hessenberg(A_false_s_l,'l') + should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') + should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') + should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') + should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') + true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results + true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) + true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) + true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) + !combine upper and lower results + true_when_working = (true_when_working_u .and. true_when_working_l) + call check(true_when_working, & + msg="true_when_working failed.",warn=warn) + end subroutine test_is_hessenberg_int64 end program From bdae9aee57a897ebdf3cf0bd35670a33092c73ab Mon Sep 17 00:00:00 2001 From: GHBrown Date: Fri, 27 Aug 2021 19:25:53 -0500 Subject: [PATCH 07/33] Style changes --- src/stdlib_linalg.fypp | 51 +++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index ba7a29b5a..ea08aa57b 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -5,6 +5,7 @@ module stdlib_linalg !! ([Specification](../page/specs/stdlib_linalg.html)) use stdlib_kinds, only: sp, dp, qp, & int8, int16, int32, int64 + use stdlib_error, only: error_stop implicit none private @@ -92,7 +93,7 @@ module stdlib_linalg interface is_square !! version: experimental !! - !! Checks if a matrix (rank-2 array) is square. + !! Checks if a matrix (rank-2 array) is square !! ([Specification](../page/specs/stdlib_linalg.html#description_4)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_square_${t1[0]}$${k1}$ @@ -104,7 +105,7 @@ module stdlib_linalg interface is_diagonal !! version: experimental !! - !! Checks if a matrix (rank-2 array) is diagonal. + !! Checks if a matrix (rank-2 array) is diagonal !! ([Specification](../page/specs/stdlib_linalg.html#description_5)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_diagonal_${t1[0]}$${k1}$ @@ -116,7 +117,7 @@ module stdlib_linalg interface is_symmetric !! version: experimental !! - !! Checks if a matrix (rank-2 array) is symmetric. + !! Checks if a matrix (rank-2 array) is symmetric !! ([Specification](../page/specs/stdlib_linalg.html#description_6)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_symmetric_${t1[0]}$${k1}$ @@ -128,7 +129,7 @@ module stdlib_linalg interface is_skew_symmetric !! version: experimental !! - !! Checks if a matrix (rank-2 array) is skew-symmetric. + !! Checks if a matrix (rank-2 array) is skew-symmetric !! ([Specification](../page/specs/stdlib_linalg.html#description_7)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_skew_symmetric_${t1[0]}$${k1}$ @@ -140,7 +141,7 @@ module stdlib_linalg interface is_hermitian !! version: experimental !! - !! Checks if a matrix (rank-2 array) is Hermitian. + !! Checks if a matrix (rank-2 array) is Hermitian !! ([Specification](../page/specs/stdlib_linalg.html#description_8)) #:for k1, t1 in CMPLX_KINDS_TYPES module procedure is_hermitian_${t1[0]}$${k1}$ @@ -152,7 +153,7 @@ module stdlib_linalg interface is_triangular !! version: experimental !! - !! Checks if a matrix (rank-2 array) is triangular. + !! Checks if a matrix (rank-2 array) is triangular !! ([Specification](../page/specs/stdlib_linalg.html#description_9)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_triangular_${t1[0]}$${k1}$ @@ -223,15 +224,15 @@ contains A_shape = shape(A) m = A_shape(1) n = A_shape(2) - do j=1,n !loop over all columns + do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) - do i=1,o !loop over rows above diagonal + do i = 1, o !loop over rows above diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return end if end do - do i=o+2,m !loop over rows below diagonal + do i = o+2, m !loop over rows below diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return @@ -254,8 +255,8 @@ contains end if A_shape = shape(A) n = A_shape(1) !symmetric dimension of A - do j=1,n !loop over all columns - do i=1,j-1 !loop over all rows above diagonal + do j = 1, n !loop over all columns + do i = 1, j-1 !loop over all rows above diagonal if (.not. (A(i,j) .eq. A(j,i))) then res = .false. return @@ -278,8 +279,8 @@ contains end if A_shape = shape(A) n = A_shape(1) !symmetric dimension of A - do j=1,n !loop over all columns - do i=1,j !loop over all rows above diagonal (and diagonal) + do j = 1, n !loop over all columns + do i = 1, j !loop over all rows above diagonal (and diagonal) if (.not. (A(i,j) .eq. -A(j,i))) then res = .false. return @@ -302,8 +303,8 @@ contains end if A_shape = shape(A) n = A_shape(1) !symmetric dimension of A - do j=1,n !loop over all columns - do i=1,j !loop over all rows above diagonal (and diagonal) + do j = 1, n !loop over all columns + do i = 1, j !loop over all rows above diagonal (and diagonal) if (.not. (A(i,j) .eq. conjg(A(j,i)))) then res = .false. return @@ -316,7 +317,7 @@ contains #:for k1, t1 in RCI_KINDS_TYPES - pure function is_triangular_${t1[0]}$${k1}$(A,uplo) result(res) + function is_triangular_${t1[0]}$${k1}$(A,uplo) result(res) ${t1}$, intent(in) :: A(:,:) character, intent(in) :: uplo logical :: res @@ -327,9 +328,9 @@ contains m = A_shape(1) n = A_shape(2) if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper triangularity - do j=1,n !loop over all columns + do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) - do i=o+2,m !loop over rows below diagonal + do i = o+2, m !loop over rows below diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return @@ -347,7 +348,7 @@ contains end do end do else - !return error on uplo parameter needing to be in {u,U,l,L} + call error_stop("ERROR (is_triangular): second argument must be one of {'u','U','l','L'}") end if res = .true. !otherwise A is triangular of the requested type @@ -356,7 +357,7 @@ contains #:for k1, t1 in RCI_KINDS_TYPES - pure function is_hessenberg_${t1[0]}$${k1}$(A,uplo) result(res) + function is_hessenberg_${t1[0]}$${k1}$(A,uplo) result(res) ${t1}$, intent(in) :: A(:,:) character, intent(in) :: uplo logical :: res @@ -367,9 +368,9 @@ contains m = A_shape(1) n = A_shape(2) if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper Hessenberg - do j=1,n !loop over all columns + do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) - do i=o+4,m !loop over rows two or more below main diagonal + do i = o+4, m !loop over rows two or more below main diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return @@ -377,9 +378,9 @@ contains end do end do else if ((uplo .eq. 'l') .or. (uplo .eq. 'L')) then !check for lower Hessenberg - do j=1,n !loop over all columns + do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) - do i=1,o !loop over rows one or more above main diagonal + do i = 1, o !loop over rows one or more above main diagonal if (.not. (A(i,j) .eq. zero)) then res = .false. return @@ -387,7 +388,7 @@ contains end do end do else - !return error on uplo parameter needing to be in {u,U,l,L} + call error_stop("ERROR (is_hessenberg): second argument must be one of {'u','U','l','L'}") end if res = .true. !otherwise A is Hessenberg of the requested type end function is_hessenberg_${t1[0]}$${k1}$ From e1f07e66e5a09b7d8f9fa2aa3746dc65cde71ea3 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sun, 29 Aug 2021 22:12:34 -0500 Subject: [PATCH 08/33] Separate calls to check in tests --- src/tests/linalg/test_linalg.f90 | 1858 +++++++++++++----------------- 1 file changed, 802 insertions(+), 1056 deletions(-) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index c1b132805..62a8e25a5 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -137,6 +137,21 @@ program test_linalg call test_is_skew_symmetric_int32 call test_is_skew_symmetric_int64 + ! + ! is_hermitian + ! + !call test_is_hermitian_rsp + !call test_is_hermitian_rdp + !call test_is_hermitian_rqp + + !call test_is_hermitian_csp + !call test_is_hermitian_cdp + !call test_is_hermitian_cqp + + !call test_is_hermitian_int8 + !call test_is_hermitian_int16 + !call test_is_hermitian_int32 + !call test_is_hermitian_int64 ! ! is_triangular @@ -674,135 +689,115 @@ end subroutine test_outer_product_int64 subroutine test_is_square_rsp real(sp) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_rsp" A_true = reshape([1.,2.,3.,4.],[2,2]) A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_rsp subroutine test_is_square_rdp real(dp) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_rdp" A_true = reshape([1.,2.,3.,4.],[2,2]) A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_rdp subroutine test_is_square_rqp real(qp) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_rqp" A_true = reshape([1.,2.,3.,4.],[2,2]) A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_rqp subroutine test_is_square_csp complex(sp) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_csp" A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_csp subroutine test_is_square_cdp complex(dp) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_cdp" A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_cdp subroutine test_is_square_cqp complex(qp) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_cqp" A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_cqp subroutine test_is_square_int8 integer(int8) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_int8" A_true = reshape([1,2,3,4],[2,2]) A_false = reshape([1,2,3,4,5,6],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_int8 subroutine test_is_square_int16 integer(int16) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_int16" A_true = reshape([1,2,3,4],[2,2]) A_false = reshape([1,2,3,4,5,6],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_int16 subroutine test_is_square_int32 integer(int32) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_int32" A_true = reshape([1,2,3,4],[2,2]) A_false = reshape([1,2,3,4,5,6],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_int32 subroutine test_is_square_int64 integer(int64) :: A_true(2,2), A_false(2,3) - logical :: should_be_true, should_be_false, true_when_working write(*,*) "test_is_square_int64" A_true = reshape([1,2,3,4],[2,2]) A_false = reshape([1,2,3,4,5,6],[2,3]) - should_be_true = is_square(A_true) - should_be_false = is_square(A_false) - true_when_working = (should_be_true .and. (.not. should_be_false)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) end subroutine test_is_square_int64 @@ -810,99 +805,82 @@ subroutine test_is_diagonal_rsp real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices real(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_rsp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1.,0.,0.,4.],[2,2]) A_false_s = reshape([1.,0.,3.,4.],[2,2]) A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_rsp subroutine test_is_diagonal_rdp real(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices real(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices real(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_rdp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1.,0.,0.,4.],[2,2]) A_false_s = reshape([1.,0.,3.,4.],[2,2]) A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_rdp subroutine test_is_diagonal_rqp real(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices real(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices real(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_rqp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1.,0.,0.,4.],[2,2]) A_false_s = reshape([1.,0.,3.,4.],[2,2]) A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_rqp subroutine test_is_diagonal_csp complex(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices complex(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices complex(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_csp" - !generate diagonal and non-diagonal matrices of 3 types A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(4.,1.)],[2,2]) A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -917,32 +895,25 @@ subroutine test_is_diagonal_csp cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - !test generated matrices - should_be_true_s = is_diagonal(A_true_s) - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - !combine results - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_csp subroutine test_is_diagonal_cdp complex(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices complex(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices complex(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_cdp" - !generate diagonal and non-diagonal matrices of 3 types A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(4.,1.)],[2,2]) A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -957,32 +928,25 @@ subroutine test_is_diagonal_cdp cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - !test generated matrices - should_be_true_s = is_diagonal(A_true_s) - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - !combine results - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_cdp subroutine test_is_diagonal_cqp complex(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices complex(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices complex(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_cqp" - !generate diagonal and non-diagonal matrices of 3 types A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(4.,1.)],[2,2]) A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -997,190 +961,165 @@ subroutine test_is_diagonal_cqp cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - !test generated matrices - should_be_true_s = is_diagonal(A_true_s) - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - !combine results - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_cqp subroutine test_is_diagonal_int8 integer(int8) :: A_true_s(2,2), A_false_s(2,2) !square matrices integer(int8) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices integer(int8) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_int8" - A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1,0,0,4],[2,2]) A_false_s = reshape([1,0,3,4],[2,2]) A_true_sf = reshape([1,0,0,4,0,0],[2,3]) A_false_sf = reshape([1,0,3,4,0,0],[2,3]) A_true_ts = reshape([1,0,0,0,5,0],[3,2]) A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_int8 subroutine test_is_diagonal_int16 integer(int16) :: A_true_s(2,2), A_false_s(2,2) !square matrices integer(int16) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices integer(int16) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_int16" - A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1,0,0,4],[2,2]) A_false_s = reshape([1,0,3,4],[2,2]) A_true_sf = reshape([1,0,0,4,0,0],[2,3]) A_false_sf = reshape([1,0,3,4,0,0],[2,3]) A_true_ts = reshape([1,0,0,0,5,0],[3,2]) A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_int16 subroutine test_is_diagonal_int32 integer(int32) :: A_true_s(2,2), A_false_s(2,2) !square matrices integer(int32) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices integer(int32) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_int32" - A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1,0,0,4],[2,2]) A_false_s = reshape([1,0,3,4],[2,2]) A_true_sf = reshape([1,0,0,4,0,0],[2,3]) A_false_sf = reshape([1,0,3,4,0,0],[2,3]) A_true_ts = reshape([1,0,0,0,5,0],[3,2]) A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_int32 subroutine test_is_diagonal_int64 integer(int64) :: A_true_s(2,2), A_false_s(2,2) !square matrices integer(int64) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices integer(int64) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - logical :: should_be_true_s, should_be_false_s, true_when_working_s - logical :: should_be_true_sf, should_be_false_sf, true_when_working_sf - logical :: should_be_true_ts, should_be_false_ts, true_when_working_ts - logical :: true_when_working write(*,*) "test_is_diagonal_int64" - A_true_s = reshape([1,0,0,4],[2,2]) !generate diagonal and non-diagonal matrices of 3 types + A_true_s = reshape([1,0,0,4],[2,2]) A_false_s = reshape([1,0,3,4],[2,2]) A_true_sf = reshape([1,0,0,4,0,0],[2,3]) A_false_sf = reshape([1,0,3,4,0,0],[2,3]) A_true_ts = reshape([1,0,0,0,5,0],[3,2]) A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - should_be_true_s = is_diagonal(A_true_s) !test generated matrices - should_be_false_s = is_diagonal(A_false_s) - should_be_true_sf = is_diagonal(A_true_sf) - should_be_false_sf = is_diagonal(A_false_sf) - should_be_true_ts = is_diagonal(A_true_ts) - should_be_false_ts = is_diagonal(A_false_ts) - true_when_working_s = (should_be_true_s .and. (.not. should_be_false_s)) !combine results - true_when_working_sf = (should_be_true_sf .and. (.not. should_be_false_sf)) - true_when_working_ts = (should_be_true_ts .and. (.not. should_be_false_ts)) - true_when_working = (true_when_working_s .and. true_when_working_sf .and. true_when_working_ts) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) end subroutine test_is_diagonal_int64 subroutine test_is_symmetric_rsp real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_rsp" A_true = reshape([1.,2.,2.,4.],[2,2]) A_false_1 = reshape([1.,2.,3.,4.],[2,2]) A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_rsp subroutine test_is_symmetric_rdp real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_rdp" A_true = reshape([1.,2.,2.,4.],[2,2]) A_false_1 = reshape([1.,2.,3.,4.],[2,2]) A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_rdp subroutine test_is_symmetric_rqp real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_rqp" A_true = reshape([1.,2.,2.,4.],[2,2]) A_false_1 = reshape([1.,2.,3.,4.],[2,2]) A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_rqp subroutine test_is_symmetric_csp complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_csp" A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & cmplx(2.,1.),cmplx(4.,1.)],[2,2]) @@ -1188,18 +1127,16 @@ subroutine test_is_symmetric_csp cmplx(3.,1.),cmplx(4.,1.)],[2,2]) A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_csp subroutine test_is_symmetric_cdp complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_cdp" A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & cmplx(2.,1.),cmplx(4.,1.)],[2,2]) @@ -1207,18 +1144,16 @@ subroutine test_is_symmetric_cdp cmplx(3.,1.),cmplx(4.,1.)],[2,2]) A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_cdp subroutine test_is_symmetric_cqp complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_cqp" A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & cmplx(2.,1.),cmplx(4.,1.)],[2,2]) @@ -1226,131 +1161,115 @@ subroutine test_is_symmetric_cqp cmplx(3.,1.),cmplx(4.,1.)],[2,2]) A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_cqp subroutine test_is_symmetric_int8 integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_int8" A_true = reshape([1,2,2,4],[2,2]) A_false_1 = reshape([1,2,3,4],[2,2]) A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_int8 subroutine test_is_symmetric_int16 integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_int16" A_true = reshape([1,2,2,4],[2,2]) A_false_1 = reshape([1,2,3,4],[2,2]) A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_int16 subroutine test_is_symmetric_int32 integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_int32" A_true = reshape([1,2,2,4],[2,2]) A_false_1 = reshape([1,2,3,4],[2,2]) A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_int32 subroutine test_is_symmetric_int64 integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_symmetric_int64" A_true = reshape([1,2,2,4],[2,2]) A_false_1 = reshape([1,2,3,4],[2,2]) A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - should_be_true = is_symmetric(A_true) - should_be_false_1 = is_symmetric(A_false_1) - should_be_false_2 = is_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_symmetric_int64 subroutine test_is_skew_symmetric_rsp real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_rsp" A_true = reshape([0.,2.,-2.,0.],[2,2]) A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_rsp subroutine test_is_skew_symmetric_rdp real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_rdp" A_true = reshape([0.,2.,-2.,0.],[2,2]) A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_rdp subroutine test_is_skew_symmetric_rqp real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_rqp" A_true = reshape([0.,2.,-2.,0.],[2,2]) A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_rqp subroutine test_is_skew_symmetric_csp complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_csp" A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) @@ -1358,18 +1277,16 @@ subroutine test_is_skew_symmetric_csp -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_csp subroutine test_is_skew_symmetric_cdp complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_cdp" A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) @@ -1377,18 +1294,16 @@ subroutine test_is_skew_symmetric_cdp -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_cdp subroutine test_is_skew_symmetric_cqp complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_cqp" A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) @@ -1396,77 +1311,68 @@ subroutine test_is_skew_symmetric_cqp -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_cqp subroutine test_is_skew_symmetric_int8 integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_int8" A_true = reshape([0,2,-2,0],[2,2]) A_false_1 = reshape([0,2,-3,0],[2,2]) A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_int8 subroutine test_is_skew_symmetric_int16 integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_int16" A_true = reshape([0,2,-2,0],[2,2]) A_false_1 = reshape([0,2,-3,0],[2,2]) A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_int16 subroutine test_is_skew_symmetric_int32 integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_int32" A_true = reshape([0,2,-2,0],[2,2]) A_false_1 = reshape([0,2,-3,0],[2,2]) A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_int32 subroutine test_is_skew_symmetric_int64 integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - logical :: should_be_true, should_be_false_1, should_be_false_2, true_when_working write(*,*) "test_is_skew_symmetric_int64" A_true = reshape([0,2,-2,0],[2,2]) A_false_1 = reshape([0,2,-3,0],[2,2]) A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - should_be_true = is_skew_symmetric(A_true) - should_be_false_1 = is_skew_symmetric(A_false_1) - should_be_false_2 = is_skew_symmetric(A_false_2) - true_when_working = (should_be_true .and. (.not. should_be_false_1) & - .and. (.not. should_be_false_2)) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) end subroutine test_is_skew_symmetric_int64 @@ -1477,52 +1383,45 @@ subroutine test_is_triangular_rsp real(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) real(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices real(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_rsp" !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_rsp subroutine test_is_triangular_rdp @@ -1532,52 +1431,45 @@ subroutine test_is_triangular_rdp real(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) real(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices real(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_rdp" !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_rdp subroutine test_is_triangular_rqp @@ -1587,52 +1479,45 @@ subroutine test_is_triangular_rqp real(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) real(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices real(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_rqp" !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_rqp subroutine test_is_triangular_csp @@ -1642,17 +1527,10 @@ subroutine test_is_triangular_csp complex(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) complex(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices complex(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_csp" !upper triangular A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & cmplx(0.,0.),cmplx(4.,0.)],[2,2]) A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -1665,19 +1543,21 @@ subroutine test_is_triangular_csp cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(3.,1.),cmplx(4.,0.)],[2,2]) A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & @@ -1690,20 +1570,18 @@ subroutine test_is_triangular_csp cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_csp subroutine test_is_triangular_cdp @@ -1713,17 +1591,10 @@ subroutine test_is_triangular_cdp complex(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) complex(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices complex(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_cdp" !upper triangular A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & cmplx(0.,0.),cmplx(4.,0.)],[2,2]) A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -1736,19 +1607,21 @@ subroutine test_is_triangular_cdp cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(3.,1.),cmplx(4.,0.)],[2,2]) A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & @@ -1761,20 +1634,18 @@ subroutine test_is_triangular_cdp cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_cdp subroutine test_is_triangular_cqp @@ -1784,17 +1655,10 @@ subroutine test_is_triangular_cqp complex(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) complex(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices complex(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_cqp" !upper triangular A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & cmplx(0.,0.),cmplx(4.,0.)],[2,2]) A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -1807,19 +1671,21 @@ subroutine test_is_triangular_cqp cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) !generate triangular and non-triangular matrices of 3 types + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(3.,1.),cmplx(4.,0.)],[2,2]) A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & @@ -1832,20 +1698,18 @@ subroutine test_is_triangular_cqp cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_cqp subroutine test_is_triangular_int8 @@ -1855,52 +1719,45 @@ subroutine test_is_triangular_int8 integer(int8) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) integer(int8) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices integer(int8) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_int8" !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1,0,3,4],[2,2]) A_false_s_u = reshape([1,2,0,4],[2,2]) A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1,2,0,4],[2,2]) A_false_s_l = reshape([1,0,3,4],[2,2]) A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_int8 subroutine test_is_triangular_int16 @@ -1910,52 +1767,45 @@ subroutine test_is_triangular_int16 integer(int16) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) integer(int16) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices integer(int16) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_int16" !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1,0,3,4],[2,2]) A_false_s_u = reshape([1,2,0,4],[2,2]) A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1,2,0,4],[2,2]) A_false_s_l = reshape([1,0,3,4],[2,2]) A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_int16 subroutine test_is_triangular_int32 @@ -1965,52 +1815,45 @@ subroutine test_is_triangular_int32 integer(int32) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) integer(int32) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices integer(int32) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_int32" !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1,0,3,4],[2,2]) A_false_s_u = reshape([1,2,0,4],[2,2]) A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1,2,0,4],[2,2]) A_false_s_l = reshape([1,0,3,4],[2,2]) A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_int32 subroutine test_is_triangular_int64 @@ -2020,52 +1863,45 @@ subroutine test_is_triangular_int64 integer(int64) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) integer(int64) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices integer(int64) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_triangular_int64" !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_u = reshape([1,0,3,4],[2,2]) A_false_s_u = reshape([1,2,0,4],[2,2]) A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - should_be_true_s_u = is_triangular(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_triangular(A_false_s_u,'u') - should_be_true_sf_u = is_triangular(A_true_sf_u,'u') - should_be_false_sf_u = is_triangular(A_false_sf_u,'u') - should_be_true_ts_u = is_triangular(A_true_ts_u,'U') - should_be_false_ts_u = is_triangular(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) !generate triangular and non-triangular matrices of 3 types + A_true_s_l = reshape([1,2,0,4],[2,2]) A_false_s_l = reshape([1,0,3,4],[2,2]) A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - should_be_true_s_l = is_triangular(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_triangular(A_false_s_l,'l') - should_be_true_sf_l = is_triangular(A_true_sf_l,'l') - should_be_false_sf_l = is_triangular(A_false_sf_l,'l') - should_be_true_ts_l = is_triangular(A_true_ts_l,'L') - should_be_false_ts_l = is_triangular(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_triangular_int64 @@ -2076,54 +1912,45 @@ subroutine test_is_hessenberg_rsp real(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) real(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices real(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_rsp" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_rsp subroutine test_is_hessenberg_rdp @@ -2133,54 +1960,45 @@ subroutine test_is_hessenberg_rdp real(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) real(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices real(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_rdp" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_rdp subroutine test_is_hessenberg_rqp @@ -2190,54 +2008,45 @@ subroutine test_is_hessenberg_rqp real(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) real(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices real(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_rqp" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_rqp subroutine test_is_hessenberg_csp @@ -2247,16 +2056,8 @@ subroutine test_is_hessenberg_csp complex(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) complex(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices complex(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_csp" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) @@ -2277,18 +2078,19 @@ subroutine test_is_hessenberg_csp A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) @@ -2309,20 +2111,18 @@ subroutine test_is_hessenberg_csp A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_csp subroutine test_is_hessenberg_cdp @@ -2332,16 +2132,8 @@ subroutine test_is_hessenberg_cdp complex(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) complex(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices complex(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_cdp" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) @@ -2362,18 +2154,19 @@ subroutine test_is_hessenberg_cdp A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) @@ -2394,20 +2187,18 @@ subroutine test_is_hessenberg_cdp A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_cdp subroutine test_is_hessenberg_cqp @@ -2417,16 +2208,8 @@ subroutine test_is_hessenberg_cqp complex(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) complex(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices complex(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_cqp" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) @@ -2447,18 +2230,19 @@ subroutine test_is_hessenberg_cqp A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) @@ -2479,20 +2263,18 @@ subroutine test_is_hessenberg_cqp A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_cqp subroutine test_is_hessenberg_int8 @@ -2502,54 +2284,45 @@ subroutine test_is_hessenberg_int8 integer(int8) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) integer(int8) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices integer(int8) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_int8" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_int8 subroutine test_is_hessenberg_int16 @@ -2559,54 +2332,45 @@ subroutine test_is_hessenberg_int16 integer(int16) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) integer(int16) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices integer(int16) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_int16" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_int16 subroutine test_is_hessenberg_int32 @@ -2616,54 +2380,45 @@ subroutine test_is_hessenberg_int32 integer(int32) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) integer(int32) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices integer(int32) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_int32" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_int32 subroutine test_is_hessenberg_int64 @@ -2673,54 +2428,45 @@ subroutine test_is_hessenberg_int64 integer(int64) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) integer(int64) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices integer(int64) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - logical :: should_be_true_s_u, should_be_false_s_u, true_when_working_s_u !upper logicals - logical :: should_be_true_sf_u, should_be_false_sf_u, true_when_working_sf_u - logical :: should_be_true_ts_u, should_be_false_ts_u, true_when_working_ts_u - logical :: should_be_true_s_l, should_be_false_s_l, true_when_working_s_l !lower logicals - logical :: should_be_true_sf_l, should_be_false_sf_l, true_when_working_sf_l - logical :: should_be_true_ts_l, should_be_false_ts_l, true_when_working_ts_l - logical :: true_when_working_u, true_when_working_l, true_when_working write(*,*) "test_is_hessenberg_int64" !upper hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - should_be_true_s_u = is_hessenberg(A_true_s_u,'u') !test generated matrices - should_be_false_s_u = is_hessenberg(A_false_s_u,'u') - should_be_true_sf_u = is_hessenberg(A_true_sf_u,'u') - should_be_false_sf_u = is_hessenberg(A_false_sf_u,'u') - should_be_true_ts_u = is_hessenberg(A_true_ts_u,'U') - should_be_false_ts_u = is_hessenberg(A_false_ts_u,'U') - true_when_working_s_u = (should_be_true_s_u .and. (.not. should_be_false_s_u)) !combine results - true_when_working_sf_u = (should_be_true_sf_u .and. (.not. should_be_false_sf_u)) - true_when_working_ts_u = (should_be_true_ts_u .and. (.not. should_be_false_ts_u)) - true_when_working_u = (true_when_working_s_u .and. true_when_working_sf_u .and. true_when_working_ts_u) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) !lower hessenberg - !generate hessenberg and non-hessenberg matrices of 3 types A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - should_be_true_s_l = is_hessenberg(A_true_s_l,'l') !test generated matrices - should_be_false_s_l = is_hessenberg(A_false_s_l,'l') - should_be_true_sf_l = is_hessenberg(A_true_sf_l,'l') - should_be_false_sf_l = is_hessenberg(A_false_sf_l,'l') - should_be_true_ts_l = is_hessenberg(A_true_ts_l,'L') - should_be_false_ts_l = is_hessenberg(A_false_ts_l,'L') - true_when_working_s_l = (should_be_true_s_l .and. (.not. should_be_false_s_l)) !combine results - true_when_working_sf_l = (should_be_true_sf_l .and. (.not. should_be_false_sf_l)) - true_when_working_ts_l = (should_be_true_ts_l .and. (.not. should_be_false_ts_l)) - true_when_working_l = (true_when_working_s_l .and. true_when_working_sf_l .and. true_when_working_ts_l) - !combine upper and lower results - true_when_working = (true_when_working_u .and. true_when_working_l) - call check(true_when_working, & - msg="true_when_working failed.",warn=warn) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) end subroutine test_is_hessenberg_int64 end program From 55e0dd0e1fd26fed7d178d0a8742a54695404675 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 30 Aug 2021 20:05:36 -0500 Subject: [PATCH 09/33] Extend is_hamiltonian to real types and add is_hamiltonian tests --- src/stdlib_linalg.fypp | 14 ++- src/tests/linalg/test_linalg.f90 | 172 +++++++++++++++++++++++++++++-- 2 files changed, 174 insertions(+), 12 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index ea08aa57b..c5a74c909 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -143,7 +143,7 @@ module stdlib_linalg !! !! Checks if a matrix (rank-2 array) is Hermitian !! ([Specification](../page/specs/stdlib_linalg.html#description_8)) - #:for k1, t1 in CMPLX_KINDS_TYPES + #:for k1, t1 in RCI_KINDS_TYPES module procedure is_hermitian_${t1[0]}$${k1}$ #:endfor end interface is_hermitian @@ -292,6 +292,18 @@ contains #:endfor + #:for k1, t1 in (REAL_KINDS_TYPES + INT_KINDS_TYPES) + pure function is_hermitian_${t1[0]}$${k1}$(A) result(res) + ${t1}$, intent(in) :: A(:,:) + logical :: res + integer :: A_shape(2), n, i, j + if (.not. is_square(A)) then + res = .false. + return !nonsquare matrices cannot be Hermitian + end if + res = is_symmetric(A) !real symmetric matrices are Hermitian + end function is_hermitian_${t1[0]}$${k1}$ + #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES pure function is_hermitian_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index 62a8e25a5..8369b8295 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -3,7 +3,7 @@ program test_linalg use stdlib_error, only: check use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal, & - is_symmetric, is_skew_symmetric, is_triangular, is_hessenberg + is_symmetric, is_skew_symmetric, is_hermitian, is_triangular, is_hessenberg implicit none @@ -140,18 +140,18 @@ program test_linalg ! ! is_hermitian ! - !call test_is_hermitian_rsp - !call test_is_hermitian_rdp - !call test_is_hermitian_rqp + call test_is_hermitian_rsp + call test_is_hermitian_rdp + call test_is_hermitian_rqp - !call test_is_hermitian_csp - !call test_is_hermitian_cdp - !call test_is_hermitian_cqp + call test_is_hermitian_csp + call test_is_hermitian_cdp + call test_is_hermitian_cqp - !call test_is_hermitian_int8 - !call test_is_hermitian_int16 - !call test_is_hermitian_int32 - !call test_is_hermitian_int64 + call test_is_hermitian_int8 + call test_is_hermitian_int16 + call test_is_hermitian_int32 + call test_is_hermitian_int64 ! ! is_triangular @@ -1376,6 +1376,156 @@ subroutine test_is_skew_symmetric_int64 end subroutine test_is_skew_symmetric_int64 + subroutine test_is_hermitian_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rsp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rsp + + subroutine test_is_hermitian_rdp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rdp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rdp + + subroutine test_is_hermitian_rqp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rqp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rqp + + subroutine test_is_hermitian_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_csp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_csp + + subroutine test_is_hermitian_cdp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_cdp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_cdp + + subroutine test_is_hermitian_cqp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_cqp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_cqp + + subroutine test_is_hermitian_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int8" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int8 + + subroutine test_is_hermitian_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int16" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int16 + + subroutine test_is_hermitian_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int32" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int32 + + subroutine test_is_hermitian_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int64" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int64 + + subroutine test_is_triangular_rsp real(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) real(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices From fd8fcf1e046c4e1cf7e2d39aaa635947d1fdf923 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Wed, 1 Sep 2021 23:47:40 -0500 Subject: [PATCH 10/33] Replace A_shape with size() calls --- src/stdlib_linalg.fypp | 41 ++++++++++++++++------------------------- 1 file changed, 16 insertions(+), 25 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index c5a74c909..aede02402 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -207,9 +207,7 @@ contains pure function is_square_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - integer :: A_shape(2) - A_shape = shape(A) - res = (A_shape(1) .eq. A_shape(2)) + res = (size(A,1) .eq. size(A,2)) end function is_square_${t1[0]}$${k1}$ #:endfor @@ -219,11 +217,10 @@ contains ${t1}$, intent(in) :: A(:,:) logical :: res ${t1}$ :: zero - integer :: A_shape(2), m, n, o, i, j + integer :: m, n, o, i, j zero = 0 !zero of relevant type - A_shape = shape(A) - m = A_shape(1) - n = A_shape(2) + m = size(A,1) + n = size(A,2) do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i = 1, o !loop over rows above diagonal @@ -248,13 +245,12 @@ contains pure function is_symmetric_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - integer :: A_shape(2), n, i, j + integer :: n, i, j if (.not. is_square(A)) then res = .false. return !nonsquare matrices cannot be symmetric end if - A_shape = shape(A) - n = A_shape(1) !symmetric dimension of A + n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j-1 !loop over all rows above diagonal if (.not. (A(i,j) .eq. A(j,i))) then @@ -272,13 +268,12 @@ contains pure function is_skew_symmetric_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - integer :: A_shape(2), n, i, j + integer :: n, i, j if (.not. is_square(A)) then res = .false. return !nonsquare matrices cannot be skew-symmetric end if - A_shape = shape(A) - n = A_shape(1) !symmetric dimension of A + n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j !loop over all rows above diagonal (and diagonal) if (.not. (A(i,j) .eq. -A(j,i))) then @@ -296,7 +291,6 @@ contains pure function is_hermitian_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - integer :: A_shape(2), n, i, j if (.not. is_square(A)) then res = .false. return !nonsquare matrices cannot be Hermitian @@ -308,13 +302,12 @@ contains pure function is_hermitian_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - integer :: A_shape(2), n, i, j + integer :: n, i, j if (.not. is_square(A)) then res = .false. return !nonsquare matrices cannot be Hermitian end if - A_shape = shape(A) - n = A_shape(1) !symmetric dimension of A + n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j !loop over all rows above diagonal (and diagonal) if (.not. (A(i,j) .eq. conjg(A(j,i)))) then @@ -334,11 +327,10 @@ contains character, intent(in) :: uplo logical :: res ${t1}$ :: zero - integer :: A_shape(2), m, n, o, i, j + integer :: m, n, o, i, j zero = 0 !zero of relevant type - A_shape = shape(A) - m = A_shape(1) - n = A_shape(2) + m = size(A,1) + n = size(A,2) if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper triangularity do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) @@ -374,11 +366,10 @@ contains character, intent(in) :: uplo logical :: res ${t1}$ :: zero - integer :: A_shape(2), m, n, o, i, j + integer :: m, n, o, i, j zero = 0 !zero of relevant type - A_shape = shape(A) - m = A_shape(1) - n = A_shape(2) + m = size(A,1) + n = size(A,2) if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper Hessenberg do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) From 3196feace209339525f86e2d00ba162ab7e321ff Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 6 Sep 2021 13:50:46 -0500 Subject: [PATCH 11/33] Add docs and examples --- doc/specs/stdlib_linalg.md | 282 +++++++++++++++++++++++++++++++++++++ 1 file changed, 282 insertions(+) diff --git a/doc/specs/stdlib_linalg.md b/doc/specs/stdlib_linalg.md index cab16279c..9314d1a15 100644 --- a/doc/specs/stdlib_linalg.md +++ b/doc/specs/stdlib_linalg.md @@ -206,3 +206,285 @@ program demo_outer_product !A = reshape([3., 6., 9., 4., 8., 12.], [3,2]) end program demo_outer_product ``` + +## `is_square` - Checks if a matrix is square + +### Status + +Experimental + +### Description + +Checks if a matrix is square + +### Syntax + +`d = [[stdlib_linalg(module):is_square(interface)]](A)` + +### Arguments + +`A`: Shall be a rank-2 array + +### Return value + +Returns a logical value that is true if the input matrix is square, and false otherwise. + +### Example + +```fortran +program demo_is_square + use stdlib_linalg, only: is_square + implicit none + real :: A_true(2,2), A_false(3,2) + logical :: res + A_true = reshape([1., 2., 3., 4.], shape(A_true)) + A_false = reshape([1., 2., 3., 4., 5., 6.], shape(A_false)) + res = is_square(A_true) + !res = .true. + res = is_square(A_false) + !res = .false. +end program demo_is_square +``` + +## `is_diagonal` - Checks if a matrix is diagonal + +### Status + +Experimental + +### Description + +Checks if a matrix is diagonal + +### Syntax + +`d = [[stdlib_linalg(module):is_diagonal(interface)]](A)` + +### Arguments + +`A`: Shall be a rank-2 array + +### Return value + +Returns a logical value that is true if the input matrix is diagonal, and false otherwise. +Note that nonsquare matrices may be diagonal, so long as `a_ij = 0` when `i /= j`. + +### Example + +```fortran +program demo_is_diagonal + use stdlib_linalg, only: is_diagonal + implicit none + real :: A_true(2,2), A_false(2,2) + logical :: res + A_true = reshape([1., 0., 0., 4.], shape(A_true)) + A_false = reshape([1., 0., 3., 4.], shape(A_false)) + res = is_diagonal(A_true) + !res = .true. + res = is_diagonal(A_false) + !res = .false. +end program demo_is_diagonal +``` + +## `is_symmetric` - Checks if a matrix is symmetric + +### Status + +Experimental + +### Description + +Checks if a matrix is symmetric + +### Syntax + +`d = [[stdlib_linalg(module):is_symmetric(interface)]](A)` + +### Arguments + +`A`: Shall be a rank-2 array + +### Return value + +Returns a logical value that is true if the input matrix is symmetric, and false otherwise. + +### Example + +```fortran +program demo_is_symmetric + use stdlib_linalg, only: is_symmetric + implicit none + real :: A_true(2,2), A_false(2,2) + logical :: res + A_true = reshape([1., 3., 3., 4.], shape(A_true)) + A_false = reshape([1., 0., 3., 4.], shape(A_false)) + res = is_symmetric(A_true) + !res = .true. + res = is_symmetric(A_false) + !res = .false. +end program demo_is_symmetric +``` + +## `is_skew_symmetric` - Checks if a matrix is skew-symmetric + +### Status + +Experimental + +### Description + +Checks if a matrix is skew-symmetric + +### Syntax + +`d = [[stdlib_linalg(module):is_skew_symmetric(interface)]](A)` + +### Arguments + +`A`: Shall be a rank-2 array + +### Return value + +Returns a logical value that is true if the input matrix is skew-symmetric, and false otherwise. + +### Example + +```fortran +program demo_is_skew_symmetric + use stdlib_linalg, only: is_skew_symmetric + implicit none + real :: A_true(2,2), A_false(2,2) + logical :: res + A_true = reshape([0., -3., 3., 0.], shape(A_true)) + A_false = reshape([0., 3., 3., 0.], shape(A_false)) + res = is_skew_symmetric(A_true) + !res = .true. + res = is_skew_symmetric(A_false) + !res = .false. +end program demo_is_skew_symmetric +``` + +## `is_hermitian` - Checks if a matrix is Hermitian + +### Status + +Experimental + +### Description + +Checks if a matrix is Hermitian + +### Syntax + +`d = [[stdlib_linalg(module):is_hermitian(interface)]](A)` + +### Arguments + +`A`: Shall be a rank-2 array + +### Return value + +Returns a logical value that is true if the input matrix is Hermitian, and false otherwise. + +### Example + +```fortran +program demo_is_hermitian + use stdlib_linalg, only: is_hermitian + implicit none + complex :: A_true(2,2), A_false(2,2) + logical :: res + A_true = reshape([cmplx(1.,0.), cmplx(3.,-1.), cmplx(3.,1.), cmplx(4.,0.)], shape(A_true)) + A_false = reshape([cmplx(1.,0.), cmplx(3.,1.), cmplx(3.,1.), cmplx(4.,0.)], shape(A_false)) + res = is_hermitian(A_true) + !res = .true. + res = is_hermitian(A_false) + !res = .false. +end program demo_is_hermitian +``` + +## `is_triangular` - Checks if a matrix is triangular + +### Status + +Experimental + +### Description + +Checks if a matrix is triangular + +### Syntax + +`d = [[stdlib_linalg(module):is_triangular(interface)]](A,uplo)` + +### Arguments + +`A`: Shall be a rank-2 array + +`uplo`: Shall be a single character from `{'u','U','l','L'}` + +### Return value + +Returns a logical value that is true if the input matrix is the type of triangular specified by `uplo` (upper or lower), and false otherwise. +Note that the definition of triangular used here allows nonsquare matrices to be triangular. +Specifically, upper triangular matrices satisfy `a_ij = 0` when `j < i`, and lower triangular matrices satisfy `a_ij = 0` when `j > i`. + +### Example + +```fortran +program demo_is_triangular + use stdlib_linalg, only: is_triangular + implicit none + real :: A_true(3,3), A_false(3,3) + logical :: res + A_true = reshape([1., 0., 0., 4., 5., 0., 7., 8., 9.], shape(A_true)) + A_false = reshape([1., 0., 3., 4., 5., 0., 7., 8., 9.], shape(A_false)) + res = is_triangular(A_true,'u') + !res = .true. + res = is_triangular(A_false,'u') + !res = .false. +end program demo_is_triangular +``` + +## `is_hessenberg` - Checks if a matrix is hessenberg + +### Status + +Experimental + +### Description + +Checks if a matrix is Hessenberg + +### Syntax + +`d = [[stdlib_linalg(module):is_hessenberg(interface)]](A,uplo)` + +### Arguments + +`A`: Shall be a rank-2 array + +`uplo`: Shall be a single character from `{'u','U','l','L'}` + +### Return value + +Returns a logical value that is true if the input matrix is the type of Hessenberg specified by `uplo` (upper or lower), and false otherwise. +Note that the definition of Hessenberg used here allows nonsquare matrices to be Hessenberg. +Specifically, upper Hessenberg matrices satisfy `a_ij = 0` when `j < i-1`, and lower Hessenberg matrices satisfy `a_ij = 0` when `j > i+1`. + +### Example + +```fortran +program demo_is_hessenberg + use stdlib_linalg, only: is_hessenberg + implicit none + real :: A_true(3,3), A_false(3,3) + logical :: res + A_true = reshape([1., 2., 0., 4., 5., 6., 7., 8., 9.], shape(A_true)) + A_false = reshape([1., 2., 3., 4., 5., 6., 7., 8., 9.], shape(A_false)) + res = is_hessenberg(A_true,'u') + !res = .true. + res = is_hessenberg(A_false,'u') + !res = .false. +end program demo_is_hessenberg +``` \ No newline at end of file From c31200f5bfe880d3e92a26f1dfdd91b5386e1657 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 6 Sep 2021 15:43:52 -0500 Subject: [PATCH 12/33] Add stdlib_error dependency to stdlib_linalg for GNU make --- src/Makefile.manual | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9e78df5d8..8065df887 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -83,6 +83,7 @@ stdlib_io.o: \ stdlib_kinds.o stdlib_linalg.o: \ stdlib_kinds.o + stdlib_error.o stdlib_linalg_diag.o: \ stdlib_linalg.o \ stdlib_kinds.o From ce2722d118f7b264c2e57021e5915a84d60d6344 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 6 Sep 2021 15:51:52 -0500 Subject: [PATCH 13/33] Add missing slash to broken GNU makefile --- src/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 8065df887..38a6ed662 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -82,7 +82,7 @@ stdlib_io.o: \ stdlib_optval.o \ stdlib_kinds.o stdlib_linalg.o: \ - stdlib_kinds.o + stdlib_kinds.o \ stdlib_error.o stdlib_linalg_diag.o: \ stdlib_linalg.o \ From 0da0d7d645212758af8bff7691a8afdf7b2bb457 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 27 Sep 2021 10:03:56 -0500 Subject: [PATCH 14/33] Change (.not * .eq *) to (* .ne. *) for brevity --- src/stdlib_linalg.fypp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index aede02402..dd2cfb854 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -224,13 +224,13 @@ contains do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i = 1, o !loop over rows above diagonal - if (.not. (A(i,j) .eq. zero)) then + if (A(i,j) .ne. zero) then res = .false. return end if end do do i = o+2, m !loop over rows below diagonal - if (.not. (A(i,j) .eq. zero)) then + if (A(i,j) .ne. zero) then res = .false. return end if @@ -253,7 +253,7 @@ contains n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j-1 !loop over all rows above diagonal - if (.not. (A(i,j) .eq. A(j,i))) then + if (A(i,j) .ne. A(j,i)) then res = .false. return end if @@ -276,7 +276,7 @@ contains n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j !loop over all rows above diagonal (and diagonal) - if (.not. (A(i,j) .eq. -A(j,i))) then + if (A(i,j) .ne. -A(j,i)) then res = .false. return end if @@ -310,7 +310,7 @@ contains n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j !loop over all rows above diagonal (and diagonal) - if (.not. (A(i,j) .eq. conjg(A(j,i)))) then + if (A(i,j) .ne. conjg(A(j,i))) then res = .false. return end if @@ -335,7 +335,7 @@ contains do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i = o+2, m !loop over rows below diagonal - if (.not. (A(i,j) .eq. zero)) then + if (A(i,j) .ne. zero) then res = .false. return end if @@ -345,7 +345,7 @@ contains do j=1,n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i=1,o !loop over rows above diagonal - if (.not. (A(i,j) .eq. zero)) then + if (A(i,j) .ne. zero) then res = .false. return end if @@ -374,7 +374,7 @@ contains do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) do i = o+4, m !loop over rows two or more below main diagonal - if (.not. (A(i,j) .eq. zero)) then + if (A(i,j) .ne. zero) then res = .false. return end if @@ -384,7 +384,7 @@ contains do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) do i = 1, o !loop over rows one or more above main diagonal - if (.not. (A(i,j) .eq. zero)) then + if (A(i,j) .ne. zero) then res = .false. return end if From 1a9ddb3e28e747126c7ba5345ef94a5b9b29df9c Mon Sep 17 00:00:00 2001 From: GHBrown Date: Tue, 28 Sep 2021 09:23:01 -0500 Subject: [PATCH 15/33] Switch to modern relational operators --- src/stdlib_linalg.fypp | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index dd2cfb854..418aae5ee 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -207,7 +207,7 @@ contains pure function is_square_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - res = (size(A,1) .eq. size(A,2)) + res = (size(A,1) == size(A,2)) end function is_square_${t1[0]}$${k1}$ #:endfor @@ -224,13 +224,13 @@ contains do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i = 1, o !loop over rows above diagonal - if (A(i,j) .ne. zero) then + if (A(i,j) /= zero) then res = .false. return end if end do do i = o+2, m !loop over rows below diagonal - if (A(i,j) .ne. zero) then + if (A(i,j) /= zero) then res = .false. return end if @@ -253,7 +253,7 @@ contains n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j-1 !loop over all rows above diagonal - if (A(i,j) .ne. A(j,i)) then + if (A(i,j) /= A(j,i)) then res = .false. return end if @@ -276,7 +276,7 @@ contains n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j !loop over all rows above diagonal (and diagonal) - if (A(i,j) .ne. -A(j,i)) then + if (A(i,j) /= -A(j,i)) then res = .false. return end if @@ -310,7 +310,7 @@ contains n = size(A,1) !symmetric dimension of A do j = 1, n !loop over all columns do i = 1, j !loop over all rows above diagonal (and diagonal) - if (A(i,j) .ne. conjg(A(j,i))) then + if (A(i,j) /= conjg(A(j,i))) then res = .false. return end if @@ -331,21 +331,21 @@ contains zero = 0 !zero of relevant type m = size(A,1) n = size(A,2) - if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper triangularity + if ((uplo == 'u') .or. (uplo == 'U')) then !check for upper triangularity do j = 1, n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i = o+2, m !loop over rows below diagonal - if (A(i,j) .ne. zero) then + if (A(i,j) /= zero) then res = .false. return end if end do end do - else if ((uplo .eq. 'l') .or. (uplo .eq. 'L')) then !check for lower triangularity + else if ((uplo == 'l') .or. (uplo == 'L')) then !check for lower triangularity do j=1,n !loop over all columns o = min(j-1,m) !index of row above diagonal (or last row) do i=1,o !loop over rows above diagonal - if (A(i,j) .ne. zero) then + if (A(i,j) /= zero) then res = .false. return end if @@ -370,21 +370,21 @@ contains zero = 0 !zero of relevant type m = size(A,1) n = size(A,2) - if ((uplo .eq. 'u') .or. (uplo .eq. 'U')) then !check for upper Hessenberg + if ((uplo == 'u') .or. (uplo == 'U')) then !check for upper Hessenberg do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) do i = o+4, m !loop over rows two or more below main diagonal - if (A(i,j) .ne. zero) then + if (A(i,j) /= zero) then res = .false. return end if end do end do - else if ((uplo .eq. 'l') .or. (uplo .eq. 'L')) then !check for lower Hessenberg + else if ((uplo == 'l') .or. (uplo == 'L')) then !check for lower Hessenberg do j = 1, n !loop over all columns o = min(j-2,m) !index of row two above diagonal (or last row) do i = 1, o !loop over rows one or more above main diagonal - if (A(i,j) .ne. zero) then + if (A(i,j) /= zero) then res = .false. return end if From ed4221199881a37536b7a5e83dc6bcc9be20d9cc Mon Sep 17 00:00:00 2001 From: GHBrown Date: Wed, 29 Sep 2021 09:24:28 -0500 Subject: [PATCH 16/33] Change style of output comments in docs --- doc/specs/stdlib_linalg.md | 84 ++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 49 deletions(-) diff --git a/doc/specs/stdlib_linalg.md b/doc/specs/stdlib_linalg.md index 9314d1a15..549a07f21 100644 --- a/doc/specs/stdlib_linalg.md +++ b/doc/specs/stdlib_linalg.md @@ -235,14 +235,12 @@ Returns a logical value that is true if the input matrix is square, and false ot program demo_is_square use stdlib_linalg, only: is_square implicit none - real :: A_true(2,2), A_false(3,2) + real :: A(2,2), B(3,2) logical :: res - A_true = reshape([1., 2., 3., 4.], shape(A_true)) - A_false = reshape([1., 2., 3., 4., 5., 6.], shape(A_false)) - res = is_square(A_true) - !res = .true. - res = is_square(A_false) - !res = .false. + A = reshape([1., 2., 3., 4.], shape(A)) + B = reshape([1., 2., 3., 4., 5., 6.], shape(B)) + res = is_square(A) ! returns .true. + res = is_square(B) ! returns .false. end program demo_is_square ``` @@ -275,14 +273,12 @@ Note that nonsquare matrices may be diagonal, so long as `a_ij = 0` when `i /= j program demo_is_diagonal use stdlib_linalg, only: is_diagonal implicit none - real :: A_true(2,2), A_false(2,2) + real :: A(2,2), B(2,2) logical :: res - A_true = reshape([1., 0., 0., 4.], shape(A_true)) - A_false = reshape([1., 0., 3., 4.], shape(A_false)) - res = is_diagonal(A_true) - !res = .true. - res = is_diagonal(A_false) - !res = .false. + A = reshape([1., 0., 0., 4.], shape(A)) + B = reshape([1., 0., 3., 4.], shape(B)) + res = is_diagonal(A) ! returns .true. + res = is_diagonal(B) ! returns .false. end program demo_is_diagonal ``` @@ -314,14 +310,12 @@ Returns a logical value that is true if the input matrix is symmetric, and false program demo_is_symmetric use stdlib_linalg, only: is_symmetric implicit none - real :: A_true(2,2), A_false(2,2) + real :: A(2,2), B(2,2) logical :: res - A_true = reshape([1., 3., 3., 4.], shape(A_true)) - A_false = reshape([1., 0., 3., 4.], shape(A_false)) - res = is_symmetric(A_true) - !res = .true. - res = is_symmetric(A_false) - !res = .false. + A = reshape([1., 3., 3., 4.], shape(A)) + B = reshape([1., 0., 3., 4.], shape(B)) + res = is_symmetric(A) ! returns .true. + res = is_symmetric(B) ! returns .false. end program demo_is_symmetric ``` @@ -353,14 +347,12 @@ Returns a logical value that is true if the input matrix is skew-symmetric, and program demo_is_skew_symmetric use stdlib_linalg, only: is_skew_symmetric implicit none - real :: A_true(2,2), A_false(2,2) + real :: A(2,2), B(2,2) logical :: res - A_true = reshape([0., -3., 3., 0.], shape(A_true)) - A_false = reshape([0., 3., 3., 0.], shape(A_false)) - res = is_skew_symmetric(A_true) - !res = .true. - res = is_skew_symmetric(A_false) - !res = .false. + A = reshape([0., -3., 3., 0.], shape(A)) + B = reshape([0., 3., 3., 0.], shape(B)) + res = is_skew_symmetric(A) ! returns .true. + res = is_skew_symmetric(B) ! returns .false. end program demo_is_skew_symmetric ``` @@ -392,14 +384,12 @@ Returns a logical value that is true if the input matrix is Hermitian, and false program demo_is_hermitian use stdlib_linalg, only: is_hermitian implicit none - complex :: A_true(2,2), A_false(2,2) + complex :: A(2,2), B(2,2) logical :: res - A_true = reshape([cmplx(1.,0.), cmplx(3.,-1.), cmplx(3.,1.), cmplx(4.,0.)], shape(A_true)) - A_false = reshape([cmplx(1.,0.), cmplx(3.,1.), cmplx(3.,1.), cmplx(4.,0.)], shape(A_false)) - res = is_hermitian(A_true) - !res = .true. - res = is_hermitian(A_false) - !res = .false. + A = reshape([cmplx(1.,0.), cmplx(3.,-1.), cmplx(3.,1.), cmplx(4.,0.)], shape(A)) + B = reshape([cmplx(1.,0.), cmplx(3.,1.), cmplx(3.,1.), cmplx(4.,0.)], shape(B)) + res = is_hermitian(A) ! returns .true. + res = is_hermitian(B) ! returns .false. end program demo_is_hermitian ``` @@ -435,14 +425,12 @@ Specifically, upper triangular matrices satisfy `a_ij = 0` when `j < i`, and low program demo_is_triangular use stdlib_linalg, only: is_triangular implicit none - real :: A_true(3,3), A_false(3,3) + real :: A(3,3), B(3,3) logical :: res - A_true = reshape([1., 0., 0., 4., 5., 0., 7., 8., 9.], shape(A_true)) - A_false = reshape([1., 0., 3., 4., 5., 0., 7., 8., 9.], shape(A_false)) - res = is_triangular(A_true,'u') - !res = .true. - res = is_triangular(A_false,'u') - !res = .false. + A = reshape([1., 0., 0., 4., 5., 0., 7., 8., 9.], shape(A)) + B = reshape([1., 0., 3., 4., 5., 0., 7., 8., 9.], shape(B)) + res = is_triangular(A,'u') ! returns .true. + res = is_triangular(B,'u') ! returns .false. end program demo_is_triangular ``` @@ -478,13 +466,11 @@ Specifically, upper Hessenberg matrices satisfy `a_ij = 0` when `j < i-1`, and l program demo_is_hessenberg use stdlib_linalg, only: is_hessenberg implicit none - real :: A_true(3,3), A_false(3,3) + real :: A(3,3), B(3,3) logical :: res - A_true = reshape([1., 2., 0., 4., 5., 6., 7., 8., 9.], shape(A_true)) - A_false = reshape([1., 2., 3., 4., 5., 6., 7., 8., 9.], shape(A_false)) - res = is_hessenberg(A_true,'u') - !res = .true. - res = is_hessenberg(A_false,'u') - !res = .false. + A = reshape([1., 2., 0., 4., 5., 6., 7., 8., 9.], shape(A)) + B = reshape([1., 2., 3., 4., 5., 6., 7., 8., 9.], shape(B)) + res = is_hessenberg(A,'u') ! returns .true. + res = is_hessenberg(B,'u') ! returns .false. end program demo_is_hessenberg ``` \ No newline at end of file From 58346ff9ed69674316e12c6245928fc99af4b8be Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sun, 3 Oct 2021 20:51:41 -0500 Subject: [PATCH 17/33] Remove doubled check for squareness --- src/stdlib_linalg.fypp | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 418aae5ee..cfe5691f7 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -291,11 +291,7 @@ contains pure function is_hermitian_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - if (.not. is_square(A)) then - res = .false. - return !nonsquare matrices cannot be Hermitian - end if - res = is_symmetric(A) !real symmetric matrices are Hermitian + res = is_symmetric(A) !symmetry and Hermiticity are equivalent for real matrices end function is_hermitian_${t1[0]}$${k1}$ #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES From a759929669f1a7d77e34a04d659b87e60f331b9b Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sun, 3 Oct 2021 20:56:48 -0500 Subject: [PATCH 18/33] Make zero variables into parameters --- src/stdlib_linalg.fypp | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index cfe5691f7..2675e89af 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -216,9 +216,8 @@ contains pure function is_diagonal_${t1[0]}$${k1}$(A) result(res) ${t1}$, intent(in) :: A(:,:) logical :: res - ${t1}$ :: zero + ${t1}$, parameter :: zero = 0 !zero of relevant type integer :: m, n, o, i, j - zero = 0 !zero of relevant type m = size(A,1) n = size(A,2) do j = 1, n !loop over all columns @@ -322,9 +321,8 @@ contains ${t1}$, intent(in) :: A(:,:) character, intent(in) :: uplo logical :: res - ${t1}$ :: zero + ${t1}$, parameter :: zero = 0 !zero of relevant type integer :: m, n, o, i, j - zero = 0 !zero of relevant type m = size(A,1) n = size(A,2) if ((uplo == 'u') .or. (uplo == 'U')) then !check for upper triangularity @@ -361,9 +359,8 @@ contains ${t1}$, intent(in) :: A(:,:) character, intent(in) :: uplo logical :: res - ${t1}$ :: zero + ${t1}$, parameter :: zero = 0 !zero of relevant type integer :: m, n, o, i, j - zero = 0 !zero of relevant type m = size(A,1) n = size(A,2) if ((uplo == 'u') .or. (uplo == 'U')) then !check for upper Hessenberg From 1915bbbe754e59b2841cc0c632ade12510743834 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sun, 3 Oct 2021 21:44:15 -0500 Subject: [PATCH 19/33] Clarify return value documentation --- doc/specs/stdlib_linalg.md | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/doc/specs/stdlib_linalg.md b/doc/specs/stdlib_linalg.md index 549a07f21..db8ddc06a 100644 --- a/doc/specs/stdlib_linalg.md +++ b/doc/specs/stdlib_linalg.md @@ -227,7 +227,7 @@ Checks if a matrix is square ### Return value -Returns a logical value that is true if the input matrix is square, and false otherwise. +Returns a `logical` scalar that is `.true.` if the input matrix is square, and `.false.` otherwise. ### Example @@ -264,7 +264,7 @@ Checks if a matrix is diagonal ### Return value -Returns a logical value that is true if the input matrix is diagonal, and false otherwise. +Returns a `logical` scalar that is `.true.` if the input matrix is diagonal, and `.false.` otherwise. Note that nonsquare matrices may be diagonal, so long as `a_ij = 0` when `i /= j`. ### Example @@ -302,7 +302,7 @@ Checks if a matrix is symmetric ### Return value -Returns a logical value that is true if the input matrix is symmetric, and false otherwise. +Returns a `logical` scalar that is `.true.` if the input matrix is symmetric, and `.false.` otherwise. ### Example @@ -339,7 +339,7 @@ Checks if a matrix is skew-symmetric ### Return value -Returns a logical value that is true if the input matrix is skew-symmetric, and false otherwise. +Returns a `logical` scalar that is `.true.` if the input matrix is skew-symmetric, and `.false.` otherwise. ### Example @@ -376,7 +376,7 @@ Checks if a matrix is Hermitian ### Return value -Returns a logical value that is true if the input matrix is Hermitian, and false otherwise. +Returns a `logical` scalar that is `.true.` if the input matrix is Hermitian, and `.false.` otherwise. ### Example @@ -415,8 +415,8 @@ Checks if a matrix is triangular ### Return value -Returns a logical value that is true if the input matrix is the type of triangular specified by `uplo` (upper or lower), and false otherwise. -Note that the definition of triangular used here allows nonsquare matrices to be triangular. +Returns a `logical` scalar that is `.true.` if the input matrix is the type of triangular specified by `uplo` (upper or lower), and `.false.` otherwise. +Note that the definition of triangular used in this implementation allows nonsquare matrices to be triangular. Specifically, upper triangular matrices satisfy `a_ij = 0` when `j < i`, and lower triangular matrices satisfy `a_ij = 0` when `j > i`. ### Example @@ -456,8 +456,8 @@ Checks if a matrix is Hessenberg ### Return value -Returns a logical value that is true if the input matrix is the type of Hessenberg specified by `uplo` (upper or lower), and false otherwise. -Note that the definition of Hessenberg used here allows nonsquare matrices to be Hessenberg. +Returns a `logical` scalar that is `.true.` if the input matrix is the type of Hessenberg specified by `uplo` (upper or lower), and `.false.` otherwise. +Note that the definition of Hessenberg used in this implementation allows nonsquare matrices to be Hessenberg. Specifically, upper Hessenberg matrices satisfy `a_ij = 0` when `j < i-1`, and lower Hessenberg matrices satisfy `a_ij = 0` when `j > i+1`. ### Example From 677c577f5ff77ec0027c29794ecfad1a09293ca5 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sun, 3 Oct 2021 22:08:00 -0500 Subject: [PATCH 20/33] Change to more specific documentation URLs --- src/stdlib_linalg.fypp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 2675e89af..db14311eb 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -94,7 +94,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is square - !! ([Specification](../page/specs/stdlib_linalg.html#description_4)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_square)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_square_${t1[0]}$${k1}$ #:endfor @@ -106,7 +106,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is diagonal - !! ([Specification](../page/specs/stdlib_linalg.html#description_5)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_diagonal)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_diagonal_${t1[0]}$${k1}$ #:endfor @@ -118,7 +118,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is symmetric - !! ([Specification](../page/specs/stdlib_linalg.html#description_6)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_symmetric)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_symmetric_${t1[0]}$${k1}$ #:endfor @@ -130,7 +130,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is skew-symmetric - !! ([Specification](../page/specs/stdlib_linalg.html#description_7)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_skew_symmetric)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_skew_symmetric_${t1[0]}$${k1}$ #:endfor @@ -142,7 +142,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is Hermitian - !! ([Specification](../page/specs/stdlib_linalg.html#description_8)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_hermitian)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_hermitian_${t1[0]}$${k1}$ #:endfor @@ -154,7 +154,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is triangular - !! ([Specification](../page/specs/stdlib_linalg.html#description_9)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_triangular)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_triangular_${t1[0]}$${k1}$ #:endfor @@ -166,7 +166,7 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is Hessenberg - !! ([Specification](../page/specs/stdlib_linalg.html#description_10)) + !! ([Specification](../page/specs/stdlib_linalg.html#is_hessenberg)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_Hessenberg_${t1[0]}$${k1}$ #:endfor From 080b552ee4a7924accbc8d727175da8b2370df80 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 4 Oct 2021 18:11:39 +0200 Subject: [PATCH 21/33] update links for FORD --- doc/specs/stdlib_linalg.md | 4 ++-- src/stdlib_linalg.fypp | 33 ++++++++++++++++++++++----------- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/doc/specs/stdlib_linalg.md b/doc/specs/stdlib_linalg.md index db8ddc06a..4dc3171f9 100644 --- a/doc/specs/stdlib_linalg.md +++ b/doc/specs/stdlib_linalg.md @@ -148,7 +148,7 @@ Trace of a matrix (rank-2 array) ### Syntax -`result = [stdlib_linalg(module):trace(interface)](A)` +`result = [[stdlib_linalg(module):trace(interface)]](A)` ### Arguments @@ -473,4 +473,4 @@ program demo_is_hessenberg res = is_hessenberg(A,'u') ! returns .true. res = is_hessenberg(B,'u') ! returns .false. end program demo_is_hessenberg -``` \ No newline at end of file +``` diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index db14311eb..8598af288 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -25,7 +25,8 @@ module stdlib_linalg !! version: experimental !! !! Creates a diagonal array or extract the diagonal elements of an array - !! ([Specification](../page/specs/stdlib_linalg.html#description)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! diag-create-a-diagonal-array-or-extract-the-diagonal-elements-of-an-array)) ! ! Vector to matrix ! @@ -67,7 +68,8 @@ module stdlib_linalg !! version: experimental !! !! Computes the trace of a matrix - !! ([Specification](../page/specs/stdlib_linalg.html#description_2)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! trace-trace-of-a-matrix)) #:for k1, t1 in RCI_KINDS_TYPES module procedure trace_${t1[0]}$${k1}$ #:endfor @@ -79,7 +81,8 @@ module stdlib_linalg !! version: experimental !! !! Computes the outer product of two vectors, returning a rank-2 array - !! ([Specification](../page/specs/stdlib_linalg.html#description_3)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! outer_product-computes-the-outer-product-of-two-vectors)) #:for k1, t1 in RCI_KINDS_TYPES pure module function outer_product_${t1[0]}$${k1}$(u, v) result(res) ${t1}$, intent(in) :: u(:), v(:) @@ -94,7 +97,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is square - !! ([Specification](../page/specs/stdlib_linalg.html#is_square)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_square-checks-if-a-matrix-is-square)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_square_${t1[0]}$${k1}$ #:endfor @@ -106,7 +110,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is diagonal - !! ([Specification](../page/specs/stdlib_linalg.html#is_diagonal)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_diagonal-checks-if-a-matrix-is-diagonal)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_diagonal_${t1[0]}$${k1}$ #:endfor @@ -118,7 +123,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is symmetric - !! ([Specification](../page/specs/stdlib_linalg.html#is_symmetric)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_symmetric-checks-if-a-matrix-is-symmetric)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_symmetric_${t1[0]}$${k1}$ #:endfor @@ -130,7 +136,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is skew-symmetric - !! ([Specification](../page/specs/stdlib_linalg.html#is_skew_symmetric)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_skew_symmetric-checks-if-a-matrix-is-skew-symmetric)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_skew_symmetric_${t1[0]}$${k1}$ #:endfor @@ -142,7 +149,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is Hermitian - !! ([Specification](../page/specs/stdlib_linalg.html#is_hermitian)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_hermitian-checks-if-a-matrix-is-hermitian)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_hermitian_${t1[0]}$${k1}$ #:endfor @@ -154,7 +162,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is triangular - !! ([Specification](../page/specs/stdlib_linalg.html#is_triangular)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_triangular-checks-if-a-matrix-is-triangular)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_triangular_${t1[0]}$${k1}$ #:endfor @@ -166,7 +175,8 @@ module stdlib_linalg !! version: experimental !! !! Checks if a matrix (rank-2 array) is Hessenberg - !! ([Specification](../page/specs/stdlib_linalg.html#is_hessenberg)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! is_hessenberg-checks-if-a-matrix-is-hessenberg)) #:for k1, t1 in RCI_KINDS_TYPES module procedure is_Hessenberg_${t1[0]}$${k1}$ #:endfor @@ -179,7 +189,8 @@ contains !! version: experimental !! !! Constructs the identity matrix - !! ([Specification](../page/specs/stdlib_linalg.html#description_1)) + !! ([Specification](../page/specs/stdlib_linalg.html# + !! eye-construct-the-identity-matrix)) integer, intent(in) :: n integer(int8) :: res(n, n) integer :: i From 6f6f5acb6c624260b34c374c6cbfe3c737dd2b8e Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 11 Oct 2021 14:54:49 -0500 Subject: [PATCH 22/33] Separate out matrix property checks tests --- src/tests/Makefile.manual | 1 + src/tests/linalg/CMakeLists.txt | 2 +- src/tests/linalg/Makefile.manual | 5 + .../test_linalg_matrix_property_checks.f90 | 2066 +++++++++++++++++ 4 files changed, 2073 insertions(+), 1 deletion(-) create mode 100644 src/tests/linalg/Makefile.manual create mode 100644 src/tests/linalg/test_linalg_matrix_property_checks.f90 diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index 7ab184016..c29170e24 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -11,3 +11,4 @@ all test clean: $(MAKE) -f Makefile.manual --directory=stats $@ $(MAKE) -f Makefile.manual --directory=string $@ $(MAKE) -f Makefile.manual --directory=math $@ + $(MAKE) -f Makefile.manual --directory=linalg $@ diff --git a/src/tests/linalg/CMakeLists.txt b/src/tests/linalg/CMakeLists.txt index f1098405b..f53d2092f 100644 --- a/src/tests/linalg/CMakeLists.txt +++ b/src/tests/linalg/CMakeLists.txt @@ -1,2 +1,2 @@ ADDTEST(linalg) - +ADDTEST(linalg_matrix_property_checks) diff --git a/src/tests/linalg/Makefile.manual b/src/tests/linalg/Makefile.manual new file mode 100644 index 000000000..faf7307c8 --- /dev/null +++ b/src/tests/linalg/Makefile.manual @@ -0,0 +1,5 @@ +PROGS_SRC = test_linalg.f90 \ + test_linalg_matrix_property_checks.f90 + + +include ../Makefile.manual.test.mk diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.f90 b/src/tests/linalg/test_linalg_matrix_property_checks.f90 new file mode 100644 index 000000000..2303fdd31 --- /dev/null +++ b/src/tests/linalg/test_linalg_matrix_property_checks.f90 @@ -0,0 +1,2066 @@ +program test_linalg_matrix_property_checks + + use stdlib_error, only: check + use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 + use stdlib_linalg, only: is_square ,is_diagonal, is_symmetric, & + is_skew_symmetric, is_hermitian, is_triangular, is_hessenberg + + implicit none + + real(sp), parameter :: sptol = 1000 * epsilon(1._sp) + real(dp), parameter :: dptol = 1000 * epsilon(1._dp) + real(qp), parameter :: qptol = 1000 * epsilon(1._qp) + + logical :: warn + + ! whether calls to check issue a warning + ! or stop execution + warn = .false. + + ! + ! is_square + ! + call test_is_square_rsp + call test_is_square_rdp + call test_is_square_rqp + + call test_is_square_csp + call test_is_square_cdp + call test_is_square_cqp + + call test_is_square_int8 + call test_is_square_int16 + call test_is_square_int32 + call test_is_square_int64 + + ! + ! is_diagonal + ! + call test_is_diagonal_rsp + call test_is_diagonal_rdp + call test_is_diagonal_rqp + + call test_is_diagonal_csp + call test_is_diagonal_cdp + call test_is_diagonal_cqp + + call test_is_diagonal_int8 + call test_is_diagonal_int16 + call test_is_diagonal_int32 + call test_is_diagonal_int64 + + ! + ! is_symmetric + ! + call test_is_symmetric_rsp + call test_is_symmetric_rdp + call test_is_symmetric_rqp + + call test_is_symmetric_csp + call test_is_symmetric_cdp + call test_is_symmetric_cqp + + call test_is_symmetric_int8 + call test_is_symmetric_int16 + call test_is_symmetric_int32 + call test_is_symmetric_int64 + + ! + ! is_skew_symmetric + ! + call test_is_skew_symmetric_rsp + call test_is_skew_symmetric_rdp + call test_is_skew_symmetric_rqp + + call test_is_skew_symmetric_csp + call test_is_skew_symmetric_cdp + call test_is_skew_symmetric_cqp + + call test_is_skew_symmetric_int8 + call test_is_skew_symmetric_int16 + call test_is_skew_symmetric_int32 + call test_is_skew_symmetric_int64 + + ! + ! is_hermitian + ! + call test_is_hermitian_rsp + call test_is_hermitian_rdp + call test_is_hermitian_rqp + + call test_is_hermitian_csp + call test_is_hermitian_cdp + call test_is_hermitian_cqp + + call test_is_hermitian_int8 + call test_is_hermitian_int16 + call test_is_hermitian_int32 + call test_is_hermitian_int64 + + ! + ! is_triangular + ! + call test_is_triangular_rsp + call test_is_triangular_rdp + call test_is_triangular_rqp + + call test_is_triangular_csp + call test_is_triangular_cdp + call test_is_triangular_cqp + + call test_is_triangular_int8 + call test_is_triangular_int16 + call test_is_triangular_int32 + call test_is_triangular_int64 + + ! + ! is_hessenberg + ! + call test_is_hessenberg_rsp + call test_is_hessenberg_rdp + call test_is_hessenberg_rqp + + call test_is_hessenberg_csp + call test_is_hessenberg_cdp + call test_is_hessenberg_cqp + + call test_is_hessenberg_int8 + call test_is_hessenberg_int16 + call test_is_hessenberg_int32 + call test_is_hessenberg_int64 + +contains + + subroutine test_is_square_rsp + real(sp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_rsp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_rsp + + subroutine test_is_square_rdp + real(dp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_rdp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_rdp + + subroutine test_is_square_rqp + real(qp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_rqp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_rqp + + subroutine test_is_square_csp + complex(sp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_csp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_csp + + subroutine test_is_square_cdp + complex(dp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_cdp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_cdp + + subroutine test_is_square_cqp + complex(qp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_cqp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_cqp + + subroutine test_is_square_int8 + integer(int8) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int8" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int8 + + subroutine test_is_square_int16 + integer(int16) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int16" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int16 + + subroutine test_is_square_int32 + integer(int32) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int32" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int32 + + subroutine test_is_square_int64 + integer(int64) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int64" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int64 + + + subroutine test_is_diagonal_rsp + real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_rsp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_rsp + + subroutine test_is_diagonal_rdp + real(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_rdp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_rdp + + subroutine test_is_diagonal_rqp + real(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_rqp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_rqp + + subroutine test_is_diagonal_csp + complex(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_csp" + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_csp + + subroutine test_is_diagonal_cdp + complex(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_cdp" + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_cdp + + subroutine test_is_diagonal_cqp + complex(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_cqp" + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_cqp + + subroutine test_is_diagonal_int8 + integer(int8) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int8) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int8) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int8" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int8 + + subroutine test_is_diagonal_int16 + integer(int16) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int16) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int16) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int16" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int16 + + subroutine test_is_diagonal_int32 + integer(int32) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int32) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int32) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int32" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int32 + + subroutine test_is_diagonal_int64 + integer(int64) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int64) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int64) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int64" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int64 + + + subroutine test_is_symmetric_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_rsp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_rsp + + subroutine test_is_symmetric_rdp + real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_rdp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_rdp + + subroutine test_is_symmetric_rqp + real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_rqp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_rqp + + subroutine test_is_symmetric_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_csp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_csp + + subroutine test_is_symmetric_cdp + complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_cdp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_cdp + + subroutine test_is_symmetric_cqp + complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_cqp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_cqp + + subroutine test_is_symmetric_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int8" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int8 + + subroutine test_is_symmetric_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int16" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int16 + + subroutine test_is_symmetric_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int32" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int32 + + subroutine test_is_symmetric_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int64" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int64 + + + subroutine test_is_skew_symmetric_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_rsp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_rsp + + subroutine test_is_skew_symmetric_rdp + real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_rdp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_rdp + + subroutine test_is_skew_symmetric_rqp + real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_rqp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_rqp + + subroutine test_is_skew_symmetric_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_csp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_csp + + subroutine test_is_skew_symmetric_cdp + complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_cdp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_cdp + + subroutine test_is_skew_symmetric_cqp + complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_cqp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_cqp + + subroutine test_is_skew_symmetric_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int8" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int8 + + subroutine test_is_skew_symmetric_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int16" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int16 + + subroutine test_is_skew_symmetric_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int32" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int32 + + subroutine test_is_skew_symmetric_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int64" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int64 + + + subroutine test_is_hermitian_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rsp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rsp + + subroutine test_is_hermitian_rdp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rdp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rdp + + subroutine test_is_hermitian_rqp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rqp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rqp + + subroutine test_is_hermitian_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_csp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_csp + + subroutine test_is_hermitian_cdp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_cdp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_cdp + + subroutine test_is_hermitian_cqp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_cqp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_cqp + + subroutine test_is_hermitian_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int8" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int8 + + subroutine test_is_hermitian_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int16" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int16 + + subroutine test_is_hermitian_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int32" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int32 + + subroutine test_is_hermitian_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int64" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int64 + + + subroutine test_is_triangular_rsp + real(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_rsp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_rsp + + subroutine test_is_triangular_rdp + real(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_rdp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_rdp + + subroutine test_is_triangular_rqp + real(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_rqp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_rqp + + subroutine test_is_triangular_csp + complex(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_csp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_csp + + subroutine test_is_triangular_cdp + complex(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_cdp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_cdp + + subroutine test_is_triangular_cqp + complex(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_cqp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_cqp + + subroutine test_is_triangular_int8 + integer(int8) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int8) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int8) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int8) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int8) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int8) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int8" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int8 + + subroutine test_is_triangular_int16 + integer(int16) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int16) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int16) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int16) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int16) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int16) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int16" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int16 + + subroutine test_is_triangular_int32 + integer(int32) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int32) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int32) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int32) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int32) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int32) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int32" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int32 + + subroutine test_is_triangular_int64 + integer(int64) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int64) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int64) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int64) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int64) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int64) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int64" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int64 + + + subroutine test_is_hessenberg_rsp + real(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_rsp" + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_rsp + + subroutine test_is_hessenberg_rdp + real(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_rdp" + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_rdp + + subroutine test_is_hessenberg_rqp + real(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_rqp" + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_rqp + + subroutine test_is_hessenberg_csp + complex(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_csp" + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_csp + + subroutine test_is_hessenberg_cdp + complex(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_cdp" + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_cdp + + subroutine test_is_hessenberg_cqp + complex(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_cqp" + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_cqp + + subroutine test_is_hessenberg_int8 + integer(int8) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int8) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int8) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int8) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int8) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int8) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int8" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int8 + + subroutine test_is_hessenberg_int16 + integer(int16) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int16) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int16) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int16) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int16) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int16) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int16" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int16 + + subroutine test_is_hessenberg_int32 + integer(int32) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int32) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int32) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int32) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int32) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int32) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int32" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int32 + + subroutine test_is_hessenberg_int64 + integer(int64) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int64) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int64) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int64) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int64) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int64) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int64" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int64 + +end program From 12be97bd41f7bcabc1c6360c4ca016190e7396d1 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 11 Oct 2021 15:22:15 -0500 Subject: [PATCH 23/33] Add back optval dependencies accidentally removed in merge conflict resolution --- src/Makefile.manual | 3 ++- src/stdlib_linalg.fypp | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index a9a67dacd..7f6a81d4c 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -88,8 +88,9 @@ stdlib_io.o: \ stdlib_kinds.o \ stdlib_ascii.o stdlib_linalg.o: \ + stdlib_error.o \ stdlib_kinds.o \ - stdlib_error.o + stdlib_optval.o stdlib_linalg_diag.o: \ stdlib_linalg.o \ stdlib_kinds.o diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 5f59bd9ed..b1da1a7c5 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -6,6 +6,7 @@ module stdlib_linalg use stdlib_kinds, only: sp, dp, qp, & int8, int16, int32, int64 use stdlib_error, only: error_stop + use stdlib_optval, only: optval implicit none private From d0a4a76e1946f260669eb4937bf483224ba916b0 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Sat, 16 Oct 2021 12:39:20 -0500 Subject: [PATCH 24/33] Remove redundant tests after separation --- src/tests/linalg/test_linalg.f90 | 2048 +----------------------------- 1 file changed, 1 insertion(+), 2047 deletions(-) diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index 42855427e..1d054dcbe 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -2,8 +2,7 @@ program test_linalg use stdlib_error, only: check use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 - use stdlib_linalg, only: diag, eye, trace, outer_product, is_square ,is_diagonal, & - is_symmetric, is_skew_symmetric, is_hermitian, is_triangular, is_hessenberg + use stdlib_linalg, only: diag, eye, trace, outer_product implicit none @@ -73,118 +72,6 @@ program test_linalg call test_outer_product_int32 call test_outer_product_int64 - ! - ! is_square - ! - call test_is_square_rsp - call test_is_square_rdp - call test_is_square_rqp - - call test_is_square_csp - call test_is_square_cdp - call test_is_square_cqp - - call test_is_square_int8 - call test_is_square_int16 - call test_is_square_int32 - call test_is_square_int64 - - ! - ! is_diagonal - ! - call test_is_diagonal_rsp - call test_is_diagonal_rdp - call test_is_diagonal_rqp - - call test_is_diagonal_csp - call test_is_diagonal_cdp - call test_is_diagonal_cqp - - call test_is_diagonal_int8 - call test_is_diagonal_int16 - call test_is_diagonal_int32 - call test_is_diagonal_int64 - - ! - ! is_symmetric - ! - call test_is_symmetric_rsp - call test_is_symmetric_rdp - call test_is_symmetric_rqp - - call test_is_symmetric_csp - call test_is_symmetric_cdp - call test_is_symmetric_cqp - - call test_is_symmetric_int8 - call test_is_symmetric_int16 - call test_is_symmetric_int32 - call test_is_symmetric_int64 - - ! - ! is_skew_symmetric - ! - call test_is_skew_symmetric_rsp - call test_is_skew_symmetric_rdp - call test_is_skew_symmetric_rqp - - call test_is_skew_symmetric_csp - call test_is_skew_symmetric_cdp - call test_is_skew_symmetric_cqp - - call test_is_skew_symmetric_int8 - call test_is_skew_symmetric_int16 - call test_is_skew_symmetric_int32 - call test_is_skew_symmetric_int64 - - ! - ! is_hermitian - ! - call test_is_hermitian_rsp - call test_is_hermitian_rdp - call test_is_hermitian_rqp - - call test_is_hermitian_csp - call test_is_hermitian_cdp - call test_is_hermitian_cqp - - call test_is_hermitian_int8 - call test_is_hermitian_int16 - call test_is_hermitian_int32 - call test_is_hermitian_int64 - - ! - ! is_triangular - ! - call test_is_triangular_rsp - call test_is_triangular_rdp - call test_is_triangular_rqp - - call test_is_triangular_csp - call test_is_triangular_cdp - call test_is_triangular_cqp - - call test_is_triangular_int8 - call test_is_triangular_int16 - call test_is_triangular_int32 - call test_is_triangular_int64 - - ! - ! is_hessenberg - ! - call test_is_hessenberg_rsp - call test_is_hessenberg_rdp - call test_is_hessenberg_rqp - - call test_is_hessenberg_csp - call test_is_hessenberg_cdp - call test_is_hessenberg_cqp - - call test_is_hessenberg_int8 - call test_is_hessenberg_int16 - call test_is_hessenberg_int32 - call test_is_hessenberg_int64 - contains subroutine test_eye @@ -693,1937 +580,4 @@ subroutine test_outer_product_int64 msg="all(abs(diff) == 0) failed.",warn=warn) end subroutine test_outer_product_int64 - - subroutine test_is_square_rsp - real(sp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_rsp" - A_true = reshape([1.,2.,3.,4.],[2,2]) - A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_rsp - - subroutine test_is_square_rdp - real(dp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_rdp" - A_true = reshape([1.,2.,3.,4.],[2,2]) - A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_rdp - - subroutine test_is_square_rqp - real(qp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_rqp" - A_true = reshape([1.,2.,3.,4.],[2,2]) - A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_rqp - - subroutine test_is_square_csp - complex(sp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_csp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_csp - - subroutine test_is_square_cdp - complex(dp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_cdp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_cdp - - subroutine test_is_square_cqp - complex(qp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_cqp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_cqp - - subroutine test_is_square_int8 - integer(int8) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int8" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int8 - - subroutine test_is_square_int16 - integer(int16) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int16" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int16 - - subroutine test_is_square_int32 - integer(int32) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int32" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int32 - - subroutine test_is_square_int64 - integer(int64) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int64" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int64 - - - subroutine test_is_diagonal_rsp - real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - real(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_rsp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) - A_false_s = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) - A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) - A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) - A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_rsp - - subroutine test_is_diagonal_rdp - real(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - real(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - real(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_rdp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) - A_false_s = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) - A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) - A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) - A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_rdp - - subroutine test_is_diagonal_rqp - real(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - real(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - real(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_rqp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) - A_false_s = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) - A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) - A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) - A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_rqp - - subroutine test_is_diagonal_csp - complex(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - complex(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - complex(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_csp" - A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.)],[2,2]) - A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_csp - - subroutine test_is_diagonal_cdp - complex(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - complex(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - complex(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_cdp" - A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.)],[2,2]) - A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_cdp - - subroutine test_is_diagonal_cqp - complex(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - complex(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - complex(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_cqp" - A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.)],[2,2]) - A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_cqp - - subroutine test_is_diagonal_int8 - integer(int8) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int8) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int8) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int8" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int8 - - subroutine test_is_diagonal_int16 - integer(int16) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int16) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int16) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int16" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int16 - - subroutine test_is_diagonal_int32 - integer(int32) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int32) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int32) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int32" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int32 - - subroutine test_is_diagonal_int64 - integer(int64) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int64) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int64) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int64" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int64 - - - subroutine test_is_symmetric_rsp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_rsp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_rsp - - subroutine test_is_symmetric_rdp - real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_rdp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_rdp - - subroutine test_is_symmetric_rqp - real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_rqp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_rqp - - subroutine test_is_symmetric_csp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_csp" - A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(2.,1.),cmplx(4.,1.)],[2,2]) - A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & - cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_csp - - subroutine test_is_symmetric_cdp - complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_cdp" - A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(2.,1.),cmplx(4.,1.)],[2,2]) - A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & - cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_cdp - - subroutine test_is_symmetric_cqp - complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_cqp" - A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(2.,1.),cmplx(4.,1.)],[2,2]) - A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & - cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_cqp - - subroutine test_is_symmetric_int8 - integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int8" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int8 - - subroutine test_is_symmetric_int16 - integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int16" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int16 - - subroutine test_is_symmetric_int32 - integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int32" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int32 - - subroutine test_is_symmetric_int64 - integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int64" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int64 - - - subroutine test_is_skew_symmetric_rsp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_rsp" - A_true = reshape([0.,2.,-2.,0.],[2,2]) - A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) - A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_rsp - - subroutine test_is_skew_symmetric_rdp - real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_rdp" - A_true = reshape([0.,2.,-2.,0.],[2,2]) - A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) - A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_rdp - - subroutine test_is_skew_symmetric_rqp - real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_rqp" - A_true = reshape([0.,2.,-2.,0.],[2,2]) - A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) - A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_rqp - - subroutine test_is_skew_symmetric_csp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_csp" - A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) - A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) - A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & - -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_csp - - subroutine test_is_skew_symmetric_cdp - complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_cdp" - A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) - A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) - A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & - -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_cdp - - subroutine test_is_skew_symmetric_cqp - complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_cqp" - A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) - A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) - A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & - -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_cqp - - subroutine test_is_skew_symmetric_int8 - integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int8" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int8 - - subroutine test_is_skew_symmetric_int16 - integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int16" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int16 - - subroutine test_is_skew_symmetric_int32 - integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int32" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int32 - - subroutine test_is_skew_symmetric_int64 - integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int64" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int64 - - - subroutine test_is_hermitian_rsp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_rsp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_rsp - - subroutine test_is_hermitian_rdp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_rdp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_rdp - - subroutine test_is_hermitian_rqp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_rqp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_rqp - - subroutine test_is_hermitian_csp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_csp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(2.,1.),cmplx(4.,0.)],[2,2]) - A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & - cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_csp - - subroutine test_is_hermitian_cdp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_cdp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(2.,1.),cmplx(4.,0.)],[2,2]) - A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & - cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_cdp - - subroutine test_is_hermitian_cqp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_cqp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(2.,1.),cmplx(4.,0.)],[2,2]) - A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & - cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_cqp - - subroutine test_is_hermitian_int8 - integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int8" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int8 - - subroutine test_is_hermitian_int16 - integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int16" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int16 - - subroutine test_is_hermitian_int32 - integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int32" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int32 - - subroutine test_is_hermitian_int64 - integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int64" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int64 - - - subroutine test_is_triangular_rsp - real(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - real(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - real(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - real(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - real(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - real(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_rsp" - !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) - A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) - A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) - A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) - A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) - A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) - A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) - A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) - A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_rsp - - subroutine test_is_triangular_rdp - real(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - real(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - real(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - real(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - real(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - real(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_rdp" - !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) - A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) - A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) - A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) - A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) - A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) - A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) - A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) - A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_rdp - - subroutine test_is_triangular_rqp - real(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - real(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - real(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - real(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - real(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - real(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_rqp" - !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) - A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) - A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) - A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) - A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) - A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) - A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) - A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) - A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_rqp - - subroutine test_is_triangular_csp - complex(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - complex(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - complex(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - complex(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - complex(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - complex(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_csp" - !upper triangular - A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_csp - - subroutine test_is_triangular_cdp - complex(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - complex(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - complex(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - complex(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - complex(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - complex(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_cdp" - !upper triangular - A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_cdp - - subroutine test_is_triangular_cqp - complex(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - complex(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - complex(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - complex(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - complex(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - complex(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_cqp" - !upper triangular - A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_cqp - - subroutine test_is_triangular_int8 - integer(int8) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int8) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int8) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int8) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int8) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int8) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int8" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int8 - - subroutine test_is_triangular_int16 - integer(int16) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int16) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int16) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int16) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int16) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int16) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int16" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int16 - - subroutine test_is_triangular_int32 - integer(int32) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int32) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int32) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int32) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int32) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int32) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int32" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int32 - - subroutine test_is_triangular_int64 - integer(int64) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int64) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int64) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int64) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int64) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int64) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int64" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int64 - - - subroutine test_is_hessenberg_rsp - real(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - real(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - real(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - real(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - real(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - real(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_rsp" - !upper hessenberg - A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) - A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) - A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) - A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) - A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_rsp - - subroutine test_is_hessenberg_rdp - real(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - real(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - real(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - real(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - real(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - real(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_rdp" - !upper hessenberg - A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) - A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) - A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) - A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) - A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_rdp - - subroutine test_is_hessenberg_rqp - real(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - real(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - real(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - real(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - real(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - real(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_rqp" - !upper hessenberg - A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) - A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) - A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) - A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) - A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_rqp - - subroutine test_is_hessenberg_csp - complex(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - complex(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - complex(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - complex(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - complex(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - complex(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_csp" - !upper hessenberg - A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_csp - - subroutine test_is_hessenberg_cdp - complex(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - complex(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - complex(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - complex(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - complex(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - complex(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_cdp" - !upper hessenberg - A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_cdp - - subroutine test_is_hessenberg_cqp - complex(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - complex(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - complex(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - complex(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - complex(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - complex(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_cqp" - !upper hessenberg - A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_cqp - - subroutine test_is_hessenberg_int8 - integer(int8) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int8) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int8) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int8) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int8) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int8) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int8" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int8 - - subroutine test_is_hessenberg_int16 - integer(int16) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int16) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int16) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int16) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int16) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int16) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int16" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int16 - - subroutine test_is_hessenberg_int32 - integer(int32) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int32) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int32) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int32) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int32) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int32) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int32" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int32 - - subroutine test_is_hessenberg_int64 - integer(int64) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int64) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int64) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int64) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int64) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int64) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int64" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int64 - end program From 74abe0fc561b5a8295c9eccba162955909324696 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 27 Dec 2021 13:38:39 -0500 Subject: [PATCH 25/33] Add fypp version of is_square --- src/tests/hash_functions/c_nmhash32_array.bin | Bin 0 -> 8196 bytes .../hash_functions/c_nmhash32x_array.bin | Bin 0 -> 8196 bytes .../hash_functions/c_pengy_hash_array.bin | Bin 0 -> 16392 bytes .../hash_functions/c_spooky_hash_array.bin | Bin 0 -> 32784 bytes .../hash_functions/c_water_hash_array.bin | Bin 0 -> 8196 bytes src/tests/hash_functions/key_array.bin | Bin 0 -> 2048 bytes .../32_bit_hash_performance.txt | 43 + .../64_bit_hash_performance.txt | 35 + src/tests/linalg/CMakeLists.txt | 1 + .../test_linalg_matrix_property_checks.f90 | 2066 ---------------- .../test_linalg_matrix_property_checks.full | 2068 +++++++++++++++++ .../test_linalg_matrix_property_checks.fypp | 238 ++ 12 files changed, 2385 insertions(+), 2066 deletions(-) create mode 100644 src/tests/hash_functions/c_nmhash32_array.bin create mode 100644 src/tests/hash_functions/c_nmhash32x_array.bin create mode 100644 src/tests/hash_functions/c_pengy_hash_array.bin create mode 100644 src/tests/hash_functions/c_spooky_hash_array.bin create mode 100644 src/tests/hash_functions/c_water_hash_array.bin create mode 100644 src/tests/hash_functions/key_array.bin create mode 100644 src/tests/hash_functions_perf/32_bit_hash_performance.txt create mode 100644 src/tests/hash_functions_perf/64_bit_hash_performance.txt delete mode 100644 src/tests/linalg/test_linalg_matrix_property_checks.f90 create mode 100644 src/tests/linalg/test_linalg_matrix_property_checks.full create mode 100644 src/tests/linalg/test_linalg_matrix_property_checks.fypp diff --git a/src/tests/hash_functions/c_nmhash32_array.bin b/src/tests/hash_functions/c_nmhash32_array.bin new file mode 100644 index 0000000000000000000000000000000000000000..4c6821c171b5047402fa4f8c901d2e433bb75f39 GIT binary patch literal 8196 zcmV+fAp74%$l0*Tj{0Tw(B(SME@d4hZr@zb_%oGtm~Xp!E*<#mlw#sa+yp}@X(t~u zlSN)@lHHw@(;%dI_s{=Wx|S>^cW|gOPF{^eQ(s#bkgn(RY9sICoQ;?`DAu724h?!p ze||QyIghxuku65eg*7fpKm+esG12g%&7u-}Kh){Y=cOB(Ml#ScK`4rKs24_blwM|) zT@~T>Lz!`!QNRG76&%JK`^hd@Bp7FhJ|_eutQP$emXFyKP49t_3Z@vp`J^x7A4$(- zz}IrR);+me4+e=;#jh0te3qRLxkDOfIIv9X$)~pwL=C7k>m#y!Xe8yxMu7ORrJr&` zrbnJnY=<{p2W49jhs^pdR%gkhGijxH$t6FOhx}*^fzpWlbt}zaA(0o(dt{FXQY8nq zkIXTL7o{y{FPTz9G{S{5r$8YasC9Ap`5(U@)};@>Ro`4>v4u2;HsKd^Eh4wi6k+`_1wOM_OqqiFY=%73ccqTV@lAD&*k=9b@Z9-8K?`yV zSNuaxffu+uFd#piTPV3I@#-e@IF_JbU{lbuEra8=Kew1)6F4=rF$|H>d;U94k(5@F zL4fcfWmoee@^&Y^gE4ozFiFyX0{SrKc%pm=-IZ54#Vap)YJ|=< z-oSR@^}c8jzXdTsYV84G*sTT?jwuS6W=d1!l)D(8VlZ_tjlp|%@QtkK?=dXR;eoyY ze4b5r6Q^DNuyS1hXGqd$qcUWgaOzo5@^={9|7uX>6U#lj5G!30X^dV9t0>=uO-IIE z_HhCT9T5+t`6f85kX z-p{Yp!aJbxmK_#Ht4{H?EHdpJr8v*O@r;gKk2pAI*`4p-55x;-n1ipgpnP*8_b?pz z!YO7g)O4WPa9i-p_v@i<@N&esv8IJr7fHDN(bcP2wEHe^2P(*Z%k``=s+}{7=Z^2V zVZ=E)<60@RLiof-0(a=DWn8wwQ`=nO!ixjpxG<$)z{?uF9(&P%W3<11hFzrTF?LEd%rA}xf~EMl_}P`{zfP4-#0W&cD7bBKsUe z>DJr%Rk@fQNpPrw=$2fsW^X!5f}?O9&6brugaC@1r=qULlSa`JCf>xdL}SLSP!p0q zbH41hYr+zkralUdW@eaQPD_V@%|P&Y^vF0n3NlRI3HOKG`5T-O(W^q2epu_0OGn}! z2x&$2EO(CE@^o%AJ&DNt=`w!wu?CWcPp;nJb7)6?422$r^M2yel99~ff zljNRnNk7k#?kT3O8UYMxYQy(w1r6{sF%(iFWoIfQs{?#-kjM+o_V8QhbU`>1w&_J< z$}Pnx#X@iJtW)PbJ8s@voR{=E_KA(F;4t=&7?|J;jRy}onk_T@Bu=GMYD|7g{+=aN z{qsDs&0)KEvEC?V4&NFl(9e{wTnZQINQJ+EEGSmTA*{eteU^qpbr&z2NdYj(7$-0ATsv7;;%8O*E`p;C6{sAVlvVak!RvJOIHC2 zQQ1DqdpFUaDN*&lTs~gv17yJ(1DHG|idQUM(z~1Og1WuEHENBYFu+|OasoWXr(}X# zh{V1`Q!IElmK`Lf%=*@FxL|4TtC{`7)+aCZy0YHe+{+VsR=RqEUaDA(7a%eFX!$?~(2Rsb>CI0~`3HP(Vm8vY6v zeN>l!77dMxU<8n>ydGV5R;-HkNT0L0HE5Fr_Rmm_tnv-?l(mPn zeH3S`=v@1Gj# z=~c6UF^LUfgkOeKtT?&ebXMV1uv+*Dm?cbUmQwxHvA+jgQ{q0{c53zRSL65^<*c)m zb<$)%uMMtATRkHFR>`~6?)Y|+ZaLVopy?cA!jL-e&E~F6_~wJJfhEdO7h?fm^}6|PuJ8=mKb+Ig zg)U5U8Q$@g)a(SUKC6oGD}7%bJyJ5SY3Nn%sma6-WVBHVP>>9;0#c$2k9L$)r%1>3 zOTqd$EFWUCTS3c0)x7nD1#u zuUR8OEluycesEZ&97MzkA~XXWzlf?lFb2y{F~V~^ew9@=GtJ4NXC=WWUJ{zu`}O{x zJpx5vGWlxV=(kpkfge+*Z|O&63+lM8OJW&0fV8w9W?r@Wy#flkARwWw@}6ETalrqr za`Xm#LppA`2U9Udwb)aKF6Z~?p?dz#hhcxlRW(v&-Fn;i*8Cbd1ekZjkY^fumG0la z5p^mKcc*}0;wXl>(xq~SrLZH5)#aC8%TqQv1O3QE`R`c{ZBK4j4`_~sCs|&Oe#6o%${6xmR|G5#nQX{dx zE12+^MB_&MnZ5;FQ!coE$~!q5Hjnn$T<`;e0_-6czh~B{d&ejAFuaP=_BFu;aX{MS zC_)w&&M8x-G_*uR6zGVAD3^Iud8ph;4Cy92d|r#i%(T07rMuxraATe6V>wN>H{u$) z?TUe5(tw>b6CKN&tOoAF2Oo;vwXX{Gdc&jVROllpYHnx*#0uHV%iZv6ouqj zyrWd$;n-aRlJ}k72L2>JsPi7-(eNDZPi(&3Np@}34R5N}$Ue!tQ^>-{R+!M)v{=J$ zXX%hSg1Sw#0IyCL7CsYl7L*4y;W|y2;_&V}3+8*bJvn>cArk|-S&)ri0=0ENETd7X z^p<3_s$GPpH5N0op8^B|s+!=waQ=>6!DF!iZ#71t&C+nt@NnyF(@rH}#gvk7W3G_f zHaYD{f`@l-i1NddcX4K{oF#Sjj@4{8tIb8O*atyHOSYt;77Uq^c>=bzkbxIX>=9Qq z!YY_R7=}9|<`7%*a7?^>r`rTT&-4+z5#=ndn_fNS`5L|RHy4N1cSRgUMZ}d@uPo=; z3A75++FlATmJpaTQo_sX_y#u-6cdy%IDFUq{=)R1oZ27VOy-jWxZ72@>~H?16mHg{ z0HYLN;**ocn*yCEu@R9@fKV9T$a!I|O0vMZ-f=@Xft)^5q-zA|&V{S$_>dZT{*(TRp@dTSe($fQm z|HNd1H+hgleClyJN{Lw)>F5ogOA{}NPPL6VyK%1ulj!z+-^#0YBj{*_G zx8t^%b7sXrofs>gWxdY}RYQAQ>4$q`ni1ZJ`52VAKvcP45MYajX~G39$4ZBa)E)s; zqEhoCk8u!xHyJa7sMyLSa2}JqO{i^;LI>wwxgUV3+L8$w!C$eKD%n(K$_hPycS9qE zM-mv*i%0T;P3ow?k+~4Cn_x}JKR?gSE$I&)71t`E7$U^m{^RNByq$8R6Ny6|Fa&D! zV!bv6-(Jky3HIk8t^Gi^1n@`S$}98>#y`~RI5V=rd$YcsZ^IC%IuO#AKzw_9Y@_8MEEZ#(S8sy_Zu`5ptNA$~t< z&!Hh*mrrFkfSDp!N|hISuZyJdSn%vl5?$T8evOaPXswPrP7<@L8?T}?g>C}Tu)@Hc z)>lMpMTh}^Ha)wqK%?>%_LMYXJD{T}P-+c`F6WUUkWlyiAN!{BdjvA-{HX*KowoD0_bxJV$|zrZobWECdmGB6-f}S zku@6z`M^%>UxQ#SOgbL48hE6!-*c~|klCdF<|GA_`ojh3PtTxfnjact&Kh5x8SwI< zF-a6fj1Z3$S%;+K0oFtAec~b&FEnXzMk&caXDxduV|>G+JaOxm4>fQO&)wPZ6n~^dy#*7LL!{l{qo6D zCdv`~>M4ob+Txm;MLlqd$)X0hGSqODylV~E?=va2G(<7wdY${!)4W}kZ378 zcv?X2M`Z=at8?80G>wh7RkM%}5ZG3hY`XTE7a8NOX(JAQq8cmxJ0TflAax*Ch1A>> zYiX>+Mz}REEu+&sh02e{6l@L5j62Vr*5G=*m@p+cxjsdamgd zQtxFQsxe~8Hy|nWdmB11XEXmgwe<akLDtb=e>p>&bz!_M2VRxYG9 zitz@n-!3AUinU#`*%)j%Hfz%#9q+sKdR*@rJK8dU*2m%QT;_YytKNODg)G&_)ue_>XTx-xAY$A=Otw6 zO7x3R#0@&%&x!@ZvER!rb3S#!VQD)!A#(2Vvl}OWyA3J!>(K-PGGmCOl7KefR$UPo zCaCRIc-=58ft9H#rO4~};mDqpA@V+?T<+9dLxkkPy^79hA^ZX@NBT_J1X5 z(HKx37xQbW?l_uH3*~oxsN*}U$yZxu22{x;W`5V-+7*}R^)-gc?fW4%3kL6<##=#G|7(89y&vv{~pIp%EH`m!ZA`A~>WLq4X@<)!)gVD8! zmKE?!q`RDiChwjdTTO(^Pu8jm-@-5$jIqULzwj`l zB_&})uv*6Z^3&3;A#4od4s!8Xv~DjA>@A|`NJY}J6Z9)>udB;a7>d|*@=Q3JH=WA- zs5zK@$=)hOaB;6=Tc8rNYjrSQFrGQ^dU@rV=D6rVl zYp@I?HTy0|^5~U}XUNNTVPqzkl199U>cf}u~-}^v9*o_lS zdUyH6jNu*-wnQCVpAfHWdut9$$Km`HW;q~ZyaJgV9a2xR8MhP&D>O+nNsc;blA5Q< z37yT{Coe>TPS@DOf7-sfMXSNnxmXf?F`@&t-zCjGh+-eU=?Sep&g+B?4nEXItxh7I zU$Yv!tD^vCc@cl*B{)3KvHGVc2!sHvk{r3cvtikl`J&d#NJETpype)rr{)@$;0u_y zHTNh@azbkz6o-hCi{7cyUMT z3gYg$|CLYCBq~RZi}vPZL@ELF4&6a`Ik<;~^#|%N_TgVAP@YHYvV7;1N9!ZM^RcfW z<=Y{r5}l5fDlR(8ko?bY+UKFRa=?5gF1m)EIvE$FG`hvH%r6l-A%$x8 zXT|siF?Od>t#{Yd8SuUUE7<*lZzAd3z51Qu)a@d?H zJ%!D=1_fLiWaKZfKSpmv%)X~dpb19hL7r7|c9Jt!>VE^!IbkFB7VMBq-al{%i9g*z zhSRcgntxIRwftuE$D1~YgDDr|PLF0rt zQm4Ebd&d%OT2&zx!^vlU%vgg0&_Y$qzo{zK`F-=Bg) z()XSVIvp+xf@CcoPz1pv0wLyMd2wl-;%>S`@PC{EdBtB8{2>sSA!|3S<*5=u`D;0a z3Sjm$;EUU006v5T)(rP#h_7S=zGKX-I8)xYk;j6r%i_acwN(*NeE`8TkaN3^gN}De z&+;Mcw-!SWIEX32jc&YY;(_ny>{+*ZyjiLmOqrgzqCW(Uvp&zw`kEt2_3A3wp{oRr zR)qqM113c-Ng9+B2f$lYz)n7A=4TJYa7dag`|ixPwvKo_|6tXlpI;RgZb5bLk?kU) z{{Qh(v7Y@|a1ujb4>hrSy$qXurewV<)DwUgyeR`RQ$p9zO)3;zv5S&fk!E$2fW5V8 z&x(E&=M8ZwCXL_@cxXKY1x{Ylle)E1YOs+P_V!sC;fnBY_IHhubT)e{TB>g$TgV?F z*v@io$;K+ySHl3}^SDv6+J%Vtw*^t<#bNnOrZ?q9FzYLz8tqUv3aPFd1-o<<^&nIt zbwppB0M(v3M@ujM_GhB#b2L7dQsfRGJ3dZnNtUV|(ojll+cIYvwkIpt^H>iE0B^3R znLYPVLe1FOS%)mpM(Tu}mBqk%j8ArmJ(q0s zgwX?AUVH{VR}S%+GG`21c;wT|)NAw$wf4+dKZB>6CV`CT1?wxOPiky6-qw>;^@smh zauP-;jlm3d!Bo)N2^i5zb8LqOT&7IE$FXcNN09Xvpov399Kqx2! zB~nNzq>D&bR)y1!7A9}Nq!59}V%clL1?OWm7B@U1nl?&TS}Xqb%4YB8%WgQL;jiGv zY%4%dx{E2hh)T3eL$7au29M$%@WORUw2|{KHpOari4c-gBXyM#BDL)5#h6G2PnFXe zNt~!=C5j%youy@2vad$&tR^6PdOpS}7H>CR!La0ZHkF=&=Yr;~Tm>v`*+`BC3L#Aw zY?2IKE?^XCOm{Q)(W&rb#eb5<%-vvMTD7_&(2tO)r{m+G&f-N2lkJRzitj=KYx%h4 z3uk5t*fuL3Ksk{(Z*ad6KQ#-3vFO|Un~h1G+HeQHB$6m-Em_WQnvf?<1O5^b!Eug$ zS$^GpqZ*bZ#z;Jlc{(+3?QdRvGRzu;5*(A_vOf1GQ z(dq7EL{F-r2pm~ZyFQKAS8zUGh9>2w8hpOYQqtavbzGl~qMXcp2Y`9fxX?aG3J?%}~hEOUag&jJ$05+#CDRWLZ{* z_hYRY=+&_{&emO2(H{IiI!X83ECCU>v9j$Qz?|bCBw$$1)0a{fIVBRk)jAGH10k+o zWnqeS#*v$N0o=|OICcsy>WhLZPL%Imes(BH+$z}h-OKboj7)I=jwp{m2YDOx&Bju^ zIP56uYB3?jbZd~6LQeZ?l7nG{rn^R{DB{6mBPmKZhNu9SR8*_=5e!yy%>ZH?=AhZ( zxP2CtXak^C?@8j6+LKu^b&>OjBatYwy4r{c`;vc8KLSNtZx;9qh8M*^#*^oohpqYf zO|j3IcLBPhiyp$@-EHpd-Z^aQE)pG|imnhPyGBWO| z>G*zK@qK3=i9cuD7ANM_(?DTlsjdW0GtVA2l&Y1tX{(>SzO zU+CWnp8_xu`vifAw6@6EdFStl@3mfaF%*Xg)&XAUYVadO4elQX1YR zV_Arq6(Y2|_4)(m$Kz1V^d$+<1$m`9N6O_jC!g2E$AoI?55hq-HJ?W`<@u)1i?%`8 zWYA3k=t}XHX1Rm-BYGzWiLvk;(^Or>Jr+ad!03Q+rDlCh0TIbx6x%|>Zd!W%3sJVQ z7mQxs8Ez1;$}4*42v9X=JuX8-vD_N|6~ftxiC7(~w}v0VC~00toUV`s?ZGXwIh z%?G#j2*u1gKTCXi8*nX!#t~{5$y=Gl>cqA6!mZ^kEWE<4O|-hWo1>09>u-u_=fRu- zeZ`W!1bny!XR*S-$5rMNzkjX!Q)>2ZbtiBK9qU2Y34gq|>uwm^=ZX*<;6)+{$DrXt z`1pL!O-h*PL>9Q1I7kNllID&8OI#n?#(BQ6n*G&_c~x)!YZeDg)`h#$ftt2#ZcNP+ z?GSZJe%2}pPeS_$w+zTmeDb&n$YtpxBY&fb@4o!gH__FlB8`W0SRjkOo=SNYF{b|> z7^DDpa?JXef7;<5B1p&VVc6Lo&Z>PkT2Z{U{s>JXb+AotvT5a!f{$L#mAScCXD`6?>C{!QW2y zVq5*MT1W%ehjZyRsY5}v$Iziz&D-~hcR%EhET!>P3tVk3PHlV=l&EPcY)lyBBi(NU zHoK()TIC+0&-KwWKO!<%Wq1zUHG{t2!ah3Ge9yB>uMU2xBzT>{YeZF^euU2|mzM*R z6RMCX8eoYcPXk+?r@$Cg)JN>JJv2Psv@WXCrptGo)AO(KwU8&VASW5%Jf-kauO6VS z$-$hwa*;+p#o=9pwG%twXxD40N_t1y2M9cqbnb=l^DcbY!R^)eFW0y*!M4!pU2hnx z;|uLPi{8&wLCWnPZ6O&bdEJu(URyrZwePUOEyW-HCO{jPOSS^toS}s?TP(b8o|bHG zvck=Ak6k@}w0%R;JEJS(q*hBwBUzw8j&-cw^mPvBM08G3-JhNA9flAWtjn&3C$o z#^QGlS8l-SMr&efe-RFodP#J%_(EQs=TFSkGaAMuCuE{=3qQ^k+>UWKrP zyCn73iJd%iB-;;{x#Qx-uJ|hM$G@xvg?W-cOm{agjyDH2g@L#Ru~5dy5+~7=q*EBJ z4rq8ZRV-3nYc!n@d&O!Zp$We3MoefwR#{BnD|Do6Usg&}tO0?-C5{0zdisn!>WJCI&3{Vd8+d7yZ^yA2 zyHgl1^>QK6`u&&&b%Fv4#|S1*R=+!<9XeD~i_n(4F{sO$U){h{?OyI$MAX5q!-NG% zLaZP#75_7ly>Eif`Ld-b%py9LiT*xnUq=s>;wUEY_bW| znWw`~30#qKxlM^lb8bW~H)%OCPizXKltqhP7)w3m0Jafcn0$e4`+o|pgy<8E4eMC7N zA5nSevl!YzrJ?E!Lo6%R-;f>l0uip9txxA&5x_#w8s*)jFMktXM%jH2vY>b+Ns!x? zMIvOsi2TzYa;Q*jl9`&I2&;aM;;VohkfLr6drhYXcXBW7i-8`uIWhRV4sA;$*L#l> zm<5j8Rc(!&3}$%EVt0sPdt&er=srZaaRBWBhi+D@9(BT+K7=FhI4x$X;%}(4x{?I? z<(j!Znw*=dE1@e%`Y=ZI0ucI^E`LRXy}lZXz-zE4K5!~a2Tv%Hod0BI9HbBaSz6cW zM=b$7jY{ud3+ShY(ty*W|`!cBP6%P%4TA&d-jI1DnRw%DLCyv|l zSWI^C{W-}?qcQnl$`HFP9hx|a=Yo*2)+!V!?qRu|l?;>fc3BjeFsu=!W&uz$6RT}^ z#={W7le-HsP=G1r8S>;Q>wh+ASXY%oXrA8AN#;&2^0KPrf9g+wkJ@xLXtdS5sI~`hq52{ zdd?4muZ+(~n;~+S`LIjBE@j)h_)VyHw^bX@sd|5uXV`njZ-p7f3p=ZNqne;ojTlOJ4LkY2q zWpk~Jy+r41Fv)fjD2_iTe7W3~u9JNEXA?+gi=B)|9YwV>XVP9jE;f3*k)TAVtWcE}Czoquwv^HPN#sAF zGTefpd_5R4x=jKjnUdv%LE_*&F3w%?r^J&i3O9gY5k+aXWh6)DjD*nLI*n7=UHr+zXyT!a8zK$T zty{A2stWl!Mqc3Lu@B*Nk%3SaY`#*uNDvM(F+{WF5zg;)YMufJ`%u1Uh1W4U=nt2P zncrUJnDs{wC6>IqLu5<8QtlT_9B!!1R<^(Z87$tAN>r8D8J||A`%4>bn={ypds%%2 zNwv-U#Mqu{Z9E`-uHa1yT5xM_CS+d>oUW*n>Hp-f zaY(tR7pLD1N#ye$HLBiOlaxdQcw=VUsrChiGL>T(txW`aa{nVPI%bS^PoUCz($ioB z@44b4(CF(N@hV+rk!+q&_s3ui@zTr1VP?T?d{|eM;{OYQ`Fpm`H;5BC+F+KkgSEF6 zh_R$!AC&r_)39b&MPmJ8W5mkl&-ivBfW)X>Dgi*p082E$wXZ{IxolXNaE-G91vGX09~;sDN-QdJl@kYnVZj6K`(e(<2PolDR0maB#&;B(35j`yIlGCGTfGxeC|FI zOYjeRVbyHQGO9Q6si*+!H5C*C*0<8e(8H|LlOR1%mWsLC--jlZ4!funaabg-1GzjO z{xM#sz|^{oxT);fko7CRQX+(@hWj8HB`LXfGRnE&kbPPoqA1FaCGWkZCwAj~LN2yJ z42m;OMkB#M`c0N{@@9&pVXpLyDC)PUB6t=RL=wx!QK1ffq%h)nbX81LAySm#=$*s%V$q@IW?Wq{20(N( zKW|jl#0BUELk>y^$vr$kjj~$LK*ACI?CR;|GmFRNxC&QAogcgz0i!YTitP1!x%^;6 zquw#)c(v{irXH0B)x`Cc34Oi$bM*0pcxMV#D$y5+>ueabvsrNkJDlV|l&!OsUgl8SdWoK+U_uM%)&8zBPLRLEgp-`EI^uJu z$jjZJcbgkVqj|Lup_Vv(}wQ10Sgm)`7sw(IZ>XQ&B>#z}y7Zaf;y!3;SuHPAV z2qAuy5v-Ql0nv9Z1@y~wS!f0lS80wV0MbVqKv|C;EjEl<~Zl*VhahW&Z)G92;i=jMR`-<|Dra zwh8ct3m9M;z?w>fcasB^G+d0}{}A`bY8j6%X8&!E%gMw_fPQBgo19Mgs|z7Zbn1^> zbB{C;A(90oky+iCgcDD;e#LrRdY`lKkh{GYKfx$evf?Cd4<(I|DRF~F?mH{L-MWXA ziFGRpmsIlox0u}0^WaZq$_xnpE@+GPT*33O-u}W~_sOcm{_w{CT%9 zKiQqI(PU|{02$wOJLAAb+m0^`A~{AfjF;)}5<$3gUW7&^sr-R53?tcoNzqu!Q=odMjxJz$)O44vR%KQI42d zo2ndpup?nQGVtY(X9#M?A94k-Xx7&$_njK36eZH?A{1=orPF5PGC*W`(qiSizB$sk z4(zaCV&CleH=(u0h%4c?49gmNQ~ty!o3|x=A%6lMJh{~goh$)jHNj2;ZR@a2nLx&% zi50mz?Io?2E4+C~= zC8Sy ztB!>g9#L{<;UL8tgXMQ8NwOV5$3J5jFhL<+ib1)^oNFpL$p_B& zktXJf@BUM8RbqzLrmM?OuR|tV_2U0FrS$plxhr%Krn+2Vl3oW5OeJPzL9F$(opuIN zQZ(ZMk6>4IR4wK4WV9O_i)(+5)-wmEN*C#xd9$hTxQ1W6gjZ8SQ(yF z&C*3a?GQVWj?T_cJhW^n;C||y^fGuvWjP+tT^z41A{>i}89NH*@#m>aukXP&@aX2& z+&Or%Zzc85ynE}xyW=z(cRM}ie9#gCjO11TedX)N5(Z7B5!NMQ-QbM?LZ zqU23fmeh$^NQ47&@84qt38wS#zyWC3pc!~CW^qT3)e#_cz)b<}2ZT?}L@2e;m9!^t z&WdU!RpI;SG~1gEfP+U%ojuW646nToCC^e#)Kv)o2^G|iZ%hzmNx(6NSMc|*d1t6O zWvJ1`3gJ=`fS8!}u3GilnHiisd`&zA%>Ok7{-*n8b$6pk@d&mBsUinf-QzC`l9#zTU2q*RBI4F<`4qg}%kh@IT z)#pb9-^V(=O&9MJ0?bf1z$83)y?v_lO)x+#CaSGYQbE7lgRzB*`!!kkf3F+}OA(5H zmHE%W;wmpQER^D~+dl}2Y$ldc?Sl@4>KJRXR)>vS7 zj7Cc+d#|=4s-$`cl)fqT^*5NY=WN*?(1;n82q%Eo&^O0>HYytP_9E5bHtf3Cl63KT z9m+GW$2zyI9t6?#$uc9j3;sDMqr`x|JN~gIw2!jii!pMY$9mtnfUe5otd}hGv-dn1 zRRY^|SKS4KbudLDZ~Sq-&zzcX3jcI*h=euILI=c3%?e4fufsC2PaH?khSX4AcX~r+ zQ9;>=BfO^8(ftX3L%9vlU-DoLR=XzebssRpUC}yRcP!Ry($j2>nDsb$5*jkWPiSgo zjck9lTZZxMe`aC9>?B;QwiacvyA-6b8r@7Z_&_M&i^B>!$yPLmUuHfQS*a>G1EJgcx*aS zs=|x}EGn0GC?9$21|`ZOd(QEZdQY`kq5F3CJRCj6*={75RU2SwjJdHB0ANaBk;QYs zT5uz?c#$vRyhXGi^2SMx zp$W{rzHlT)jR*hW-H9i*FC3@u^A0m>L?UdostI7f%iIb!t~0U8)d7NK2q3ZDi&h_- z4=FY`j0>H=uYB10U(tk+>6%A+4kuQZ!<)Y@;}gOs>m&43aI7z&I-lCI*&HurNCu)!MgM_oGzxs-g zae&msvd2G}IqzstPqfpwG0$=dDusHj6DN!_Alb3D8yw!)OEWpJEzWi_`ym#tirS97 zxAMA)H9x5i5rqCtn~_4Yih5gm2Z}z}317%Hh`zxN zqCs4=EB0j7x8VKhC>-DNmz)db?MiAzJ`@iY0lmlR0ex1bm)rrhx!vVs)~un?<}|H%MLi1Kd}{lgQtZ}mC(Ae~lD(tWL)0+-e%Jq0TZq6p z`vyBV{SJAuVo-a-_{)>lfB_dJ2}d}sBn>ynltI>3qs62worocux2}-@vy%<|hUheQ ziQth~BsW!_)!NhYKxhD{npPA4J!CM<3l`V5`#tdbhpR1eU{OG=(GWu-3o_#KjjP^$ z2lRMH@x4u1dz{qk?EbyXF~-}6#TXd>Lek)uzaciSE=nG^i?04;B_3$dqSWRg6o=4F zrd__aAXGQ0tbg;LQB&Ob{IVwUYG7nKSkb`D1CL~lvDW@*`tK7Nw3_@F~9cKh{f0);K{e+|3;Qov?4DE#^BYrZ(T)DBmMUOzDnxI0PWMG_e^kzpD zYn^>}Y9y#!4mWD3i}$y&u-_ZY^j&y~;3v{3gmUwcExCO4OK;gvkNdLpez1>3@Oj1- zV0;Ax*OLiEStmpO7l~-f9)4`aN9Jkvuf9Db8oG>s1eNiPU(;9f)9XeOEAt=I19>u_ zH-zpQX3V6T{W0glC@-@&CKuUJJ7OAqaX$!IRj1dW7Sqd8^WkS$#2jVDmM9p_-}uDS z?aa0_rd1!t|JuWs!)ASJdy2$wu^-<_2GfjWIuQVHJMKSyN0Kdyl#h>-~u}q~DNUmW< zYNcI}GcBg>dywlbyXG3uAkIHqNSH1sx(zw!awdcJ5{?)F$G4=`iV7qS;;cyFb9dti zzJY}MesH=R+AeCS92o!yOlG^u!eD;DyLAIT`#cs#PGXFhQ~-(E5DkBf=P|hrY=6i( zb^?^LPvaKLGupGs`;Cg;0B(RxrPI)iX6pt+gc{Gp3l z1!A{Bt6?^}qtwFK82s}q*|Gcv0|G`$QGs<4p^Kfz#FhX}~JU^FJl>izL z&ieD8`B2^SGfMY0*g`Nxv=Y*}9|R==k8&J=qC5UT*j6ti=_daN!JU?U+H_q3*ndPH z(^Ej>2h7ZN^9_3|d}b44dWk4J_3pfQ4E_27;8x|u0feD+7GDoON!SFrjl*0MDjscq1U z8lmhM%7M)t#eN3Rymv=)*9V`y&X>u!!NJk9>IeIQ8sj`8f2w>ruR6n#D6sxduPpG9 z?0gHrM<_X&r=Bu>TqZ{mBDY>%xNE_`SsaYKnMdFIm34af)p;`g6kkosZC8x3e%9RM zII7TUc&Izxu3gc23ptS35Nr@D_E}bP_thq8pI$MSgf**RV)%j9PGF2P*mK%7kz1(; zBP~{#t`gUua-fk72vy2<^rGT+m;ifclLe_W{gtDBz2C*VTIa6q> zleLo2SMoF$H+43LR8#s*k6Ui9SUhKwR2}GlD>ON?^tv87Q|_o*MWf>xLy)S#6Tdd+ z;!K~&bnBqG!VL+xINa*nls`}^K`}f0{XJyzmw*4w8C%LQyIM~fv0G;SG>8)WZujib=7o&8-$;ohSly7 zIdr&>6%Ep6o4XXF&#_d6KA1pcd)`tU9%%_LBURSb=u9xXq_EKIIqSWlKsPbQnpg7^ zltQBHq&_`eJLJtXeXH&kcq;bh*4ORq_4v=+YOULBiNdrs>7E<=Y+ayC(4uQRM;eqh8 zE)~PaaI2nPH@-ErxV+QHf1I{LvSHonQ)S{*a_;xnG|~bP$A`%#eHHyD;gyeXMSh+6 z6Kx4Y&wD~7S zXZFbf`uurqwhPyRpm9DcTFe}Yht-Vy_`GMG%-N|owPbR5JuD(RW%}cavPEtfy@W5= zHek$Qq|-@W-e&5qYe!4XPJM^`xGm+(@>5qy^`ZE%+l5$C#k?gYuXUpl@%ldiU>W$8 zzRCpt7H=!|XeT&n%#f={DvHnfD4c>K_vJ`&6|{dkiAS?y5Lcv5{F;SQ#(h!t8cTEFbm$k@dGP+7?;4qm8ptckShEpQpnimgIptDC zR%ZjB%bGP3A9&g@QOiN`FHH#b3lGt(DWi{uwL5!`;uD8^`RqABskZE)#jjtEoTd>> zkYjk|we)Vwtt>wOE3@8jBLS~e7)MO5X-Uz|cvrwAbO-l=uR=dbJ%vJt^cy7h@oP>W zk78vNt0#69iF`ojwcl{#c8`w2bx4}G8gkMJ00W&cvxvV}<65s3OxT7Og4slwZ5-1I z=~h3A20&pS(ZsG&{GmZmc6M*i7*R41rr;A!_|&;W6}@k4MeOD|4~rPQvz7-Ec7oI2 z!*4%=)!*OO)_irn6wF+C5|&fj|4VAJF3bJRz=g!JoJB2jWE-H~$)=N%IW?HbnE=mz z?0EtlBvVjt2n9~d5%-7PJqtWS`I%M61U<6 z8yVT-IY3%-ePE`N=vji4z6d~!>k0n8wZzA^SG2nwv^qDLOHnvgjOex-c+N>Zqb_T$ zdrJlP*Biaz-{g8X_ERnq^gqK{5gXXLjS|}-q~zx(5~6+j?$V**W_VRjuu zGdf$K#CNS@nEk?`f9DpQb`AQawh4sN)HQgJJ_^!`AQ(l3uO+T)GjR?b8(y?oTbyjo zB*+26Q%@Ox&n9?=gC#;gstxm!?zEdq($<+>Q7&#f0e}Xr3qi5jhz|inZEsgm418aO z9n^`Ay#s;I`~s8PSL_P&|MYIK77k6|Sk)B@uXhGnAh$A)Wv`@sOL0yzLOTjbOo-zH zM)4o^XBDFB;E4F^n?Ns?E+y?f(vI3AXQbgrAYnSJSsq|*)O-NnHXj1|zsrAa+e6tI za{hM`HZk}*1Atq+{|u zv?!>~oSoK1fj&>=T5w$EwsOkeePx0W;5Yqp1q8FOpIobH+4aO_()*UsD5*19B2;ai z16KSIEz3~Ol8kD=sen3HocZAuyQNrD22aem#H6V*kqf+C(d_S1qd$PQbg&FJe1FK0 zM~p>Y*&u1Q1nrdj!JEzkm^4JpRFp!oNQF$RYtJ;o-f@dT-&jI8|I!ug(wKmx^15(YdaQi%HS0ZXq-&*wv!T5 z>)d2Th;XR0Kl;Ti9#+kCQR7(O79zWlz_aqjE5!n-+9}T=-lFi4w!3+hU`p*Jz;U3a z;>{sEBMnNQr9yx&E+4lk%90(Afe9k@g)wzXUBsFoD)5VxavfD#dXkr}MCEy_0e+&pS(yxXZ$pei4J{7Ilr(dCE^5=nGq{U;AYQks~<{-$$B zruMi>PKXaB#?-hvRT0%RmZ|L46;B?9rPHR(Vm(c0?f$>Xbn3^YQO z3!>E$e7flmiwFHyCT)AHYL+l9(7L|*awB=zf9t0pXT&E-GSx2Ek_@^O|HFNqKRmK4 zM|5w51nDM0%`_};j9$Rc(ZZE#;%hy{F;dHA8FBMpYCMJMJ~f>dy(KV(Z&f}Q?jyWQ z7aZ2sge8~+u^k%bX|v|~MW^9PR+l~VqJl1LwQ+rI1wZTlMo0;UqpHJ93^x~zk}{fi z_T!aE9C4_Uq&kZqWr;=t`CD00NJvSF+v}r2jY`(gUROc8&1g;&HFH0>B<@k2=u1zt zN!|{hw;}zbHJ!bqY6=XG%&%3`y<0!bN-j}w&GNe@TY)Y;EtJ2I_Ous~qxa)GvmnXx zH4cAENxJ?(PfHCL5m)JO^?X2C^-( z7T~2-6-*u&R@?a4S!0)mFDJF(pOfe*|HhOr(T&dyR)Gl!be9tOdVUCNEYJ5b>Mp2y z*z5Q%^Mtgd=%3rNaOqG#?dY3b!&?@3_Dq`(0UC8g*$s;(HkaAP*9YbrT;U3k9438lR zC9u)2CM5T138eO8IxU~Rip$TlJB6TxqK&cio@BkNw%fAG!NHLx3Rq^@IOIkp2=`J) zoi+d~KF@{?L}cBVV)qQK7XSUh=nKDp8l3S)Ds-s8VrTmfAQ*=ZWVxuN?I{_uQ=h0J zm>*RUS_kxrwChg6Nm=jqBAgl~=Gngtj6+G_dK>l zNZQ1Nw+Yqg?2x`hRSvYdZ}3$fy9iz7V?uPfITG6#fI0u6P2?d@#V|N&)`(y5&D<<| za_(fhmmhUV*)N1Bg;FM36(w+O2u&yQV?Qr9_?BvzFn#x-DaH z4aR@zm|VDPXmp31{=kotEyG%Jb?hSeFUX?$r8 zma(|RUk44;7Oz=a)Zbi_I(4|%)?x;P0{Oj9m2MYcU1n27DQute0FAT=-}BBC8Bp&A z{}l)^aC*s+LDm8hrQ(lJETQ|*_t$BECAD8~#4pYaHuJj4X<`lQ1vg8$8n(GU}j}@umCLiCV=bXY~j<((HtzdX2~}W^kL71`EOQ{7Fv5Sao6XKoS_W zd(PK}Tc^PQ;zEwq*FZYjVQs97XXKuJT*p6%$$4YWS^A{%ee?vhCc*ysPs51fINWP} zHKDi?9_KB*L!FpZ71S4mloGEQAjzv^!IA;8F7ddk{Wo-z=mPyiL3}r@L&DV+D%#TT z!{kjIpto4E$JOH_5&sfssgxK@J|kw94r`$qAlbN>LY^hA9*k$w+5Ou+p3$79*OAviSd8vwLZ_=-J22rn*_5(~s4gI$n&*u;Xt}@5bpypB z@aK#YnX^>T9hK^S2=`@k|DG0U#X#+-FUNFq%0iO|vz)B1B^|A@(enC62CgZ9u;t zPK21{a4Oq_uA_s}A;nTjB){6_6u$X#)Ezqev*0KX+@!#xu)~@xHFQ4u8ttgS@Pa}@Z zr=A8>S8*#%?`sm*=6UOtCBNpjuKs3gRQt+P8-RbV9PRmxTng@N7KDq4kmx#GUcsG~ z5ifOoa!ocfM!}(#G%`gS(krTmGsNpT%WHg8rhPQTB!0M)K8AsbR=+8^)+R}1JK%W? zdYSu93t8+Ui9FGR-h!|z&>O(M%06o%YY~U3Z6|Cg&|kLqg#I>n?Vr;BsjhNp%gifX zFi!u~8N-|ph03X4t5+IKdYdYLT&TAH-rAn42D2r1@hBm~A{uZg4RbX>`Jd|S0i_|j z*|>WA+E)LfN5uPL^pW5M>xFao^jL6SB3hhGtA%xWjP<$ldJ5IOJ7e2{pXrIu|BE2C zQa31$rrqq^nL?OUNzhlmhietUBsrm7C(D$w7EyUK>t9k1{ZJAaY1z~Sn>O?=t9g~T zP?`*SV8SXJ`L>NK*dQQ%7}GlOd=aGTssyf11=V!^$ELcpu^4}(d=jC~A?4TMGNEf< zZ4W4*!$Sl%=KhF{=*Yyx_Qui^$(G@>c5{=$pMyMQMQCD2b^;cb&AJ(Cb= zLP1GUEcOKeLF)8?GHKX|iAH+hEUcwKVYqZ`wLnOhGBlsde zY;JrU;$E|7HU9?wl#Y1P(BygPVXPd>Oq#y^-NA+Fyd3BN?rHp8mmQVq9BNmm>10KHu5~-H_26#Dc4!=bW_jw`&YF`9mZwiWSS}bll$8$j`(9*isjc&Z-oi9I#n4J54^n z;HHW_Y|-h@__nMKP=|;Kzny3Ngwf>N+iegW025hoTRBzb1QLmpo>o6aR3B5Tl(Aw3n^)>CMCXO> zej_-1&X$5*ucN%r{L}##o2cIem~T=wbjwX?IyAhzhK)5~dY*Zk@=<4Oz~po%tw94T3btQR6J9m)l(Jbp4oY znQf*9QVs5|aUZ)ifJD*S4L)~xqc8&lI0rNAl=`aU`2apkJoQRwwYN74+}?$R?L`hNs{T-{_TnSgE%^Xg17YlRMXk3;zoWjRm zldD0JOV`c5(BkotjR&Gb=ZYCyXFm48s6j(1JgWUE%Hkg~u*hRFzM8S19RZ6Z25wk( zhE_YV5m++JZ0&N1h=cx*AITczuhlNrtW4b`gXtFXRPGTvsAs>#L93xpx_C?Z^DK+7 zF)hp>4<&AdZRLErvofR@XoFn{=k4UbfG2~`&!P-In=ZYmnIaT`u_IFlw+khJ8s~K= z@gW;3TyGziC*aJWq%;SpbFxRSIkE2!^9}FErHO6@ey+Jj5=ZLX$q~x_y{~khn(xzT z-;gOip|abAcwB&4opDLyauG><%fD(g3q)WQQq;clAb)x?`(!FHL=Z*cdS@ef1 zH*v&rC}|p#eZ)tIxp`KPcqsxN*;3^G!~XYH9pO6xf1ehFrV(Ds(q*nmjg+iVS^?1- zVblW6*sLyP7(MFgWN$)W8k3q2)#x+_EWpv*K7vuVTMIche%aW=DM(9C-zk_8oXB*+ZT2ulfXOXE^@{ixyY@TZp?E zTrZsip?8Snz>ls5DfHSY1V_BPPx4{z1i6ZVg@_wzd`!tYAT@hdSw?Kyy1gP~laCc$ zzEg$N>6r9`FuT)Hqnb9B@V1r|_~aO;$~`c<5I}@%BmlAi;uq;(riDIhy1p-vfYBb zfQ3rx?lAFvs_jB-5oG$ERJlTGex_aD1F2*V(=F9|LUlFAF8P<+E0fD;h<(GCpUvs& zQwJ1+jA&X|zp&r>lhM@e)m284oP05?WtJnJBO{<#_iEeo2ZtTcz5ghpRlb-R^E2!R$=MM`v+0V^#L{~ucl zFg_S z`_6uub|}K%+*+9}zb~ZkX36+Da#v9kJla}w%YFlm4hc`MvhzY>QsehB@p$Du5Y<-!QZnN?2m$`$JAm?l zyhI=Q&$ET&Kb887+A++<(R4;hubcm=TTV9vFv(VM(H4b(9kjjC)S*(ENpNq@(cp5) z8z%_nBa>T_F|5IID$A#?;#2yL*!VYFT{b5TK01CJD5x~sH+I|)b8c?7UMC3y<4FBY zlg;L0BOrh72l#F~gHC7aAmfEw01X_Zi#~ZdNypJYd}sSXoidkCS_qep$E7}=FJExp zBpL5v9Cq-~MM}h{sSHxP9upcG!YD;Ew??(B5 z)=t@Izc9k(*AM-n$3pWDk(x3yX23N57!1BGeY+~`J^qh5Y_Xsyv(Z*Iy3QF4WcO(P z7uD@s|E8c}&L;+3@r(^G5Ix=gT;*Nkn?PB<#gM3-{_JOBm-S8qpz%cBA$Pan7<$`wfv5h>A5R*Ru_x3_A~`_e&qN0AzC_%MiH9n z3?+pGaWiJJ=XaLazyc!xi;%pZSQx}hq$VhKa{-URDxW@hU$E54Kwl>8Aihg5!l-r> zK2^JP0ub1(6y_5<8!S;<1rQk_ODO5ts@@v4NCcYBVvnA<-K8EIhfPt0)ulA?&xDJqb<;$S1g2fi{6s3?@$Yl%foKA zld(2|93J~CQLOXaAEox~pt!3EV|Lp(dJxNR$wA;|2Pr=Fe8i|;YaSiKCYj^|RT0do zeYB?b`Bk0|v2$c8H9+y}p!xl*n*_#3=AJkSEqkRQL!9H9+Nvf>nex3}lu}m62P5&p zDX8WQa?St6oHM*-IwCf0Vc&w|J^vf6mwl;r zk|=p-@4w!B60n!t1q%X{CwxogtlCEiUss zaqaf7%%h4XLwY&W`P#^I;?!plRE@!Hrl_liq`%T-G+zZ#H02%mmvGN z3fd-l`cs9lx49oGcQY6B8zNs@Hrf7~VtvT$;^lsO)AD>5Vpw!lY)uV=m%znCOE$ea zCL+PMI#eR&x@ME!!2!_B`zROI1~SzY9n%MNrL<@X8~%75xiy~UvlMp2!HQ|`8IxP( zbSmpvg_(N_{fAx0JmVuVf#%PAwx9>22lM^GB{mzpqp+zf7HC1k{cKTw2lHk3RQ65HStvDMI;??H7{f*%9-*pL>lGjYQ!*`Ihs!l9?h zitzs^9KC<9{qYdw1(1Pr!sd-tu@DYBT5aR&a>nL*b0?~=(tTNhU~geb>pyJEvrd!Sjwl$!06fxU z{b$Xr|DniWx_OaB1fSi0&cc617DA;DMmc- zihDbmzLZM&jNAB4%fads0vmZ9bv#6bConCVGo^?=v0k%APR1+}pL-zTPL+ytBiaas zL;_aY^O!PPp*3ou(z{GYv(YrNb3ML{{)dd30|6unzUJNTtSW!n$Q9^$D6e6_DTT{_ zIJ;0ny1Z4q z9JBf|US!k%I#3|BIYcFsj*RcuP99@hf^Ozy>FY3;6N1yYNV4ob`A9B%Ss=E)<#jtC z-l>G6HuRI*%CtpdYFYfx3x+j$v+=rZbT0Eybq+r?I0)4+ISxbSLeEHieQ(HCA|L*Xy)w7e+$6r8ebgT3e(+z&8H01C$Hv2q z&0h^3W5Y!43;|Bj7PXmZ4_p-4@{X2&LmKWE{)@^#q_{mAA%%^S zbcl;rPGOa$Um=a{uvI{t8ZB2>LNe<5Gjd#fA^zT_i2Gej}2mU<+?5J9Xej=&Aox4;+#7b_<^h8_wpeXa) zD`#s;K09obVQFk5#`>UvG;jV|6l|6Vgh>}jnNb}* zdpAP+lO|;3HjY~nwKc&Ni<7EkZ3UF3Vr^snFN*L{mC@1ldy`>^V($GMHmYvVgCzxg zO@daJnzZ$gM>a)3_N$(-!WAl!rJa-dbD5x<%>&F zpvF7{Iwto#0egz|J^gW_G?%}~0d&1tFSl+t51!o0b$_5;O&t(@PB~4fHBNgr7!;kP&m;JU1DXMV9hT5NwvZc9aWA&BQ zTluR=w1mS!MEXQWB-@8|k5a1$4?&s!Rp;1knW|}5qOt;zvM51@dN-*4GgUwt`LMXB zF3FZ+^}I$`=q#NFpp;5s5C)g$szfhyy#%ofvt>!DeuxO0BsIJaaXdXZwLI$|anFqt5(wZFUDb=Z$tL<(FjJ3CIShfQ z{nd(NP{2FPNGEWeYAlQdDGJ2R*)VA|(mf2(cNXo)lAsp$kNvXn90d2qSd@TPcBqzQ zV($FW1@AIc74Q}o(frjqP-0>$j~+65K%asq&s_S?dgcEINs(udy!qK?de63cw&7Wi zp}*>VMpB?!+L!Zh+i z&B;x-AkYfvpx!fz;Y!pBL;Yr<9NSF^UB!pVuCtJ|wP^%E@Pj+&W6yzxDJu;sR#Vj7 zWY5?i=u_fFcb~gkbcI6ub);xSxSCu-^04f=*`e@oz;cjvhgep_ypCADw%XeEU-Y04 z5BBC9vv@}4&kN)-uv{0DB9`$b&*k_}-A8TPNmC$oAu5L@iFtHa$-yaKGiB37g&0Jp z`=QKBX_E_?^Fs*av6~#Kdu2oOb=4y)`^PaXysLD-r;ZHZ51Ne(M6AqSQoxcO6`M$f zei%?bF?hamHgMWI%=OZ8_`Njc@Z6v5W=FwG`W9w}-w2R4J~K9DvnQ+@F~f5>HUf() zO0d|-yv}mFkyvxs7K_((GDha)WG^_s6wS1wLy5@%q=6lscpNw}b0)9%H`7 z`e>r{EQNoPgr=J7>6V)^sTJ*@vHA@-wz%<#;~}uPI->F#dH4kyD^AuJn97`>JXqnvKGoyeCgP0;x zR_xpzj)A+P@KL1FburK1k&Q4^1uYyP%oG*FYg?0ogDjLM{4D6a_6x}8`Y_T@%n{JL zOtdiFP)0SN6+o6jI*w#mr!2W$e z=XljY?Q#(@*tF$@6dQY?i|qA~TRu@s-ZP@%Nm>8(oQL8Rb$W++XRcUsSL5&Q+7$Gu z{DP}?iPLS+TP7z3-?K0?)1$t2#zRoIyW-ZI|F}ruxQwP?uK7G|drvz{M|^S@SPC#X zZ69RFD5y#t)Hz7_(PRxosNN#ro;)f)ouxOZ^!`(5`se^4QW(vlq`yEa zFxG?;)$e`YaPtH`5Qbxjm#1`mKemLQ=aw2seFRP!$t zY0P1HMM!|C;v3DUB3uu@f>~qa@N4!%?JHMjNH5eAaT9?flPkOimwx$HK_mXrQizH) zA#tqe$-W9i6)){R1Ghya$=6u^Hg(Lu5b5YM48(Pmm#XLH>+6w!#m#Zi1x^x z!nH`2vYGD+o##Bj;~RBH>kbu)!ryJ`#J*gK{?<(#tlReH+uQE$a1>N9f*trzfJ>Zj z+)IlHn12|4`m@IqyLJ=jXT0ra&lKec`0Ed`mm`+j)NN8vuM&O(ZyEsIb5x^e zar3lLcni=7`IXQ2=p-vQHS@jR@Z7O9O8a5{bND4{Qy)ab1k-a5++60iwFH= zyXf5o8#CbRZLPf(2G1*B6RH4L8D^-GaeA!%5 zgm;Lz)DBhL4JX8P$DE1!8aV+kR(PYhyQyQpD4T(Gq5$tFf*ii_#R>+R(F=Xc_Br`q z+3=rWO1LMAN0X$7-~C=MN}v1-R;S4DgfS#%0l=-o0E=o_;7Wn%{DA0^B2V{<@>UYI z({`}0fTg!1F&KV+8X>fHZ+(H-%R{U|SJDT2EW4Wy7qyZUEfpG_00{2Dn4naY;jR1G zOs9S?lHvRrI=fdVZeFRoL2J*Hc^4QDJ|VF)i=2zuYvv3QJ8i%a$3I?m3b`MPZi|Fj z#bYsgf0i5_j{of6@p=8FZF%se263)bgGho z{SjhrhsY0A2j@nfg2N9S%Poqpx=G%tV=GYEre%oI_DT+BKYb|q?Shms%ou9ZjT(VS z_R|auaH9g*H@`-;$veQ%R_#|!37I$P5pb-@{gMH5sTnw&wD9cXeI=j@ytmg5dtt&O znN;zloZJ!`W5VT#grL*)FIbGr3FBOi%(`4p)}azNo^K;2VzXjiCuUDoy6 zPq>P%I5TA-0(;qiB%xV2d)QI|as++z7^0|=Zd#cQO7M~qd`OtjAHX596Esbi^xfy2 zv)T3>Po0+R-q6bK?BOswjYIAHzT8*2@@5y645XAO0Qt6e6HSM$SS|MM7TcThg0YK{ zJ3!KbV?98l#3)L2ubmori;q+G6F7BNMtD0@=*6^2O5vW+ATd;cCH0H?1?#JySnuH?131d$~_xakVy9b%_fWz#wI*h!%+99_bOwLA==GGzJd_~<bAFEdRqhaXOgFtFmeKMv9-^|F2|xSAh#hjzLnbrD_c~hV$WOuWB?YG*yC8dqdlD zQ7&u}nF52nu(JLZXC$nIQT=LG_{+5_O5y<0*vKrBl|mAB??%Z7@XeciOq20AB|&gKZ;9Dk$VVnMeYy?>lws}k}mB1q(6rJ%3` z=v((>um5}=7n5mBGflkANvuIzLkDbghj3~5&iG=SxNN*&veqo7wRa`4gwmg*`^Dsc zXgICdBzMME1~zzKMGD>HOoBI3^c8Ds(uqBMFD-SBWWzX(&kGJrC~+%hqZJ`Twcm1< zW-&lrGc$Mk)D4o`YH{xBF394uTOwX)fE=+!aXOXp+jVv^iQCZ@c@eaw5v^v%7=|w4 z3anhwj<29wUs#o-ynO|9uvQKeC#s~6Q_kh;4L}Khy-&ELH=sv@#wUq*1!~aTMBDS* zHB;Hgz_EI>zK1lE!r-_HfaF z9y#?5EeQbHYJe0WI^%?beoDQnGv}>OH$9?=(gi%;p`EchkB@AD^3znyRw*GGYB7=V zH8d4%@43>Yvbl)4=exyu%OtI%GHb{&PTC(~rlxH?u;S}yCKMD@9EbD#oqj~rz5qNKd7drcXYwqV z9wBJb;{EP%d?cbecdw22sFl1?1TspZry9KS{mN+kbiF4I2FDBB0|TIfYQNpCI>*w$ zfW0hKUfcqpuyflfDBrWQ(96Pu-JP#KQXBo8lAvg+OZYhLZG*7Tj4}MtH7_$cFXh_$ z6Rd?9)J9eVEnIX&dC%9ZSRBMq)e8R`&|R^R*}?};vWeA^WU_(VmqDIsEj5;NZOaC> z7|)6c5<2y4FG%{v;W$G{_cS>8sCiJ|&ZHr$hBg1e+GnkKm>c|Coj48wmhg^}arFPDBgDi?8%{0cYy(0-X%wT7LE6X3kH3I)>Bp z1y|`JUkS8C-T|wpTSu)OBAo?5Gp=Cd=7mu**Dq*- zM)}+^vGQ)QW|*H)B%uVTV&m6X%-$8-i@{`dV&}XJrbVEIw;5b7=kQr^DMsGwDjmqIo102lQPOp4)t#D<7&u2tw7o$2r zLm(VoK}IX`dDX96NH952BC8dYDa^6ugqnVhc*9jPf)lCmHR=r|<{r(UfQ?XExSi^< z`7`7Jk~9Y;Rj9pHg%j^#b!1{e)*VoWx|w!ksn->xQ)@EC`i+~w=Z_|Eq0V}*KUIec z<85niqxq6_s{lEr%P1aPGf?~BJ4*#&j_z5-MKSe7~{kXVIZ;}^8 zzFD+H3vyC^R<2+DDKqY@$|vO=Qya?Aj5Z)NH-=F+O#{_3XcwIH<(2tt|5(d5=hnxnPVHgqsVn)gJmh*%u;<;_m7 zBb_ZAl#AWDYf9b_x?cXwT%1U`}?x3B{00S@Y8z@SS;aYz)eV2`iGe}<3p`!zQF&o`x_vbBwG zS(<`-FH^P@p=UY14gLuF;9~d!oJCmYi$jDkU|;71-jWe7$%|bAq4SC?&xw|O0)Eee zLms4MW5&A`?SHTd)lXX7Jj0{gkN6F@50Rc`-V8J#tT$$46O}2{u}_W?0Cpc;Hj{f8 z;ytUBMy!|C#*7_fnly(@d#WTdicrM=wy%?wdLONAi6QJDR0p+DfX69vTuxi(^KH|d zvj~D?IW^3=4Ws-xM?2T_ov$>}=Mk}RQHY~$~&==L5R7J%m#yuH+l+5_-OWZhmd~w?@qLoGT z&ihW%e=({0X{WP_{O*Ut%m6DqQ{2KH)HQ`e{0Kn3ooS@OA`~3!Kp7w4-9VadSp{QS zj(dmN{%X10Qh5)2(*O9^Eq7Z1JPqnG_lE3<_;DgKp`Ds5OG0U`v5>iH3RE4iu12p3 z+%#k?G1jcGg#)UPJx$Gc^{Vj$j*Rovf!++_2}%$iMmO%VGm#Un0+Ur|px6o8n|~;K zwRmiTfRHCOAvIT+);TFKLPgBhSXKyQspPFH@J_O07sc zOvV8&qP+O`1+KGO_K3G4r@149e>2a^S`Te~Ddj6*T9F-OFH5P$(A;*svLAmV^)9aT zHmgs0Wu6Phc#D>rqm*W$xF>aOmi@I~Q@nrtmT{dcSOvvW~8*w38CZbkkVd z%th$+1T zc?d`^D8XYVcI%~u_aV?!Ym??qI|{b@-OR}ELH*UpWC_q&UTRRJ-$tLlQU!|38kE_m z4A+m8Eu+zkIR>FnkmvU+jwhakvEo3Exy5K5ABxN|Mg)~EMal8WB%dQ~yE~|YVk<3x zd2?dAvr!CupFLJ~y6yx+xz3%RhlRxde{Bn6Eu^me)?Sk%ldT{SZ&pasEcW~*vF4DI z_V0>QUjcJVg5{|1C!<@GnVn(EvAsBOpq1qud1F8nYdZQpF%vpdo=6b)8`j(Acm3L|@|V zU-_D^TQvpF{|bs*WZ@mfWKyc-`R(pVqy&Y3!Xb}^D#V$+>PEoU8{A>1^Gz+bteMrq{Co literal 0 HcmV?d00001 diff --git a/src/tests/hash_functions/c_spooky_hash_array.bin b/src/tests/hash_functions/c_spooky_hash_array.bin new file mode 100644 index 0000000000000000000000000000000000000000..59f885bf3be5f5e9dcb96decf782618a5ec3ab92 GIT binary patch literal 32784 zcmV(=WdroFxh_FfYNuc;W zS(Dw|yI^(Bh95j9G!x{S4MNRPQ0q==hUD4HnyP#)-!+aqHKz+{?pTL-zc8Hr)m&WKEvOP2HVJ7ZW4duu$T#bXp5f1VG%FXa zKh61qLOZU3yN*Z&1B}&*p3Yt)vza^T#gOfhYUSBU)YY2Ex`Nz@2H#8F)_uE1t5sC0 zU4GQOnWEj(g*5MEqz(Kp-U-<&Fa)`;W2}g}cbDZZ$c29ifA0sf6t3t((+$ph$I|e18&PuJ3@lP>R zK|Aj2wu|70m7TRS<-9N2v zI|+`)b-nA%pfhZ|0}uaZ<>L} z-VYNjE{;a8l3a%wHanrPIHXe@-d|J4q}k?GDv%uuHGcCPH63A?Np;!vn=MMm0ESPA z#!v#Z^w=fB5a$O~h-!=pM*1lo(N1aBK<4_0uw^w4%@XC`31|>fF>UB0VXN`MD@^al zh~9>%rL&kPIuFXmrxAfORF*up_LfWZ;s4TsvNo(B#9}Ef1EuR_|5jk!9vg%@Fclzo z8uuIBNVQ99!APkEoituOPL><~mW-rQ`@ba2e;`X$X47D+sd+5fCKdFKYe^+I4}pR| z((3GzTPA4Lk#>#66rxiK-@7#BnG-A8qv0WfP++myirUEW_1K9VO&9{{YFTh>;-}+}eb!?Y#7|b00L=7-nMtZPFljTBTlu$bhvLae5S)CR zFX3Qct&Vy(%8hgtu_S=NUw1px;;#jJ(Q@9aHRRXri!Bc^^=~luQLu1NOH;B z>N~n|nG{)^`m9VHdok|>>z0j964>$gU*?~~YA~p^s|FL5r}`b$>?o1z)Xo!0VSt`1 zg0KNODzWH>mZWUg7#$EYHqkoFYhx_Dclbu@jum}~Y*qJOf5kibYJ66+2{*WTuwl}B zAwtu;X{SDainAR=+IbwYr=@PlkOH2j92Ur7x*7~prOy{Hi)FD9|LQu#4;$A?9GwE0 zxopgw!$d%vf+H5rSaM(rqPbfoYTez);lOOzhf$)Bnj*N>(6dqSwnQ|6O*cm2n2+1i z%&qAz2z{9q{%64C1Rtp-tIsu3Z5E+lpBpwzUaR$?Q`hSCmjw${%1xbD*I%|;%^Dqu&8sMap?2j@%TPN>NiO% zvGV(2ChigNlF94(+{%4e4|9C%&-TzY2*KcBg8b4A$_O|Cc;Kwx8U3%FZ)TS2r|y&T zAz3&@q*0=1C?_7^iV9|ZvD37k$Os_nhU@?oBCajg5|&fL3xSWG51q=nGZwFmSJ^8N z#a?a~fwTky(jqp(dcv;8(VIu>I0-ZDYvLB(C(aNwjsK~)RiNqOu~GnzqXVGDR(;;eaH(ki%o%M>IVTM*cEB`?HyYb#d^t~}KC z)q(C;{~dxHNU5ewHA)2vS8JCSbAnofqFi?Y6k(F5jxFG{)!1QT{N)1~E|Dl;tX@1G z?iF7~$X%Qc+8BY1)L*THLEC`0l=;}<_;KVpWB@e8FBigL#gX8r6MErEnGx-awA!+% z-o~?QlLT=A7~V2OBSH61rfguGb3wt6YCz$nat{*{Rh)dVEetL5)yRjhL%DI($zCJ* zJym_UVXc-yzaTKRP5mlj48DXY2I75pqG7a`B7NiDqa98SerW)?v-sbJg5PKf}J+Z!R0osxV=qF^YWnh zXhzpeCBxHXTOHK8bix&!_UsrBNpZbBZd%oq?mGhtuC-ydqH{5sx!{buXDW$3Cibx? zi|MMXDV0x@7tC%OQhKzzF7KZ2k*?hT{;Ig;vE~Ren>cb7C_L?}2)}%#u*>FoZ0o;{ zZH?VuWRm|8djuPX^(^bko)^<@V502_v95ev|HJq&yaB%96S{_5QsRk9Y^R4*?$1AD zI8BwqE$!o-rm1%stuanihHkQ-_vT?Q^qGlVUgle!g#Z|zjA)556sV+4!{ivW$AS|V z7f(m-8bRO%4k}OC^T4Csa6sUz6@h$#jE##?5z+YJD!?;|rZcaf63sQHIhPC7#5(Gu zHBmj=MbR*Nh@SOpvs(nxwo_o!L*q6qRxQcXCp(5Z678xFBE8u%NNlN3?R!J&2)~n5 z-OCQEEE=%vMPyyip;kvHq@$cMU8TG9QL-!i5xqqwK<;~H5ZnqZxMfAv7D%ctAw=3r z`i=NMitqlxnMwO2b>=KMUK}25WlMrZOo-8Ujp-pA^kNw6a3uTPbi`zw`4QiyOaDf= z`MryiWSe!2UZ213iP5Pf*Kw7*&U~!U2;>x>`lzElf8*K3t;y$x6~=uhAskF!uDW$U zCHAjXg8D^oG=AO^^2Y8^2pF?Q_nMjKA*Gedu$54M3zOD5i~ko=gX;b3WiObqI;#7z zh;@~=hLFs%+=Y&m&>@RW0M$mWDGE%T2-e?i+b9owR<*zj`tF&hr^5~0h7&syJ#RBP zPW*asMH86Cn2!qT4YMUqc{yJF-{Je$;SSf9!x`*7R(CaP&8Py`w?iXN6K+lmOeo`x zXHAaI4jl7us`~=Vx;GLEE2;&+zEtVy1 z|B-7b57rdL69<_$4x}OCeOcGecyZDiCEA@W2IXFPJZ|>vj(3*}+T$#N8>@qKp1K`{ z(4NMv_e>zKP1eQ^7-a)3oBb*h(I0%F?tNy38VV3uD~45s^T)}7`27zh-;i`qmt)^#^BMPM;f~Jt;@5p)Pw!-PnNxs@C_#YI-&gAD47`>XF`A>MII$ z|2D@-6_NVc*hdSyz{Eu!E1{DmC$l>gAtsTQgHf{9?DbgHhr}KQr;~&)p0dhX5>j)K zlS!XI&=xi$Zp$y9|AZY;3H0*A7<%#A?g1d(`6`Pfs~QAM2YB9#YD~m&`Wzw6mP7g39pT- z`Xf0K-okMeKi|q&U7w8nT(<4jGL$y}*VbklWnB`oPhmjI zb7}OoL?N2iViq5ejgCc&g4SycOBmTa?C_fwq^G=zmP)v^{4m&7u4-{4P{CiupZ}{} zQy@IuZR_x29{xO*ld&lavih3S&>^u9q-~JL8X&F^vZ?D|b+C^-S;f?f3&#n|54ix1 z4XmYF;o1^oYfc4Oy-|c3;tHhVYd=g&6ntYM%lb3;)}wTGfuXF09MXyCJ>gEe<|4O@ zpPr(RPZKfGfrq=$y>u7C4^$dR$BV1*6HVmo{i~=O7&8s3(W25D?WZ&c2va|fXR>zk z0p*eZ7u0;TIcXTVe}`AM^q5#PePP3j0;Y2=D>(k)1Ec@1^NI5rwl4vC&n~atL^f}+ zO-BK;O|s*lu@xt;czP^|WC3?Ud44TxfydnMi+aQuvS?FqBhagdAo2Fx$hX zM`_qxj>wNxd#SndjF^&bj21rM^ewv8#GE2+ni?77BEZ0ay$Y$&kM+;@y>Imr?3CnN z3%MYSg3(wN0X&Vfu(Nq=T`iku%vo%&Xg(5EwF5baVo2+O$Gt3@#)oJN z{=Kl4R~bvSM~{Ft!TiABdc13!<2*w)^!-$8WgTw>eX`{V1= ztRpp&yN5qCjjQ3|()wtI*=T9Lp5x@BRX+;`Fa>kBQXX3~0meX^`^5};+n72I0oULlB(-n&jQg1&T!-! z%i!zZ$7}oZj^=A3zXqwraQyFu9ACny{6m%E;LE^uK_iEt9U|jYBu_{xe)1Ov!hNim zGU=QB zboZU1M(3X9DI`Qjbs;DXu#aT#gzCFdGOF~W$F zvO(yqD&U{ePSkZV|BfCRUUR8qh~Atkph#@HTDu6X}IeCuWv{Ev}loYA?tQY;1;JZp}P7&k`pK+EtJ z>fGNHcRm`-oK}%W%~bOaE$%BC1Db`uq)w z!pp(E^GpW-E3KyoE{+`i$EX5q;}T-==+)CsYdV`vD{$lL=DmzU%{)Ugr76^=sH{Iw zb~Rr3;L)DeR01=3K5BT*CS=l1e-mgY`k1iKNn@b-6A-9x(srMe^sK^_gDt)1b+w55`;(Pim6_*N`% zr=v)DlIhw;=tsn6Q8XA+xnCPfX8F6c4{re;L=4+!gPZpaR18JrIZAe&;zriq)FPkH zhDsF6C;d#aeyL{~PqQ;?1amcGsJ;SQY4UI6HDF6Y2f;^#+0tg;0_M4e1t^K5HsfI~ zUHDYCR(B8Y-8kP7FaNxLR59C)s*%8r+GJGWuPj*}DRTQwH^>|Ld=u^M8Eii7$$Ac` z75;g#^8g7bNE*NfKGAf6Ydd^K%VR%@y`K4Vrs-mG#3W7JCjbxLa6nGj5=o5nx_s~tk1^I7)5#)|*AbKvuVsjNL_v8T>&l<}4B!+WQ&x|74l>+>P)^CTF`i8?ox zGV^WJ_+mIIldjTJpw@5=gm+6C!T3@$X`BJsbt)^FuvG@Ye_Ql3Scv%R-L9oKs1yx5mqCE4*UFo-v;8MQe_MJpJYiIg`_Nqm~Mob6WCabE&> z3uC~b9)al>@Uqgpbw&>?$bE`&^^M4PX?aWe|H_o_oL7j`*x}cy?=8hB^9y3kb*N6d z+yV%CvAV!Yi#rs}V*)d_ zApjTgC=Czdl>Y?Xy(H^q3~Rz31jMh7=uU(-%&Md6mR0)tdeyftcsa$o%`>k4qpj)1 zBq@gx*6Y2*Q4Xw5ij;I}g5+H*k*vb_*|6prf4^$V?T6t~1Vc!TmwZL*_(%VONcGYd zn7e;E?i$<;%}|-(VusbpRW^D~YGYHlRw*FBO)q1MH2DU#L)cw8Al9WjC}x9BzqdnRmu@1wjxJ*(eEJZ0Cc$3N1pqW6CCCsY=^ND-UUgpKD7)}!># z<$#HW-8)&WVGG9xc4?OUcT_$brVM;_2?iiyhvu6Mk{lGa)@@7pdkl1GZsB0@rLJJ$ zuEfi21+}33tD3W*S>oN4eb*4|*ZiW!Bn4U$r|fgA{dV;MPWGwZ5&{H!)hGzo`!I&D zXsfMZk)!SPyh@BbSrWW3Gs_bKwsV%K!xc&O7IB4-Y3Hz%V<}j`HEqhe9lOM9bQ%xI zOio$6{;LGtJAnj`ouM$GS~1+?D=Ox0%bi4%(#Xf>&-=9TA~3}uML=1_pgz5 zDvCc4;BKxX0vQdg7}F`E2kj$r$CAu5nWo>^NOqKmgJP&a%6{OUmZ`~UYuIEA%nG(? z?Yd)lA#@LoNn8yZUelBmRNAaL;6>vCT&_N$>~|bxUw@ZzOA4ZYAC@zXB|N@v)SsvAKpy9!TFbj8;K33%srB1orlG^Ger*clo|R3~gz6SLZsh z^~QSmLxxe$F97LgkTM*k22#k#~-)bhGSgPeO=m-_?Rpg5CmsfBpO z{u(bgF!*hIc_3?0$vfJ&R9@`=UMqheCyQcLUei~n;CM<0Mt`(4KkYG*dZe>;&QJ`> zi--sv|0gQUA20M5 zH3r!cg0eFeG%pZUhZnP5t#lSMkDhf>cKD$|VN59nBuvF->7=ghDJBp&Gd+*_^*9(l zmLb#P3M*ZZTuwruo;7(3?0^{Ior(i{bHOW^uPIck?ZlT4G%>qcp}qB zF!1oOEYNuY)5hzATa|n5&+jsed2zH4M-9kmpsl*)*^ZjopP&L{en45$!IE*Fky(5c z@VBvZP%2zxw;Ro93Vz3LFLU&ob(CE>?V6IX^}TDl_Y$Js57xx3l%qXa+FQ+>jA59K zR{s=?Z15`XBD)4W(n)47oeEY1RBn;^y%Y{^Iac}?F&gLwjWJ4Q6N6w3q2UKvFl-tF zg28vWBtQg>d?=Tzqsd0~v6vaX2;-!NB<@RzfVNri0hvo5=O&$klA_DTT0~v^xkm4z zDNk4H3yOYs*)Bk~9f!RECKkBb+-YWm6Xs}AL*&Zb7IFBVwHb@i{NgFoZ`}uGBd8wU z#El~II+DBn4=X;p&8%N9nsd?^y3}qOPrvQ**ly(z=3ww)?rBC5*Nw15sqEjej^>VM z+)XAri+QvYMs*iecwjpACu0@wf-#z=5zp9c7aG6|cRP_9U&*sS^#j1R3K6iCw_>!)Dc)$`_NH>6<#E2r*mP4O0Kj}U;4)MXbMY>jeM zkOzNL{j!&9@r~-v_^2cIc*7rdoNeI{;2tJjAPJis9k;tER7+5P^*zYQ`5ZkjrR}64 zSFJg(XJ0b;(JNvpK;aYql=WFxT``a&QF0JzA6t&{0$K~}>_owieuYH`Te-M3>O;Wc zQzK^Es;M#KBrX@|f?oGleHqdZAFWd=3KgUUNVnXE&JTss z1WiXj01hd4Gl~Pe{DCyS^z<&HKgAdq`vkWyf*x)I0du))EY< zw?{Zc?!EX1vp8d<3Td;cXz>Zfku+C}y;_ra;2x%rr2~-MN8o3PCy-x0s-X&|pn;Fy z?0PYl0x()-&YZh6_;JnnSB(6EpGOp(gYsO;omIHxoV|r+UPGXIO2f1vlOAI5$qJIL zQC?8Nqk}>*v={02pVw?h!Onw8htrDtYEF21 z=e(gc2z~2Ss}_h)5^)Gtbdfg88-{CDYu?#f62#ohpPV!5dnb21>>h3ZmFh?Ip&Eov z_!feU5@A=!aFA~pfPBaEV@~#O;+)Qo`@-XBFXQzbIBy<%1{evlek_V9Xwyh z?7|nt+(8YtpoCg5V&daV#RmGe`jbD<7_%%lYq*!g(#X0xkJ3>-cY0*$Rper9wSnh`@G<64tW7p4MuLu}*Xp9wnDz&&}zo;R5u8)KR@@uyerL!eTxq zerVQo4Y>^T%0-!9&!3G1#BAu(C>Udt-_HOC6T+|%cUnl$fB9bKj-Thz62l7U@@d8q z9pe0feQNOWn8v@W%U(=WlN4*D?hd@zk`}TZ{>wffxd|Doq_B827z}+QiQiz`b66HJ zL33l@&R|^4x{!F>7DN7jV{Xwn2TVR)(LIyUK6&W(a@G>AuM!iwGa12*AJ2}zWzoMv zes5}0F+K8GgU|uhthSt$QR|&QWvADV)}@_VQ5d6J;5vgE4{q_me6rRwvU2xR*Idp%GRf@hC ztFA&oLMGH6gvZi!&y>Oz}O)xVGIgP;kaAE+kx|AyQTK)SB^~jcYC>K z4Zu(x9+L%_t3d773@a5$JDqY;$esaz-zalVA1Oax3IQ(o0SW`652BXV`-1hY`M6Ie zUN8tX3n}U-vvfkigdbHT=Wnx47^JYuCz}_&Izyvj#sBDw^c(~xaKA~LbW&Lw?$y>O zaUL3@kILxEo{Ot_;*Fca$v5^IQ7FR1ep2n)ct z+;|*^#~_ogXOj&}??}RS!g@WSUu@Hp(Zv)zWcM|Qq6gWV}xy` ztDp9XO|-*Zj`3wv3d~kK%V4<;NP`F_y)AVhXzw2+!yJbqx{SPqrPnH0ulB)aDh+mC z9@?410LsXFyCcMf_Lhfg5`Do5NK%*04~s|G4=g~+t{t+Ix1{|GQKMB8jxre}d^^JK z1Wj;H`0_Q|j;H9t!5^f{HsTa(r2pA3sxfD7{;Exf@Y4?aCz70m3-=?w8iS9zDzJDt zZ(<0K*R_b7*2GKcu1bh3P-}ihRT_Ypqp1^o12kISZ624)mWrz%n1LF)OY?g_Jd$_Q zy%Iyhisefr@(Hmh!Nkz_dg51*0fFl!`>8mB@?c^vW{1CC1)}dG`s}SCjMi70ed+0N zF5?F4CeF=Zrd4wI^=dQV&%c4$$a|Gc63K8iQ#to#)L`PA zcwsTH%sL32?#w_pPeOr<;|e^)7CnnygWB@A^p{^ZKaRC(ZLoH+IN^|BscSxK_sQLyX>bG(5&laF7)Rp|%o&pGPxP_YKgY zeSslyV;nLEMI=xY?L~J6`0vU3$Y0{k44NbnIPtrOkoZ1Sn)iI<2vZ6CY!gGSah%u0HHw*&X_M$+NWLTZTgvZ`|-E= zQAGZck_s^!6DoqMlhI}8nP%cxhX8E$=p{NyLfk%*6G*}FDh$N9pI9 zIQ_3%RWYkv%t!U9=I&mHO`^`)dOoL?#KvyREC!k@y~hQAXZ>=`E244@G$V}&s#m}Z z`luHas*t|MxhVi$k^CZ9e14jte8bk>_cf~iXRA4Zusv^(F9B1iDJhaIV)U(v zQN3b-2=*aeV$=HP+k@6Lr;=~j76AvZ$?G^xippAm#Pm8#=t@nH__X$x4_jXBl=`tG z?7LCJc`f7!Lemq)ew|DBi7N(`l)tX#cczdaH^JNQ-DI+qMOR3D5YTz~WI4!EF@_1r zN#kz;0n#j2O#t?54LQ@^z2$>R!3kxWWUC05s^L#XsM%IQ(RV|mQbq?-C^vgdE-Io} zog6v7Egu>m25nOFhdxQeFvs%8$J}ppillgLdP>M||M{3M60?=to1y|;{^FqMxmeZf z^&FCgKr}wHBgU#V6X}$$BPtkN+C$k`zHeCj3xGtGJzi7&CDy&3XV~tJ(@RW(Lkmtq z{2n|lS>sy2bCqA}ZHIDF4bLyNuQ?te1;JeE>smpYG#Z;=Z`Qmy4_hOY;TU=(P|MB^ z*_llU8A5yhTOr3E1&c-uddrTQeSzD$@D=hWw8d1(Up%8_n^JibL$Wn?_%#LwGPet% z`9Ul2sfJj&;WB7{-crW3)_#_J3uA6j6%XXTJF9fLXjd9}n4IoRpi0cY)A9dJw?ndDDO!_n1awbJ_6B9N zC`hGtTKlfFm98@+5BKN3iMT{Q_~BIAroOHOV$q63Ti*MiC8Q||oY~^sc)&;}>1ULi z7jM&qDC)FCUL2k0(-}YB*GJ{6&k!HSFVDucTu4!=qj4*3iKueqH{H|;A#D-Rt=5}k z@w@S8SEeHDgAbFU0CIUz53(@|JF!wsDMqjr3y`D9wOp(%+|mPf&5N7N`l0nFQ05W@Co#XQHki8N7GdYyOkikk~_!)2< ziv;D6`2?K*8BF>ukHRJ$5*=w)u9QU0dT1^pNs^a+XFrd;75#Y*(+0s6V3> z8Qs*4iK)?K??aFC{VWb5OmkkGPZVe*<{asQv&!7%^7iKu;ybiS>f*jn!ZQpCo|x*1 zR1N1HNyiIQ@n3iaAU|SU{NXMNLVTCyvatdSbS_P%kU!J!sIqVD39b; z)9k3JyU@#$-SRD{Meg+2ZIpby=mb_NBn}7eQd6;J13YRLd+0&TVAH3Q8{-@my>4nU zhK4Zpd3z)7e0gESSv1!Q2TwKB<5;%qK-cR)FANB8(qac;dFhv#97=qU1U3RPz*c#1l0Ge4mYre{9hSchUHN zZ#STWNfPi!)<1oR1WjfUI6VPHQ5^d&=z|GE-Vn6Bj8XRhz z^~DrM&i7d93`@$m_f~PsWTHiBb>po<_4*brXtqEyTH9232D=gX_zfxW4+5Kkq2GM2 z&TF6C$+)&C$DEv=Z8G2Rq7QI)6ASqJ#=o3aweec8`(>(OTEB!OcVxAZd_MaVt|_47 z&GPYl`m`Ld#z4`|qbSkiqeV9>^a|jxBPL{f+FkmmF1qp)2IhgWc6eScaQ<#ywy!rk zoI{(UM^AO$0fP^PHYq%xHQL16tjK2=R-ov+IU^Md=4lmQbtfeb;my-*rQ16AjY7Rd z4dY@?>%~14sFEX;0>DfKdFI9{-6o4y0#xvL#ZH5hYjDk(l$yxHrY&ZMDSK<;T9}1n zpww)Lyp42r!9NO2RQ< z@(G*8l)FKUTvNA0^Upr`L?ZGYp=G4OLv;QMHXDalugLny1pt$;m?0hSv51-P&gvhE z_IwL7_eZRlyqQb1CvG)p+7mxFQPvjBo>=_nx1Y{chh)B1{@rDcC0hd09k9A;9bsUb zP_cPd^Htzl+hfUg-YvSebkkst9IX7CecA&^Rno%4IaUEpy&tUnz`gD$-H10kyhgF; zQ(_8UHc~0WhHqZ1ivxfgA{13X-piC-a8_eRq!K<6eEdW+s%lsLpiZYmHnV8_z=^_u zDchcC$E*}b&2xmcHlvF?USOg!J}Tn|j{f#QXP8`c)CKyU09zs2XrD8-FefXi{4bZC zB#4+3`3ItRI*Oo|?BTm}OnvEHqo3Lv>BqufsWSWHvVW(&-h0NFwC8rH#0@U(zU}jr z`QcNMx<%9Xj`DVKAm}4GH3Ns^Zj`WAJHrl)*ZM7z=9Qp5!(^+vG{XG4P=*%+Hsf70 z5u2L_C5gYQPhh_t3K9Y8K-1qXUzcpk#CJtf)=;dK0AZn4H8Dh9dj{I|=wG;f{+wm5 zZdotxT@DX0*#vBYLR;$@i|&f!^(gxy`iDOOKoD-Kf!9nE{PV&x`D-1A(RW(wI+wR3 za3GJ9STkEwniWqYEpUpaK(?vjh!*x15=(hp=x1T^?K1JSuo%HU5VW|5jTlYtx_vgta^L|z4}nB;qNo5zRvQrfeQ;C=8~8jr!f$eP~O zaw3HQR=j-u$07bG4JxdW&ejWywBo>*6-_E_fyv^=paFY)DGgmT;*F4!(E93y6Re3k zX2|lT&AjjnP^G^X|C}<=6`blmg&0BahhvcX=6q3?h{sL)5Zmi?L)r`aNmr8HUDFZj zBGYNeM}uKyC^E23Z0u^r+k~f>CwMq8L+R^=yI!qdEQn~MgECxEC^);h1FY07hKB9q4Eb)6p}M&WMv;jVKZ z8f4NLO!o>KNS!fp;$GkEV<_c9So5S8rYBiFR>~1~WHZ^n0z#Dfia)xPK1Z(V&S|44 z?+#|wwEXUMT+io~r;Jx7%!s?8hl`34)BS_-S!>K@HB&T_nWKjKD&USsocP_?6ujO_ z{_0hCMTp9((cre_G{>{r{BTG`Mah)yuD`#~f0lQ-8hCxbr?l09lu3|JMTb(CUB+#w z+{=-#MerIAiV?nA=~ER5b&@B=i*i@}l136@5Jm=Q`>akJy}+FZ*vUV0Vc&giuiY&F zqOWvRb6v!c+V=S%Go3)}&~?sH>6d5Dr79$jPdKI4A-rAV7j`yrjBKN>KN{~#RDz3a z-Tn-oqx4_YF~_W6v0MeQ5LjOwk3bKgNN>;o9R#06!*_<(?|hBDI||z)?Dn zAxIU0TULpdjVEfWS)mqTq$-L;^!kxBIiF5ROoA8^#dT0}qx}5Z*^ny{)RL=kjCZ-obw0#X%W7{ z3>`LbsaJqR=55)};95VedqJw93jPua0^v47arLDe24#PaAbLXH%@VVfEK&RE(7Yt# z9bGrI>P-xk#EXqSwf6b69VpaN8ro&6pf5D)5~ z@0dFdeaF5W+U79U7e6vRXVrOLB4<6%yrNoSZ~}!*Cwub^(XtArc(!Eh z$at*G=;{N_U;;luOdr3uwl*T&1tI0-8m7aoh#9wJ+^HACO*W8#B!@9etZ` zLNUfIFH}@vk)M$8=x^d>1v;J7mqu~7IorqAKcc{ZPKM&sn~(i_%>9+udPDV{t?8{& zruiQ1RDfU`9-tVc%a9Ce-a4&x@#fbz zxujjczfB-EySM1*2W|<3O)&AurcV+iJJKi@R>9}LyF}%R%DrNwh#xq|*C>@3qqvZz z|J)=O%)Fkq(>ZI%A>V58bVtiAAIRMHfy*OM;`IP7acsba-e_dOd1Y~MIP$(_oq`vq zV<@e)_P93JZCdPEE7+W4d~z+XnmMyN0vO_KQ{7vs!0Hk}DNZ6T((M1daDIP>WGTW83Hc<|M{j-OE9u10AjW=zJ(c_@tPi>a zq9b%0v>SZ#`0ds{6O8#Wr-AL%(r3zoza*H%T;HrSU8j)B12i~7{lp+5H9+n&_Q7EE zqr)zT8rtiZ`y(mYEMyjPs7W?iRDj@qBikkKOcS)UzfaB;YpRuanH_#KiE|OQV%}0G zNSBqSbIEMHm9M3B30T@H?K47lC-!gf$_)^Y?sZ_&~ z34K?17lN=TCQ5`1JUgPyG+w%K=@hjnFNLAZTCvY2IVh zp1^!R$^4UrqLZv+36D!fKOPA(Ef+_@9E;<#WD$wW*I}m`O?tBPU@3gi8KrzJt$@%6 z-tKcw>pyjC6P!oxZLHCuf^#8Tj4YsUO{t;|*d9vWF6q~k>8PKjYFe5aoJ~y4xa-v- zGyX8$^VPymDUr+`Z3C%u9)kuQctjmcSeX!(q_riJzAOK=iXC)ZXG&;Jb9h8enzu9$ zZu!}`%ritkK5U0CSqyUzj2?iXB4sp+DyP0in;hrs$^4cOEt{RQ3$hojd#uajHP5YJ z^6e6Z+qdhKz@si7=<)m=>g-Qg8|Tk576d9QJK1$!b=9evkcb%GS2E}hK-($q^76(t z6mt-hckS!M@VZx4F?m%@q7I&q2Z0s%nv@}3J*oDwe zTP=;&7OGv_K>T+5^w@Kd74d(j0kT_t`dn`{K^{thgUc2&$&@|k_ieBrO?q5DmB2t{ zP!W|(a_Ig>C6c~XNULKEb(eT*zXd8bm2PaB{B8QKgQ z(V%?>Cx=87SWPrc$Xr7akA3Z*KS&fFJ=zr4pA$4>wH6l*ouT%tQEUdTs%f!r?f8Od zBNcdjc}5*|JEDIwkWsC}+WVQQ&(fx}^OMVFy{UHF6&_C8XgwF$%%#zHXrPf=sN_ts zq*a0^33mUBjTz*g{n-()d?Lyrm&?TGYLnCo?>dVLNaYbDz|{hImNZ5;a!8$*S=e)Z zYtf=zhCHeyys<=T)`8t~zA0oU*Do8T=z%Qw?INnPM_GTDmlB@Ehk)}zfW?sE~FP=M&I8{a@Wsc%w z-;pZZ=Y#?7=1NxLS7m;II|7%iHgh<+eTc1G>b?+Ewk$opm z+AxooT63^i{#v{Sm@qsUzQaWAwG!QP)n1%#1hC1v|NG{dt{naS>UncI`(j~EP8FXP zi6AiDaoa&x?*eafyHLbT+_}5Z3xp|`2Lz}b^WpiHDq4pHkapkh*ko&GAE2L(>ZJ%e82fyv-{I83>~vPReP(| z2&;rPYm}!biuyLCUCW}Rfh^o2w59-TOW*e1TFr_qLpA4)z!a~RDI#8JMukDPSGjP%2a39$y9f8-#n zKbG%1ntC=n)4V*Mw73);R&*HfLly^T6$qC>ahR#e{hN+}M&A@Hz};s^V=t&Gxr^JM zgfy^3+WRa29%~w>qo|-2<&Fx%{)yF52a$#>a`RvB;x}~M`9&wmJ#Lr!7Lx)oCP7iR zTRXF?Q<+QruB#$+B}x4e+sQ5lDL31$;DuT+#2p`!E-=6Po&n@_O~zsu#&O8JY{~GJ zb1;jG)Kql`wpz^Igw1YH;{byP8K&I|=IJXqIk^#MTzk!kg;0nvp*HOD>$((O9K0}f<2(n?XCPXQ9gt&8vLp1JxjMd0TU&||ZW?C?M_jsIq+Isij zw!5$`C3hh#FG|+2{DLr;RhI9Z;5o+0mO%{r==@bQnd zm$yGTqnkM|4D;E9rzF0%U%)BxK21lQEIxRiUb_DXW$m{C@H5kl;|UO-3U6(+2mN-Z z6__!G|E=4lfx4Ffbb6Nka%-O8pcY~-NXwy7k}j7u*o+gr{NxV?dd;#um~5fXCAn%l zLPBc9Gxf?^tQIrMlUSBtl(7)djj4%5c;-;JyV|2PUdZgCe&AV*z_5hYI?M4!<1Pk1 z^DWji7s~;BKs5iG^UG~l7!nIm4@=8so~ax8dx%IhNE31ktYfN-`|Sw1cu1$Xox7`X z>Wy#%=Yl}*;EgzeIx&h}ViEZ59Pll_MEb#@Bspa~|5ZXZP@__XcKl{xj-MH*E8cj5 ziz|gw=x1Lb7dC5`h~6`+4@5YpSQe!tDY`TGF|+{ z639~?bzN&~@NwTkowUaxtvA0s^S96BZ(bB!we_{VwJ31oR6qr$D1L^jE8*)wCHP`& zl8cz%w^M%oamzu1Wx#0KNuGm$%SrdGc>Mw@U+N_~gmG6swHQY1Go@_;c9);?9GVFo z21MgRd9DvCcVNm^BfAg{yAL;hf<64qtcecL?f=y6%D^UxAC!=m4)=L^Fxb4*WE-G6 zG(+fmLlXJqTbh3?PZ8&UVlrHId* zGVb=wzv_5bv+`K0y|}h0nZ_Nv?$VC51$aVcp1x{rQpw&Ed0aee{bz=23BGbVEp!^q zZNJ?y)!O{=t4_sg9r={>0HHDmxA-F0GUG%@4n>u{bwqB6eKpror(%u4+Jo4#wQgLW(A>0#2I>Erg^_Y|M~L0qZ{$ zz#bwYF4{@#X7XuAT8A{D{#@1)ZH7Oa$sD0`KkMFNwj+8eT637n#fWPR9C@zkyJ<_O z*3sE+8|(Ti5W{wvu`LDGCG~pb0z53aIh=vD?eC7Ek=P5j*R8uv&9RU7H1g-K6vnY! zb#;}fj!HQYih8wZ+eV-K`K%E6>pZ~mI11w>L`xPCP?+S`Hh8E+Li{KUP8umDhG+hc zcPfk>3qFXFk}a`x0LBZEdl?G-LO^Lid-%t*dA+lY8Uk<$^Y-XPNY8mIM?ov{-Fhal zdZl}wjNPp}>jaSVf&6)`c~4p5&=jrtWWD*SAihUY0t$b|Zf&4CujWfd`){@Ulpx9* zt4Q*?jo|FqvMP~=g;&iXAKC9@~>M(qm?sN^`*}{esHN) z*~+|#RIlT=1DxMf(@j|V%Do4x3N-3uQB)Zau6_2emhm@)k zJK%8T7bNO=h8lwtf1|r%mYeJYBZzK9aXQRdf$W;{h{zrohU?6{MO`J#(*ysaf5&&Y z_EKgMtK1nh$fbx!3D@>Udr~Fppc!N!q*vTuHjh%6&K1pEnI0y_;}%Ku5)NVSzjz(k zlM@z+kI%dDap^BmWkoH{@z|X*3WxD(fdtd1yWhfRqxQ~ILTxc)HERVMTq6CLhsw}5 z=8n^SVA*q2@ExfRWW3+gjd!$z6e7MDj=DeL{nEQmO zq7aUDzVn(CoF@`x9H<{47Y&$yWkCrd{*`T1af=@0iWrZ$4v_96 zmwy{vGLAx38&Tzzh}7?Jg`*uzM~(DlcApzEfBtbuklnlvtSd`~%G%QDwd>Av%=6o7 zM?$*SJPn&~yAm9oMgjgLP(@1p#Vs&kI zFvyY#uS0;SR!uHwT_DtV#{h=cvQp9<3KVRWj1-gi&$rNu&=G{<@}r)(A|8VJA(mYr zy#7f*I?Mwv$m}Xj%oq^SkW$?=L~}e*ry%O^JQE|t-yPohm=t8~&64%rQI2rO0HG#C zGbGcy!qD8eT7W5iaZH_cE3z#A5@S1VjrgnA%!farz)izvXA{+!tIsbBk3+` zifTyhQ%A!wf@-Q7l*xLCS>o= zjr&Uw;J(C6jM$u8%RW!!?wB0S;ap`irwzk=UlwtFdFSlZVCVVx&^Ht@; z$fMXCLLN#ft~~)F1zuIJ(3gi8UA`*Hd*RrE>GK)_+_7&NCkyKRbFy-tE2?oRz_^tV z8_YduT8Y;e|rl>k`WB;=wU!jn@W9DdCKN_Bf{c@5%d#`~3{%4bZ@ z$DAjeiPl&|11rYsGeR1_yG)340zmbm9ZJEalwwx#4Jg1L_MW#&1kH;0!HFC+7%z^D`e|aD zpLizG_n=&FlWIbgd+GkVaf#d|pnL51J8q*}0bpvLyUO}vt`ec$Fwi(f%~O!pUOwzn z0tgfusNs4fRMx;AWt79s9fS%V!devq5idY~@#v;uUO?eJB!=|i?S!r--fju|v zcUVkBd%%n*=gu_(c^0Obf1uBXWkW*8@#UxqL26t}#nTXH0j-nO zw|w*`Vqvy)B{SCnlNI^$z!gQrjYjzzwempJ{W)HG0Rg zx_rtaS%GOZ{06!QmQ}$2<)DXyC6p{DnGh7gCA+-DgWlpxtXFt!@!^P#zr6sou*gVz z{faPErCelOtxMDeu3EH$OylvC_WCRCz~fOGuInx86H_NAmj-#I#C{k3jL3f(a$s2 zEq>eEw?GUUy#?)kpw$-fZ=!96QlHIAVs~C-c@Gh>a*T05JJK8|7Rc_LBi4wJO&kkK zLS7de!KT)|%eLwrQk6OopQv#Tk`uoN5{>_@=g_>;MZm3lJlR4uGy|vfuXbCJV6t?6 z)yW&DyOJX1ZsTNGX=csZPzkoy({B48tq5O`%Sa&FV`EYt8%b9{c-BUY!0~+_*HnYh zI6)Zscb6N1k5S@n!#7^8FEvp6>Ow=t$0l{`zha95dz&C zPi{j$$s0gHGP!e+zFX)u#N<<>`Ww-b12$?2n8KCKaBI&4iqPti4<-i~9B`zFfa=Zo zf6Y692U6j0dFRXYV>VmitqS}~cUpO^CjQslu*@UlO0Z{+W`lgyL@Ph?i9*aVC zUQDeEhyb==2>ZhlXQX?Rud)>wXK-3TCC(3o55UdvAnu$sn9FwQ>Wg=v1}JYb zRG}(8x~zzX@B=fuQiw_CS=804ng?I^=QUD~a#@WoUw$dNBbfsg=6}ny1M&~&2pncI z!Qr20#_seC@KpGWw?^FjSZ!mN0|rJb+(YiWT*ad_E&n#j0N@xZPvk82{q9Ai?7X6) zaTfHhvY&TG<|QJ}LF*h1-8%8VfxA{$FO;jJv(5W$#H3*|r|!qGES7!hpY#wl(xf=K zhJ4H{ZN2ihP4HW9bLMz*-E~^WtdCP0runh!#}$Wv%UZ3);KzIyQ_mMtV?D#R7UrTW*?zgNstB zH9Gj?B000+v_H+PRhN`11vA^| z%S_Tlb%kGM-he!Ep5XunxqDcWftezyaLQAnVXnOX%b1$w@JbS9)+fp;MBnH&3x#wQ z?n)K!wNE?yc?tl#-o<5MIzn#q&rul%A;CX~i}3sqs=SgdJk3RPkR}AHsT3vWNVT4$pAt*Z|zpJpIG*oq( zE}UK0HhHX%PY4R-+*wm2T7xFnHS)be^~v7dZB**bW>3*fe1q^u0;?h)#l~gaR;^(#*&bX+BP)WQU|p(%m{!x2y) z8_Y1Hii!Ekx&lRa%IEdf6dw)#3$%+BA&s9Cu_ya%UXDzC*VgQB?0l4bUbHcPKkR;v z?a650Kc=n4%?NaiKsp<#`n-p!WO4XbFySTbNJxo#dH}IF(|uM~0&*hxu+3Yx7~D5v z&vAM>sW0pb>g+M>rDXnGlwAh`cO^+AK-dnRZ(iHsy;f&j?OJ-z!c4cF?L6=YXkmiz zxiFZRdL2<{KX%(Xy(3pQiDOV6eqa{FFq+qMD+_-b1sq*N0uH0V?1bQooBEBLO1p@- zbsN!AfZk-Dd*|Vs*Ut}54V1kL6Cv^4m%aD9M z1t!mmr<@N1&na_r7k>OU<&qWkvb2>qfFw}&=_W_>UU*i1U*l8QFB;`?G5Oq#?NQ6uO&8drLjml4>e6*cR93( zi=y`XQ{ZXDbn5S&gi1*2syV5lW4dZ9GtH}u5LSWD?B(^O72|MS@+>Vu*z{%xa;?@T zDLnkyTva^vM`m~zCnk=cxLUT9hbAMUQAa}Uz#aZnQFdrLT0r0RXR5bxXInjH?A$XJ zFQ~)%ay*Uv=OHZ{417&1j&%vnJ|HUX9OsWmC^IVT%W{{b@AL(qnba=P>2o|Q72F+# zb;Ue;-~#bR^Af$NDb>}Lj%LbJNuV_F*{-i-L2h#yxqiwR1Z{woxD^h;n}lk3tCPLt zQEUyFf+UZ_^poQPK~#*D-DLd;D3>1(T~>I5Du2RAId?6Cr@XrBXfzEIyP+IZ$j6J> zrA2K>QC3@=7slV`r;g6mJ=@Lf-v5Y=M{QT1<3-cO?VqMaLfMO+55Q>eOu+e>r1GZ_ zfw4Mq7jdtfFK6;)%k3H#O2CpvmfrW^wLK44wGVM-RM+sHk--3!4Fl%>EZTB;e-&qg z`nY$DINYOIkOgaMH;SLG0x=bzS(Y4%$c&r5KbO}6beQp2izdiUN`)gU1( zr9CP`v*P5j0)+$H&^=X@5m_r|v=O9FuCz+9(9uMctkys)cOFkyw?N5N#E{`=-mUQx z9rQee;|Kg{u2VP5F<*h>KVO5V=++Ep@=1!gN*g_Oo&PKf0sCcw9;__kO`jlc8nR_b zFhU*<4fZ-jObuKqjjBxf`rJeFM00s0$QEmLHm;AIRv5j7{^R@{Qq%Y{=O)JRvU(^R zM2ab}?#J`obv)8m!jo$+Atz@c2H{8BpCj1D?(%F^FC`5HQ*;e2Oiipxcnj}}_7Dg1 zgP7hjZe6V4CnED@lJ9iGU%X@e&2KVp$KJkA`Fpj=%8DSP5uhnqP9Ql$hTF7!oQRQz zADt+V1wv2ci`rQYpsh03Ng<*c1QT|tb*3)P{peX^Ae zd9;EdBj%Fxeg=flJ48C#DEt&qDv`{OrH(4FrzA|oIJi|19#$3=LAWn#%N()1l0>`6ONG-6gCBy-!hnbecbua*y7hz zUhT_NXFt-rDD&Bn&Seg1Zd8gQq(|0JHHe|WyW6Gm6R@PB9e*#>Z68AD6 zuEQo3y$48s3y0F28x;I|;Dt8QCF+l*n&pxdhzy@(1Bd2Tem%u(*#kGl0#QUyuqw)PcS=-wQk}RK zenNjf$y-!XEafYu6I9v@&tN0VAdgmFREjU58pn>2<+&@~e*I#ejo7>!aYWKGKDZZt zPBM~Va^rvJm~-|bp3;Yu6t3iwrXT$uX-#}$cK)RAVw&7Ov%0WFI_FzB9LX)TdV+hj*eS&9#ax7`4Bp$^p%KfV&_K+TGLD6+L^q zLbe7us0$3uBi~n)6dLu*q#h`4%8JPnMb;Z$F^tk4XR3!fpMPEm89H4V6bnS8H4*^t zxLjSVZ*>Tv)-B{I<%@m0p+D=wyv2E@>Cx4Md~cb4|}Nw}Y`j(b0k6?j$U?+0A4|95q-EjdVYOoT<8d zKErjvF{lz{sCcVlFw{ zT?6dL6*L#*Ecfu6Fe>g%xH^xt_ZFTbLO{gWGdAck!80LnL}_3Zfc0VfugY6GcWoau zMZNK+WaDzTrvy&d=wTXm?46O^_2W# z06!AM{R+n;+jdY@V7H%iGI$mu?)u9@t!)K}G*}QZS|#PIN6rILyvcwptsUK+Sb_+z34GWy zWXzI8;!`F+B9SPfh%F=A!G3#d4WgF9wK(u7ga@!-N?P^9`zW7ufk-)gMSH_P-(?}I z<8ScziG%J*4;FNeqhqr7E)2vZGZO^{9A0u_?BP+yceZM87g{UD7xdj z+32I$wZ_eTn9LKl(%2%8a(lEvyfi8o-QmXU?+@8r;F%>HpaPf}v8Z-8Gb`06{I8sceL-Q?9I%ks^L^b&`}) zb)9k7JB2B4r#}OtNc;b2%ZMKs`|GX?^@Tk7Mwn!hd(!24S+cwH*%-wcyLGHPJ0eyw ztVv(0#)XEsvTn>rN~F-TE4}r;i?pdcXg%uF>U?s*cJh~D2LP;iC>+*J5v>i}Rp9Wo zFX}Zv7nkuD(WzYb_0F*$I{Ii|GO|b7NS$!$`>h5<2<#1W=Mab|<&p*I93JB+*mc;@ zS1lxZkbLl01B`5oeJ~OF+a2l)qR~`UF)vQd1D+7%YocCMVqW8fHQT+X9#QHmO z>}}wjvSx`KoV1xPrX=buMH(z=_}nOUfDa(H?2^8|&tkTw>=x<=f%bhm?RV{owQekI z9Pdbt`xaM_gKF)Io>$Y$7V|k8^oT?;D@tQ{>NeJe58A4f1wrzfEe{ombk|yn3DqDG zV$n5{3ZvTB#O8{jGA6`pS)_#0#m3C;j`1EDcSn(2L^I{5Z#q=Kx-fkE#gWgEw5{r| zC!xdm=;i&o$4B^OD1vkpfo@V-XAf4TByPH0rDjq#!(Q%hEYDiZ_;3gFDrw-E*}dZa zk1V2Ig3zp$-!Q_=tRWqoq#V6qyTf&v4l_iMlaS|{!iBlbE7Y!Cw~jud*1@C{XZ5Sd zK=OS6xWDtZphMKk(vR}Jr_6xNxZf{b8N#u!Bgp>KlsDv;?n%`$H+i~S-DkRAaMmEY z%5Q_8G{}JaQ3&>R9>k9roV=RdZWpE-kF0zAk|Ac1O>w0QL=eqN<=3;;{5?)|Ei4FYe3wK>~R6 z*dW3H`haWD@jDHxOzt}v1}%QpaS=wVt6dI$^mh9grEyUQeAKb;|8Q(Ec@^nt-% zGFIO@@Os#%43RE<@J8GCI@+v98Ob@OFFf9oa2V8&`{0!luX(YZ9~fzo-W5D0iTPil zD`A!r?x5YI$p0lNBFdj?B#{12X%Mw6Tl;t!yBepNItfay@11A-iF3PH5Y^s03aE$J zou!gj#l(`+VU28u_A0>D0OHlVC81Kj>b{`E@mQfMBtt&Bk{OFf1ngiW$+9LsLrzRCJxKmN(&xwQ{WiJi{aDau2+Az>GHc(Z|N(U9V%l>=w zj={~hq`UvKJ@OU#SyaJ#B!%TVkVfycc2-dVx8BCEl1hT-r#s2wZ8JtW(|PpLSU!fS zJNGmq=05XV)#7d1$qhvjYDm@;5Dw2Q-YeXz?xtr{E%?%AU_fz``4dk>f$+!&q&2IH zND$V@C(TFOV<>fD{sqVu1>b(LGU2_G)r9EzOOYn0owft4HIbn&^GJ-;P3&^NKs)CK zjRt;VwoF(!=WhXB$#NW-ibrbrGXAG_M5zIGuY=kdo2S~DW=!?{W~ICgp)r7=rElA< zPVFqixnq^#i3CR++j}IGZ@#{c(YL+JT8v;@6+%ct^HkO?ZhgtK4?9HexFX1Q2QFvS zH$^%bb1M`zEFZ?K{bgqkQ&+U;Af}^Msvz#ZpJNFUv9>wHV*nTJy$u%SQa$YcI9jE> zK5CGTzY*~Mg?uC(^*A<~q8Z}&7ymZJ5|=}fqTJj5^?(Bw=TDE#3BNNd4jN$yw++Oo zC&BbXt3`S-mR;!%L()brmbbXGu2g-YiAt;O>!)K5#!g#26SnAh=5})Hk0CyZW~A&h zQ6;bb9}l_4pttXMLP`%gi^bQ<*YsTQ11#2ws`>3O;%h_pXM#Qz&3->N;=3XP ztL1iOfKvAz7|}U&r8P41tTp++TD=7xK|3Op`h})ctl1?^}6lp(H16FXU>s)yYL(bG+g% zuk&Ia2($|AlVSM54nKX=lG+{6+k|Ev)lrF$m2xnldUh;ye~80jJSZzTuK=$(XP&pV zy9^Q>OwMlRYCStbq?6hf>YHs`gJgCl{d-W=!igeQ)qPl!goONjo#a-{2Ko5j52LIu zd?>U&^MY;YO7#?+7K)FC<1}D6!yME#&L<$ z%mksWq|_b)A0<{F7#g%_)%eL@_;+yV-gaQTt`2pxvF|a2=u9ErQ0$kMw)J13^I7fm zd3TL#M{O|vhs+D&Kpc&sAp63=PB=;2SLz{2(W8d_@52jIbmtK&?+757_@lLx*Lswf zY4!`63jGY2n6g#A2Mrc?YtvnoEHUR_S4!}rrY|Gn0fnX(rB9^G+nu|7;JVYlIJ>pj z&Ntid5kt`K3~xfrhmf(lnXi^0|AxD#D|b8PO{F8%_MPieUdbO@>3SG2{Gdk_`_E{I z7{Ip#@VH*fDBmD*8+AupKAmkW7=Q%SC&-laxL71M7Ht(i@7HeI4LZOzn< z9rIUcxMyI04VyM`bJ)BG^gLzU$mq7y78(-2s3@5eN{p~qb|DJb6$!s>YacoHA;dNS zRt>>9a;tzkq1bm4>)?r9Vb2iLD(XC8Jq5VM3G9csR|}1`#|N{@F_GI2*F3ps>4a!g zuG11~iM0$n=@8n)V+^5Yj&68st9(Wzvj5%#sdhY1r-$NZ*NqrDxt$eyCJhYIk)Ex4 zG*0psm?Rx~Pzec0*mlHQ$YAmJ??85za;_q`g}u?S1f*V)xV;N5!kuodoaA^zC5x6S zo4E=h?%u96zEM2gSwfU__GNZ*+bR1Wps8c16R|dI;~`=s$je~ddfB_oA}LK=$u~|ADqJt1MLPrjsPtup zp65@q#6tN2@I`TBj*Io#r2_IAC!&IPz*#m zFf=Hdb*jIQPkjgwNa+QKlk<{BzGj`8rgDe04lo(8JVXMj0&S07S$2&-T{P5zX&8v2 zPEIL48>}y8YkF_B1Z3_^+F4>F$>vp(gEh(eeO9T$*KWSvgGC9USumbtEloL6$hh%? zesyP$1@q+_pm=wx4%^aU)yIRUclzzdyr7<|6SX2R;0xf)QU;ONMh!?wB|O1Ag-Cwu zdCRrWf)o?t6-i9aXTC=8q};@>-tR%4|BFz3kR*<`;3#I!Fx(Ycs!bS<%0@&Mf4dfL z635CE*4$0iIajW0J?%8yx%H7v+g~^@^Z%yTWK*oKnzgv~JXPSsLu zpe!vE#_MnYqlyxgrK@=0&Q}@yd;-b}Tc=G2NHX^RTy60Hb-jBnYX=V=0)c|Hm%2N& zuX=*!Hes33aTFfHU6y+d?1WGQz8Qoce@t$C`~p^k(l#|<$-yAc9Kv!;RzGG)Mvbof zwHDSC5%T&@Uh??K#q}k{>`;sQYRwH;@T|GRGizlJAP146L-L~qx5D2s3A^vcUO`R@nuW#LEwR#9`N)HT1H&nLV_zqsO ziZh}$=N<_~r^XR8Oq^COwvSZr3Jw);0GwD*n47Qqr~YK(-|E1NHz+-O`R?GkR$qHwobY>ZJj(&lPl|{fOx(wu$S2@Q+QM+F zrqL}WH6Ii=7#5tFbCa=k?+b3p+8}(}^&TUOd1c30;EEKk1h``#>*7*G-@d4gNH8KC zCJx|u&a%%zK?<^z7%)L<{9gzz@p3@eo=1Yli;~~rP+B;d;#>8*%N07|7=~_k%T=LC z!=#)*!69>7v$m{t-6p1hlgejI$bH$M^zJ1teGY#d&O~@&kI-aRE|$`_4az0E+!Rzs zizQy0fR_n(dOy>KSwMP}_od;&xjankRgjQaa5Ie~5$T%=Q3$&_g=x-?6YI^1y3rAX zcmR&dP{D`@0kY1F4tn#LOHY)p&T_*pEg3DQkNYi;0iy+vZnW8-kpF^EjzzPi8L>lx z8pPC)wOQODq)=OpU>84?>IMg;yMqi>l}$TmHuJXd2#ne2kHXcN!LX!GHA(rcIdsk| zCTGU7%tEIg*)SUUv5{Q$c}XCQTSulpQt6H_h(M8I*3`FL<*xQ^+M|L<@CgSx65?VO zc781t{Jk(pj41NCzr9oJ>5UF{Tfha)Ber>9~8DLs@6Uscmp$!GGJ!8$=NGV|uq6Fee7-e=KempJOC~G@1)>hN#$?aJj69ddi~dKb!c>VJ45gdl&z`Q#?GmvU{Ey3yNp@gE zfC$hJ>{&XtTy_DAeI6LkNrM%q=fxH!mT=^kpO}j6cO=Pbb@^Ok zML$;)ToAIAR#xOoU#&u6ys;_U;_m9GX2qP1w!+zneZ7zBJM_dF>z|aF(<%*aWGaGLH~^@O%NX{ zET8^}est7?bLBL#R?~rpCpz1&n#DtZGprZKG@iP10}=F5_J$j`H&z2p>bvQT zN!w!iQi#g!CDfhcQ3*&NZc94W$BGS{wz^j5E~Z0*Lk%VYR~41iASzY4|jgCEYrUoN2( zG``D6#Z+NXcSL5gZUH5T!T1~jBtuBn5|&yxEuuLSIz=1jwCl>{E9EPYdK_XD($Y1u zn{VM-LRf3ansaKHV6l(ye(kj3ekEk~y6gbg14|&Y2RPn&%1EIzql!PB8xy8CuU9|; zMhG(1`Fu&?uq<=A>PN_mm71+k{M4fes;dhdc9j`YN0Vh#Pt(pLhxPXm3s!-GD9N)% ztCH$ZC6fC4?VBJjsxXy0mwrND2)~@LW}MNCiT3}${e&1T@cD>1fPAtG)I6F@jJT3^ zouc1|0p|)iJvc?G-4K5m6Vg{WaDdcUYyemJjNn1Ts+$vK58jsY(uuoYaWc@59+aQ; z&0e3?R^w8arE!$gQ@I3YoXFU*B`+(q#ZAj?{Gr{fDyOK(brK{12Ua41E{aW8PGFb6BJh^ zDw;WgL4HYKR5iRuo4WBYOeQnoO_--S0tg^yVJ_z*L^hRI?Yy1(;e(*DVJp4{W^8sZ z(ai5ML)l>Lu|kM7Qx~CH<(~wdMVJv(U#kXdqM7qn{x8F&6lkMhFb*BDjUC=vH`iKp zv0O9t(H-l0RuUOa(AqIVm2oFy{B|*<34d3n-g=SV(M5`lJ<4^K1(Gz4sUC25eW0|+ z(<+AcW3pl8+ahnqZPQO{Q;ewKz%xcDc^x>6NV4d(;xOsU<|#RFO6AzLsPqY$cw%mhS%HxG7dIT(yRer zAx05L&tU+1kV95OvcF@rrs>^P$3?$Q<}8~5^5hLS#?^vVNQ{O-Q!9XtN>N*p)B07E zJgz*xT12`C+AXCB`1T@h{#xc=$81OWTU<$$6&(TxCVOz#p4`2KvnFSC`(-%BBZuxUk{-60gum68D~ML=SM48Gru2^t=)a2 z_GJhv&{D7v2|bf@uR4-7iZxvf6AH5V-8z7E#K}i|kr@1j-_5UxGsfOO;XW5a<$V@U zju2X@1h!wdw&6nz*ezeY^YeP16#e)`R6(ai>H|JzdSU8#K{kEJ?u|LEOjn!YwmLH_ z@L|s}c3|G_d@IjUhQkN{Xd-n2K`wxS4IuoU>*KWP&zi75Hm9Q?W?`#u^>TDV{G#s3 zNIL}I0}Yf7z$h8siqA1HZ`Wv~ts6eZVbeOw*3@R1si+F6+5_InTpFi&^_l#UZvdTl zB!GETVqwf&hy3s*L3aVPGm&w}N|Hr_|A2}>vm9qoP$!QoIc z7e_q(`d$m|pF{SvVU_R^=2Ba!bwX#yPR^8WDqR)*Mx#NLwr(s2eDgO|?b;^QEqSZs z4O-`u&$6C%4m$Rn_VOSz4I&OO z#^S>$rPRn{WApAAl{xi;2#>km_@ruRs|$}hZc&7PJW37fsZF0Br+ragF>UbfP_vO*OC zUqRk;AxNi&VYl-6?J18OT}?y7+^UH_&fyQcEI7wO@Y|nA&x?!HF*?e%cR_HRe5xuCeQr@+4}s6lhGQf^F=Hs5eZZ{`2p%Y2 zV-`D8HF&y~-zLyG(r>#^@;6a_g+BaR>rFxT(^ zrozKG?nbzi;A(koDp8}TOm*?tMaO_#1cU3#f-x`@eX6Ht5xj3yn?m3hrf~(k8ZX5o zn(8mhTw0Nlk}-6vmrJEehA%apbC?nc#LnnZrxM5VK&hG7tD!Sx>@R!1myQJ(jVXs3 z(gUBg<7qlGODbQ@{Nf|4>!?!CO1y0>#22Xwlh9vsQ2MF&Mi^hnNB$T6+$!*EBpy99!Owi;d@hk?F-ew|y@L)(7(farY~e`6+>))|8n1%ni(THwH{` zuTU0H|LV;fF(w@xvvkj>l8bIiojjUrpFG(|_qAkLzohIq{CedpMSKmJ7G z(yj#Pc5C+Wd`}SMm~lJ;wb2ea6WNJc`KO%`2N(u%9WW1{6&kC;=3f{#xcVJXZ%qv> z)V0yfW-SMd$ouVSRwNJL&Llt=i4&oa$XK48KE8t3h*PM2-SU;>7x21b{m&tjR%ON8 zi(KG3VWFGL;Q8_yMD~Nx49k?taCJ?cA<845d8#UDJeW}MJ%6TZ{0y8diCV8%gaoJD zeW6^GukL@wTX1QlAQk48N&FS}$_h{COjUhF%s@oZ>^fGMK2HxVC0ihpgYZn+yFZX3 zWxBw)T4w4@+q@Wt|DW&0lY|YS4M$Yc|4{+Z*}n7t7J4Bjyi|4egL=-ee12x&DHNpw zt~-h%+MtVZPA3^jk;IZOm;56f<#KogXE+BP+_rr7vDZ}!@v_R73&=!ydmq3blNfYM zD-mFv1?;fyk<3OgJ8pSt3yYie4v@YsIendg){yt?BTlqfmDbeAO~t&WT97$f7Ga~3 zp!<-YS@Ws*)byy{|PvJY5ZwTRS^(lgi8#|1|EzCEpyUP&p0gp!S|GvUXf z#2qu6_`C;&GW?umtqIL?`vbQblo0R-1!3s0KEBYK!IN*_=@(f9q#YTLK!Y-8N44>W zNyRbkw$v)qn8ss5&`-B|Ouda6Dhd_< zRcD<2gcI;>_Hy<-@6oZ%A3>i2UO#!nteP}ep z7#h5MAonCN--yKRXZlrw|Ji?rzGO$o`tn@z)2w-z9=STgQLTyZ>b+CNOye{)QaIRi z_|WTz@Zh4oI!Obm8EKY5$s%|;k>Z0cj52$i2ty-hN~4^eUrfdfkZ$179J#>Y^Jl!w z5F(a|m>FmGvdPwwZE4qFSRon2?ifgy?zzA@>6 zT17UXt)}Ljg*kv}O!olemh*OID}TCoai;H%bEgtvmRpCro7}G~LM_St0;;we)C!;? zi9>=TlE$s=_#{)jsZ4fLJ-q!RH+K0dZJ|uZ%2EBl?%4qe0t@SHZDDLJ`=~%%FUpcB zB{OlpJ7kMnSDJg*5y0%PXJ5zd;tF|2)Ah9x3Itp{+9iLN!}PT!L%aebdQrj$OtBvG zn#sQ(7scA&;x0Ynl^n_AL7N4Ne>p>~)7L~OaQb-QD=qN4L=J~EPFU0yKLBQFNJ7ex z#lbM!gQbnzH&(P=U)F7MAA^$ip*Dj5U%9!nvlbEB{U}$&Lm}qhD&H&}x4D`#_qz~3 zV?F(t3Y+C6bJn0?-vcisT_<%?PbTVZwg#hOiTq}bh)N&t<#?y)%FCMIr0VENz|X!B zG>5d!!#A+3$NTx#qi*Z&lpi(9o5D2r}Nb^>6sLg^t zz$UkbUw*Jbe5SBa^MOxJ;=n|0K#+E=hCxLmLJzJlywZ%KYI_e_peu#hwd#-Mg1>}n7ZoY8RxBR<}9_dL_5!U(%G(}$QwrkZc>`% z9Z{RZzLykUBWHU?1DP}HnAS8KDK-O!81FES31Dc{7y#H^06&`=NqkCWxIgOF5=5w& z(=Vt!c|+U}#yzoO_!Z$rUdO?}RwBXJ_;MH%P_n9sY~jn+vZe$#2>BB-ZUzmN+7AwY z#)7GMtyKwrXBo4Dl$l~HLdV&L&(g~dJYhHNyjv?){au|8cVW}@=%rx&{H7rWxOKNeE2DyQ z7RBw|)u+xcBzfSHaeM{`8U8b|q+B9_5MF2O_*#RkPa)JDav$yFYvLd(SWqvRT$~i3 z2Kal-J-pqI{mNkJDpqy60g>>efXte3sfd`6>0Agke|gT1Tpk36#i+VV)*Rh^-kD?_ zr(BYSA3)2dMSlpHdqrYeLDv;6%@;?aXgry!9+CR&qtFX8hBSsbT-j05UTxJ%|BxyP zfBND)j>N4IrSG>PkPfG*w>ShatKZfI@xWumWXxf~Q0;4lHb-7HnDCWpPOe*2$(^rZ zmWzabv(W!O=?w?YVqA(|8E(J=dHl0(!$qv8#?i&uGcK-R%rK;XbA>*rSy|c?g)FM? zDfK+*W#lXe@m4ZnH76L;(*Fd+Rp!=;eBs9&)34IOKc}{XI@ka%#0wtzNX{{N{UN@L z;aKDp(lvT?KhNHKFM?Wr`=bvlNlBC&k-(x4JJ6Jfy&`nFBY{p|zm8tUWd1@3pD*uvmBuh4G|4;)&?Yx+D|f%+vr%VpkV; zc>R(1v2GKoD=m%Th&b5NX{}(YJb11%Z(>Q)+C()V`VnAX3rm9FGc1|Hgx5ygI!# zLS``kT}^PcK&pJt;g%#Z64+}{Yu>~ZNky2(oim3MUO_xBuFg&ilwif&Q9%b636qH9 zxHW^=Q(A(Sm8rMKrwM#yu8V1av{OhwlnnJ*6}+eNN@>ZrR;#nLrx>8P0?|*Hv19qY zE$FC#YZH15x!vgElz?Y&m-v>m3S06DrK2&|0@vc$Y~=oH$O4-e-wpf9)j zS3Y8QY3u_qtLLqVBqic$a8uPXwKi}_POrBx?|s?+yvTMrN>^`SUva){%hXs;!8aJx zKFrp-f{U>ord*c(`EyK@7loY2YKutcCi0Is$3nx8$64rjo1Vsrxbw*DfE@w@;03sw ztJnn(Ogm&OjA#x{;zR(aNyOLcM!q3|Ntm$>CdM;^k*(Cnu8Q#2mS65C_WA#>zH-j< zJnBk;{1)u5%Xd8Q?1H5OZ;z_%JIRtfDj-y&v8<`! zHdZ$eYHy7^b|v-)0x|5qmAz4yIXR#f1KYb}i28fSYa$-5lQQBDlE9}`&A_jeE}PCU zk~ zrBuB%l{x1MQ>@jwy}Z_dtz*13LA#~RCttWy_@>v;qQ|+xx zGG4NU9b8uZ0GRT~?8Z;_Lst;`J^x8FaHGy(bUÀZqTzp9jL#AEvGJ(9lW^lU;% zQfZcl>~JJVS84>OK z>pTn|mHa%XKU$vr%k8}^{V-1-KyLRfe;{(os+=bDp7+A1JW#o^W+yl5BN)$fF6-mR zsbhiwGqthdPk~S~2~y33M1}K?65$vF3Xi24JoPHBO!t`XG0eYfv?laNbNw#fBiY2~ zLS^Hu&>%aWMi#l*>UpxKAb7zyZ`*Y)e0t_UQRY&@(dQ(8xlV6yw{j`bcVjUhcYWyq zSwYV}6Gbz9MWHo4Dx4G6tO0XsEgImshtGdCn+$L-$BERGdQ-hIT%OjcB?5kbyAJ#j z_#jPeoaXbFrlkH%(W=a0GWs}@6gG((3A4*Zn`aZYNgb-bYx)HSJrN3dEO)YoZl&B8}QJo0yVWr@60`;|MHi#bp@jno~6Z(Z78yY(y7h;5G zweKmjOH?);i5a_T!vAm$00fKNU(7+@FN>Hb@EarhOg@&Sa4cKDBx2JJXMce|7^AUd zJg3XCN3DYQkNrNp%Mq7dH)qV5rg}7XJFJ1*@D5Fws81$b4r$R#%+E3<qGQq(>L;R zPRCaW@~T8ZdJ2NGXUFM}_DE6#YgWjj$Uvq-`fA7Us?e_A2K-B|gv)laF;1o+ID#i1 z?#jBz|MFAD_89n~Hj%MYI%qz9!z#TEz4QM_QgJdeXXGZVCKM+9#lZo3bq#p6)HQ#9 zPqKZ|(Qhu4%&VvjW<;j0Ox|t*iIjP7lZ)|}^vFbpMa>`duvG-^1XVCPaPX%N z+y)xL4?OU9imp(*_Ir44ACsPg1LV3vPS zT%&+$)&3vhH+$CGT`HRrFa$2WQ4IAyd0!{};(RATv@__iv-Pa%)6-C9LH$Y0l_Lyem9-cN;-7d6c2p%BLpOp$a~zl>CAaO|`sH)e!Bvw0tKY^v`p#WpB>#JcLMR!d{B5XT6MZgFD- zO=+au&$qAgW+3<{C7H_H+20t*r8HhYp2Yk{C|w1mF0pD**sn|CiE?ZtO*if(bh{=B zV4M|3fQLXYzK{JvBn!}$+Tbi`&4Lf_+GSIL?4Mofs$P~}gJcz69`g3apr6{O%a#4I zrOUCl0TeE&R4_0&WNK&Mx;u=SxWODCP|^h)6xy5_>-Ka=_GpUz{jAWlqd7twMkV_d z$I+^mMgx*H=e2X}X+gfGO4@{5{bZhTzqeF%-;2)sHulYhT9C1Xtl#vB@XB2Jx(Q4* z7FrBy``B-4pIkuPnbhi`uL_uKdFEA#6Rkx4oR$4hP4z=%cC zcGg-HX44y^6ER@PMAT5txXp9PyxS}6#)stefDqdI*W}GZ57PZCsfOjCG;z!m&)ZNy zA^(jJG6u4k0JjT`of@+OWqgPOe8T6eMxLlvPx5-cR>#9%7S(e`koE0|1pRylmMlDh zx4mQG?(Q@y%t4D{)m+moV4|Ej00uE<1THg)kg9FrIV|zgJW&y>VBC~pDMgTzq5uTVA#s2yU%oiMc@z1(A715l6GUG~`~3_}{u zPGRXqEE~64F0r*3*Ij~J{2s0VsA2;3M8yO_>r=l*ryv;Pj=mFvCh4^?YC%I?zOZf~ zia>9VZMkAb0?{s1CF_1Z(dRJ@vdn&ln0z<$sX`nZM2g;Fg*cWg22g0!->vFt@uv1P zRn?OW!S!0-p8FpT$zCOC%+o0uP#VgVw2qNPN>ooxt|DW-y#%mZCfzurAzzZN&7G@U z*1Ta5=&N&Fk9=GvDmyiXDG}?{S$BF)`q=wgf>=hEyMnL| z{srz|*6;+@I@cwFYI~@lvgU{A0k&xr-7wL5sU6OBBYA&8n&tE0{GNv^m6dyHZP#A) z0RFg+WUdo~F&J2unYASV=#h#Zv35pOS^M)Z)(z>ZDz5FNpcEgD(l!ADUlN2;5tE6` z#4WNR^ZKZ0qbtgF`+;yhC66(a{nBnT6e7l{J};4I-<7?8KqxT>7_X}R)mbR`sPAJR z(uhAYf&%cHTR`p6ALtvv>39Xz;I9ITnhMJk{h5GAZ9f?=EfXGf#19U>k42p2{?2n zptev0c@Xqq{`_bRL5?aGJBzdVYzMnuzG$LAX+6Oog{oe5&uLmTw_ z|Mv;7_tObRyl_e2hRU{z9Bz6H{Q}SsJ5BXY_Ja-BJj8gmG!d`*;M6WSp{WG~4VZCp z8#gJ-UI2iAn7YnnoV=G>xX4Hx57wPaq?Ai;qk$1T8kCcDJDoG!yxfy>f#U_F3vt_1 z!#!Tg4LLP>(>fUz=wI^D6b-pqeREdGz;MTLsB59-8{R`IERkF-Bh);WeQN^=H76uz zdy!FpWR?H0_!*RTvD-Ap;!Kyws>Fs4qLTvq zeA~b-c#%MZtb-HO)9%cF?J#<##hYDov)Eg0Y~I^3Fg{a3AbvN`zzh}^|KR>o#c4Su zyf+~8Yubb$lfxwFn?D0Cjod%w{4*PwV+ur1c`&_{<|Fk9j(Pn0W-^G+hwUn_!~ef)ed-Hyh7o=Sp&bg0D%4Y&zn zbm-nP{TcwQ{VjA4LI*9QbA1Xo3$z&k$C};c9DUf`_bE>(CdR zx79|MDgYoNOw2{QEQc!_D(4$6L3-I|9RD6T_h8(3>4u8i%W495s~?>2g@8Rt^%7q& zzt?Q#AbUQjt1q%f9)$J)|3}OIZ{SL-0>M@V7ob-fr?`CtYsTL}YC$xU?Zx$VdNRdm zrm`spQ`;3BvG!(eKr;yK6~(*RZgzn=5L3hw1O3GHf>qn2kMt8VB9ANWMTCanz15qs z>VbQPcLf@=_I#w|GKUA`r9PL7Xz39tj|$^n0zB!bWFEG&-2LC{7c?Dxw|rK<&dd&En+p|k`VZ;3**Bkf z`KtIO(WOb}CP==BUiFRtF8c;#MS2s6f^w2zNw_JN#iG9g9r<2YWs6gM0PW|?a61+72Q6r?_crY^ zmHbgj^pUL+*grrd=;bk{MIBFjHRj?3o&fhPyQP1N6PNEr{MiIDEw+=NRx+J_@VMAuP3G$8=9LfH+5 z!3f1)WgzXNus1-=zdO3qchzBgM0$1R^pMUQPEtTO6cxa@8SaLNF!00RLvDgafYG`% z3Q0W|ClA^QZo!Rj-o{?SQ>ND}qx`K|>;m66#D3(64CRJ0jR>4%orjOjOWWvY{!CRG z1Z=T~)UGIY*CUMI;M8SFX2MCXN#XjPdp(el3+QID+8-Ef(x8v{aw9jH)DYeO4vgtE zg1|EwrO8*Y!#GY;5!TKsag*IpC6d|q6PL-n(9~vk&c}H^SOW<|Vk&9fP%|G-mv?Z) z=``W!$0^KV6roGQ-!x;ck>!R(oXKTIT@)xgcZOm6kkx|SjBV4d@0#&1UtogsHyba5!P&FH&}SkA~W&|SJj^qVqS z04BSmm&6D=Z%(jp%PIcCfqIz6qv7fCCt;kjywJV4PZ8@!t|TY%|9W&;#=*%LZ!)MD z$_`5|Rg~a=Qq$ENDv(}s)ktgR5Ncm2*f@qrnjEZ-j&uZZf%Ik1!M3*MTuLV+>m9Avvg5(k7Z0Bk z_{%QBa7i%P`w;7$DF9qT`T#p>6?kv+IKcGPr`Ok?461@L#kM93I zjUDJ?XR#raA;#H*NXF-3&f&taRSNVhd5E-Vz2m_jK^8LQSl6fW9D_XA8uXM;RvrcsvxEu__6>Gu!20L0Or2Qh5`gdzFBE#~Xc}_7n0!SxjTYRJR>v*O`d)%5k5AY*K!^WOxJ9NfWkV z!J1IImGkN~=>Sw|6NCW+GLpLZ9m$q1G0&a1xy4S|o6q_M1srn%Mhf}^H)@1bKhd@lI{D%gX_wvq^5oqm` zq|=6>Gh8fi&nc}79FkccJuJSRn|K*HRNaD_5FS&l8@OPuxQ++xOT{ob%kRp9XsPTC z#Iwa^C!8OD4+G+~KaBe+&1kqmhL40-q_0$aAFke#(BIj?F2!{|%+oP#LL^uP-16c{ zdhCvxV56?9i|k?2dt9x^`RZ8{`T+J8;5j+<84e-&sn6U=)ofEzz*mayt;W&+`YxX- zrmXEtZbKT~EHj0#+nE9O0ewAWB5z1T*Sk_lvnL|6kXCG71&sQ81spHX5M^qc7sEs8 zceIoBoK|W&poVN_$$z<(4ovwKui#+GWEw$6%(3N7V@7FLGt65i)b<3oxqYFQawCv_ zA`!Wipz-lwy_cEB=o>=2GxNWHN%xrw%5_p2PgC!wPO*n1B1Djv`u2yiMarYA-i9S~ zm>N5L;=Ybt`=@DAtNA^{dS6k3HZ+G~NOG zEm!1xM#-9bADP{}72JhFm=O ziy0gT?^KVD$ruawu&@LQTjdE{iomU6>FpQU$8F^e)gCLnTS+6wK~9mu@IEN&LG$N0 zm0BZq%U?FbO?ppY&{c7~-U43%ziY^EnS9@zF{8UpJRI~mvH$RPhNHx~=b?+c9(ysx ze4xe4+Kr#m`y39M*8g?YlH|__341#z`1fVbSzE2k~rvMQ?#Die_FCJ2QVhJ_J6cbHK#ElvO z=Z42AtPns=in>h)D`wGYBw%dBGg&3&$(N;27ya`2{-GQ^jYZSd`%eQ#_GQDiRM({^ z=@NC2$|eI)ekDM7*}J2pTK9N(+dW*hQrGexCyTslGJrcTJ{b0aZ8BwkZkykmDyE2m zqAxfpcv&B;uk!oUA=eZPl1U;2*;%~jzhsfflx}1)vJ=(`kRD$s&dcnXmofZIiZ%IB z;-o*Smb2N0k67{Xam9xZcB^@{O(OSfx6*9*c15%V7#x1Se(aXu&6i>nO0al%pLEZ) zyUAD%ElymC9&zqeN5(qI+)9p8dMUwsxYRr?jqJ@pH>`#($F|wOQu`eTN(Jv^+9r2; z?i*^lF^q1|zS8H(Qnv=@PK?Rb1OM4=w4M&WE)PKl+qk%&W5ijl4()*Kge7s{6jhww z5L5)pp@38yg?`?7deC^gy_4R$nR)`@T#Bojf^>eEFkRIcc9!@&d*c3;w?Vjg?RQ*G^Q$3OaqNS?^<%2 ziCE)J;skp)n!_Xmet4}YDo3eh+i;DuT&58 zD@NtF4Sa85=YELZW2b3^TP7!?FwU5+c{mp1xzs$C;y4;SjV6BzHJ~!5Y&DOTBp)A| zR7c2v2PJrPR$5LOrT2yoNvE%;4**1!31$Gai*vNLyi*#!fI#oG#w%rO66rTv_$G#k z)Pa#ZN~ds+T*NhUwOo}@N~_9fe(644mUv^QLRAAGF=_c=e1KU3Y`)>oH655t%Rg(s+=cwU#Dw{ z@Grb=s+orF%v37bc`G_n6S9TB=NG;v`FyZZubiI2TV}Y0R;^9I7Zq#WOcuRt_^ny< zaFWOIu;&W+t=;6>1>tGt@3zxRsg=*o@^V*MJ5u$yYwWpwvB=9|>A<+oU%KmAi! z!Cr@~e3BSrfl->NjjT7yas!9a8;{&vHT-tD2_xXn7(ydsCtr6*XsOU$eD!7g39t{U zIurhV*Kk03nr~EAe4K-}>d6+tq6K(12Vlad zXFEo1{=K$Y!3?bM>IInw2A~|@lu{yl8+`7WI;cRKoL$;-!{wDdmhm&gdPHD+S0 zSJsmHvGi9j2w<3h8HjYTYFx(+AqFkpY=*bgJ54&gp13fxvxu(xXk+%J(UGW3Hr9=a zSQZSqo0`p`J6Le1gQKDx+fUH?*EaJ8;jDwhu<|&{oJ$2#iA>J|xk1BBDACjW{&Oxr zrJDLs5k=z_E3vjvKhs*j2UivwTGZt>oqpelU-5|HdF{s9MDyCZ2yfPH`Xf{`g0%L1 zO4%#nLn3jvXaNaWYZER3Jngg1bR+PHNegUE&ThstyDO?_~R+qA&RiuTZU1RSBx1q9H z)v)jo_})O3%H!I~JluZxCTL%rz4i~?s6bf;#)3@ClaW~3ISw_;U4-x8j?VU4Vf<*| zBdrF5?*13}AZt)AoBS5`PPb)t3RpP&ajNkU)S3y-8d${xBE)l@OTxe-=Zr zOtr-Vrh8IwfQ2(4|LzJ>SKbWY6y?8w4+7@XIqebsBa5rkOm_@KzDYrGuc)Oc<=zOw zkZV2F2k#c;C3%`BM&X#S*`K}BDZ*R=Ux-SLH_kKJ*;q=rlWGe522TJdwag6dn@1Mb zZ$N**GnuFw)uo?&KA>dcquH_GKzR$yh#{I&MDiM^*(D1+lqUe_E+Cr0k%>F_^TfiP z&r!r6*c3@n-OcYN=a!O*hAlG;HAXLQMku$3$C`LjOZa(wFTl9u)hf4BYy76`UAaQ^ zeKnfT6-*ttQa0*6csiEsR!OU$0$S#hYkh~~*KPM_P}63T^h9EmA4zGj;zdHCLoGiW zUba?>#V2+P4x#KAx3Jc@Z8Ra~PPK;kK@8SwjX?YrbQWVEMe(8xaX&$q(%2B!25NUr z>xbkYqAVmgNSUQt-~$lc?(nKrL+fhd|H!2oWtd*S-bRFUQ-}IA&m1o_KaW5W z2z3Lg#55IdgQwi}OjgBCJt+y?q^=$PB-rsf)+%t$nUkFA7d@5gjCE&CB$MjHS8}2O zN8zkSx?u``sAI`s*#S}WbZ-pW?{{0;2}c|}B1pVn(-|K||96{I>Y6yq^L4MwFe2CW zs2TTXFrk$fj$nY2euoWmv=`)JYA4VBkMH_wQhtNopsUTM6SK(0t0R<74^9Q literal 0 HcmV?d00001 diff --git a/src/tests/hash_functions/key_array.bin b/src/tests/hash_functions/key_array.bin new file mode 100644 index 0000000000000000000000000000000000000000..51ab341e8ed3d45e01ed7ac621f0e789937318cf GIT binary patch literal 2048 zcmV+b2>+w_&x=`XyxpNSID#2tT#*4u{&pY>J+@Rk6{Sqm@-xwdZ8=4PP(-V zvM>W6lfpPReKO?k%PkR;=cOIs)3w%!i>4V2`bLuSQX{FC5*y1NB&zXAEH5pt2Byir zC?VkV!`yVgye;hu!I}>nD7rmqSg>n)gT$oz4^Rd*t<1xyexgnh){9UCDYF5HoyvgU z15<%L$3RVL#TRPbnK~;GB%8X1nuU{LC|J(FxD-%vlOx1Cee9i9nuy(0X!W~S_14#q zBVPtVbS^=&A@h^*?RyWAO8ypc3nar=!w^x}_1+SM) z)DNHx3^E|?MjY@I1kuWQ2l10EOtJCgI(kPYv9%1k24a`mwC7OGXDqu2zqyaW-Wmrn z+ALQlwITDRo0I%#6QMenjAc68bmjE$2AC)XeV?MJ!>|HPTisxWN)~^&W)4K<{&#LQE>X zf_d)G;y`Kk#&E3q4sSCKx-*_3G;Yr$T#s5$K5+29t0G@|CJ#oq0Gtgd>6yiu z(%ta&#XNtVTyeVT6)Uul_iikDWo1g$Imkd+X44-N*O6-n1|;*K3s9|18${kP1a5Qq zw#K$s)LxqPQKAXupI*u|zYNbznAbWg)=OUv6`txVzy;SnQpNd~O88^zchJovg=WXO z12A2_II@7cG#^i7pCGqvBHFh1*XSE@L2Jv@CUDgt*6 zfw*wmjWmyF5Fz3`a!*;Xz$+=gUdoHTTIi-6bCT*;TuCF5s`YXRS0cf~V9b@}x1Trx zpS>?|hl&z57))n)OKz3aIy|!%Sr?KWpK931HGEt~jnbC4gxZMjZ5hmPq|o@qvnAz* z_t$}K%9-!M;!UKjOIL}F7Ne(C4rVKBT%12+yUR?zd{7l z3C#{ltt~I47v=zBm+(Cw1Sd~RfTgVtH=-G*vHq(l=r1dU?*gnKff za+OI=Aj2Y{C5uhjuUrp&$wC>j9hmgre(9W(|2gj$u5B`QJ>Ejgl~j9>oesF_sL2$j z_g`#}d#X57W72TI+N4!|kl+o4YUg$}Bzam2KV9ZCbehz(o+S}s-~?c>V&hmhsn>ITzTrpi*o_rb{4(*?fYwScNDM|V#kdEnE1B*j~&jAg++&Y$4 z%TcQnambaysR8$gZ>%VV!4ogG!!fl>bW&=&KG|&u4L;xucG!I)VZHoJGGlyP0QpYO z^OJ@2y{3i;I7bz`)A~H~v;SMOs37-ZK6}HQZP7B)c8r^F7pmfPPb6wyns!8i?mn+I zBE>sh&6P8`k5ch3vgnBt#g-JDX_4rd0=8nPyp*ACE6K~i?juTNc;xrI!0o<&x4bE# z9MXiV%xk0d4;k(n>t;oxkgJ0x=x;@>zA@xk=l>I9+(X%B;UMaAp4(4f&WG*dFO8HT z_9llW-?G>WUU{eycVdI%0SaS}6iLr#>;ClX$9qN?c?rmvx7mP~0rw|<+}dw#%3rW^XY`zA6ffL#f2M4k_Le7j zwLQ*y^W*p|$5^!I-@dFmTgkM4j)3ZHLjTTM>bW8-W$QW)G_^qC2Nl_EkRGu6A{Lul zg5k}XUda8`**ZYxe(I=WaQ4&sc3;zv6ZN1*E&w*I_$$Pqwxkzs(x7=5(kfO%4qoL# z_#}lBe}EVEd@-B6+PTiMri+CvyqFDYgXNyuZo6EXbE96Fej~F=L%>b$D-ZZuz8*Qe zz7JaRb{i&EsptQ>1dCQnD#HpS8@o_{=K}C_KsicdzUW7GL{6UV95RkwwNDN=qxUXF z6{?ob5NPx#P!@>_A#jrMPZ7Ti!~PiiB4TzVq~31&wg7gnCWsc4!p=X=BGXvGUZus0 zfw2CS7|aNYaZ;r{=b#ITqRn?l4(u$yUw>&S1GCmdN<@KJXsTFkau*$VR}x~3(S2|i z#Gb$LOyChtvnrgIrBvecSRM{1+;ui>K8lj2Zf2+}2_+2Ni2W!M1Q;=fn@#Pw zk8a51a42>M+5IT)1qY~n;{^HL6J{jSnX4YM^aU4#MnH8d_0od|u~SPFaDMig#mxj; e0 Collect all exported unit tests + subroutine collect_linalg_matrix_property_checks(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("is_square_rsp", test_is_square_rsp), & + ] + + !testsuite = [ & + ! new_unittest("is_square_rsp", test_is_square_rsp), & + ! new_unittest("is_square_rdp", test_is_square_rdp), & + ! new_unittest("is_square_rqp", test_is_square_rqp), & + ! new_unittest("is_square_csp", test_is_square_csp), & + ! new_unittest("is_square_cdp", test_is_square_cdp), & + ! new_unittest("is_square_cqp", test_is_square_cqp), & + ! new_unittest("is_square_int8", test_is_square_int8), & + ! new_unittest("is_square_int16", test_is_square_int16), & + ! new_unittest("is_square_int32", test_is_square_int32), & + ! new_unittest("is_square_int64", test_is_square_int64), & + ! new_unittest("is_diagonal_rsp", test_is_diagonal_rsp), & + ! new_unittest("is_diagonal_rdp", test_is_diagonal_rdp), & + ! new_unittest("is_diagonal_rqp", test_is_diagonal_rqp), & + ! new_unittest("is_diagonal_csp", test_is_diagonal_csp), & + ! new_unittest("is_diagonal_cdp", test_is_diagonal_cdp), & + ! new_unittest("is_diagonal_cqp", test_is_diagonal_cqp), & + ! new_unittest("is_diagonal_int8", test_is_diagonal_int8), & + ! new_unittest("is_diagonal_int16", test_is_diagonal_int16), & + ! new_unittest("is_diagonal_int32", test_is_diagonal_int32), & + ! new_unittest("is_diagonal_int64", test_is_diagonal_int64), & + ! new_unittest("is_symmetric_rsp", test_is_symmetric_rsp), & + ! new_unittest("is_symmetric_rdp", test_is_symmetric_rdp), & + ! new_unittest("is_symmetric_rqp", test_is_symmetric_rqp), & + ! new_unittest("is_symmetric_csp", test_is_symmetric_csp), & + ! new_unittest("is_symmetric_cdp", test_is_symmetric_cdp), & + ! new_unittest("is_symmetric_cqp", test_is_symmetric_cqp), & + ! new_unittest("is_symmetric_int8", test_is_symmetric_int8), & + ! new_unittest("is_symmetric_int16", test_is_symmetric_int16), & + ! new_unittest("is_symmetric_int32", test_is_symmetric_int32), & + ! new_unittest("is_symmetric_int64", test_is_symmetric_int64), & + ! new_unittest("is_skew_symmetric_rsp", test_is_skew_symmetric_rsp), & + ! new_unittest("is_skew_symmetric_rdp", test_is_skew_symmetric_rdp), & + ! new_unittest("is_skew_symmetric_rqp", test_is_skew_symmetric_rqp), & + ! new_unittest("is_skew_symmetric_csp", test_is_skew_symmetric_csp), & + ! new_unittest("is_skew_symmetric_cdp", test_is_skew_symmetric_cdp), & + ! new_unittest("is_skew_symmetric_cqp", test_is_skew_symmetric_cqp), & + ! new_unittest("is_skew_symmetric_int8", test_is_skew_symmetric_int8), & + ! new_unittest("is_skew_symmetric_int16", test_is_skew_symmetric_int16), & + ! new_unittest("is_skew_symmetric_int32", test_is_skew_symmetric_int32), & + ! new_unittest("is_skew_symmetric_int64", test_is_skew_symmetric_int64), & + ! new_unittest("is_hermitian_rsp", test_is_hermitian_rsp), & + ! new_unittest("is_hermitian_rdp", test_is_hermitian_rdp), & + ! new_unittest("is_hermitian_rqp", test_is_hermitian_rqp), & + ! new_unittest("is_hermitian_csp", test_is_hermitian_csp), & + ! new_unittest("is_hermitian_cdp", test_is_hermitian_cdp), & + ! new_unittest("is_hermitian_cqp", test_is_hermitian_cqp), & + ! new_unittest("is_hermitian_int8", test_is_hermitian_int8), & + ! new_unittest("is_hermitian_int16", test_is_hermitian_int16), & + ! new_unittest("is_hermitian_int32", test_is_hermitian_int32), & + ! new_unittest("is_hermitian_int64", test_is_hermitian_int64), & + ! new_unittest("is_triangular_rsp", test_is_triangular_rsp), & + ! new_unittest("is_triangular_rdp", test_is_triangular_rdp), & + ! new_unittest("is_triangular_rqp", test_is_triangular_rqp), & + ! new_unittest("is_triangular_csp", test_is_triangular_csp), & + ! new_unittest("is_triangular_cdp", test_is_triangular_cdp), & + ! new_unittest("is_triangular_cqp", test_is_triangular_cqp), & + ! new_unittest("is_triangular_int8", test_is_triangular_int8), & + ! new_unittest("is_triangular_int16", test_is_triangular_int16), & + ! new_unittest("is_triangular_int32", test_is_triangular_int32), & + ! new_unittest("is_triangular_int64", test_is_triangular_int64), & + ! new_unittest("is_hessenberg_rsp", test_is_hessenberg_rsp), & + ! new_unittest("is_hessenberg_rdp", test_is_hessenberg_rdp), & + ! new_unittest("is_hessenberg_rqp", test_is_hessenberg_rqp), & + ! new_unittest("is_hessenberg_csp", test_is_hessenberg_csp), & + ! new_unittest("is_hessenberg_cdp", test_is_hessenberg_cdp), & + ! new_unittest("is_hessenberg_cqp", test_is_hessenberg_cqp), & + ! new_unittest("is_hessenberg_int8", test_is_hessenberg_int8), & + ! new_unittest("is_hessenberg_int16", test_is_hessenberg_int16), & + ! new_unittest("is_hessenberg_int32", test_is_hessenberg_int32), & + ! new_unittest("is_hessenberg_int64", test_is_hessenberg_int64), & + ! ] + + end subroutine collect_linalg_matrix_property_checks + + subroutine test_is_square_rsp(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + real(sp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_rsp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + + call check(error, is_square(A_true), & + "is_square(A_true) failed.") + if (allocated(error)) return + call check(error, (.not. is_square(A_false)), & + "(.not. is_square(A_false)) failed.") + end subroutine test_is_square_rsp + + subroutine test_is_square_rdp + real(dp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_rdp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_rdp + + subroutine test_is_square_rqp + real(qp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_rqp" + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_rqp + + subroutine test_is_square_csp + complex(sp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_csp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_csp + + subroutine test_is_square_cdp + complex(dp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_cdp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_cdp + + subroutine test_is_square_cqp + complex(qp) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_cqp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_cqp + + subroutine test_is_square_int8 + integer(int8) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int8" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int8 + + subroutine test_is_square_int16 + integer(int16) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int16" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int16 + + subroutine test_is_square_int32 + integer(int32) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int32" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int32 + + subroutine test_is_square_int64 + integer(int64) :: A_true(2,2), A_false(2,3) + write(*,*) "test_is_square_int64" + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + call check(is_square(A_true), & + msg="is_square(A_true) failed.",warn=warn) + call check((.not. is_square(A_false)), & + msg="(.not. is_square(A_false)) failed.",warn=warn) + end subroutine test_is_square_int64 + + + subroutine test_is_diagonal_rsp + real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_rsp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_rsp + + subroutine test_is_diagonal_rdp + real(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_rdp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_rdp + + subroutine test_is_diagonal_rqp + real(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + real(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + real(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_rqp" + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_rqp + + subroutine test_is_diagonal_csp + complex(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_csp" + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_csp + + subroutine test_is_diagonal_cdp + complex(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_cdp" + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_cdp + + subroutine test_is_diagonal_cqp + complex(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices + complex(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + complex(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_cqp" + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_cqp + + subroutine test_is_diagonal_int8 + integer(int8) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int8) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int8) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int8" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int8 + + subroutine test_is_diagonal_int16 + integer(int16) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int16) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int16) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int16" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int16 + + subroutine test_is_diagonal_int32 + integer(int32) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int32) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int32) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int32" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int32 + + subroutine test_is_diagonal_int64 + integer(int64) :: A_true_s(2,2), A_false_s(2,2) !square matrices + integer(int64) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + integer(int64) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + write(*,*) "test_is_diagonal_int64" + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + call check(is_diagonal(A_true_s), & + msg="is_diagonal(A_true_s) failed.",warn=warn) + call check((.not. is_diagonal(A_false_s)), & + msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) + call check(is_diagonal(A_true_sf), & + msg="is_diagonal(A_true_sf) failed.",warn=warn) + call check((.not. is_diagonal(A_false_sf)), & + msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) + call check(is_diagonal(A_true_ts), & + msg="is_diagonal(A_true_ts) failed.",warn=warn) + call check((.not. is_diagonal(A_false_ts)), & + msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) + end subroutine test_is_diagonal_int64 + + + subroutine test_is_symmetric_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_rsp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_rsp + + subroutine test_is_symmetric_rdp + real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_rdp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_rdp + + subroutine test_is_symmetric_rqp + real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_rqp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_rqp + + subroutine test_is_symmetric_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_csp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_csp + + subroutine test_is_symmetric_cdp + complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_cdp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_cdp + + subroutine test_is_symmetric_cqp + complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_cqp" + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_cqp + + subroutine test_is_symmetric_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int8" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int8 + + subroutine test_is_symmetric_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int16" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int16 + + subroutine test_is_symmetric_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int32" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int32 + + subroutine test_is_symmetric_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_symmetric_int64" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_symmetric(A_true), & + msg="is_symmetric(A_true) failed.",warn=warn) + call check((.not. is_symmetric(A_false_1)), & + msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_symmetric(A_false_2)), & + msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_symmetric_int64 + + + subroutine test_is_skew_symmetric_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_rsp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_rsp + + subroutine test_is_skew_symmetric_rdp + real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_rdp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_rdp + + subroutine test_is_skew_symmetric_rqp + real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_rqp" + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_rqp + + subroutine test_is_skew_symmetric_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_csp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_csp + + subroutine test_is_skew_symmetric_cdp + complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_cdp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_cdp + + subroutine test_is_skew_symmetric_cqp + complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_cqp" + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_cqp + + subroutine test_is_skew_symmetric_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int8" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int8 + + subroutine test_is_skew_symmetric_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int16" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int16 + + subroutine test_is_skew_symmetric_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int32" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int32 + + subroutine test_is_skew_symmetric_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_skew_symmetric_int64" + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + call check(is_skew_symmetric(A_true), & + msg="is_skew_symmetric(A_true) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_1)), & + msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) + call check((.not. is_skew_symmetric(A_false_2)), & + msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) + end subroutine test_is_skew_symmetric_int64 + + + subroutine test_is_hermitian_rsp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rsp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rsp + + subroutine test_is_hermitian_rdp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rdp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rdp + + subroutine test_is_hermitian_rqp + real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_rqp" + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_rqp + + subroutine test_is_hermitian_csp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_csp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_csp + + subroutine test_is_hermitian_cdp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_cdp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_cdp + + subroutine test_is_hermitian_cqp + complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_cqp" + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_cqp + + subroutine test_is_hermitian_int8 + integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int8" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int8 + + subroutine test_is_hermitian_int16 + integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int16" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int16 + + subroutine test_is_hermitian_int32 + integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int32" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int32 + + subroutine test_is_hermitian_int64 + integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + write(*,*) "test_is_hermitian_int64" + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + call check(is_hermitian(A_true), & + msg="is_hermitian(A_true) failed.",warn=warn) + call check((.not. is_hermitian(A_false_1)), & + msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) + call check((.not. is_hermitian(A_false_2)), & + msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) + end subroutine test_is_hermitian_int64 + + + subroutine test_is_triangular_rsp + real(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_rsp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_rsp + + subroutine test_is_triangular_rdp + real(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_rdp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_rdp + + subroutine test_is_triangular_rqp + real(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + real(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + real(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + real(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + real(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + real(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_rqp" + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_rqp + + subroutine test_is_triangular_csp + complex(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_csp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_csp + + subroutine test_is_triangular_cdp + complex(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_cdp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_cdp + + subroutine test_is_triangular_cqp + complex(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + complex(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + complex(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + complex(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + complex(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + complex(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_cqp" + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_cqp + + subroutine test_is_triangular_int8 + integer(int8) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int8) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int8) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int8) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int8) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int8) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int8" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int8 + + subroutine test_is_triangular_int16 + integer(int16) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int16) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int16) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int16) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int16) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int16) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int16" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int16 + + subroutine test_is_triangular_int32 + integer(int32) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int32) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int32) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int32) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int32) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int32) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int32" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int32 + + subroutine test_is_triangular_int64 + integer(int64) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + integer(int64) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + integer(int64) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + integer(int64) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + integer(int64) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + integer(int64) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + write(*,*) "test_is_triangular_int64" + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + call check(is_triangular(A_true_s_u,'u'), & + msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_u,'u')), & + msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_sf_u,'u'), & + msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_u,'u')), & + msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_triangular(A_true_ts_u,'u'), & + msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_u,'u')), & + msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + call check(is_triangular(A_true_s_l,'l'), & + msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_s_l,'l')), & + msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_sf_l,'l'), & + msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_sf_l,'l')), & + msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_triangular(A_true_ts_l,'l'), & + msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_triangular(A_false_ts_l,'l')), & + msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_triangular_int64 + + + subroutine test_is_hessenberg_rsp + real(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_rsp" + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_rsp + + subroutine test_is_hessenberg_rdp + real(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_rdp" + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_rdp + + subroutine test_is_hessenberg_rqp + real(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + real(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + real(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + real(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + real(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + real(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_rqp" + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_rqp + + subroutine test_is_hessenberg_csp + complex(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_csp" + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_csp + + subroutine test_is_hessenberg_cdp + complex(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_cdp" + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_cdp + + subroutine test_is_hessenberg_cqp + complex(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + complex(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + complex(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + complex(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + complex(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + complex(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_cqp" + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_cqp + + subroutine test_is_hessenberg_int8 + integer(int8) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int8) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int8) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int8) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int8) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int8) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int8" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int8 + + subroutine test_is_hessenberg_int16 + integer(int16) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int16) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int16) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int16) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int16) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int16) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int16" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int16 + + subroutine test_is_hessenberg_int32 + integer(int32) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int32) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int32) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int32) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int32) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int32) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int32" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int32 + + subroutine test_is_hessenberg_int64 + integer(int64) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + integer(int64) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + integer(int64) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + integer(int64) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + integer(int64) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + integer(int64) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + write(*,*) "test_is_hessenberg_int64" + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_u,'u'), & + msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_u,'u')), & + msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_u,'u'), & + msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_u,'u')), & + msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_u,'u'), & + msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_u,'u')), & + msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + call check(is_hessenberg(A_true_s_l,'l'), & + msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_s_l,'l')), & + msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_sf_l,'l'), & + msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_sf_l,'l')), & + msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) + call check(is_hessenberg(A_true_ts_l,'l'), & + msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) + call check((.not. is_hessenberg(A_false_ts_l,'l')), & + msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) + end subroutine test_is_hessenberg_int64 + +end module + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_linalg_matrix_property_checks, only : collect_linalg_matrix_property_checks + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("linalg_matrix_property_checks", collect_linalg_matrix_property_checks) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.fypp b/src/tests/linalg/test_linalg_matrix_property_checks.fypp new file mode 100644 index 000000000..04e2fb938 --- /dev/null +++ b/src/tests/linalg/test_linalg_matrix_property_checks.fypp @@ -0,0 +1,238 @@ +#:include "common.fypp" +#:set RCI_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES + +module test_linalg_matrix_property_checks + use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test + use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64 + use stdlib_linalg, only: is_square ,is_diagonal, is_symmetric, & + is_skew_symmetric, is_hermitian, is_triangular, is_hessenberg + + implicit none + + real(sp), parameter :: sptol = 1000 * epsilon(1._sp) + real(dp), parameter :: dptol = 1000 * epsilon(1._dp) +#:if WITH_QP + real(qp), parameter :: qptol = 1000 * epsilon(1._qp) +#:endif + + +contains + + + !> Collect all exported unit tests + subroutine collect_linalg_matrix_property_checks(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("is_square_rsp", test_is_square_rsp), & + new_unittest("is_square_rdp", test_is_square_rdp), & + new_unittest("is_square_rqp", test_is_square_rqp), & + new_unittest("is_square_csp", test_is_square_csp), & + new_unittest("is_square_cdp", test_is_square_cdp), & + new_unittest("is_square_cqp", test_is_square_cqp), & + new_unittest("is_square_int8", test_is_square_int8), & + new_unittest("is_square_int16", test_is_square_int16), & + new_unittest("is_square_int32", test_is_square_int32), & + new_unittest("is_square_int64", test_is_square_int64) & + ] + + !testsuite = [ & + ! new_unittest("is_square_rsp", test_is_square_rsp), & + ! new_unittest("is_square_rdp", test_is_square_rdp), & + ! new_unittest("is_square_rqp", test_is_square_rqp), & + ! new_unittest("is_square_csp", test_is_square_csp), & + ! new_unittest("is_square_cdp", test_is_square_cdp), & + ! new_unittest("is_square_cqp", test_is_square_cqp), & + ! new_unittest("is_square_int8", test_is_square_int8), & + ! new_unittest("is_square_int16", test_is_square_int16), & + ! new_unittest("is_square_int32", test_is_square_int32), & + ! new_unittest("is_square_int64", test_is_square_int64), & + ! new_unittest("is_diagonal_rsp", test_is_diagonal_rsp), & + ! new_unittest("is_diagonal_rdp", test_is_diagonal_rdp), & + ! new_unittest("is_diagonal_rqp", test_is_diagonal_rqp), & + ! new_unittest("is_diagonal_csp", test_is_diagonal_csp), & + ! new_unittest("is_diagonal_cdp", test_is_diagonal_cdp), & + ! new_unittest("is_diagonal_cqp", test_is_diagonal_cqp), & + ! new_unittest("is_diagonal_int8", test_is_diagonal_int8), & + ! new_unittest("is_diagonal_int16", test_is_diagonal_int16), & + ! new_unittest("is_diagonal_int32", test_is_diagonal_int32), & + ! new_unittest("is_diagonal_int64", test_is_diagonal_int64), & + ! new_unittest("is_symmetric_rsp", test_is_symmetric_rsp), & + ! new_unittest("is_symmetric_rdp", test_is_symmetric_rdp), & + ! new_unittest("is_symmetric_rqp", test_is_symmetric_rqp), & + ! new_unittest("is_symmetric_csp", test_is_symmetric_csp), & + ! new_unittest("is_symmetric_cdp", test_is_symmetric_cdp), & + ! new_unittest("is_symmetric_cqp", test_is_symmetric_cqp), & + ! new_unittest("is_symmetric_int8", test_is_symmetric_int8), & + ! new_unittest("is_symmetric_int16", test_is_symmetric_int16), & + ! new_unittest("is_symmetric_int32", test_is_symmetric_int32), & + ! new_unittest("is_symmetric_int64", test_is_symmetric_int64), & + ! new_unittest("is_skew_symmetric_rsp", test_is_skew_symmetric_rsp), & + ! new_unittest("is_skew_symmetric_rdp", test_is_skew_symmetric_rdp), & + ! new_unittest("is_skew_symmetric_rqp", test_is_skew_symmetric_rqp), & + ! new_unittest("is_skew_symmetric_csp", test_is_skew_symmetric_csp), & + ! new_unittest("is_skew_symmetric_cdp", test_is_skew_symmetric_cdp), & + ! new_unittest("is_skew_symmetric_cqp", test_is_skew_symmetric_cqp), & + ! new_unittest("is_skew_symmetric_int8", test_is_skew_symmetric_int8), & + ! new_unittest("is_skew_symmetric_int16", test_is_skew_symmetric_int16), & + ! new_unittest("is_skew_symmetric_int32", test_is_skew_symmetric_int32), & + ! new_unittest("is_skew_symmetric_int64", test_is_skew_symmetric_int64), & + ! new_unittest("is_hermitian_rsp", test_is_hermitian_rsp), & + ! new_unittest("is_hermitian_rdp", test_is_hermitian_rdp), & + ! new_unittest("is_hermitian_rqp", test_is_hermitian_rqp), & + ! new_unittest("is_hermitian_csp", test_is_hermitian_csp), & + ! new_unittest("is_hermitian_cdp", test_is_hermitian_cdp), & + ! new_unittest("is_hermitian_cqp", test_is_hermitian_cqp), & + ! new_unittest("is_hermitian_int8", test_is_hermitian_int8), & + ! new_unittest("is_hermitian_int16", test_is_hermitian_int16), & + ! new_unittest("is_hermitian_int32", test_is_hermitian_int32), & + ! new_unittest("is_hermitian_int64", test_is_hermitian_int64), & + ! new_unittest("is_triangular_rsp", test_is_triangular_rsp), & + ! new_unittest("is_triangular_rdp", test_is_triangular_rdp), & + ! new_unittest("is_triangular_rqp", test_is_triangular_rqp), & + ! new_unittest("is_triangular_csp", test_is_triangular_csp), & + ! new_unittest("is_triangular_cdp", test_is_triangular_cdp), & + ! new_unittest("is_triangular_cqp", test_is_triangular_cqp), & + ! new_unittest("is_triangular_int8", test_is_triangular_int8), & + ! new_unittest("is_triangular_int16", test_is_triangular_int16), & + ! new_unittest("is_triangular_int32", test_is_triangular_int32), & + ! new_unittest("is_triangular_int64", test_is_triangular_int64), & + ! new_unittest("is_hessenberg_rsp", test_is_hessenberg_rsp), & + ! new_unittest("is_hessenberg_rdp", test_is_hessenberg_rdp), & + ! new_unittest("is_hessenberg_rqp", test_is_hessenberg_rqp), & + ! new_unittest("is_hessenberg_csp", test_is_hessenberg_csp), & + ! new_unittest("is_hessenberg_cdp", test_is_hessenberg_cdp), & + ! new_unittest("is_hessenberg_cqp", test_is_hessenberg_cqp), & + ! new_unittest("is_hessenberg_int8", test_is_hessenberg_int8), & + ! new_unittest("is_hessenberg_int16", test_is_hessenberg_int16), & + ! new_unittest("is_hessenberg_int32", test_is_hessenberg_int32), & + ! new_unittest("is_hessenberg_int64", test_is_hessenberg_int64), & + ! ] + + end subroutine collect_linalg_matrix_property_checks + + !is_square + #:for k1, t1 in RCI_KINDS_TYPES + #:if t1[0] == 'i' + #:set SUBROUTINE_LETTER = '' + #:else + #:set SUBROUTINE_LETTER = t1[0] + #:endif + + subroutine test_is_square_${SUBROUTINE_LETTER}$${k1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + #:if t1[0] == 'r' + ${t1}$ :: A_true(2,2), A_false(2,3) + A_true = reshape([1.,2.,3.,4.],[2,2]) + A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + #:elif t1[0] == 'c' + ${t1}$ :: A_true(2,2), A_false(2,3) + A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + #:elif t1[0] == 'i' + ${t1}$ :: A_true(2,2), A_false(2,3) + A_true = reshape([1,2,3,4],[2,2]) + A_false = reshape([1,2,3,4,5,6],[2,3]) + #:endif + + call check(error, is_square(A_true), & + "is_square(A_true) failed.") + if (allocated(error)) return + + call check(error, (.not. is_square(A_false)), & + "(.not. is_square(A_false)) failed.") + if (allocated(error)) return + end subroutine test_is_square_${SUBROUTINE_LETTER}$${k1}$ + #:endfor + + ! subroutine test_is_square_r${k1}$(error) + ! !> Error handling + ! type(error_type), allocatable, intent(out) :: error + + ! ${t1}$ :: A_true(2,2), A_false(2,3) + ! !A_true = reshape([1.,2.,3.,4.],[2,2]) + ! A_true = reshape([1.,2.,3.,4.],[4,1]) + ! A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) + + ! call check(error, is_square(A_true), & + ! "is_square(A_true) failed.") + ! if (allocated(error)) return + + ! call check(error, (.not. is_square(A_false)), & + ! "(.not. is_square(A_false)) failed.") + ! if (allocated(error)) return + + ! end subroutine test_is_square_r${k1}$ + !#:endfor + !#:for k1, t1 in COMPLEX_KINDS_TYPES + ! subroutine test_is_square_c${k1}$(error) + ! !> Error handling + ! type(error_type), allocatable, intent(out) :: error + + ! ${t1}$ :: A_true(2,2), A_false(2,3) + ! A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) + ! A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & + ! cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) + + ! call check(error, is_square(A_true), & + ! "is_square(A_true) failed.") + ! if (allocated(error)) return + + ! call check(error, (.not. is_square(A_false)), & + ! "(.not. is_square(A_false)) failed.") + ! if (allocated(error)) return + + ! end subroutine test_is_square_c${k1}$ + !#:endfor + !#:for k1, t1 in INT_KINDS_TYPES + ! subroutine test_is_square_${k1}$(error) + ! !> Error handling + ! type(error_type), allocatable, intent(out) :: error + + ! ${t1}$ :: A_true(2,2), A_false(2,3) + ! write(*,*) "test_is_square_int16" + ! A_true = reshape([1,2,3,4],[2,2]) + ! A_false = reshape([1,2,3,4,5,6],[2,3]) + + ! call check(error, is_square(A_true), & + ! "is_square(A_true) failed.") + ! if (allocated(error)) return + + ! call check(error, (.not. is_square(A_false)), & + ! "(.not. is_square(A_false)) failed.") + ! if (allocated(error)) return + + ! end subroutine test_is_square_${k1}$ + !#:endfor + +end module + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_linalg_matrix_property_checks, only : collect_linalg_matrix_property_checks + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("linalg_matrix_property_checks", collect_linalg_matrix_property_checks) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program From ecc38d1a578115c0f7c3d29be2757c240b08fab3 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 27 Dec 2021 14:53:56 -0500 Subject: [PATCH 26/33] Settle on global style for fypp templating and add is_diagonal and is_symmetric --- src/tests/hash_functions/c_nmhash32_array.bin | Bin 8196 -> 8196 bytes .../hash_functions/c_nmhash32x_array.bin | Bin 8196 -> 8196 bytes .../hash_functions/c_pengy_hash_array.bin | Bin 16392 -> 16392 bytes .../hash_functions/c_spooky_hash_array.bin | Bin 32784 -> 32784 bytes .../hash_functions/c_water_hash_array.bin | Bin 8196 -> 8196 bytes src/tests/hash_functions/key_array.bin | Bin 2048 -> 2048 bytes .../64_bit_hash_performance.txt | 14 +- .../test_linalg_matrix_property_checks.fypp | 325 +++++++++--------- 8 files changed, 177 insertions(+), 162 deletions(-) diff --git a/src/tests/hash_functions/c_nmhash32_array.bin b/src/tests/hash_functions/c_nmhash32_array.bin index 4c6821c171b5047402fa4f8c901d2e433bb75f39..52081e7b8a41a6641e3e3c33020ae14f4c49b23e 100644 GIT binary patch literal 8196 zcmV+fAp74%$l0)1IuxMq*xiXY5h$REk(Ub;1+Er;qR+AL`n2{zXXmmgAc7T$Awo(g zgrkC6IZ7O%nq&oG@#8m5x90|j)3naG+Y-54#hNu+w@5|mu*}(OzpNQsIVvowL#`=sl1~cRgazMfSnK~(>DtlxRKY4L2h7%^gS=TC* zM|0c6G0fy&Fecll?vzDNfUmn^`UBht95Ndm_95~zl$ffql)Z=BOh0}F^i31@qnRaE zn?r&u6hvyqJ;Xd#)3uYDU3WBt=FFn0HF>}5uDt$!V%Ah9rl8i2{6B*4FGNE-l&e3@ ziu=^2VRURZIsrXrp-=5?*gsedsOVQc?d(+Eat{J%-pxR-$G6JNt9pJt7H=mkJD4hW znix;@7|qbaR$74iSZknu?^m&Ljym53#I8pro()(fGd1@Sd2^aN_?p<`rw9oo^-&33 zsVP7nyT@RV6r_>Y_`f-a<4V=Y?u%Qaaug2-OC~n~XolAub=g)8WZ7j=o%nQ38Wxd7 zyyuTTW$QiH`YZNK&A8vaC5^ht0tLExDWoGn>M=(~Qfq!!24{KpY1x#z2I5boF{FMbJ(~Y_e4b_WH1LmU>xfoJ%9n9ZE~I zq6x!A-B($xu}F`G^A(q)E<{o*{deH>9!ImXvphV$L?0ZHOIlHILBHjqpU@UOxzoA)GbhYKRpk?3RP$wm zr~ZRYychm~Nc2iYN~+78z9VL*=OOdlttmL77YtfeS~yPu4cALuel@msUG$%KelU@> zb5*3_dg6y}tlg>FFH|)i!pvAbuqYPBRxkM96@xBogxjv`qoTUfG3OYHzgdHW6d_w>8`Xg+J;_U^4y8U z_pO0@kY=S~^;6_vG6lWqvnbsixMbg1lpaKll9p%O7JYd^jx!ik?c3>baBaECV#P4S zE@Pv@>%s-?7*fgsF7!x`1{!ba4p$}Mus2qhHh zxz&x&zqbRTsqfytp_ZFtNj0ITD5~f|Fvgrel&$9Rr2Gw_gmcpp8 z78FaoUY9@lrH?MjYl74O$V9$Qk?UGauv78)&&V;@&VOK1AqvMM6ke6~i1gwW89-LIOxFt`K0n=HvP`x^C)vpnEW z#~Upy!WmzpdZ6M8L%6qIfDj<%!qw_&q}0LBHn=jK41UWGO5+{a-P^&SL^>0ZeqB;S zpaP6}?Ba%y#~t4*M>sFx9R3R;<@YdX_|oI!RfJ}rp*iDHP>YJYBbAZWG&@N}^ks(G zG;wQc9sL0)yMgWI3*!*rXnvW z2s?Bq;4D6=TOmq9W)DCUE%5|5nMQLun&`JSgbluYi{EqSas z;GwxfW)7@^cjW5ZX)^$KpK>zYn|Qr$)T-eLpT;9`X3n&I5!p-us|4;RXTPl59KcTf zCIDsce*S}Fm4y)qR-qmhzQlW;i--~{=AAnifAEz_AGM7j=@gH`789StJ@I`^tvCgx zznhbp?&ILCSZ+;=B-CG0A&ixw@K)}6?zoCRmlWa&1V3shu!I%T$Lv~dQsG{@{@)!; z=j4+@Y&q{7$3_}i{qKOy(iQOi2Tmsv6FfW^V22XcsO~0Eg${wAus?e`tG(#hfcMLa zh6^OSsDJkX>g6y(TBS-Dvw>lg1snKmP-fA!qQTNQ)G*D2(%?=xI<}vzk~buqb9!#~ zW=aXE*I(^M>T{=@Y(Bk7HKQOe+IbV4>OP*wjXwi+*<;u5g**2T>p+g?{7r^(mmrL7 z<&r&sa=Mb9+2$7C11@65MP~Pz-=op6bK2iFg{nNYEAFx^yn7GoxR za11PJIO))WW_HZL@Rf$^MkORZdzoMrS5p5Pz;E%jb!uXgiu@^k@MO6^IZ+RCa#Zb~ z`UnKNTMnFsaChF*GY%_qA^_Stb8tmZKC}St9a(w=4b7)4BpbiBC+fguNp^$fbZ+YD zsf?*j4oytPTm25QUAq9^V7~*43{EA}rv; zF!>w`oWQuhD`2Uom})aW(ILt?Hm&*XpFbj6$h-?952|2)IJDu)mlaseC2()dW5_+v z+ApajkiZE^;5|&_^c3X#K?3~!z(F(_Sfv0ufj9Imsdqgeu~x~7B7$wttqg1uFopWt z{VN|}9A8e(FVV|B&kb$!3f{p67ON)7!vTb_dBatVI@qXUv9`u2=QMPOPKn?l-l?J3 zI_5O?%SOro#*B|dk?wgMwq$R{j2T)*(W4&t<-Izc071HS>Z zY@KGX9D>C7nLFqAvl$yM8II+E-_ZJOzyvMT>y4Hv>4n9b_{8*(lGiCb5IBxbquisV zN2nIl6E^8D(&8l6>JoMe#HL_6u3Jm@R;{uKp|Y->RTaDagj=uPzMKb87fGLM;==l? z{;WE=hs=vz23IPi$lDLqJ8{7>;fANRRQ)BHY{QfqbuwwRml)fdi6GhmjmP^m#4VU4 zSM>L3^f7Nt(7@kiZzO0@DYCwt44?XGY8^88r zS`3lC>~rsJMK7)C9dc1OOxEiG1F8-y>hPEZu3g`PCzU-xPC+;|9tz1qmi{_YO$`MD zhStgZvUwrJOhhd-0}i=0R1<k`6Qc%Y6X|m1=H~1(-Fm>ZfNV$K&o3itmLwl5=u{ zEvnN|u6I38!^WI6((mKr(NU4WT@<^3C{CYEFzqWNS{lF?0g67zZ~tVQ z27zqf$`V!$OiKDx+Z!*!Tf}v=A4!e!2X!X8Idzv|w`*gH+~&kG>!8zAEn=0|`lxRk zo5sxk^OLg1rnH@Jol3>9Z)kMueok>!>~lo=D>gK9)`4W2g5#GBwW%bKPX0KdLu&w7 zrF4gEiGhP}yo9f=3h6LzTVYzV5i$^8Bmm;Gk+O;_^B?J7yla|rz9lHQ8OZ$g;wMV7 zK1Y#mcUnnv>W?F1|JFZ8o=FLp!9*gPh>CY9LLe8u65h|M2P9mcq>^fL_2 z^r5|@!DfIyB#@Zy$rGzXJ2w|t#QPRzjkn~0ZdMu=?Nej*4?z+?G5mAbq`!R$SIgr1 zgu4U&t(8sz^Qk~Fk4AGcApT{)c4TP*A)lk<8XxD<$#a6MA?f|fqrYs;9gkjKBF0Zo zCvPx@rRyToJdc}6BHtuI_d#<8>5yD>i*uXeT*Tu^7Cm+&5KU0OWbUsZV6WzBBgy0~ zi#;STJi>zRcv4uMia^>N$;E{8E-*<~FI-j>0GBYj&4vXc2CsKr%aaL>ioY7$V^>LmG5^~%pIy4=Q}q6{_u%t}tJ(^~{gaGI zow?GzAUj0vPZb`-g4^y^TP&1G0%S!ZOAk;{AuV5?5b)y>Ea+MQ4Q%3 zP|WIez`xhi^n-B8TtsK!iZhT5)X9%Ppb%l`;yBKCR*b_&=^3Mb_P64NsT5=zdt$U* z+Nv$7{^hbP4xYIU$nEr%$hD!AQj_OeaMqVyd4e@cD(cx!`F7%NA%ony?So`GY%IU# z+Qn8@^ta`5eQQ9qXrC%(lcanDsNSJp+TZ)F*;?Ft07%91eplgtEbDS4ePz-4ays4fb0Cn+H0PUXi zAdfT@4?@Mn@}u8&0^=D2f9evG%Y}D0R%wgu>}j5%xiq}f1aqZx&n|6081 zVGN3`8eNmOQBz_j)}N|3PLdHnB99q=W9PX~k>*C9D&NVuWl)Suv6WIO7z>9`f4ngzW3=fHQo@qpZZgrG79-~9Q5z!fTAX% ztg|v!kNzPz*(jCYsGF)VeJkD{-_uRv)+=VjqNwwIoyuo-l4q1H+igxs+K?dlO+_ z6Bd{gm;@rv@g#s83_!$~*#lAhYvuhzHA zXa-pZ0y9kUa2_o!$ycQx%*UJM0F@tHT*c~b{;h_3^LAM|>lDQ%I|>?|t3Eta=F+F0 zhuK)GEBmY+ni6GHH?K9oG7kD9mn~z0iDPLs!N~0%9(jbfEv(U(%>Mbs!5wVcas~;hNG{s*;sPTGn z?3#Gx5U}_+x-ebcDL;Z0b{T;dsuPL;LfxYLddYOe#Eb{RFdVA;`7_wmx(oXmtfekp zLkEPGDFLr1c~A6C3X3QQiv_K&9J(GuhV`P@FJxSaO3Qxuus6c2O5oL!)}Z_*36}$M zNjx4MVew#gfJtwuXwrWRSqEM}3mks6sJZWx8SM6`Xg$xU?y86jLO0RI1jJ6!&bg0x zYfQbS;yQUYA{_~z^X-6U`PQ=`6y&{WObrl2-$dzAlWO@y5)ie!k2R@wW8N(y$FO)v zxL8g}yZk$*%KfBzJ6gff>BB%X^mD;;Iz|DBq=Rp0w)hW}JXHCXUXBs@g|VJ)Q#4$+ z`B%a;-F<+2R{WA+lh{<7+xFSG=+8rE(c64Ent1TjSjP81FKMa#-HhjgN(8WfieiyU zlA!Yk?jAS=Adu`5iwWqpYlwwZBdF_oTkjo4Nx|00ghiFJAFd(b%+lk~!*E|aTaunQ zuyb|s-S!4F}ktC=~T6Lj>N}kaUB_nxjZPrTnDj00f2%>L{I$WiacI5}oZ5 zFzYGZl~MRzXR{YJ zyMX6UkOE}Rc^>D6<3-`w{p_Pyln@=MGijKvT7f|8bAc`ZBUVosr?Bjm;NS4{vuT&B zUx^^s7kV9NmAjVHQHOW2ert4WU2_yqRSj6k#xC3PVZ>~rgtVw!n9vlIb}qK+-Rzn& zwEL4Y+Nvzm-17jB2-L3A0@cfF8{+jXvacG$c+;2>zyJvDl>lJVk&g|XVxw?12u#{A+c8wQ>2X#hhBgl&#SR(m6e+9 z(Awe4u%JUTj8--|?#yha;oT7G*jHWB{sFWg*mhGfe}9qPAnb1>b%jxylt6AFCEWgJ zTin-(QjW4rH?Yg*iSY|WeL~_}z`c+pgbLv{{S~{Fi$=2T6V~ykkeVu`M@L1(*$%PA zrS@v;bjF;BSz0m}4OwIuCB88PlhtqGXw*%LXCVPWCY zj{cvt)yH-8Ze0#6bU|wLVD~xWBnb0)2Q{l?oubAGW1XE?Tbp{^5q7LUnM4SV;*=X0 zD+_hLx#p?H7gGDbAc_fbt5Y9#V7k;nLNxsaNStVjdbt*aTI(Z6>(0J;emY&=Pqr6) z%RP&=0wavo5*%7hDy}ob?zGaLN!U!sAy1=otC4YDzz_SKEf>sw?p>IWr3r7U)P9J> z6iu87sLSYW2$Zpx^;bv=g4c<;b^R1*5!wc*28T+u0TG{*lSa@Qoo@Ps45<jQZ_HCLXH|ZkjejTji*m%AeS-Q%|1Hp+i_mCxx@Lpra}zfu?X2dWzhEeVw@Rl7K|f<#+^HnmhsptZu_{A@BZ9 zP$U`qQx;lmQzty;_IGyILGPPgKgrvLf`dBNVFD6X1#L8hNji)9cs`BS`}3>k!^22u zay2+USgy5~P?q&Xz*h7W4TbRvV;$VyIZh7^#NTuH=01p~;qZ@~PnhocJW?e{?Niv6 z?bgcNSDs{NZj+ai$Cmds3*Yn52c>|f)IC%x(h|zlHYh9&zY*`GTGauW=nNnqCoLCE zph4XPCu_MB0;N*YOjuOHnf5>GC(o(30^XsLZHX=ockw}ZrNIIy07*werDv(Iuf&29 z=kXDm+5&bZ_D1Z^0DRQEx0#ySdaP-2@RBDE zgZel*wLUb%JPzpWKlW4W(ntcW-m_bz3*_~AW6wu|4FKAUy`}0+S zOF}D`A{Z5(17t_oorz#U(PJl-VI_KuguOj{Q^#@35m!4J<9FHffX--|-mhPo(GdP{Z&Hz`*=hl1Q z)3S_0iX6^Az>(5^|2t_KA^Sk{-V8|IDIT;&*(FmW*}7pp0l{jcEm=aQQTykNW`?Cn zaVvuW{FDleBugi?R_5*7Vl1WD>qCLEhH zGmY4Ma+!q0`SbW*U8p2Tc)PZ}9LFM*aY8a_&Q_o?6Y1~F@9w2f`5Zs7Y1cQLykt25 z*AZcEqgS0^mB7a=7C4wFgx}-;1{eb|3iNu~!0s6jebqR8n1kttHb5DtypAjP4}_-c z#n_-5un|c!nj7uJxJPZYq4l2HXsD7D=7Jf5`HJ<@6W~4JCh>5LEf`+`H2L|jBJupFETQ>(ro(PdZdY$HNsd+{+4t=e@MdlD3$OxauOp%3TptLWD zfjAg{j8Pw_7g;lTm??3aKN(cuuU$Rx7Plp{;{fCVVbSn7b4EKGlR$7w1`^fQ1~+v4 z4uffa=*cV`4(sI$^OwrOM|zMl;Jcn7qgV}-6Dg8W6c?~&#Cs$Fr~a;gtCmE4C26X^ zI$jL92`J&PV=QkMgyZa$w?;6X%4L)p=s@CItAa)9WYq2RuS%nOR8p4cajZ%BO^cW|gOPF{^eQ(s#bkgn(RY9sICoQ;?`DAu724h?!p ze||QyIghxuku65eg*7fpKm+esG12g%&7u-}Kh){Y=cOB(Ml#ScK`4rKs24_blwM|) zT@~T>Lz!`!QNRG76&%JK`^hd@Bp7FhJ|_eutQP$emXFyKP49t_3Z@vp`J^x7A4$(- zz}IrR);+me4+e=;#jh0te3qRLxkDOfIIv9X$)~pwL=C7k>m#y!Xe8yxMu7ORrJr&` zrbnJnY=<{p2W49jhs^pdR%gkhGijxH$t6FOhx}*^fzpWlbt}zaA(0o(dt{FXQY8nq zkIXTL7o{y{FPTz9G{S{5r$8YasC9Ap`5(U@)};@>Ro`4>v4u2;HsKd^Eh4wi6k+`_1wOM_OqqiFY=%73ccqTV@lAD&*k=9b@Z9-8K?`yV zSNuaxffu+uFd#piTPV3I@#-e@IF_JbU{lbuEra8=Kew1)6F4=rF$|H>d;U94k(5@F zL4fcfWmoee@^&Y^gE4ozFiFyX0{SrKc%pm=-IZ54#Vap)YJ|=< z-oSR@^}c8jzXdTsYV84G*sTT?jwuS6W=d1!l)D(8VlZ_tjlp|%@QtkK?=dXR;eoyY ze4b5r6Q^DNuyS1hXGqd$qcUWgaOzo5@^={9|7uX>6U#lj5G!30X^dV9t0>=uO-IIE z_HhCT9T5+t`6f85kX z-p{Yp!aJbxmK_#Ht4{H?EHdpJr8v*O@r;gKk2pAI*`4p-55x;-n1ipgpnP*8_b?pz z!YO7g)O4WPa9i-p_v@i<@N&esv8IJr7fHDN(bcP2wEHe^2P(*Z%k``=s+}{7=Z^2V zVZ=E)<60@RLiof-0(a=DWn8wwQ`=nO!ixjpxG<$)z{?uF9(&P%W3<11hFzrTF?LEd%rA}xf~EMl_}P`{zfP4-#0W&cD7bBKsUe z>DJr%Rk@fQNpPrw=$2fsW^X!5f}?O9&6brugaC@1r=qULlSa`JCf>xdL}SLSP!p0q zbH41hYr+zkralUdW@eaQPD_V@%|P&Y^vF0n3NlRI3HOKG`5T-O(W^q2epu_0OGn}! z2x&$2EO(CE@^o%AJ&DNt=`w!wu?CWcPp;nJb7)6?422$r^M2yel99~ff zljNRnNk7k#?kT3O8UYMxYQy(w1r6{sF%(iFWoIfQs{?#-kjM+o_V8QhbU`>1w&_J< z$}Pnx#X@iJtW)PbJ8s@voR{=E_KA(F;4t=&7?|J;jRy}onk_T@Bu=GMYD|7g{+=aN z{qsDs&0)KEvEC?V4&NFl(9e{wTnZQINQJ+EEGSmTA*{eteU^qpbr&z2NdYj(7$-0ATsv7;;%8O*E`p;C6{sAVlvVak!RvJOIHC2 zQQ1DqdpFUaDN*&lTs~gv17yJ(1DHG|idQUM(z~1Og1WuEHENBYFu+|OasoWXr(}X# zh{V1`Q!IElmK`Lf%=*@FxL|4TtC{`7)+aCZy0YHe+{+VsR=RqEUaDA(7a%eFX!$?~(2Rsb>CI0~`3HP(Vm8vY6v zeN>l!77dMxU<8n>ydGV5R;-HkNT0L0HE5Fr_Rmm_tnv-?l(mPn zeH3S`=v@1Gj# z=~c6UF^LUfgkOeKtT?&ebXMV1uv+*Dm?cbUmQwxHvA+jgQ{q0{c53zRSL65^<*c)m zb<$)%uMMtATRkHFR>`~6?)Y|+ZaLVopy?cA!jL-e&E~F6_~wJJfhEdO7h?fm^}6|PuJ8=mKb+Ig zg)U5U8Q$@g)a(SUKC6oGD}7%bJyJ5SY3Nn%sma6-WVBHVP>>9;0#c$2k9L$)r%1>3 zOTqd$EFWUCTS3c0)x7nD1#u zuUR8OEluycesEZ&97MzkA~XXWzlf?lFb2y{F~V~^ew9@=GtJ4NXC=WWUJ{zu`}O{x zJpx5vGWlxV=(kpkfge+*Z|O&63+lM8OJW&0fV8w9W?r@Wy#flkARwWw@}6ETalrqr za`Xm#LppA`2U9Udwb)aKF6Z~?p?dz#hhcxlRW(v&-Fn;i*8Cbd1ekZjkY^fumG0la z5p^mKcc*}0;wXl>(xq~SrLZH5)#aC8%TqQv1O3QE`R`c{ZBK4j4`_~sCs|&Oe#6o%${6xmR|G5#nQX{dx zE12+^MB_&MnZ5;FQ!coE$~!q5Hjnn$T<`;e0_-6czh~B{d&ejAFuaP=_BFu;aX{MS zC_)w&&M8x-G_*uR6zGVAD3^Iud8ph;4Cy92d|r#i%(T07rMuxraATe6V>wN>H{u$) z?TUe5(tw>b6CKN&tOoAF2Oo;vwXX{Gdc&jVROllpYHnx*#0uHV%iZv6ouqj zyrWd$;n-aRlJ}k72L2>JsPi7-(eNDZPi(&3Np@}34R5N}$Ue!tQ^>-{R+!M)v{=J$ zXX%hSg1Sw#0IyCL7CsYl7L*4y;W|y2;_&V}3+8*bJvn>cArk|-S&)ri0=0ENETd7X z^p<3_s$GPpH5N0op8^B|s+!=waQ=>6!DF!iZ#71t&C+nt@NnyF(@rH}#gvk7W3G_f zHaYD{f`@l-i1NddcX4K{oF#Sjj@4{8tIb8O*atyHOSYt;77Uq^c>=bzkbxIX>=9Qq z!YY_R7=}9|<`7%*a7?^>r`rTT&-4+z5#=ndn_fNS`5L|RHy4N1cSRgUMZ}d@uPo=; z3A75++FlATmJpaTQo_sX_y#u-6cdy%IDFUq{=)R1oZ27VOy-jWxZ72@>~H?16mHg{ z0HYLN;**ocn*yCEu@R9@fKV9T$a!I|O0vMZ-f=@Xft)^5q-zA|&V{S$_>dZT{*(TRp@dTSe($fQm z|HNd1H+hgleClyJN{Lw)>F5ogOA{}NPPL6VyK%1ulj!z+-^#0YBj{*_G zx8t^%b7sXrofs>gWxdY}RYQAQ>4$q`ni1ZJ`52VAKvcP45MYajX~G39$4ZBa)E)s; zqEhoCk8u!xHyJa7sMyLSa2}JqO{i^;LI>wwxgUV3+L8$w!C$eKD%n(K$_hPycS9qE zM-mv*i%0T;P3ow?k+~4Cn_x}JKR?gSE$I&)71t`E7$U^m{^RNByq$8R6Ny6|Fa&D! zV!bv6-(Jky3HIk8t^Gi^1n@`S$}98>#y`~RI5V=rd$YcsZ^IC%IuO#AKzw_9Y@_8MEEZ#(S8sy_Zu`5ptNA$~t< z&!Hh*mrrFkfSDp!N|hISuZyJdSn%vl5?$T8evOaPXswPrP7<@L8?T}?g>C}Tu)@Hc z)>lMpMTh}^Ha)wqK%?>%_LMYXJD{T}P-+c`F6WUUkWlyiAN!{BdjvA-{HX*KowoD0_bxJV$|zrZobWECdmGB6-f}S zku@6z`M^%>UxQ#SOgbL48hE6!-*c~|klCdF<|GA_`ojh3PtTxfnjact&Kh5x8SwI< zF-a6fj1Z3$S%;+K0oFtAec~b&FEnXzMk&caXDxduV|>G+JaOxm4>fQO&)wPZ6n~^dy#*7LL!{l{qo6D zCdv`~>M4ob+Txm;MLlqd$)X0hGSqODylV~E?=va2G(<7wdY${!)4W}kZ378 zcv?X2M`Z=at8?80G>wh7RkM%}5ZG3hY`XTE7a8NOX(JAQq8cmxJ0TflAax*Ch1A>> zYiX>+Mz}REEu+&sh02e{6l@L5j62Vr*5G=*m@p+cxjsdamgd zQtxFQsxe~8Hy|nWdmB11XEXmgwe<akLDtb=e>p>&bz!_M2VRxYG9 zitz@n-!3AUinU#`*%)j%Hfz%#9q+sKdR*@rJK8dU*2m%QT;_YytKNODg)G&_)ue_>XTx-xAY$A=Otw6 zO7x3R#0@&%&x!@ZvER!rb3S#!VQD)!A#(2Vvl}OWyA3J!>(K-PGGmCOl7KefR$UPo zCaCRIc-=58ft9H#rO4~};mDqpA@V+?T<+9dLxkkPy^79hA^ZX@NBT_J1X5 z(HKx37xQbW?l_uH3*~oxsN*}U$yZxu22{x;W`5V-+7*}R^)-gc?fW4%3kL6<##=#G|7(89y&vv{~pIp%EH`m!ZA`A~>WLq4X@<)!)gVD8! zmKE?!q`RDiChwjdTTO(^Pu8jm-@-5$jIqULzwj`l zB_&})uv*6Z^3&3;A#4od4s!8Xv~DjA>@A|`NJY}J6Z9)>udB;a7>d|*@=Q3JH=WA- zs5zK@$=)hOaB;6=Tc8rNYjrSQFrGQ^dU@rV=D6rVl zYp@I?HTy0|^5~U}XUNNTVPqzkl199U>cf}u~-}^v9*o_lS zdUyH6jNu*-wnQCVpAfHWdut9$$Km`HW;q~ZyaJgV9a2xR8MhP&D>O+nNsc;blA5Q< z37yT{Coe>TPS@DOf7-sfMXSNnxmXf?F`@&t-zCjGh+-eU=?Sep&g+B?4nEXItxh7I zU$Yv!tD^vCc@cl*B{)3KvHGVc2!sHvk{r3cvtikl`J&d#NJETpype)rr{)@$;0u_y zHTNh@azbkz6o-hCi{7cyUMT z3gYg$|CLYCBq~RZi}vPZL@ELF4&6a`Ik<;~^#|%N_TgVAP@YHYvV7;1N9!ZM^RcfW z<=Y{r5}l5fDlR(8ko?bY+UKFRa=?5gF1m)EIvE$FG`hvH%r6l-A%$x8 zXT|siF?Od>t#{Yd8SuUUE7<*lZzAd3z51Qu)a@d?H zJ%!D=1_fLiWaKZfKSpmv%)X~dpb19hL7r7|c9Jt!>VE^!IbkFB7VMBq-al{%i9g*z zhSRcgntxIRwftuE$D1~YgDDr|PLF0rt zQm4Ebd&d%OT2&zx!^vlU%vgg0&_Y$qzo{zK`F-=Bg) z()XSVIvp+xf@CcoPz1pv0wLyMd2wl-;%>S`@PC{EdBtB8{2>sSA!|3S<*5=u`D;0a z3Sjm$;EUU006v5T)(rP#h_7S=zGKX-I8)xYk;j6r%i_acwN(*NeE`8TkaN3^gN}De z&+;Mcw-!SWIEX32jc&YY;(_ny>{+*ZyjiLmOqrgzqCW(Uvp&zw`kEt2_3A3wp{oRr zR)qqM113c-Ng9+B2f$lYz)n7A=4TJYa7dag`|ixPwvKo_|6tXlpI;RgZb5bLk?kU) z{{Qh(v7Y@|a1ujb4>hrSy$qXurewV<)DwUgyeR`RQ$p9zO)3;zv5S&fk!E$2fW5V8 z&x(E&=M8ZwCXL_@cxXKY1x{Ylle)E1YOs+P_V!sC;fnBY_IHhubT)e{TB>g$TgV?F z*v@io$;K+ySHl3}^SDv6+J%Vtw*^t<#bNnOrZ?q9FzYLz8tqUv3aPFd1-o<<^&nIt zbwppB0M(v3M@ujM_GhB#b2L7dQsfRGJ3dZnNtUV|(ojll+cIYvwkIpt^H>iE0B^3R znLYPVLe1FOS%)mpM(Tu}mBqk%j8ArmJ(q0s zgwX?AUVH{VR}S%+GG`21c;wT|)NAw$wf4+dKZB>6CV`CT1?wxOPiky6-qw>;^@smh zauP-;jlm3d!Bo)N2^i5zb8LqOT&7IE$FXcNN09Xvpov399Kqx2! zB~nNzq>D&bR)y1!7A9}Nq!59}V%clL1?OWm7B@U1nl?&TS}Xqb%4YB8%WgQL;jiGv zY%4%dx{E2hh)T3eL$7au29M$%@WORUw2|{KHpOari4c-gBXyM#BDL)5#h6G2PnFXe zNt~!=C5j%youy@2vad$&tR^6PdOpS}7H>CR!La0ZHkF=&=Yr;~Tm>v`*+`BC3L#Aw zY?2IKE?^XCOm{Q)(W&rb#eb5<%-vvMTD7_&(2tO)r{m+G&f-N2lkJRzitj=KYx%h4 z3uk5t*fuL3Ksk{(Z*ad6KQ#-3vFO|Un~h1G+HeQHB$6m-Em_WQnvf?<1O5^b!Eug$ zS$^GpqZ*bZ#z;Jlc{(+3?QdRvGRzu;5*(A_vOf1GQ z(dq7EL{F-r2pm~ZyFQKAS8zUGh9>2w8hpOYQqtavbzGl~qMXcp2Y`9fxX?aG3J?%}~hEOUag&jJ$05+#CDRWLZ{* z_hYRY=+&_{&emO2(H{IiI!X83ECCU>v9j$Qz?|bCBw$$1)0a{fIVBRk)jAGH10k+o zWnqeS#*v$N0o=|OICcsy>WhLZPL%Imes(BH+$z}h-OKboj7)I=jwp{m2YDOx&Bju^ zIP56uYB3?jbZd~6LQeZ?l7nG{rn^R{DB{6mBPmKZhNu9SR8*_=5e!yy%>ZH?=AhZ( zxP2CtXak^C?@8j6+LKu^b&>OjBatYwy4r{c`;vc8KLSNtZx;9qh8M*^#*^oohpqYf zO|j3IcLBPhiyp$@-EHpd-Z^aQE)pG|imnhPyGBWO| z>G*zK@qK3=i9cuD7ANM_(?DTlsjdW0GtVA2l&Y1tX{(>SzO zU+CWnp8_xu`vifAw6@6EdFStl@3mfaF%*Xg)&XAUYVadO4elQX1YR zV_Arq6(Y2|_4)(m$Kz1V^d$+<1$m`9N6O_jC!g2E$AoI?55hq-HJ?W`<@u)1i?%`8 zWYA3k=t}XHX1Rm-BYGzWiLvk;(^Or>Jr+ad!03Q+rDlCh0TIbx6x%|>Zd!W%3sJVQ z7mQxs8Ez1;$}4*42v9X=JuX8-vD_N|6~ftxiC7(~w}veCLTXpO-ev z;~(q9RZ<-LxHpCd8y2>Cib#*FWvpzvAuTwG-SBfn0_;~OdV6zaZ-g@K^*gOpu+%OtA5`XFNJz&Iv6NgKw7 zDya)StQR>kKh7Wm6R}JQ9^-7y&wBy$Bz57VYG<`E(Xu%Pg^{2?i(IEhHVLiew6H@Z z$dXuaYT(6-l5+$G0UE<0G5$(&Xge0;x_Ge4X1t&Rp}f&?zH~;z5|$^G4BC)b&~PN49pu=NoRJ248u;-Dsq1KY8F$Pl6cM+_Uv!Z{02O-Z zg1;uk1W|pZsxg?x9ce| z0#^P!OJ;Uv*k|R;J#AX(zThz4#c)@tVfM7u^L`OrL#R+CVg8!QOM@6ssf*utc~G8s zR!`Wi>5gT$4|%34Cv}#gcx;kWiP5o(SY7c;!a^Txn-n`n?mBQ0+FhYEDcTD(_GbUF zF5Y3?yl;Ga!(be{Pjn{GymQ>oRZO)ymI*!9l5FQ7W>+T1ST-z4JBgKGU90hitUtjU zu}Xt0ckan`9Iu!}0d52m{%Rjisrvid+sYakA($vld2-q1V13sMdE~@tW#ie}zXl%9 zhzlyxi)|ePF^0}+qX(;FlTVB1IS4#k<3OfL19nLSzgf`Z`&>@g0IkNO8z#_T4ED8f zE4y~E62=$~v^;0Wsk9>Ri|e!XmVr+W`f6`niMC{vEo1;%PPOrwqkn>x@9PGztTb!f z2^_G+zEHi1rLBu7FW0@< z3CEU@$ohfO!S%a9A|wIFYRPW-K+bRuKy)M3bblFo@{e=5`Xg=J*%FgDf=h(j<{upIiY-eH9xLyup z*5_Xo%dO4TF8oaLQmjF4uOven)a69`~y*{wC-*Bo&>1xwZpLc=4Xe_PkEBVwQlf~e- zg;LXb{phl*XtwFYSOc)BffCAM2WjDpx#DCZ6Yjy*?lnTn@t|nw_>yPbs+hQJ zdgJVtuyqOp({ddDbzP7`AJeH(J2wza(=Azch9WLu9k}#KKD`Anm%f0|4!cD9TUwyW zFc_p!Hb7+{1lj|0c-ksjPm3Oz1ce@+sPHpxhfotz5g38Loyal|jy%Eiircj$tf_Td zFk|Y35CwIl4Ns9=S<__czB}2$v|tJRFBI8+ue3%TL(ZIWUnnU;W&g1kNlS9~zR$x1 z5&2+KQ9w<=CUL>pI1b{1H=?_MTxS~B^Ygt?$X#uE_fS~avL((uZXm}?TR(*?{$9pb z%aVme5wh^ooJ!qSOlCdQNoQD;m%-Qr6uxgN0(GvENK=Gm2^5`6W54+VL2T;3y^K`l zq2pv|VbtZ-mkPbMqaTTV89V{P@obCML&{xw|;+)*LHNrkH-< z?)H>YAKNh^O1^kc1RNvxxwgbOfWnZKe$ZEO+I(L^KX!)t^9h&eQ1d{ySHDOJAqI-I zF612jrnE;8P4B$M0;gWdC~R&frL@@43L~NBZl8es9?CBORkmnNtxE6c{`!9tVe9nm z>h{L6n2xN9ibpqsK`c5&h${IGn~+~258gNPDvfD>)u~Ps&HN_)<-l0sz#oOHvm8?W zSLwD~hQPCPN8eT0jILvOYK+iFk{g3+sp}{U*m+5NayIt#IFA;UU+eO#xuUH4J0$|{ z(TLYBK@xHHWVVmLw^8naxN?Vv5+Kn zde;v`53`&`$+CL)4~nl)(dloIO%{7|6adCb!^sx?IXdz3Fnibwmw2|!@oc{KG$j#K zSn0BPg@Kf6D{kBmNk9)tNngF`Lo_s+$kz^a#TN2iu%!-}zH#MLb_;eGk@M(cMpj$5 zRlI84>VsryRkm7>zX_d+^iBnO5B-+E2Y+K7{sU(KYr8T^2#ju2DjBg%&+1XS; zrBq32c>#<&#c7vGv$4N){q(L`adtqm5 zI*p=&-|TruuVHph8LO4-S+i+PG;LBH+M0U-it;GC>tt^ikWXY9bBgn zKS)*rHQdhu*s|-5y2HIF=W!wV1Etv>9o3drBnb>_(_vYr*KE!rg~ls`rBUU0ao+Dd$>Uufw4X{&35q9jGZO}n?EPYdH)ohA@_lj7Bh zZ0U0K_Tba?W$>`0{Jw%=!H+Olc$$VS>q?@+@@O)y=>{s^88F5;WEiDio zf67PG<1Rh|h7=wCtk_R&W~ptgQc{LXcSfg#^QTRgVr58MrcE}-i&k%|vgyEU8vmfr z(}aEDuWT=-?I*x6ygIBYchWe#TdNoXotsd=ZJ45I5dox8wq$O(+I9JUI6E{y32>#z z{$IS5xPF7IPx_+*6nc9Q3g*4>H*XlN&OrOZxlXZv22a!?4Yt3Mv_Ra8HD#0{Tc5#x z&L7kw^5Bk`yZd37dY^+r&3`#P9jzC)l-ku4NK!|da6jgW32|-{!K4Eq#uUI4XhrsL z2ne1pf>AK|NsSdI66_mE<(HxeQ2~>?{)`rwN4+Xa)XG><(zdlGRyvvlwN@-8de}p7 zKxQe^OZ2pOVsX|%Q+)h(Yl!);`OyU)oqJS`nGaB4(Y<_@KzxgK>hwB2Z_r&8jFQ=? z4iDLHqbv6j`}Mg%SChurWc=k^RP>G|h-pJCC-Yryi9Mly3QFIIb&qPj>YtH-;h}l9 z*RQ)ruh-pFf0QnKx}_R7iBt4K{nJQ8H|d?Hy+?@+Ufq=y!wH!nJ5`4nFDCulSot>0 z@p`a0o$H)qG>z4HlsVby@JTLih=*mWL1^$$*xX6swssQSvbE~JTS@mWWB-%#$v7{4%geInE(gjMsT${50Vzrt;4#67OV2 zE8O0HT0a(U)e9@lR6*OZ9&w`D8qs8&_NGh4NGH5tfLS0S z0U-3GH4t^&|2;XhY0F0$$;Hckga*_rF7iB$?G`bz{pV!n6E)?;%ZXRlHpr)UYeog3 z{J13@$2uK8b~3|qKt_y2R`b@r(g;!^B+Uk77uC_B$OPUh;@ z97&XE23@*5I11AJJ?XAJ@AMUOdCAx#gAWdT3Ggso;pTJ251I?#F=@oasYIxZ0YAa< z3KEB-@hw%8uug7cjJ1a=SguKVN$HWvv$FhNVCu>U#Mf(lQkpq1%u1)##I{^?9v)3= zgHjxdezr-^ynz%dEl%r%na@u9Kw|_K8@C~qS;Vj3sdQfBx!QlR?$-V#;dBNT_v>&K zOlL9AS!!fQw%xjdi?WJvtghC9%Z*F_`c{r=df+#2)tvy&;3sB${Y!70cGfslY zy(OaKd}dQvtc|Ho8JwRnsqibU-<2`VH+A(IqGZp5>GR}7V#=NfkQ2_cvbuo z+04g3Jj<)SA3=Sg^8h%s6}sqB+6W$*Wb;!{x|P-@RgnHa#Pb7tJo$G9{mqF0Vw6e% zWfTNI8H`EtKhtH37bb=+9LenMUC4K018MW1mT)h#ZZEB8NU~x5?t)5Fx#{g$-6w){ za|gKC79R*%L-eg!XUN^^e&_B?$G`p!3_%Otm`7ukja`IJ6~6aW(FN&)h~!qb+otS% zXCg0cEM@3OMxcE42gkKz``QU! z9(P{hl+C_8g5@~vzNH$ca-p4(9vLOz7j@|k8%=Pv77U+(w~R8QZ+~?^AUJzW(Ioni zbZoYxmql^z+yh}8`a4;?_E%8>E|5X?W3D)sLyJt_?3vH9EimDBkm3aoOBj-tEf+oJ%2imX zsqTl9G?Y?k66@1~WG8vBr#GDtLIAckt zRjX==Zy(C~LIZFSF17{4-=#JC>Fs7JE{kem9ms6y|bGqf8$*xbL>B zeG;mgBNOK)vH17A`plVMiZwbEEdcvD1Cq#Wxo`&i|6jbZ)CPB{st1$6h+<^;CBjTA zTusezw=1>9-htC>x*{0diFGX{M{of(thrZ|_W)d4{KBjqqEl{*ff*ikwHbbUB$6UV z_6`Gl8NUnuH-rjXe`flqt9LPcl{-w?{f3}n>kS4nN`5LyfTd5J?KSM4-c7mDjiix_ zV-E)S_sm<5ZvHOlP|~au=WCW0+H8u=`%tBZ9Xa7dNt=s?-ZB>LVlA(&o6Dfz_F#;+L5BC06->Vt(O)y zWEJTU&va@BX_zE#=gVUl|1fjQk-a{G0h)v&ZJ=O*V;=+G>*<47aPZe8F2dtDnk$NJ zGBsH2LjoYHyt2$r8`JywdN>qd)G%w4BcJ_=8d7fY)iK62UNBB|m{ z(knaD<4De>fhjXi)t?9|e-tua%Qj=v2ss3pkc85|vwq#&${X&I_a*js#ZtBIH8jzK zmTa-aE&Cfa2UeOE?qIRA6rxaawJ5-lyOzoL!D1yFZl@8Y@V{{`1VE~WA^OkJvpZRj zJ{?-i9=9JKR|E4PzQ)-ehx!U4LV zL4*0ZdZP*$< zT&*92ZY1^>?t#;`BZRshsv8cRLRe!~Yxdi)Mu2D?H?xYr+IKBHcYNXIS|;hZ*H04L z?)ngbOo#ij_90qKG{ABO187G%X@2CIWB?9$5QjztYm8I@y^%8~`nt?qPQi6B`z>vw zdl_hHc=)kaFqdfFIMjkE_Zp-=qoQN=P7D>L#S-*q!sUDnO-|zbcmIdb3jzawc3EgQ zdr@fAawbFbkY1cxVPksms&x=I(Q4yI^5wN-rdxu#oEUUz9H(^ifmUlil%gwCi4M%kTUNu}K}& za-W!xCJQ5UzqnUL7d5^n#?Pd_H$aGE`bSS6m&|iF2vKT*wE0ZDIwZJvH;=f%CNF&? zEb(z*{am-ilvfIchzj>|MT4wmpoNB0znqsJCh(T&&8i;u3fL#B?A3}qhG9@qr zmS5V%_-oeXl{#62@T+Qf*pA)ySm#q4kWz@5Z!Q7K8Q& z$eIeDDf<#H0;t*uQZfRT_eCi&-os!*KoH`puStTU=JDRh-=*t75^k>fBvjYC?5xCC z`D^?_oz@%uB6Ilz)|JORGnuE9_H`f&)YZzrkEj8~?tb1RH(60cyQI3GJP zD$D#}RK%OI8|$NMu@NGCrC**i&$e9~Hs{;)>>98oObPA6QV@}KkLoeuTkHA)&^RHR zh~pkAJPmtC8$a`E2P=06%ByiOJ&9i1&FOgJ&@PVsDM!r-o}}WzbigOQXWH(1k?jj8 z$Et1llGJ;DK)Q#H@|y@TysUdxMZ46KF6eA(F7?Yfch+v6dTSK|^djo3QaMoq-zgBq zw-mWEs*n$&NX1d`E(->|o)PNm1nTth4}<@_b{6b#dv%7sB)5_Gw@KWmIrr;unQuXd zr~|@7;@$BZHAn=bCj!}G-gr^O*JH80gEP{Qokcv*2h~Id0ou`x%lh!ENGG_ zU-bSJ)96Qf>DTW{i(1c9LeoFK$^J8kkgTZ^@Mg>o*_sLtel|?3al}00xZ`nWvC*ZN z4u!eZvk^_8-UB)f=?N4s;mnDz`GWnoe)U#;hoTzQw>Kh3F1Cr7414|mZOh>G$)E;} zA9-IyqI&o2`I5;p53xYV*>uugVa#E5*@?lz(@hoz?a2cGW&uNvAN-wX;3gn@@J=Kd>ZDR4=8@%dKr2l_WIga7l1$v!w6oOWbW!qmLfSLKp3wJ#8M!Q( zu4`dRcyy}B4aU0t29uO1@F?x&YwafQlly5Hx&lJ2g8@&rsOnK+;11;fZ?;KH(v=q{ z3~_%P3$Jm~?B+NS+fP^74%kWP*Rt=XF0Y}=md|ppQnp4eFKv4jODPsd(+k^M*G!uY zI6qY9Fdj54iJ1e)({B1$BMmeO@cN9R4v9Ua6dM+1(-F1;b|&tiGM)f>qJUp#B)p<9 zb}8_I`<`S%+hQ5pdC8YG(I0fHgda!+3!iqzyc67I>g3=%qU$B@KbTpt6k2u!KpR%O z33vq9LL{yF3aVv-8GV=J%u+?9nap5E3e#s(8`U_JJpz}f2g7O#q>8i}`rqqXWfO)a zKKU~RLE0~lq>75x36Ik+s{}|*G#k2IIsnegTAIp6bNC6GUjy|^=u68q{%#;!x>|A6 zy&s97^jsZ6-BXziB=&JyeqxU+n@vP``CBq6dU}I`TQqwoUGm1Z3(N{kxp_26wP*n% z&&wd%V$^KLUS?vmtMz!0&Nmr7bB@?%HiC2%ceRGC!^ET7y&?8vQ#QMLTKu1 z!bWm&`I}qNFX759+Fqgp*)7)7e%=1YM}@RFprjs7YRE#V5zF@x_+zkycgf~^tru^) z@?8GQ+8>Oh?~nonTLKAKoPLg(fw|$d`eB6l+5=?SZ_{9Q_LhK~;?v?Poa)Hv@W;i? zg6Q7|9`mc^Jz&(51B3LII4MB4Lr6i$ag#U*I4(MJ+6WO5A1*+KKn=-urETd~^IJOp zmckS*t-~Et9nWKg67Ba*sqMI2tPZwgSiaKoCEA&v|FXEF4o(vLr9lCb2E`0aFz zpA`4FA029Z`o za3A&tY6`Y|KukgsZ8`&gNg4WG`&N-7-a*)KAw|^`E_wPwS`6z}L_h|{M$911Wp$5p zqC18?`_C^bb7u#7I*-(x#kz_6Xk)|6z$rP>VE=?h4qSAyE$E@nlp-d(sowOZ*Pwv1 zf0zXAD2x~A;St-`HSk&48)a-(jt*{3&m(33eGhS*&GobOE*AkLQ=p(taRr!gj&|$% zP9wXm$am?8Agy{NY(~V+ypX0qfFTZQnuBEbRmy(ErQP>x6N)EEuGl;^(anwnZ^8;7 zJ;O8U3F$y0GZ+=s{I#Euk<-|PpYYtd1|Hf>UVf8kT)~&m$L}C&1!n8-g{S;6qkAt)C9V%ED*SQf<`_RiC+! zqi^<3F4xz3;Ci$q=m`z2`YEU}&z$_ZeaqQua>0$3s6Dt01H{t2jaoaZO?WH7^vW z-Mt!`jpC~`_0BPUB`RAcEVntOjZ9N6;Z)DHxI$bVTm+JV-;!btKkyQFcAFCksBF~M zU&;tCLwKJ&I`diHze`~(h_LdHi0SMwp4LW4d7fFCupJ(s{iPK8a z<~!W~RhetmhS=WkBT3P^zgm`!_{FQCAbJAC%q+bv*R8n7i(ZBj&{UK-k5)8sP(Qk zqI9w{iVlwZq};tnPj8mR%iKKh2JpS^9f|D%vNwe0bGQ~P3Nc?BZ;sV^gdDGL6^MM% z$x7rdPw1Qq6}hnLzNx`25ZE&j0}fV(|C}=bz90ED^(m-wwP!eY(I$XPc0}Dm{RXicq?%CdWLjo#~aP(Ig+Rh@a0^K5PA;-u~7>+{+RPWj){1MWI! qBo2AbH`f^FT{mkIV4UPJIL3LZONkv4;iDr(ye2QZN|eODM^7{1HR5jo literal 8196 zcmV+fAp74nM}&5PizzS32_lZCZ`ZusB($c|AvaP5nc%L%+1)eROQ+}8B}tVYnpx(l zoW2B%^7~2xTS=|H#f?ex4?548VpeR@ZnV0A!sSVl%6M6M>0VC~00toUV`s?ZGXwIh z%?G#j2*u1gKTCXi8*nX!#t~{5$y=Gl>cqA6!mZ^kEWE<4O|-hWo1>09>u-u_=fRu- zeZ`W!1bny!XR*S-$5rMNzkjX!Q)>2ZbtiBK9qU2Y34gq|>uwm^=ZX*<;6)+{$DrXt z`1pL!O-h*PL>9Q1I7kNllID&8OI#n?#(BQ6n*G&_c~x)!YZeDg)`h#$ftt2#ZcNP+ z?GSZJe%2}pPeS_$w+zTmeDb&n$YtpxBY&fb@4o!gH__FlB8`W0SRjkOo=SNYF{b|> z7^DDpa?JXef7;<5B1p&VVc6Lo&Z>PkT2Z{U{s>JXb+AotvT5a!f{$L#mAScCXD`6?>C{!QW2y zVq5*MT1W%ehjZyRsY5}v$Iziz&D-~hcR%EhET!>P3tVk3PHlV=l&EPcY)lyBBi(NU zHoK()TIC+0&-KwWKO!<%Wq1zUHG{t2!ah3Ge9yB>uMU2xBzT>{YeZF^euU2|mzM*R z6RMCX8eoYcPXk+?r@$Cg)JN>JJv2Psv@WXCrptGo)AO(KwU8&VASW5%Jf-kauO6VS z$-$hwa*;+p#o=9pwG%twXxD40N_t1y2M9cqbnb=l^DcbY!R^)eFW0y*!M4!pU2hnx z;|uLPi{8&wLCWnPZ6O&bdEJu(URyrZwePUOEyW-HCO{jPOSS^toS}s?TP(b8o|bHG zvck=Ak6k@}w0%R;JEJS(q*hBwBUzw8j&-cw^mPvBM08G3-JhNA9flAWtjn&3C$o z#^QGlS8l-SMr&efe-RFodP#J%_(EQs=TFSkGaAMuCuE{=3qQ^k+>UWKrP zyCn73iJd%iB-;;{x#Qx-uJ|hM$G@xvg?W-cOm{agjyDH2g@L#Ru~5dy5+~7=q*EBJ z4rq8ZRV-3nYc!n@d&O!Zp$We3MoefwR#{BnD|Do6Usg&}tO0?-C5{0zdisn!>WJCI&3{Vd8+d7yZ^yA2 zyHgl1^>QK6`u&&&b%Fv4#|S1*R=+!<9XeD~i_n(4F{sO$U){h{?OyI$MAX5q!-NG% zLaZP#75_7ly>Eif`Ld-b%py9LiT*xnUq=s>;wUEY_bW| znWw`~30#qKxlM^lb8bW~H)%OCPizXKltqhP7)w3m0Jafcn0$e4`+o|pgy<8E4eMC7N zA5nSevl!YzrJ?E!Lo6%R-;f>l0uip9txxA&5x_#w8s*)jFMktXM%jH2vY>b+Ns!x? zMIvOsi2TzYa;Q*jl9`&I2&;aM;;VohkfLr6drhYXcXBW7i-8`uIWhRV4sA;$*L#l> zm<5j8Rc(!&3}$%EVt0sPdt&er=srZaaRBWBhi+D@9(BT+K7=FhI4x$X;%}(4x{?I? z<(j!Znw*=dE1@e%`Y=ZI0ucI^E`LRXy}lZXz-zE4K5!~a2Tv%Hod0BI9HbBaSz6cW zM=b$7jY{ud3+ShY(ty*W|`!cBP6%P%4TA&d-jI1DnRw%DLCyv|l zSWI^C{W-}?qcQnl$`HFP9hx|a=Yo*2)+!V!?qRu|l?;>fc3BjeFsu=!W&uz$6RT}^ z#={W7le-HsP=G1r8S>;Q>wh+ASXY%oXrA8AN#;&2^0KPrf9g+wkJ@xLXtdS5sI~`hq52{ zdd?4muZ+(~n;~+S`LIjBE@j)h_)VyHw^bX@sd|5uXV`njZ-p7f3p=ZNqne;ojTlOJ4LkY2q zWpk~Jy+r41Fv)fjD2_iTe7W3~u9JNEXA?+gi=B)|9YwV>XVP9jE;f3*k)TAVtWcE}Czoquwv^HPN#sAF zGTefpd_5R4x=jKjnUdv%LE_*&F3w%?r^J&i3O9gY5k+aXWh6)DjD*nLI*n7=UHr+zXyT!a8zK$T zty{A2stWl!Mqc3Lu@B*Nk%3SaY`#*uNDvM(F+{WF5zg;)YMufJ`%u1Uh1W4U=nt2P zncrUJnDs{wC6>IqLu5<8QtlT_9B!!1R<^(Z87$tAN>r8D8J||A`%4>bn={ypds%%2 zNwv-U#Mqu{Z9E`-uHa1yT5xM_CS+d>oUW*n>Hp-f zaY(tR7pLD1N#ye$HLBiOlaxdQcw=VUsrChiGL>T(txW`aa{nVPI%bS^PoUCz($ioB z@44b4(CF(N@hV+rk!+q&_s3ui@zTr1VP?T?d{|eM;{OYQ`Fpm`H;5BC+F+KkgSEF6 zh_R$!AC&r_)39b&MPmJ8W5mkl&-ivBfW)X>Dgi*p082E$wXZ{IxolXNaE-G91vGX09~;sDN-QdJl@kYnVZj6K`(e(<2PolDR0maB#&;B(35j`yIlGCGTfGxeC|FI zOYjeRVbyHQGO9Q6si*+!H5C*C*0<8e(8H|LlOR1%mWsLC--jlZ4!funaabg-1GzjO z{xM#sz|^{oxT);fko7CRQX+(@hWj8HB`LXfGRnE&kbPPoqA1FaCGWkZCwAj~LN2yJ z42m;OMkB#M`c0N{@@9&pVXpLyDC)PUB6t=RL=wx!QK1ffq%h)nbX81LAySm#=$*s%V$q@IW?Wq{20(N( zKW|jl#0BUELk>y^$vr$kjj~$LK*ACI?CR;|GmFRNxC&QAogcgz0i!YTitP1!x%^;6 zquw#)c(v{irXH0B)x`Cc34Oi$bM*0pcxMV#D$y5+>ueabvsrNkJDlV|l&!OsUgl8SdWoK+U_uM%)&8zBPLRLEgp-`EI^uJu z$jjZJcbgkVqj|Lup_Vv(}wQ10Sgm)`7sw(IZ>XQ&B>#z}y7Zaf;y!3;SuHPAV z2qAuy5v-Ql0nv9Z1@y~wS!f0lS80wV0MbVqKv|C;EjEl<~Zl*VhahW&Z)G92;i=jMR`-<|Dra zwh8ct3m9M;z?w>fcasB^G+d0}{}A`bY8j6%X8&!E%gMw_fPQBgo19Mgs|z7Zbn1^> zbB{C;A(90oky+iCgcDD;e#LrRdY`lKkh{GYKfx$evf?Cd4<(I|DRF~F?mH{L-MWXA ziFGRpmsIlox0u}0^WaZq$_xnpE@+GPT*33O-u}W~_sOcm{_w{CT%9 zKiQqI(PU|{02$wOJLAAb+m0^`A~{AfjF;)}5<$3gUW7&^sr-R53?tcoNzqu!Q=odMjxJz$)O44vR%KQI42d zo2ndpup?nQGVtY(X9#M?A94k-Xx7&$_njK36eZH?A{1=orPF5PGC*W`(qiSizB$sk z4(zaCV&CleH=(u0h%4c?49gmNQ~ty!o3|x=A%6lMJh{~goh$)jHNj2;ZR@a2nLx&% zi50mz?Io?2E4+C~= zC8Sy ztB!>g9#L{<;UL8tgXMQ8NwOV5$3J5jFhL<+ib1)^oNFpL$p_B& zktXJf@BUM8RbqzLrmM?OuR|tV_2U0FrS$plxhr%Krn+2Vl3oW5OeJPzL9F$(opuIN zQZ(ZMk6>4IR4wK4WV9O_i)(+5)-wmEN*C#xd9$hTxQ1W6gjZ8SQ(yF z&C*3a?GQVWj?T_cJhW^n;C||y^fGuvWjP+tT^z41A{>i}89NH*@#m>aukXP&@aX2& z+&Or%Zzc85ynE}xyW=z(cRM}ie9#gCjO11TedX)N5(Z7B5!NMQ-QbM?LZ zqU23fmeh$^NQ47&@84qt38wS#zyWC3pc!~CW^qT3)e#_cz)b<}2ZT?}L@2e;m9!^t z&WdU!RpI;SG~1gEfP+U%ojuW646nToCC^e#)Kv)o2^G|iZ%hzmNx(6NSMc|*d1t6O zWvJ1`3gJ=`fS8!}u3GilnHiisd`&zA%>Ok7{-*n8b$6pk@d&mBsUinf-QzC`l9#zTU2q*RBI4F<`4qg}%kh@IT z)#pb9-^V(=O&9MJ0?bf1z$83)y?v_lO)x+#CaSGYQbE7lgRzB*`!!kkf3F+}OA(5H zmHE%W;wmpQER^D~+dl}2Y$ldc?Sl@4>KJRXR)>vS7 zj7Cc+d#|=4s-$`cl)fqT^*5NY=WN*?(1;n82q%Eo&^O0>HYytP_9E5bHtf3Cl63KT z9m+GW$2zyI9t6?#$uc9j3;sDMqr`x|JN~gIw2!jii!pMY$9mtnfUe5otd}hGv-dn1 zRRY^|SKS4KbudLDZ~Sq-&zzcX3jcI*h=euILI=c3%?e4fufsC2PaH?khSX4AcX~r+ zQ9;>=BfO^8(ftX3L%9vlU-DoLR=XzebssRpUC}yRcP!Ry($j2>nDsb$5*jkWPiSgo zjck9lTZZxMe`aC9>?B;QwiacvyA-6b8r@7Z_&_M&i^B>!$yPLmUuHfQS*a>G1EJgcx*aS zs=|x}EGn0GC?9$21|`ZOd(QEZdQY`kq5F3CJRCj6*={75RU2SwjJdHB0ANaBk;QYs zT5uz?c#$vRyhXGi^2SMx zp$W{rzHlT)jR*hW-H9i*FC3@u^A0m>L?UdostI7f%iIb!t~0U8)d7NK2q3ZDi&h_- z4=FY`j0>H=uYB10U(tk+>6%A+4kuQZ!<)Y@;}gOs>m&43aI7z&I-lCI*&HurNCu)!MgM_oGzxs-g zae&msvd2G}IqzstPqfpwG0$=dDusHj6DN!_Alb3D8yw!)OEWpJEzWi_`ym#tirS97 zxAMA)H9x5i5rqCtn~_4Yih5gm2Z}z}317%Hh`zxN zqCs4=EB0j7x8VKhC>-DNmz)db?MiAzJ`@iY0lmlR0ex1bm)rrhx!vVs)~un?<}|H%MLi1Kd}{lgQtZ}mC(Ae~lD(tWL)0+-e%Jq0TZq6p z`vyBV{SJAuVo-a-_{)>lfB_dJ2}d}sBn>ynltI>3qs62worocux2}-@vy%<|hUheQ ziQth~BsW!_)!NhYKxhD{npPA4J!CM<3l`V5`#tdbhpR1eU{OG=(GWu-3o_#KjjP^$ z2lRMH@x4u1dz{qk?EbyXF~-}6#TXd>Lek)uzaciSE=nG^i?04;B_3$dqSWRg6o=4F zrd__aAXGQ0tbg;LQB&Ob{IVwUYG7nKSkb`D1CL~lvDW@*`tK7Nw3_@F~9cKh{f0);K{e+|3;Qov?4DE#^BYrZ(T)DBmMUOzDnxI0PWMG_e^kzpD zYn^>}Y9y#!4mWD3i}$y&u-_ZY^j&y~;3v{3gmUwcExCO4OK;gvkNdLpez1>3@Oj1- zV0;Ax*OLiEStmpO7l~-f9)4`aN9Jkvuf9Db8oG>s1eNiPU(;9f)9XeOEAt=I19>u_ zH-zpQX3V6T{W0glC@-@&CKuUJJ7OAqaX$!IRj1dW7Sqd8^WkS$#2jVDmM9p_-}uDS z?aa0_rd1!t|JuWs!)ASJdy2$wu^-<_2GfjWIuQVHJMKSyN0Kdyl#h>-~u}q~DNUmW< zYNcI}GcBg>dywlbyXG3uAkIHqNSH1sx(zw!awdcJ5{?)F$G4=`iV7qS;;cyFb9dti zzJY}MesH=R+AeCS92o!yOlG^u!eD;DyLAIT`#cs#PGXFhQ~-(E5DkBf=P|hrY=6i( zb^?^LPvaKLGupGs`;Cg;0B(RxrPI)iX6pt+gc{Gp3l z1!A{Bt6?^}qtwFK82s}q*|Gcv0|G`$QGs<4p^Kfz#FhX}~JU^FJl>izL z&ieD8`B2^SGfMY0*g`Nxv=Y*}9|R==k8&J=qC5UT*j6ti=_daN!JU?U+H_q3*ndPH z(^Ej>2h7ZN^9_3|d}b44dWk4J_3pfQ4E_27;8x|u0feD+7GDoON!SFrjl*0Mnu~s{A)-!s@4ndSz5V?soK!aA-H+S3kJ*| z5eDO9ZdB`VFt`NTfGam&DSZ&If)WQ%2@)vB9fr$%vw_~Y`*mYV+jpe+L#ZLvW!X`! zNXPQ=%$%_bo+j*zVTJ%o8VtV$Q^};T2rU;8=#^Yr$mC2orzETL;h69pW{wU2%X4!z z+#5>{JnNL2EH>hnf9$^;wdhNEcc?|FyV(IO|Gw=sVow1_ z%o^x5cllraSGUn+$nw{(+*l9qeCG?`TJUZs*76hlaZ=>LA?~Q`{8t>~_1wH7foM(0 zrU{p}4wmoV@FGL}RmY0}bn^5xT(aT5d{w(rB%nQnL>Tpu-oHXY(DgHUPepk4o`ey6 zuK-WS_P7h*-_BE)AdN@40W{!;v>*Qkx7!nN_y3)_c9K!GG1027!Mj6{VZX+tzSDT{ z2T@Hqr59R0Q@YVVK`1B?V@+35kDL5 zGD8;l(EM@^l1Rm%BcS9hm}2g=Ua*i)k|QF6zquOCZa~XBCn&J!rO-q%iYq-^-F0>@ z)NL8)=X(dJK(AbJr}lR6j^Pzcpap()4CPOjrF(0w0d#C|8JDC+BGb094`w;BTY#|u zD`tJC!?-G)^}I5!A8rCz5hR^NanXhPys6zeL69yaGpE3^9YGOS>e!T;A(z;Rh%6Zd zq#tfoY08se*8ur5DD0ghpFj9bQfn4tlqrJwXQsKKG>`q3nj+aL`)F)DZb4UnzaIZ0 zMGCDV`-+Pen%qp+8Qgz^BWH!Dqu;`vUm|+D(y`; z9*zXQ3=V-PO?DEA52k$4f{b>?o{c2XxqdBt_GP8wGq z^iN}O z!8v5TBBDJ(Uywa?o#OBo%Me&O$h#muQ|Uuoyrocq(KGlk-0Tm{+(59wxDNd}`{KZ` zuGQ^%szLuL+kNKbz*Q~v=(^zgLkEdR;9!4qZ-f7C2Vw3~^eA*Q_gj}%vIfgpUO4U9 z&vsTFe-uCdv^#`ITXEApVhQqToq=b?rwqm79^OGGoFZi* z@=ic2DS-ZwbLJ`l)NlanCZZo9bgqnf1}nP9WH1JMYA2UVeA?TZfV}^rLl-#toJhs? z!p?(rnsI2K_2>%06~<}dWN1a=#ZtOEdNBANBw1{0F>sUnsl>KMSzem;p${PytONwk zh}YSLmPCdy+>~#~W(VDp`qEQ9mP5G*K;XJIMB0W48wVcI<40k4%wU$_qL#{yt^WXN z5qN>6_FUtvhqixnAmGZ=dh@V<7HI`f54cK-dsydp@lR&qF8L&1$S^{KYBw|pN20!FYY&>`?vSJumo%lFnTO6oRqtq@F zs$5w3cY0tSO8T)#gHlhce=>I08%soTE1818T5pj}K#J)bcd@j8>D`(1I zF3bseJF5lQYh$Rh@&~7T_D!J{Sc;jBK<5lhEU*@D=ZrBDOU3oD6Y5Dd`@Uix;K&-H z5lJZQB*W|d((-4$m(%c$Gn3Nr*wWL(^m9fn8v9qq!KQvfhK;a5nnT}9>3g1YJmc+9nejP{bdZLMDeB3c?vDeg<-ujdQ3eL z3$M|+o$3z|;8a_GAE_5&2ycJ?B)OZDw5j)kM(+e=CI1S2EG_z}jW2XFV)iwPi%=`y z&aL7V-fQ6I@2mxkrvTDNJFk!dDe$W_qcZyZEcX8B{kRZmlBmXPHvq}RII(`AK_s`= z-2ujl%MuSTUM5A@ZQ8~LYJmVEWD)`?4d$+qyl@xqxP(GLA)5i)MF`ZM#lZ>kg_zv> z;*QU#2AWixouoZLDG;C5RMs;qHu$8r+r1+!9xPQxu_b&MSOUUbmAyweSCuX!CA%4sN$(iM8rE315ZK) zyUos`f;4WwO>a11wIG~eXpIhPv?y9AZO#FVn~kzz3HOWsy2PV`SjZi=n)`Z#-I4IP zm6U@HjXdX%sTA}!cKZG6gApHbLYgO_RaMQLOTHWg&iPjY3d}&;6=amLOd>!>o_y>D zk_7%Pqi}p!Wdz{ZoP^0OPU!!7VyPgCW@ij~^SgDjM>lO$7)a)bv{m6XCAKEK`9(?ZN73q~ z$!_qMo4pBLkH47Rk{}dVL+>;mI1V_;YC`qZ%j^l=l@w+oBd)2$Z7HriL-^XB8<=6d z6%uBP(n((v8d9pPUTw5XLB1S&*U-{*Jl(;Y2hNGuhb!(zDR2Zr@$6&2kg!NH(OGS0 zBw1d@!D>`d?_+7|1!*1+!eVW^1!MaDfaOq5y$Dn@gE!^RsjZQ?$x% zb5(@Q319#z+(f3D_{@ayQnD=%?9g56qz*Oit<-d0w<2lzvTHC%a;6wuTNMYKrteP> z7>~r4?rhl%mEG#52^#q%rLaZPUq~4}^)LyE^x9RvqJq1c*t^kqY3cxfoxuhdvx~R)a?SOPNQ~i9W2(S3B*P1a z%0*LEX=k4wkHCSZvU@F%s{G>{ZLwreUR5;JZ=-N@+>hbuC1ODkAf$zPyh1y99Yd?E zi=en|F-4w1X;gX64=vyLL9eQ8P*!ZG<)81|^DdrMkHbwvstBy~gzQa=-pVRtv%W)| zh_xy7gy5o!t}$HaO3>@kF(!GTYbSL=p3unrFd`W(vq|9!-<8z$+A3K%PJm|;ECda+ zwu&o8m0$(UI)IeT6pdYtZt&^$%|(FvC@FmC8=$&m zJjU8L49EzZlbB$}PM}KT0#t@D1TqOsZ|7W5X-iOd^7!^Y@kP7|7T-m(B-OE@JL$;c z$lRA`GCn+mQAR6CKkkVez(c%!jhl2;o)zn=mmVO+JWB$(iO> zo<59pRz2z0M3bnsuA+%5;kmM;t3sy=!wUsc1AQwydCgc7`sIr-S3!XYq!Vzx@R^t! zDl#=RZn2<)Y*pvREegA@6g5Tzzs*3S_PO-zGdIfu7WZ6?w(LSD4U7drU$$(7yYqA5 zId)D;;g#FQoJ>y3f|%;>U2*f;U7N#>icOr;ACbuE?pm~%aZGtXfpIfNRMe{4e=*d? zdp{G1msjds!xEoM^Gl|C=uBAl0)l;J6233QIy~=CSSNQgFH&S$5F{#?f2!JtZ=WvL zEdOLsN5bcLRs>tKx6>&0ShgSzTS0`72(D}&*5Vfa6Q+*_zu44nH=ob432rU&9x~g4 z&FAzJ^z{-8DKE?-(9bDgSJK@5YX_$fWU-rA!(GowJXC_8;rH7t1k+9da`-W8mq|+1 zW;2gcW9ersHQaoudBS3;F_16*ANVZX&PgxQ({_ww>bwBQRL>-!YQhtXsg28Z{7 z%W{nSgN`p3)M+I3szCqq4{Q+6?Gf7ZU>@(I+TE8%SGdV|=)){4e0AoK0o_~O;%bX~=izQ{X z%C{nM2#K*Wk*~Xt7Wa9z%@)7uBKJc@l+)tEy4E}p;gurCRwJh_C#`r7wG$o1O@CxZ zOIGE6c1hRWm}-wHNNK!7b`G;=6?4x$5as-;S7ZQmuj}K$NnO+=3-BMI?udYB=0~Aq z%w8V)SQSi^NoJNzk1HLIbfDw5r>twb!2v&@)?emc{9a`AX51pz*>E=E5m?nxx0|Nh zL{;#IDWK@Qxax++Mw{vix%2V^aICsmbG*X?$ZXWKc$Cy9FtHJo^X*B z|N7XN#TTQ-9m`hpVLCTpDOvt;E|-*@;-ZP5q?C2q+b45XpWDGgAMwoQnn>Ta%DJPd zrzL`$5o!f<83~lw9n+AsYFCG?%jyyaF?OyxDd>%%e37B~tt8G7ISO3CyR*&3j`fQ9 zc6)2``jkVbpENxlGt*cSFt@H)x8EO1H-3&ikm|>*#5W0`N+->q!^jMYf7y4dVAfx9 z*C#{h-8Sdg#z59rNW*eJ31FQ+pW(QZI3;AF%}-cc%HX<<^JMDg%ME2Ad1>KkaK&|;7=^2$}$Ik!GDckKk z6;^%TQV><(dN3(!`r7WI83Km6hEEu5*u-^EZZsRE$Fe{G&WU;g(GAFkvz$x{87XS# z=c3roJ@Rnc64`A*KCqm1&(QP5hD1 zY7@zpz$@6j|Im72De&(QDJFe+3Dzp{ragQe+|KXDrcw0?@@dQ6FDV=84Yiu!huwEm z6SO%@=ALH}TgKK)5@TVhmM3&~qpKhuw$%$ON_6kXiWiBh?x$Fa!0W*4&b2?+Z=jQs zh5yLtZdX5Rg$krdD>&~qKDa<>=Aul~962DHQ>^3=zAvia@5+*xa=r>7=%BOLBaYCJ zGIzkE2V~aQ!gs;B`YpM@OnZ!q?Hpkka>(jG9H5%#KYRGse*l1DY#JZX23Z*~);6vbH`T~`a0 zZ%A?*V9372K!0hykpHkotTDm9s5s?=Y{C(AZJXj7-D9ECJ$>5v;vTk%Dd{>QP=hx_X*2i!LtiWB?c$^ko?SUh~cS7qM-pRCXa%Ws`4xf<+XWSinc(dP2-uL znGLkRkvapwvFQU}i^gcbWjw6MMVEEV@YoXpwWwa+ek5CpfF~j#<+Rv-ZiSudfp>UB2S=ZNc%9tcX9c ziP*H5oCcH76R_@rz3-}a%at9r1sAoZdt3n=OT@E0%0TI9Ys~G&mBIY~4_9m#5EG3k z{P-3xck_H0Z`9(u1W#>!=L>jABd5S}?`*aEBjcTnMr<+Ejs0p(P)t9BDM(K)SgA19(kEH|h= z3z38vT@JMMSGa$rUT-4hvxCr3ic&v}ZM>@fUWZ~w{~S=37=-Fko!sTC%A!x15Yi-T z4#g-V=K|1I`5p#h+Qt0$(vN0jszaOt_8k`-0sdp(nrOjEoTK}jGeN06qZdIgfW;%7 zr2iu)X+`X7B;b3<#F-nr31j1mB&A5z!vXTgLPO-&`!JILrAW>5=yZnZAJTn7IW>sm zRBTpoC|JD8%!~_td$|e<=iZp!v+ht^F~GGYIV#Q~+KW;GkDL5a)ujO>ubWTAelRaO z@`lDO+;v4)&UM3fMJI=e2PeNUQeJ_X;ro_zQ!B!xyk1opmJss$%#{$s?;MJ>IsX!Z zW=9SZ(k^+^wVkBbok~EfweS52EJ+t7f)ZT!fMcqEl{~Jw5fcpluGRbjLz*C`6io)z zp~|+#QjY5GFooE~6xgE3;C0Z_SY2SzNU}9$+0UB#T2rRdv2C2>U{D;ZS^(?}w zRQDb>1+usDZkcQ@L0B)$_5#+VYs&7l)T{EGWp2a=n>9a>!-nY?&tL~UR>G1^fZ=2z zJA&V32Q>h+C}Gkldp@3&;Jvvx`uK;F%>=p!h7qT-d$C1R(NB6ha^#D#*7G}F^uHid zErAQVmw!B-A5!Zsbn{ziA4z)9G2mOqV+1d@`fJ*9<9Pa zh2@9Rt{kS8A?;t7NJUV}k>I6`5j~+8AkzML^MWcOL{Px=8_Kj+3I2vz1uLDZ7xqQ@ zSYrDTTq~pdn?{<7rL7?alagcZN^(6H%3T0C3JIn`<>!UCXB1wui7RU}Wn)nGQi96$ zBcp`71D+VdEYGgEF!i8T5lT>7B}5-js6v;2X|cmqF%KbqU860KuFm(=hh$4$Is$D9 z(4Ph{K^)n8bx%jm%Qakja)xWp?KGAzA=TPT04JOTD^OTEjhO0r)j(?E7Q$G9=}xpB z_?{5Xph#Zh_=mQgOv7EW5vBLHnIxNx{s*49VyhE%4}|yU*GF)nmDF*;N&bA8pzqZ~ zaRW#;Px2Pcu0CVO@)*?ITG#KjTgVW+H2Iubwp2WiwObi{N$VyMhc$oIMG`6cLB7`p zgI$9Dq`IfpW@Ynko)T%84)?(rnm%UrG`xK$ZUc&Cju# zMoZcLx!a|`LY+*xKISF+Iy_D*^l^){g?d9_I=9e<8}no-ecR`PZ29aXWq}h23p8(* ztDG^j&z=q11D>mzN11a6F<1U)0?5%jBgTAT(V>}vqWCC?T1Q{%x2>4?!cJ=!Cdux2 zJu$KKcTfyVL^)&4`@g|gvi9@t8k0RD&<=l>t}x=oRLP#%(exm%bE$PAxTzOiaf;y! ztqM;re7+(DQG!0tuhi59sdc11U{C>G$OZJE&PcmnI9S*D-L%n;rO4S-hqN>iy@?sx zfkXR{2`Z3J6%?JR*FvkuFuN74PcEYPL+!RGoBt(KH#A z;fWECKhq=L~PE)oo?jVtL4Eowcce1nMrck#ormS=SaxQ*h4T~b z@S=t0t6l4>g3{CThJk;>*Hu>>Gii9Wdp}IoF%C3;P&hObkCF|v!4(#F$Yk@gQra8U z7^^Gh+vp4hh02L&aV$Gn8PFn0n8NA^|8FpDo(>;XfM_Zt<)5Pl@0X3Wz}k7jOlTzvmq4x${GL^} zu)ZK)-S*d~K|t4Fk~eCxWzoNYONGC9{4HQqxF(yW`Hsi<;c!g|VwW076k&8uUh}QkQ{sNb$vT2(tNAJ`^U&;ipZ?A{ z9PB$%7PZGJQA?K^`IhnB7cD(r5CA#?Upizb5cyM-$00!>{9&xI3~hfA4%DIp zz8EqIfelTFT^}QZk9S*wZ-ySGQxB8(LPN}HgnL0{NhTdXD~ABf^s%j#px6&9;3%c{ zuk>SBzO9P?=`yi^Pm}(LtOkp=To2L7WWR+9Mk;!icdrp(7g0`qDO;mLr2$_oVlEeo z`|5#D{g}?iFJpPtNG|F4amHv!qbpANk&_gHYWj=(E)xNh`$podJvh_WKlMRRVYzeL z2qvr9{YtXdntr*ZT{G$URkCI;=9miFy~@_>d-eqE#tbfaSunj}kjmg%2xfwE5jp@e z1rPw_n0v_$Sa_i}xTzAB=YpG=!A(qY%4n56N!EhLcW~HwO$0Aa-Gr$2?;r1+OLXHQ zfGCC9$Typ#?O^qzyiyp zZFsD_NtKoKVYes=pt?qQqP{<8)pYCaMUk5T@>pB6@%|(@^NMib5)oR`Y~u!$^lgOe z*2ka1Zhp`?;>HeJA76r@r5J{Q2^ufQupBR1#j?LYire;|MSg0 zK9j*r-Fq#!8=0WceDIh=`3>Y2HW#nJL^4ZoUB)Qr9?#+%9Daq6iMGlD{4kaz=mUxM z=j&OT#=5P&Lbd-rZ0EtyHxi#kvj#kmxe1Piqn*v|eR63ay%YfF&d?9SGd&YAfq(4B zn9doXezjyzo%-C3-^N=XBpkewhc8N7)+YyJY?hPC_BVV1jy3hcAOkdx9dy>sW#QoJ zE@BE>T@o#5Pwfo*pN<@cAPsht3Uzi%L>4)cY{RPwd$XDOd2ivqT9^^8$YjQ%0+!tQ zDl%s6b%tRtYf6a1sfaHTuNuT)a-+N()R`#a8%&D~O(YW6| z3&!twW{VApeTB1~$A0XdzTW4Z5A^2<*F_vd9{wMW5e)cyU7#C(a8j`puJ2O3+7vp- zRDe~&-;CWKSAtfmXL{K9+cADKgEtu?I^OXTO?T#9$zSUlG(lMvyM3>sYHkQlDKT0! zoD*h=QUAImJG0*=f0KSx21P%t zyi+dh0ZN-?qds_e*y1uSXgyqaf9wA{{hgN&t87)9O|ax#F$JgnKB~I@P{|u(~M0K*tUc}E0i_f{mej|vCASz(Ne_Bu}}XI}Z(%&?8Q;K!xVQ(}bk*bN&$UDC5b9cqjJn5hWY1rFh_=E(ok6vqR-cQ5vXLSFPdA;-SyYsf9daxoC;*-5m#m5S9F%ZXw|+`uPOnYVo84{dMy{CQqFIHADQ6}%i58%6yu|*C7Z02Fea&a z)qgiZ_>h=lWz~{3pDN>4M?dVS`Yvi`ymAI>HA_a_1`ouynJ!aL?4pmSnLHq@cHae` z2?zJujI}_^_*5!a=T6=fkMO*n-0QGlhNxo*`T{bA_j53V$=#5%^lYr=3bQ!SQJP{Y z`*qeGut#=~dTgRHb+|n0(dF)_$BCAPM=E%S_0~qNDv(2Jm1QTc8aBs~Gcs3n!GPr> zA!4!oPG~U$0b_#dPJFe>M;qvV%~diVE@Sb@KXXwrh@`DfZ}DW|aVsm96gQ@|Fth$% zqf?&${UWE0eSH^2UK89YtQQ+f1%Xo9!RpK@`ze_1D??CGRRP zp3Y(d#d3qSP^)ISB@0bN^kPf<%poD!!%6=tWPt8jUu8-KJ?$~iTa9sm*R=(novZEw zFXiQ-0);5Om9ZziFIy4)H(@RcL((?MSJNv8{?g&Rt zPgCiupUXq?YVB~D12WLe2o>x78Q=I2$|v|!+?3k!AzJ$X<`DJV$&iOMGa7?$yLG>} ztQF&SU|*!Aip}6Cr&FABHLZfY_sTBG(UT%PYwrTSKRJi9`XX(66j%UUE?pyJ7?k4J zp=yeUtg2_|hq2Q*5Rc~i9GI^VjmLNYfml%gJm>8#=7CQ1c@2t;`;=zY^H?vnL&7C8 zbXgHfAD{Bh)wa%u0pL-Y^G3Fu^K-Yn4BBJwC|-&A06BsuX>D=QH3RPM7lEy!j8s!Q z;|~rvtyQ++^yv2d?M8Z1oy;@6h1kyq(Qd$4pIx12u9zr*iKOtHAx|dtDPD_nZ4p{g z4;7W5ghgwE!HGmp3t^sNpqmdvAe%Guq4H8e&~dT39JN?8P2ZY14GD z-u!yZF{43<)Ba?L4wG@7phiLT3iRslF4s|gF>Go6BR`q-s1NMCT8NkQF%vS1YDoLB z;OOHUX9fx1MxrP=lT2$>$fp=JZMBIf8s670}mJr>YRGGs|~*4!0w4f+-WT>wdmjarN^ zDeZldUzAbN`SpSEj$pWO1eh(n5r}s$F84KE;Ao>$lZ(-eP)_rtT{ck7VtGMs8lF6} zol|*$)4=B*Pk-vTyz+NCNc5x31uA7S*&3SwHw8vOwYWmY0E06hhCQSo z9UjUAiZd`;t-LDGp|IAc|MVptXa}e?7Y;bI;s@VbIR#mZ!_qwpz8;DX?~l_d7<~7fhuTEUafgu?Ll&9` z0#{KfWM93nt@6OCMOC|rQEN7bATvN{%l=;~3%CBjoHipf2}PF!amWa5SW0e?EH&7V z$j=ke5Hfh=XrZAV)8=#fN$*d0E88cbm#RLZct8NabYdK?0Q(&TE!;fDH%e)?)5Naz z5qHD_BrG+P!QPMGyO&xQO9r8#o0EK9F_#QxFAuNs%lj0U1&IAb!T)9bj;c>A zOq>;W!dc_`wIUg2`m0N74~N%`STWniP63R;r3FD$cOx0e2ah{GQH=M!%AX?-di4j9 zBH)q%`?&+iIm9e!IvKG%VM^5B@)tgzW?e)HA>V(xrk#QbStu5@ZgJ%>#sd$OD z8Ak2 z9K-f16t8QvpCorXM;f2{L8_blwx12n-dEfekms0b=cXj+P@gi{(_8Y!9iK7#HdaF& zi9`3V{Q~c)>PkSd37}B?5MlwvmS(q2L)4yq`8k)RZXxe$ygngg!wG(4-zo28>CA<9 zk(B(Gw6c8sVtqA_^o3?8oSazL@pgl`H@NAXM>LG(+y@B&k(0RR{e&cp+=>RzPGv3f7`5nJXKGXm3qKdO%^--HJ`b znrv;3SFV>3>`#zjgr~(`{fQLRZ}ri0x(l@_N!HQg!%Zd$}9WN%AfLwfCgugTVsm z%w`QDSE7|Vu`SZx{l2}E&aE2R5SYviU6X}gE)vz@_lY{5BQ)m-RRPm4!5O~z(l*2C zO0YgPaKm&qEi5+7n4Np6MFT#2Mw0AV8tk&|8wNm_2t#BQK#a2^! zAhc?zuQy_R-$&GNWNN9P?_-s=W@d`zF)o=Wv}2$WLc%TTMQLAJ2P(A10MK@{5;m2h zN);N3hS4t=UoyWBHIR9%s}2mnLVa+>q-@-LWTUiQ@Che9Ffg%7BjPGnE5>C!*vglB z$*c)sl~t6OAb1Ni_FFkE2MDDNe-*$ypa#G@tNPW5W zh`LwSCmFm+9UGHdqCi~?n?vN#i?t3ED~n#1*Yl7Klh4a5=w7N!5gsXyH3r$}T?H7W zYjyZPW-%jCWs#_)H^kV22rmNXM>&f+$6QtN@9O)BH(V9f5gSwE7?dZmw<`ic+^+Gq zSOiOk*gRbm>Kxqo6EVu#CRfJwz$FR(@*yY;BbE0dl~F7OOCN%KM*|`sTld68C|! z-INpjnWcASxdKyB#ON#-dfQ7nFHk2I&6|nTNW}F_y)T&!jNlf7enGu!52=H6J*B{l zyF!$KA-oe^i(DHmgHea(Hw@&ERtae6PWb##ayRXgqj-e3t&@c=x1Xk1_YEe7eqp+j zYsM0=je~7XZ~NR4vc`_P8NQobYH}~wC`n3k1-f)*G)?}Ve^4U4_~E92()#7km|ve| z5>6moZRH{RZhq@^&xSzkpL(RvEi`zG5*Mtevr1rnAG%r|%8cHD=CARJH*w3+V(AXj zl9ckmQU`htf2Cb=VNQ+UU!X4laj$5-tmt(Bk z8Q6vO!2UMr5J8H|u-Y3*_qI01b2sv;2sF4A=*ec>iPL51?gK;7+(_9NI-qKq-+b9UEXkTZ$GS2w2f;}i{l9>efyhx%r+oM8 z{P`&;&ZK}2*ieGYdhzh{yB4$}w+VbgmGRZ(yW>?xBOs|h?m@<`kr1>G8KHDcpoG@- zY^L;P<6!i2M&d$XWW#b#r26A?Icv9(ZOoPyPeT6op~-|HVHSYe0o6pm?>jq2Os>P! z8<007{H`G~mqjpkv4j+W@MA)y=rb$v+GL42%VoJL+s=%Jg#Gt)+C)$58u?pUKr z74s$(Igp5{mP$@4OZA>5aJ#yi74_Q{h740QBI6KH0%-{lxjXmm9Z3Ok`;cRsxIhF8||&JoU0uAPWb^U>+QfaM_Vn&y(ltVQd|}K-nwwfwn}@D8e^1){T~aS z+5I}w4L?WqH9KTBiu8+uLyA5^>{!3Kq^NpNR+2E8yaZ74a?X6h2_W?$vZ@6IOFOSf zD-f>F|334Pz5TaFO#OTR8h%nocp+aZ`GZ-Ov#KTyCPX>5XSP}I(I&B0NR1)h9r8u1a1POXX0DJ?A=Kcd0v01`O z@Yv&!jCeAQ1NP5&vnJAA1N>n56?^T>yXDcr; zuE%XFfLh2DkL!~l--H{*Lh?DC!V45->Shz}=dP7JB^78mR1cga;sL=BFvGHAGaol- zZny~}EO4xF+#qf420yI~lm5s=? zDucq0m7V>ZT8OdkK6qOX0_CyV;-8&lngSw_17q$&02n{@K@pw`Caz_%hiKn6Eu{Dh zEck#<3w;t`Cg{kG4{i6u-s*Ukj>{f9j5jmMT-92yuXRZJLTOnkI)|854d`)X3RVX7 z7K@GIB4Uw~8rF#B$*qYLFnq#l)fUjwMHvk(X#-cgYL_e(tFAwy9vzAQOHV=s4I^eL z^6h4X)rD0RAhQI3+=ajebI7s5F6GKnl++*Bp<3Y*)n*TmdKZ@b{x2A{o%n@17;D_? zX5|B%CSgnL71jGXFt%W2Fq<|VNhZWZSu~YmR6~NkM*k;yUothahcL~w^r}n$L_+Ho z?|&q=S6u|?X&taLJaZai$?pq~b~$mRt`|EjQ~hk(JaHBWu`-I+{eVe?{{6o~tdSgI zshbsiNK?5hxa+rSJ`HySoU^A$jDw<=|FLbsSrWM_<1tb>NX$Tw$tU7WKenQ)f!Om} z(~wiSILOPuOW|~%jGWkdre^W@(PPNxAzvwk`|B7V-H1DV2>|#`@wVe>oi%uuZJcSu zMR(AevG=Gp65UMnkGfIu$u{4A5vOOKkoz5PG0@t=Lz(50)WhXmZ66ih+DX!n!EYI! zd>`FURE1@EvCJ1l>q(KUb zRS?*ms8syt7jNX>>0~+8_XbbuH3x4QduY{){BJp_u9W6NK=A95i=uCSr_ff8^t)@zRciF6LbG>4>Wgx z_mHGc8ZB_H1&p>{Lb2M!OcZ4)C#F{PNyK839pYfJY(Ci6Yh+ib{zI|)FQ{X8y>!ryS&d<~F|{Z1LRat7&~tXQA7?-#&AoHKs>oiqcE(tM}aB&327olZK1O~Jdj!`c`T4b*)r zyG$?mE52ruv2!(V)CI$`;ui-MQ9*Rcar8$2WO8nQG?gLnN}Pml_%clpY(#RPIdvOc zHDE$(sg(;G`9An&$IeogNgB{Lgu6__^xqr#l*?5@MIr2Z12-O}?!pK45en!fOc74h zBqByqJRxErK2txvP|14P+(|@)$g1b9EHlpfMC26@3L65FfZLTvF<0GeEt=_+()&R&xG22<(UlO~=@KyFHkr3qYs<&QxAIvPy>j(R zNg7LB7~IlQr}V8IB^?c~V;d5~`jIEarTXn4pSCFz6Za%PV)A$nwKUO(%Qu=mZ&jb{ zAY#)`kT)}c(CE31BCiOz@=iD^g3()-`mbaUJqe280e%2pj5yMdFD<0dLrFSMn5g|k zLl7bIb%%O0=@}uv=ISP-0KhAN074XS9l)o^ITyG5ta^=Hh_DARck1s~-gODLpoti- z)5q9{b2IHVBg7Ai-4AEs#{p^*CH=!CADkh7^O+`;3@^L&2hKN@7R9?t8VjcJPz(h7 zK4yc(@!4y0meSQOaLI(`Ag8@ry$nzpP>&X9VZ0n1sw2@FREz30$dW)MBak}hn_qqT4tCV0)t?hOT{UWad;$TTWvUS9rx1Bap%-hwNElkJkh9elph)ALSKbL|1Gy zn=VTgouw^qlv4!*-TV}S+qx2b8X9j-qP43*c>Y@rM8`w|5|i9=<4s0Ib>i^h+bJp~ zg0|Ae3`sK}S-La)B5dZRBQ$!61sm7Qo%z}94wzWSWAx(X2KK!qcy|woyi&+68~@ak zs2;f6`9PoGJMu_V`gLYvh1B0dX$$fXT2`la%xt&98NHtt_7elD^bucK94t^WVLi1+ z7Zan9R!9>LiS0}0#&hP17oR`%@67sRnnX|B0GsQ#?Kl(*XqVpz1q&hqPYarsqMTBu z@(Ov{7Ol`o8;sxOUgjU=R(`o7lBvMy3hY|KH-d3w#tC+Bu`W(LwZAuHd=ZQEj-wB($|3|?gTVPSBrE-oR30m7)pKxvf&al=bn8I;# zw`62vs^&Zg_d!VBDoP2dWZR(2cwRcpy`@%Rr-nL*6Je3-oh$ipNdPRR2DSkDQc|G} z2f`!$CNoxWG!F>)}n{ye5&$g(o*dHIZ}?z}B-Z^=~X zs600u%N?70Y9F?z$GEV2Cn4tTa$wuvv*{BNShMwH$B|kNpS$zf<;l#=LxK`kulw60r;fTR-AY$2 z5Mg~UY1swtk*KR8Xo{c$&m-6L7ms8&kUBxyzeGx1*4yWfZiHHU`il1yp(O5a;6|5O zE0FV4vzkKT>Rt><3ST8809gTBAe73{fr(Aq!#)~C*n}%#2t4N{=>zeW1XDmYb|E}{ zYNT&KpSZKWehJhA5P+xB>%xmMzemof9y$dR^dO>i8ihv7Xs$-`qp2Hx(=+YoYpOtj zg`U^MrhFo=C51_!%j)J9(^&Uk7|9h>Jh!Ae^v1>-XLbNgqGE=Yn9Q>8-+BHfgQH|W zdWWJm2SLZ5ENSHnq9VLQ#)9_w?pYk2n8o!jzDhM;v2@|C!6@F{{q3b5<2a+ zxR}!Aq;#OF*@HKcNfJQ_o68cT&J-tvHg6ck%&V=822pHJgjiZECuBQlQ6t3w~<3Pp>dEy zUWs=t)60Hg-R{ao<^D3jGbeKefkUrpK{Y&Iqg$IvJxq)J5R(O-&yW3^5}b|44BWL& zm!#>7hftxWizgLOV@a#va&L*&gZbddg3e}EM>iF~+v$*!4gRO!vFCfxlDCzjhVre9 z*0~zNXK~ij=u;nRY}stf#$B24v$$!T0|)K#A_%pvKPbSTiWLt-M;bGyjlKAG*#K^> zO#;z@r@5g`z_W$7QVmXX!uMYt6f<;b0RNs=8o==7gi5}*`(?(mx|LXSev zSrMgc#Lga_ z#-OjQVWLnELJ97?U_*g~V~(8hWKi45U?U47w3B}+C}0x8slqh*p*f-Or@+i1Iq3D% z?LIOZs37vZ{W)xtQ(He_?WYVaSGAC;6?WK`A58aK+R#U=lGO^yKL$xQU&#aUE-j>w z4h$;mf&s4}LL&DE!APZNoDSF=@4ZIeKPr1AeoGAL#xd0L27>BKt8X|JX}5fXWHA5e zbI=EM*>Z~Ap;6cYMKghywvK4E=%gqwL&1Nl45j7*`4}I)>T%+tGIT=mrqB<7aqR37 W3`TVf8CE2k80&Uj3yOHn2MPi1*uNkE literal 16392 zcmV+jK=;4A+iiz$2b+jjrHbqwJqa+UiVNXGOX912B3edo-RE59Cku@*fuf7{+i9$n z)^|{zKShHQ=RtFUNP)*#g}RfyRWf4sjtGTB4xi4?4X3C}YEbPLD!pFM3M>Djscq1U z8lmhM%7M)t#eN3Rymv=)*9V`y&X>u!!NJk9>IeIQ8sj`8f2w>ruR6n#D6sxduPpG9 z?0gHrM<_X&r=Bu>TqZ{mBDY>%xNE_`SsaYKnMdFIm34af)p;`g6kkosZC8x3e%9RM zII7TUc&Izxu3gc23ptS35Nr@D_E}bP_thq8pI$MSgf**RV)%j9PGF2P*mK%7kz1(; zBP~{#t`gUua-fk72vy2<^rGT+m;ifclLe_W{gtDBz2C*VTIa6q> zleLo2SMoF$H+43LR8#s*k6Ui9SUhKwR2}GlD>ON?^tv87Q|_o*MWf>xLy)S#6Tdd+ z;!K~&bnBqG!VL+xINa*nls`}^K`}f0{XJyzmw*4w8C%LQyIM~fv0G;SG>8)WZujib=7o&8-$;ohSly7 zIdr&>6%Ep6o4XXF&#_d6KA1pcd)`tU9%%_LBURSb=u9xXq_EKIIqSWlKsPbQnpg7^ zltQBHq&_`eJLJtXeXH&kcq;bh*4ORq_4v=+YOULBiNdrs>7E<=Y+ayC(4uQRM;eqh8 zE)~PaaI2nPH@-ErxV+QHf1I{LvSHonQ)S{*a_;xnG|~bP$A`%#eHHyD;gyeXMSh+6 z6Kx4Y&wD~7S zXZFbf`uurqwhPyRpm9DcTFe}Yht-Vy_`GMG%-N|owPbR5JuD(RW%}cavPEtfy@W5= zHek$Qq|-@W-e&5qYe!4XPJM^`xGm+(@>5qy^`ZE%+l5$C#k?gYuXUpl@%ldiU>W$8 zzRCpt7H=!|XeT&n%#f={DvHnfD4c>K_vJ`&6|{dkiAS?y5Lcv5{F;SQ#(h!t8cTEFbm$k@dGP+7?;4qm8ptckShEpQpnimgIptDC zR%ZjB%bGP3A9&g@QOiN`FHH#b3lGt(DWi{uwL5!`;uD8^`RqABskZE)#jjtEoTd>> zkYjk|we)Vwtt>wOE3@8jBLS~e7)MO5X-Uz|cvrwAbO-l=uR=dbJ%vJt^cy7h@oP>W zk78vNt0#69iF`ojwcl{#c8`w2bx4}G8gkMJ00W&cvxvV}<65s3OxT7Og4slwZ5-1I z=~h3A20&pS(ZsG&{GmZmc6M*i7*R41rr;A!_|&;W6}@k4MeOD|4~rPQvz7-Ec7oI2 z!*4%=)!*OO)_irn6wF+C5|&fj|4VAJF3bJRz=g!JoJB2jWE-H~$)=N%IW?HbnE=mz z?0EtlBvVjt2n9~d5%-7PJqtWS`I%M61U<6 z8yVT-IY3%-ePE`N=vji4z6d~!>k0n8wZzA^SG2nwv^qDLOHnvgjOex-c+N>Zqb_T$ zdrJlP*Biaz-{g8X_ERnq^gqK{5gXXLjS|}-q~zx(5~6+j?$V**W_VRjuu zGdf$K#CNS@nEk?`f9DpQb`AQawh4sN)HQgJJ_^!`AQ(l3uO+T)GjR?b8(y?oTbyjo zB*+26Q%@Ox&n9?=gC#;gstxm!?zEdq($<+>Q7&#f0e}Xr3qi5jhz|inZEsgm418aO z9n^`Ay#s;I`~s8PSL_P&|MYIK77k6|Sk)B@uXhGnAh$A)Wv`@sOL0yzLOTjbOo-zH zM)4o^XBDFB;E4F^n?Ns?E+y?f(vI3AXQbgrAYnSJSsq|*)O-NnHXj1|zsrAa+e6tI za{hM`HZk}*1Atq+{|u zv?!>~oSoK1fj&>=T5w$EwsOkeePx0W;5Yqp1q8FOpIobH+4aO_()*UsD5*19B2;ai z16KSIEz3~Ol8kD=sen3HocZAuyQNrD22aem#H6V*kqf+C(d_S1qd$PQbg&FJe1FK0 zM~p>Y*&u1Q1nrdj!JEzkm^4JpRFp!oNQF$RYtJ;o-f@dT-&jI8|I!ug(wKmx^15(YdaQi%HS0ZXq-&*wv!T5 z>)d2Th;XR0Kl;Ti9#+kCQR7(O79zWlz_aqjE5!n-+9}T=-lFi4w!3+hU`p*Jz;U3a z;>{sEBMnNQr9yx&E+4lk%90(Afe9k@g)wzXUBsFoD)5VxavfD#dXkr}MCEy_0e+&pS(yxXZ$pei4J{7Ilr(dCE^5=nGq{U;AYQks~<{-$$B zruMi>PKXaB#?-hvRT0%RmZ|L46;B?9rPHR(Vm(c0?f$>Xbn3^YQO z3!>E$e7flmiwFHyCT)AHYL+l9(7L|*awB=zf9t0pXT&E-GSx2Ek_@^O|HFNqKRmK4 zM|5w51nDM0%`_};j9$Rc(ZZE#;%hy{F;dHA8FBMpYCMJMJ~f>dy(KV(Z&f}Q?jyWQ z7aZ2sge8~+u^k%bX|v|~MW^9PR+l~VqJl1LwQ+rI1wZTlMo0;UqpHJ93^x~zk}{fi z_T!aE9C4_Uq&kZqWr;=t`CD00NJvSF+v}r2jY`(gUROc8&1g;&HFH0>B<@k2=u1zt zN!|{hw;}zbHJ!bqY6=XG%&%3`y<0!bN-j}w&GNe@TY)Y;EtJ2I_Ous~qxa)GvmnXx zH4cAENxJ?(PfHCL5m)JO^?X2C^-( z7T~2-6-*u&R@?a4S!0)mFDJF(pOfe*|HhOr(T&dyR)Gl!be9tOdVUCNEYJ5b>Mp2y z*z5Q%^Mtgd=%3rNaOqG#?dY3b!&?@3_Dq`(0UC8g*$s;(HkaAP*9YbrT;U3k9438lR zC9u)2CM5T138eO8IxU~Rip$TlJB6TxqK&cio@BkNw%fAG!NHLx3Rq^@IOIkp2=`J) zoi+d~KF@{?L}cBVV)qQK7XSUh=nKDp8l3S)Ds-s8VrTmfAQ*=ZWVxuN?I{_uQ=h0J zm>*RUS_kxrwChg6Nm=jqBAgl~=Gngtj6+G_dK>l zNZQ1Nw+Yqg?2x`hRSvYdZ}3$fy9iz7V?uPfITG6#fI0u6P2?d@#V|N&)`(y5&D<<| za_(fhmmhUV*)N1Bg;FM36(w+O2u&yQV?Qr9_?BvzFn#x-DaH z4aR@zm|VDPXmp31{=kotEyG%Jb?hSeFUX?$r8 zma(|RUk44;7Oz=a)Zbi_I(4|%)?x;P0{Oj9m2MYcU1n27DQute0FAT=-}BBC8Bp&A z{}l)^aC*s+LDm8hrQ(lJETQ|*_t$BECAD8~#4pYaHuJj4X<`lQ1vg8$8n(GU}j}@umCLiCV=bXY~j<((HtzdX2~}W^kL71`EOQ{7Fv5Sao6XKoS_W zd(PK}Tc^PQ;zEwq*FZYjVQs97XXKuJT*p6%$$4YWS^A{%ee?vhCc*ysPs51fINWP} zHKDi?9_KB*L!FpZ71S4mloGEQAjzv^!IA;8F7ddk{Wo-z=mPyiL3}r@L&DV+D%#TT z!{kjIpto4E$JOH_5&sfssgxK@J|kw94r`$qAlbN>LY^hA9*k$w+5Ou+p3$79*OAviSd8vwLZ_=-J22rn*_5(~s4gI$n&*u;Xt}@5bpypB z@aK#YnX^>T9hK^S2=`@k|DG0U#X#+-FUNFq%0iO|vz)B1B^|A@(enC62CgZ9u;t zPK21{a4Oq_uA_s}A;nTjB){6_6u$X#)Ezqev*0KX+@!#xu)~@xHFQ4u8ttgS@Pa}@Z zr=A8>S8*#%?`sm*=6UOtCBNpjuKs3gRQt+P8-RbV9PRmxTng@N7KDq4kmx#GUcsG~ z5ifOoa!ocfM!}(#G%`gS(krTmGsNpT%WHg8rhPQTB!0M)K8AsbR=+8^)+R}1JK%W? zdYSu93t8+Ui9FGR-h!|z&>O(M%06o%YY~U3Z6|Cg&|kLqg#I>n?Vr;BsjhNp%gifX zFi!u~8N-|ph03X4t5+IKdYdYLT&TAH-rAn42D2r1@hBm~A{uZg4RbX>`Jd|S0i_|j z*|>WA+E)LfN5uPL^pW5M>xFao^jL6SB3hhGtA%xWjP<$ldJ5IOJ7e2{pXrIu|BE2C zQa31$rrqq^nL?OUNzhlmhietUBsrm7C(D$w7EyUK>t9k1{ZJAaY1z~Sn>O?=t9g~T zP?`*SV8SXJ`L>NK*dQQ%7}GlOd=aGTssyf11=V!^$ELcpu^4}(d=jC~A?4TMGNEf< zZ4W4*!$Sl%=KhF{=*Yyx_Qui^$(G@>c5{=$pMyMQMQCD2b^;cb&AJ(Cb= zLP1GUEcOKeLF)8?GHKX|iAH+hEUcwKVYqZ`wLnOhGBlsde zY;JrU;$E|7HU9?wl#Y1P(BygPVXPd>Oq#y^-NA+Fyd3BN?rHp8mmQVq9BNmm>10KHu5~-H_26#Dc4!=bW_jw`&YF`9mZwiWSS}bll$8$j`(9*isjc&Z-oi9I#n4J54^n z;HHW_Y|-h@__nMKP=|;Kzny3Ngwf>N+iegW025hoTRBzb1QLmpo>o6aR3B5Tl(Aw3n^)>CMCXO> zej_-1&X$5*ucN%r{L}##o2cIem~T=wbjwX?IyAhzhK)5~dY*Zk@=<4Oz~po%tw94T3btQR6J9m)l(Jbp4oY znQf*9QVs5|aUZ)ifJD*S4L)~xqc8&lI0rNAl=`aU`2apkJoQRwwYN74+}?$R?L`hNs{T-{_TnSgE%^Xg17YlRMXk3;zoWjRm zldD0JOV`c5(BkotjR&Gb=ZYCyXFm48s6j(1JgWUE%Hkg~u*hRFzM8S19RZ6Z25wk( zhE_YV5m++JZ0&N1h=cx*AITczuhlNrtW4b`gXtFXRPGTvsAs>#L93xpx_C?Z^DK+7 zF)hp>4<&AdZRLErvofR@XoFn{=k4UbfG2~`&!P-In=ZYmnIaT`u_IFlw+khJ8s~K= z@gW;3TyGziC*aJWq%;SpbFxRSIkE2!^9}FErHO6@ey+Jj5=ZLX$q~x_y{~khn(xzT z-;gOip|abAcwB&4opDLyauG><%fD(g3q)WQQq;clAb)x?`(!FHL=Z*cdS@ef1 zH*v&rC}|p#eZ)tIxp`KPcqsxN*;3^G!~XYH9pO6xf1ehFrV(Ds(q*nmjg+iVS^?1- zVblW6*sLyP7(MFgWN$)W8k3q2)#x+_EWpv*K7vuVTMIche%aW=DM(9C-zk_8oXB*+ZT2ulfXOXE^@{ixyY@TZp?E zTrZsip?8Snz>ls5DfHSY1V_BPPx4{z1i6ZVg@_wzd`!tYAT@hdSw?Kyy1gP~laCc$ zzEg$N>6r9`FuT)Hqnb9B@V1r|_~aO;$~`c<5I}@%BmlAi;uq;(riDIhy1p-vfYBb zfQ3rx?lAFvs_jB-5oG$ERJlTGex_aD1F2*V(=F9|LUlFAF8P<+E0fD;h<(GCpUvs& zQwJ1+jA&X|zp&r>lhM@e)m284oP05?WtJnJBO{<#_iEeo2ZtTcz5ghpRlb-R^E2!R$=MM`v+0V^#L{~ucl zFg_S z`_6uub|}K%+*+9}zb~ZkX36+Da#v9kJla}w%YFlm4hc`MvhzY>QsehB@p$Du5Y<-!QZnN?2m$`$JAm?l zyhI=Q&$ET&Kb887+A++<(R4;hubcm=TTV9vFv(VM(H4b(9kjjC)S*(ENpNq@(cp5) z8z%_nBa>T_F|5IID$A#?;#2yL*!VYFT{b5TK01CJD5x~sH+I|)b8c?7UMC3y<4FBY zlg;L0BOrh72l#F~gHC7aAmfEw01X_Zi#~ZdNypJYd}sSXoidkCS_qep$E7}=FJExp zBpL5v9Cq-~MM}h{sSHxP9upcG!YD;Ew??(B5 z)=t@Izc9k(*AM-n$3pWDk(x3yX23N57!1BGeY+~`J^qh5Y_Xsyv(Z*Iy3QF4WcO(P z7uD@s|E8c}&L;+3@r(^G5Ix=gT;*Nkn?PB<#gM3-{_JOBm-S8qpz%cBA$Pan7<$`wfv5h>A5R*Ru_x3_A~`_e&qN0AzC_%MiH9n z3?+pGaWiJJ=XaLazyc!xi;%pZSQx}hq$VhKa{-URDxW@hU$E54Kwl>8Aihg5!l-r> zK2^JP0ub1(6y_5<8!S;<1rQk_ODO5ts@@v4NCcYBVvnA<-K8EIhfPt0)ulA?&xDJqb<;$S1g2fi{6s3?@$Yl%foKA zld(2|93J~CQLOXaAEox~pt!3EV|Lp(dJxNR$wA;|2Pr=Fe8i|;YaSiKCYj^|RT0do zeYB?b`Bk0|v2$c8H9+y}p!xl*n*_#3=AJkSEqkRQL!9H9+Nvf>nex3}lu}m62P5&p zDX8WQa?St6oHM*-IwCf0Vc&w|J^vf6mwl;r zk|=p-@4w!B60n!t1q%X{CwxogtlCEiUss zaqaf7%%h4XLwY&W`P#^I;?!plRE@!Hrl_liq`%T-G+zZ#H02%mmvGN z3fd-l`cs9lx49oGcQY6B8zNs@Hrf7~VtvT$;^lsO)AD>5Vpw!lY)uV=m%znCOE$ea zCL+PMI#eR&x@ME!!2!_B`zROI1~SzY9n%MNrL<@X8~%75xiy~UvlMp2!HQ|`8IxP( zbSmpvg_(N_{fAx0JmVuVf#%PAwx9>22lM^GB{mzpqp+zf7HC1k{cKTw2lHk3RQ65HStvDMI;??H7{f*%9-*pL>lGjYQ!*`Ihs!l9?h zitzs^9KC<9{qYdw1(1Pr!sd-tu@DYBT5aR&a>nL*b0?~=(tTNhU~geb>pyJEvrd!Sjwl$!06fxU z{b$Xr|DniWx_OaB1fSi0&cc617DA;DMmc- zihDbmzLZM&jNAB4%fads0vmZ9bv#6bConCVGo^?=v0k%APR1+}pL-zTPL+ytBiaas zL;_aY^O!PPp*3ou(z{GYv(YrNb3ML{{)dd30|6unzUJNTtSW!n$Q9^$D6e6_DTT{_ zIJ;0ny1Z4q z9JBf|US!k%I#3|BIYcFsj*RcuP99@hf^Ozy>FY3;6N1yYNV4ob`A9B%Ss=E)<#jtC z-l>G6HuRI*%CtpdYFYfx3x+j$v+=rZbT0Eybq+r?I0)4+ISxbSLeEHieQ(HCA|L*Xy)w7e+$6r8ebgT3e(+z&8H01C$Hv2q z&0h^3W5Y!43;|Bj7PXmZ4_p-4@{X2&LmKWE{)@^#q_{mAA%%^S zbcl;rPGOa$Um=a{uvI{t8ZB2>LNe<5Gjd#fA^zT_i2Gej}2mU<+?5J9Xej=&Aox4;+#7b_<^h8_wpeXa) zD`#s;K09obVQFk5#`>UvG;jV|6l|6Vgh>}jnNb}* zdpAP+lO|;3HjY~nwKc&Ni<7EkZ3UF3Vr^snFN*L{mC@1ldy`>^V($GMHmYvVgCzxg zO@daJnzZ$gM>a)3_N$(-!WAl!rJa-dbD5x<%>&F zpvF7{Iwto#0egz|J^gW_G?%}~0d&1tFSl+t51!o0b$_5;O&t(@PB~4fHBNgr7!;kP&m;JU1DXMV9hT5NwvZc9aWA&BQ zTluR=w1mS!MEXQWB-@8|k5a1$4?&s!Rp;1knW|}5qOt;zvM51@dN-*4GgUwt`LMXB zF3FZ+^}I$`=q#NFpp;5s5C)g$szfhyy#%ofvt>!DeuxO0BsIJaaXdXZwLI$|anFqt5(wZFUDb=Z$tL<(FjJ3CIShfQ z{nd(NP{2FPNGEWeYAlQdDGJ2R*)VA|(mf2(cNXo)lAsp$kNvXn90d2qSd@TPcBqzQ zV($FW1@AIc74Q}o(frjqP-0>$j~+65K%asq&s_S?dgcEINs(udy!qK?de63cw&7Wi zp}*>VMpB?!+L!Zh+i z&B;x-AkYfvpx!fz;Y!pBL;Yr<9NSF^UB!pVuCtJ|wP^%E@Pj+&W6yzxDJu;sR#Vj7 zWY5?i=u_fFcb~gkbcI6ub);xSxSCu-^04f=*`e@oz;cjvhgep_ypCADw%XeEU-Y04 z5BBC9vv@}4&kN)-uv{0DB9`$b&*k_}-A8TPNmC$oAu5L@iFtHa$-yaKGiB37g&0Jp z`=QKBX_E_?^Fs*av6~#Kdu2oOb=4y)`^PaXysLD-r;ZHZ51Ne(M6AqSQoxcO6`M$f zei%?bF?hamHgMWI%=OZ8_`Njc@Z6v5W=FwG`W9w}-w2R4J~K9DvnQ+@F~f5>HUf() zO0d|-yv}mFkyvxs7K_((GDha)WG^_s6wS1wLy5@%q=6lscpNw}b0)9%H`7 z`e>r{EQNoPgr=J7>6V)^sTJ*@vHA@-wz%<#;~}uPI->F#dH4kyD^AuJn97`>JXqnvKGoyeCgP0;x zR_xpzj)A+P@KL1FburK1k&Q4^1uYyP%oG*FYg?0ogDjLM{4D6a_6x}8`Y_T@%n{JL zOtdiFP)0SN6+o6jI*w#mr!2W$e z=XljY?Q#(@*tF$@6dQY?i|qA~TRu@s-ZP@%Nm>8(oQL8Rb$W++XRcUsSL5&Q+7$Gu z{DP}?iPLS+TP7z3-?K0?)1$t2#zRoIyW-ZI|F}ruxQwP?uK7G|drvz{M|^S@SPC#X zZ69RFD5y#t)Hz7_(PRxosNN#ro;)f)ouxOZ^!`(5`se^4QW(vlq`yEa zFxG?;)$e`YaPtH`5Qbxjm#1`mKemLQ=aw2seFRP!$t zY0P1HMM!|C;v3DUB3uu@f>~qa@N4!%?JHMjNH5eAaT9?flPkOimwx$HK_mXrQizH) zA#tqe$-W9i6)){R1Ghya$=6u^Hg(Lu5b5YM48(Pmm#XLH>+6w!#m#Zi1x^x z!nH`2vYGD+o##Bj;~RBH>kbu)!ryJ`#J*gK{?<(#tlReH+uQE$a1>N9f*trzfJ>Zj z+)IlHn12|4`m@IqyLJ=jXT0ra&lKec`0Ed`mm`+j)NN8vuM&O(ZyEsIb5x^e zar3lLcni=7`IXQ2=p-vQHS@jR@Z7O9O8a5{bND4{Qy)ab1k-a5++60iwFH= zyXf5o8#CbRZLPf(2G1*B6RH4L8D^-GaeA!%5 zgm;Lz)DBhL4JX8P$DE1!8aV+kR(PYhyQyQpD4T(Gq5$tFf*ii_#R>+R(F=Xc_Br`q z+3=rWO1LMAN0X$7-~C=MN}v1-R;S4DgfS#%0l=-o0E=o_;7Wn%{DA0^B2V{<@>UYI z({`}0fTg!1F&KV+8X>fHZ+(H-%R{U|SJDT2EW4Wy7qyZUEfpG_00{2Dn4naY;jR1G zOs9S?lHvRrI=fdVZeFRoL2J*Hc^4QDJ|VF)i=2zuYvv3QJ8i%a$3I?m3b`MPZi|Fj z#bYsgf0i5_j{of6@p=8FZF%se263)bgGho z{SjhrhsY0A2j@nfg2N9S%Poqpx=G%tV=GYEre%oI_DT+BKYb|q?Shms%ou9ZjT(VS z_R|auaH9g*H@`-;$veQ%R_#|!37I$P5pb-@{gMH5sTnw&wD9cXeI=j@ytmg5dtt&O znN;zloZJ!`W5VT#grL*)FIbGr3FBOi%(`4p)}azNo^K;2VzXjiCuUDoy6 zPq>P%I5TA-0(;qiB%xV2d)QI|as++z7^0|=Zd#cQO7M~qd`OtjAHX596Esbi^xfy2 zv)T3>Po0+R-q6bK?BOswjYIAHzT8*2@@5y645XAO0Qt6e6HSM$SS|MM7TcThg0YK{ zJ3!KbV?98l#3)L2ubmori;q+G6F7BNMtD0@=*6^2O5vW+ATd;cCH0H?1?#JySnuH?131d$~_xakVy9b%_fWz#wI*h!%+99_bOwLA==GGzJd_~<bAFEdRqhaXOgFtFmeKMv9-^|F2|xSAh#hjzLnbrD_c~hV$WOuWB?YG*yC8dqdlD zQ7&u}nF52nu(JLZXC$nIQT=LG_{+5_O5y<0*vKrBl|mAB??%Z7@XeciOq20AB|&gKZ;9Dk$VVnMeYy?>lws}k}mB1q(6rJ%3` z=v((>um5}=7n5mBGflkANvuIzLkDbghj3~5&iG=SxNN*&veqo7wRa`4gwmg*`^Dsc zXgICdBzMME1~zzKMGD>HOoBI3^c8Ds(uqBMFD-SBWWzX(&kGJrC~+%hqZJ`Twcm1< zW-&lrGc$Mk)D4o`YH{xBF394uTOwX)fE=+!aXOXp+jVv^iQCZ@c@eaw5v^v%7=|w4 z3anhwj<29wUs#o-ynO|9uvQKeC#s~6Q_kh;4L}Khy-&ELH=sv@#wUq*1!~aTMBDS* zHB;Hgz_EI>zK1lE!r-_HfaF z9y#?5EeQbHYJe0WI^%?beoDQnGv}>OH$9?=(gi%;p`EchkB@AD^3znyRw*GGYB7=V zH8d4%@43>Yvbl)4=exyu%OtI%GHb{&PTC(~rlxH?u;S}yCKMD@9EbD#oqj~rz5qNKd7drcXYwqV z9wBJb;{EP%d?cbecdw22sFl1?1TspZry9KS{mN+kbiF4I2FDBB0|TIfYQNpCI>*w$ zfW0hKUfcqpuyflfDBrWQ(96Pu-JP#KQXBo8lAvg+OZYhLZG*7Tj4}MtH7_$cFXh_$ z6Rd?9)J9eVEnIX&dC%9ZSRBMq)e8R`&|R^R*}?};vWeA^WU_(VmqDIsEj5;NZOaC> z7|)6c5<2y4FG%{v;W$G{_cS>8sCiJ|&ZHr$hBg1e+GnkKm>c|Coj48wmhg^}arFPDBgDi?8%{0cYy(0-X%wT7LE6X3kH3I)>Bp z1y|`JUkS8C-T|wpTSu)OBAo?5Gp=Cd=7mu**Dq*- zM)}+^vGQ)QW|*H)B%uVTV&m6X%-$8-i@{`dV&}XJrbVEIw;5b7=kQr^DMsGwDjmqIo102lQPOp4)t#D<7&u2tw7o$2r zLm(VoK}IX`dDX96NH952BC8dYDa^6ugqnVhc*9jPf)lCmHR=r|<{r(UfQ?XExSi^< z`7`7Jk~9Y;Rj9pHg%j^#b!1{e)*VoWx|w!ksn->xQ)@EC`i+~w=Z_|Eq0V}*KUIec z<85niqxq6_s{lEr%P1aPGf?~BJ4*#&j_z5-MKSe7~{kXVIZ;}^8 zzFD+H3vyC^R<2+DDKqY@$|vO=Qya?Aj5Z)NH-=F+O#{_3XcwIH<(2tt|5(d5=hnxnPVHgqsVn)gJmh*%u;<;_m7 zBb_ZAl#AWDYf9b_x?cXwT%1U`}?x3B{00S@Y8z@SS;aYz)eV2`iGe}<3p`!zQF&o`x_vbBwG zS(<`-FH^P@p=UY14gLuF;9~d!oJCmYi$jDkU|;71-jWe7$%|bAq4SC?&xw|O0)Eee zLms4MW5&A`?SHTd)lXX7Jj0{gkN6F@50Rc`-V8J#tT$$46O}2{u}_W?0Cpc;Hj{f8 z;ytUBMy!|C#*7_fnly(@d#WTdicrM=wy%?wdLONAi6QJDR0p+DfX69vTuxi(^KH|d zvj~D?IW^3=4Ws-xM?2T_ov$>}=Mk}RQHY~$~&==L5R7J%m#yuH+l+5_-OWZhmd~w?@qLoGT z&ihW%e=({0X{WP_{O*Ut%m6DqQ{2KH)HQ`e{0Kn3ooS@OA`~3!Kp7w4-9VadSp{QS zj(dmN{%X10Qh5)2(*O9^Eq7Z1JPqnG_lE3<_;DgKp`Ds5OG0U`v5>iH3RE4iu12p3 z+%#k?G1jcGg#)UPJx$Gc^{Vj$j*Rovf!++_2}%$iMmO%VGm#Un0+Ur|px6o8n|~;K zwRmiTfRHCOAvIT+);TFKLPgBhSXKyQspPFH@J_O07sc zOvV8&qP+O`1+KGO_K3G4r@149e>2a^S`Te~Ddj6*T9F-OFH5P$(A;*svLAmV^)9aT zHmgs0Wu6Phc#D>rqm*W$xF>aOmi@I~Q@nrtmT{dcSOvvW~8*w38CZbkkVd z%th$+1T zc?d`^D8XYVcI%~u_aV?!Ym??qI|{b@-OR}ELH*UpWC_q&UTRRJ-$tLlQU!|38kE_m z4A+m8Eu+zkIR>FnkmvU+jwhakvEo3Exy5K5ABxN|Mg)~EMal8WB%dQ~yE~|YVk<3x zd2?dAvr!CupFLJ~y6yx+xz3%RhlRxde{Bn6Eu^me)?Sk%ldT{SZ&pasEcW~*vF4DI z_V0>QUjcJVg5{|1C!<@GnVn(EvAsBOpq1qud1F8nYdZQpF%vpdo=6b)8`j(Acm3L|@|V zU-_D^TQvpF{|bs*WZ@mfWKyc-`R(pVqy&Y3!Xb}^D#V$+>PEoU8{A>1^Gz+bteMrq{Co diff --git a/src/tests/hash_functions/c_spooky_hash_array.bin b/src/tests/hash_functions/c_spooky_hash_array.bin index 59f885bf3be5f5e9dcb96decf782618a5ec3ab92..8326ea147f4192d04ec0e77c67dcbfa201056363 100644 GIT binary patch literal 32784 zcmV(jK=!{8HNB((QX0+Wc!`c^G4Oxr$XkVr03V`TD>32;Zph_4F&^{2Hcn*9EBz^~ zP;F^@g@o#MD5@d=qcr2?I4w}di>%s?vx^{kkMyPeNRBEnJFTf`7%Yhaxp@}}<4LaNx z0{7s~Op1{%9A9}HuSM&!gr4<1!03vr8b7Xwr*!c=kpspz4cVELZP+0HJArT}3onGj zmWG$=>pe*etlm*0# zI}`5&$f`d3#1y}pWHXa-6llvTj1OHNQJIvwDMQWeT>Tv(rgm9u7}}rjh%_g^(J(or zpboO*qlWS*K{{v^B5kbfkxYuNm*82h8*r$pT6LvgP3|_mie$XQ7%(*~(xT&w@k;wJ zFzm@8z5gDa)A2E2!0eW7%vb-oM5lO(D%@N@4Vg2hkC+20h)ZQ|<9ynB?T*i{^k5&& z5m0a#stO{F;D)PDJ|SKi8G1^Yy=AKK!dVSH6m9&IDmPtL7o(1kcBpx4F6sysbXkGn zz1lf>2EDJ5W60SAYb@$;pFGR5iLRUXhOP5>OB5L%2AO);zyGVS7Dq+Tfz+B5JIESh zw0JqC#{M80WT5p5j7}HN?W4|L#~BFxY#x{@#s-$#X`fX~c~(soG~kp$U?xtw@fGKN zmway^;qjE3UP!*a%@3X1rP>{v-xX)Rz9}&cH}$$%?pC)x$>O5;;nbfiqxyn{RG=f7 z@B{Ku^Q7E$)XiKY5x~wb_Vy)vZ1M?#QbM9m*bjaY)g;$c6rGB+H!78qA|+@fB~X}n zI~2o?7~@q%=L`^hE6y;iVk^8S4YlDJcHG#>B6V&n0st=ikVc@N8IE{) znD#0GtAAyyGQ^(rEg=wfMkT(!$F$X6aZ5$&Y7R#Ts`?cRDM(Xp{2*5#T*SDzm^&SE z>eie8GDa0*b2P#EIv#^{ z*i-rk0b31_bc3gJDoa0wF27AAitA6| zKmaw6X%4Hv`?=o*%U|tzJtVD*KV}-#0V)+o;X=mkdIzhY_Wi4XJuEIID~VJu`>`{| zwTMEQ^7U|}$zhn{aU7*rui4OT_*hd(Ecda#2-Nz{k1R0H{HfDMabrvh z6|y}BsxlFwzGY5&uz3DT=4|%r+h&W=IxA2)YMy?4U|eHkUF>aW%Hi7PcGGU|`IJ^m<|poSmFn>3Rga%Wz+A*3FbwOz z5f=t=Id8w#8=(J>EMQamoPH4|Sn~-c_Gp7xOi)1Eccu+1uktve_w4`2S(xL{76@_t zEY~Qyy;K zmO2~YKZv_+{@4*nZQysa+Nguk`R9^iPxRr)x3ms!rKG)v7j#Q~u{EmnhIK_kAOibC z7)D12qUV~;`Dit}-dQi#CgXP2ZIgo%H+l;nu%B#{$$6KRY#w&xa(bN zs3&+lu2pWyD7*yVh<*-b0tHru$oO~OmXzZP<1X~1tXGfU6U`u4bB5{vai(Q~4%+0j zR3xo$b}>v#JO?9~a%tsea?j%pKGVmVrdaqKI(m}XY*po-sTG%|n%kc2ARWZmvvc`> z=TJNBhy11yG}EtAkT>vz!~IMX2fN&z!u3mDQPOBu*P<)$7i9Mrf-6l0q|!y>~8PJptwOWhfPEB4v^n4BCBv45Ow2 zjBkDf0D581dvTiIr`0`z87@pjh zR(~|GQ{mNn`7wN7E8H=@sKtc-sWF6jp@(RdmrDd_Mpp#Itty&IVzxclTdG3TKPJY0 zTRVNWK?D{CH?F&UgRSK0WZRw**(X58kCOTTr9^BeIl|Vf2+F8mlj`r_lv>U(y z!Tweif~Tj}->{k&T{z~DrHQgfM@)fKD>wzRhoMlA2Z2Zr6AmoM(CFq z1M6J}vsW3DI(z(Eg?M3W3d}d;IoY3)ZK{5H)Z!U+I*oq>#xR!wQ35;orV#A${*S!V z{d1$wO2<2Ho^#eafDlwQ+Wzx|2zUAVtH0-MAsAV=p1?!B z&_@pPt~mwZM6Up*ydIYuMS^AM=W)G>A7AIT0e3I55qxE2RwLz6*b$|B&z&JWqh(#4 zPQw>lfR}&|;%8ZFT6iHm^w=oxX3A#`S8}T-D1cRs^>rZKSr9d=ETgd4&Twi11tMlB=R{g&2bTs)^Dg%Fvzc@=Dh7^`{lKN z=v{Ugtij*~zNf7a&gPVtHLVRO5bWu*M=Ji!kn!4&c0A-#fRoKX=z26Y1w<((aSMsT z&jg8G`g*Vsa%D+;17z8=xT`iKc&&?&PgG}`1g3!=n0L8v-URhnip?3CP%!ohx~jLS z0KG0#5LYl+=cDxZsLrdx?gb=xB@QaH+ex?<7Q<33-Otjv4Q=)oY78Y#)f6vdTiKBU zipp|}%|w!*g7;ugrDHNws-hK+%5}F;jM5+b~XL=lHeN(low!+7p!^(s-tef zfr(%;`Zi%^ICyKYE5@P;7mu=8dHVnx$UfQKh2BkCG2-cZ8U3oh(thQpG3~*(MN-r(61j>y!lPfdB`sdoT{Qi-kn+?y*JSa- zZ{Js-6;yd{{^o6T{1m>}u@`xyZ5RZ{zID0S0Um)P;}f4$W_Bk6d@^y+^Ec+^m}`^b z(i~Ahk9I6Mb-U;NDsc_RDLJ2#B07VbH@xOtH*m={OAIA88sPlCm+=fzq}ww>Kk6xx zpiXeTV#&qz`0W5o)>Z5tCDV-QOPekk*#Fmh&(^vfP<27W!{i(Bg>mFY31lm4ZNlx^ z?bu_n&Bce0B8ek#=1DCeH21n2^wiHOkN6#V2wm8u!=fb0Stw>#mo3s<%vV#gz(*pU8b-_<9%M>%FLANQOz(x9S9G>8Z+L|1;U(HYT8CV4@oP z@lAib^2z(I_RS{!)jr3$$#w|L3no?!e#6exvOLMxF9t)79y6RfgMB@mDfM`26u2JO zF-n;Ve8*e2IO0q%ITN8M7N(E2tJZkVktsR853TfdbekIy>vR)=t)pa&!JM}>o%G9o z+V}a*=8QOmMl#_YN(ruL#JDRZ*M>;%jo1(dP?mjAU0Bj}+4~#3J8t62Q!#vPuauV-rGJZ{~hMD2l4x zjthu>ugWk@9y&YCUu|aefsgS1xp4$l-c@)S$vQRF&c%1>z2&8tWd0JcQRRVjMX!&eIT|IHW*b$v8cdC6panbAF1}v9-li48Y2Oz5!nGWM7Z8h=pqo4MFG% zrmndS7mdm1%QdV5;rnuSZf|{iq?5X6C&Sm~7`3XHcv6Q3SM^aKRpA}2gFaPqRieX; zud7a#{j6F4M$15M8SAqnMGs?*5V{X-m{m!b@e5}?2^ill`=>Z}oo{AIsV85qQU!-x ze(QzhUp1zCNk|yQ1dj;c6sRBHySDHXTuDIC>)liXQOpgNi)xGtCELtjQeM*5>8X00 z9a_v{{DTzE>H25snb-Hc!vuNaTcfeiiJY#20}qJ3baaWKQfw-A8OKiwWsOYx1PoPf z{c!mZNzZyR0grn=B41CT?aOo*R)QalPiFO7c-JrdF=t0%V~$;IDjqepA1nWx7RV%V z^j?XT`Z=0P}uGZ@aNEd9=NLgvfWG&`}mIAZxC zFk2+keO?w7t4Vgm%2I2PQSr@v5b37uKs_m<6(Jc1YQ8}0Jg?cp6^SPSQrS7HyVqPV zi{-J{jL9Cb6hYeIyDaDLfIUDdmTZrQ12AUZcbUOC@>uCI(XP!-enQ{VEOOTxy)(CE&)+HM8d73ua-ACv80fxmVXUU360k_k0=ZWt7Tt}o#vv(p=*IB@NkySX$qJVPQcT@S~8^lZ01f>eb_+%~hEKh_&Y6*>47VSLd-73KeXIkpQ+os@F ze0YA*G@`I6h74r)o0Vq2ZB%M@(6p%@SqkGSDFP^Rx1Db)MSk+m0g82kJ8fp_PK6?`8hJ{G0mn$$Jxbdz6=0 zSiq&4^~t*@(cGb?n|a2Yv2MYQMhG)r=xon%NZODnM@k&cFx$wR`r`@EQT0@A1Q{}~ zb)dKyg!k(L!%-sLa3!~z&~!rrcVQj^K&PkMW6Z*eDqI>!LQ7^)fgKK8EQ%UICVrh& z>LVT5SnMgTbHYKCrvA=pDM0KE66$U9LECg(d5LUCAh5=(#L?n&r@ww16F{WD-D#Cb zKxQ9NzA%nV8{W_0Ym9>cGONwwEOXVh(u?Nsk4XZi@4njvrj_ju_I&BbEn8#h~$IYW3=of@o?j>F|xj^s~vx;JQfnU>KVkpNy5nf0f_=>r%qr zo5a8~^&5Z=0-<<^2Q>nY29o3r_;_Yye#EIrcZ1Ear$!FELs(8LUng9I`Kb zidlpLEG1%iYH*sbk5ZC3n=#&rxA_zFkJft1x*BFpr9pI@!2oLcH}lRmDh!i3S*E+Q zr5r0ff_t%(*0ItP=tls*nZ@A1VT9Q&*T8J0sin_P{tU7LR`JLj2kN%|dYG4CsocgS zru$-Z0Stb?0@NnQl z_;UELsNd~zj6tcPM~Rul8~1h=!$Y~|%eP|yvAYhGXZ8bhiGsD)8P=2)Z}DveU<3EH zU=Zh_^4BRVLVY5?|L*jtJ3|M$r^Cevt$6#;NDD=l#iAxHY@oW@u;=`GhGFhn3%19c z+?}pA)>TN|%0&cCz))vz#WdtRUP-Y1!M_9l?Y;@eH#~^ohzp==P7TOD4A%gl?AnMG zhX8)@Qb<~TqX>aDYd#}K-@by;&T*^g4WY20s?XBCJmRL&7j?A#E0w4tdj<9li8(CU z&NZal(VT@4o|esdT(%6LVy$UmI7;8RU|`cRS`pKXVr^HtcdAnilZ;1z9>pW7mI0LJ zv1!R2GefrGk7M3toQ{fuyjP>|IfHl5eiNix96hVt#{QY^Kalvt+;+nnuFlWUiG|z! zqZVqxNSZ!M(=>`$Gai>g4_!vK4iH~9oYeAE%)&I&%6-w9@&p1!sAs@ot8a|AV^bYt zJXH+3Vvrth3L#|VgvsP^;2&UIh8hkA4~4VF-<^zyNbE3k0JOb=M(Ib1xyR3Qps_~e zwpQ-D@i<8W1E%d66m^%Vtqh3SKb47X9GFDGm)`&zk zZ(7`xY^-K1d)3)daq1DQebAx$z*HaQFf1L{yj5k$wTUiekO5KuuA2p}LePY?82(uo z^$B}lWyY>XQduc3Er}fm@&kZWwMj_rHyw8de;;m!b$`VV8Xg3*x^(y!v16Qc>U?4~ zv{N(plMriKNc7pbwEgM9%dZ(MwYK$4f6y=~vi1Zz;_qb--HzGjNPztrp6ZHx1nHHt zU9@62@vJfrJ~qmI?KRFr9dQmwQ>Pf=xUG4ow>c9J%<2T4`#pOpq_^*&}NKN3&hRWsN-_Tm}?di{VMq z`uk&2gAxl|RVj(#(M}JIz^_CltO=YvDD|^=l-`nMpS%O~2NP3w))-v;Z9i~qpU)U> zANWcSLrY-NgVYp*bzm9hc7Jzm0x!_?R=;{n<^L48th!`+dyc%H695iD=#KI2t?kNp znopOoOQjX?yMkaFDrvQ|RCd+%u{_@Uc|5vWz3e+EnQMQynfl^rBH6;qB;ioEO+70? z%|!nhTKp+*x>F*&XALF~3X=E=3%6UV)PS=Estm2gBP5q7>065WNQ9#_FyWJ^D~>qE+4=X@CZV zplXACcvBU`5b>$nKTlnU6*eM+jmQSOGwU1MNGca7fOk`s0%-+8{OER7F3Cu(uWVP_bd^13ljgG22RP#Pp>17GYfG*@wQJJchKGi>b=HeaO z=PtTry43Th+AZ>e#mJTDw>u~!PA5`wDUM0s`z9KQHa|piJRV_qyDUrrpi}$@vohz8 zX{IL(7Q+--GLe$BT}?Fm6&cIl!BiYrF0iCzg`rJWaK-H*NcQcF2)Es#BI&ZyXQyKW z7@UO>@NF`S$U#UqI9cQZqobCKFuPO4tpTm3+Iiu=M#PC$nSnHWimnAn5(_%VNqA@o z8uyFTECI;oU^=z9xbj{L^o~aeQ5%6&%rulW52vFn2GKh=u}rHHPcSAZ>X)6J86R$k zjFS5?=gY`b``txA4NyR4{Ms6`{*wJ7CgwI@lD6mZ>yUJdCi`idm3W*`G(hjs2G`g9 zfOmrt(u)*?zP!KQB2?Z5#kVJ?FD+?u<@UEwV7(}HMMoLFwD;V<;!>18VE}u=T!ra( zO4(oBO)&;J0i}KeS(__f;DZPRV7-&IUXV4Jm^T5WlRSAnU?ql1qTBYQqPt*>Y?r0k6YI)?Ia= z@7M4fZMmpY`OuSeHCeN+v1%o&g=ikp%x|9Frn`{lGFUJ_usM8OsMng!wb(IJJxD|{Hi{g)>kCut!+lF7;ti0 z2bbc;iSaCPz(LZOd%R<$q?^F~7sGFbZ5}F}ZX5F1M2(6%)))SyA^O1)GUc-Cr= zwkrIeR3ac~ImoW=B``!+#vwJ0pSiPD(t2LcZs1zuIPiw&XHjQQaaX)|*kM^pfOq^E zJYCFLdtHA}a4}MM7v6+*r}Ut^Lv@ku00HHv?<0x}Y%XeMU>!?*!C9zgEges6OWVuV zkv7;P9{FnS>SWL3ZWZqNHP=@hYSaFpW``EGoX>mGx_1oxj`4FG)yp*faPQjRF+|ZR zwjdMp;sAYk%aO#Es$^=EbbjGADt$XPv~-(j2~isRt=|+x)w}AxggyiMtC{z~5WJO6 zeJB(yK(M6d7$Ppf`~aU%qh3409>&?oROJ>KF|50GC8!0<4wHzh0ZPyzblG- zhQL3Ui)*dA-x4kf_S6^}c|T1YQUs;pi9Fa8OO=BH;qCE$+D7X9VFIVMVyrj(9Vw>d zS-jZYti2aUr5>+OOMmMq#UCcvRz~)?E}+1VPk)Tuzw&M4@ta46nw4Ugi8sU%8_IY! zgz?U8#|E7eJ+{ej>W>hNx^>7nkPCF>5u5mw<&56UNEmfM6)`&g&j1tc{0f~SaFH|; zcSk`oXs-;61JV&_kyA(KY-&LGYARFMD7Sg8u{*fiJ%F3lBt!7tq4%|l8hA*;B+GN4 zH>G}5fXCm3%%_?CL**9>SzmeXvC6_Zg_z!Qm$q2PI6%gE7x)6S_wF`_+4uPQSl++m zi(TK8H7W^~@kq=cpF~Q&JlcE9^(+t+J zKtd=Viki@WBW9Nkcp`(LghNpr8qw7xYwxmV+kw0%@z?~SJ}DO`o&x<{IrF+V1{r|J zdG_)l19S`Av?JuMo;1Jxao7tikp1L&#r2cb2@yuKgl3Qgv}A!!wv<469I9rX69qSTW)yD_PnR=PzNodwhE%lgEtNEInH+9a@70+D zKX(VXVx0;WQFNf(lLxz_7wTSR7m+dpMI$09J#rGWe+JEREok`xe;*lmn`OUhg_$^+ zdV@n8#~!m zbgG9IpVK_gyMKIJo+NBQ!YLMISS5$FL+qQWB*RzqiLg5VteC&QDUutaK9NOr=V`jV>AOOK?d<5E*VDuwCgKLr_86r&ea*>Q%Pmz8*N0PoVrCqhhBr>#x1AGRmn_ z_MU#w%;HGdbnBy?jJolPQ8y+{U0J-G24u&B_d8pAG5QQ0xZ8v;ge$AMYA}6pMux1` zZV4MYl!Lx za@4`29L93#o`3vp!IIp}nxDeA?#Ht_<)(CGqVZ9Q#+Epw>^{lHT=<(#tGA&x;)paW zCwzQ1#OOKFgOQ13=eUE%JM4x72agv%t8c#`2z!Ktd#nsFJ&NOWj;gp+i+NZJ8od9sFsceZs@QT%IAqOYo~ zZqwi4-+ppCMK>T}ls=q_L{CXkBn>h+Jn`yJ0sG|PO8LV%%cB~1%(MR zhuN{uPkfRTN1fAnsvq5Ia^I88Kh?MQ85&pY(WbUWK`Ui}zx!HF^Q-idWF6 z>J4J5INy3E-UaFlm0IKM7*AG%Fc?;?s(Lkd62iv^`F!dEQdrwv!^EQQDs7sFkQQx% zU)?5zLGG#P#GsxRzn+U2@WKQ_q!J~pGimw}cNmtCy87;%$|m{oy9?Q7xjYnpxec7N zA-NuhfyP>z_blHJ^soANr&v~ZECG68C^*(Q4_E>6d3-5ZL(7qV-}5-EY(uW0ceAMx z_q7`p*lbbaki)I*c@yqQ@<5(@l>Vy^9>BKvy-NfWIg%E>Q&#UFXoFhXS&h)*GhW0O zy?MBmZ1N)K>Rw1Wj00HKgN-x$ba`)8-RDDb1_Z1lx^?Y8?H#xF*YFm>O} z>L_>35xhj1KGYjpM4t&0TvAFOwCmi&y}Z{L1q~-KnKe=Z)bh!={BCODzfM>8dAh$z z^B<-2fldJ;Bwp0a39wgF-7>~x&v~f-saL22wQ_)ttucGHo{CTG5#0rO$b2>S7SwX_u{*vCL2m&42B5mR1}=iuaq$g6plw2K><@{D@&Gzu;68? zk+IQI$V@%?sMQ-BBDA(J^U7~`8S?c#c?ZNShmq3=Yuu5%p?;hc$IiH6#)=ZKA-B}d zEL=0?WI+b`ZeZ$XO+>iky2oi}O6~8hqO`@u>gK3}A12t#VGi5on0N*x0i~>tM%Ee9=%54I|Eqjy#TJ>*> zRa~`!jIaSMoBR&bBOv$G(bIjTamd}QG#!8iu!iiyVH9M8rZs?)HP2v`_U1PI`I6mv zfk|a#F;QP7#RykXTs}M&wf=w2isciEN{AjSPTC8LxDLa?EYsY#A zL^G=&fw3}=KZ|0Ve+ArtW$cY6K__fdiI#4qV5lykn4LkH5({6+b{Iqo6C)_%;*67- z4icftU3_nkb~%9w)vk{KufACZdU9j6$7qJL()e$srTUx(&BiPFBRb`-DcN(?|=*2Zle0Bn*Oa^lZyh1M=oi3mCo)CZ&{nJCR0hzX%Tc90>2jw50ae@+4%+R(jN(AH z-8^2J&^vRW=upS3wwKKkmvD}%b;vtugW8HYrww9~S2QidhBuq$&n*Y9JX?Q0J{s7O z*?HV^!lORQlBy(05<^4Hm31@kk-1L!vq14Q^u_EB_7MGP3~i!3WUX3w2v}Ik`M>%Y zgt%U3+ngai=Q-JDwb1bpHQ$j2-aIK&EELJiU$8BKVg#cmwvuXchGl)#&TaPcYYYgRyLu2El zJ1^6arDDD@Nbh2}0p$KSdG942P8I#3XzO0<>DcYYVPOILvk4NEq}=-HJ~WiT;<5Hr zL*ose(*ieJNvROWK)Ni8$5sd$mlu~&DoKxzoiO&EZ7)3tH*0tt%mQoIm-s~uW{CTw z`SD792IVL9BD|nDUa&}lEB48)8kSTD4BprYFhvSp-qW#3$%4WMA?LY%%nu^i`&EV$ zY4Y{kZCyt!nU+hPZ!VCkW*E#6)S(zXXw*N871#Zt%u>hc&h4pzzAK{A1XEy~-^F>( zC<}vjtp6ai>wPQ<@uj9Rl%e{l3yuB@^3Yhb^0*Tm!h9qPp`xHCw;9n-urJ!~z=?cu z3eN5#s)OXHJvE-|%LY!O+U7pV8tw-COL;?@KTWpY($Md|vfe1>lJFdRoGM=GhIqV1 zNu0BH9@j$?N2BQxRUWMWn+tA)ccBk$IDQ5Bue#YEo^e6khdckt)IHX`L?8Izizh&bII zUuGv8ylqAXkB_Tb>sz1(&%fFiFK_zgKK2fJZC(NytwPluxYJcM1_!FfimLYtHwRKo zcm{%WNy8gSPeX*w94V#Vm$Erf+PyA66@KpJ3kaGFe!)=^tiKP_oZwxTn}CnpIEF+ZqQU_@n9?rp zj~NZrDH{Ts66e>9u+Hw|-Vn<1&txT=*3q?fCSXk=7`E2ymDF`2|E+^+h-W` zYv9`|Tm~ne_{O@}(_;s=auG!)P}Y|*KKp!>*jI+E4xx>y*nS}YY3v~#Cw=KKtvY6YuLuT(sGs6eu}&av8WHJfi=R94`hm)J>Wj@K*BrM3x8#98 zmFBZwer!NMdzR%E{qzsvlt|J<1wl*c&3ylgh$Kl*y)ZbdNP`SOA6A;t*F2~&U+f|i z(?4k{Zzpg+S?Vt4P$R6z6bL6=AS9`&vkT_cG{3myq zV?n1S1Uh&&`D2IaoY9uka_7@O_l#E#k<;3Nf^?NmSxf+8SFc{EEB|xn@+cwGKwb5r ziHOvxdqoCrV6-ALORKi!Flf19WH!P}Kc9aA*G4kGI~cokVp9v;v(+#Bp*7O=R2vW? zp(tuP{mHSM>=jVYEq<@!uHZlyo|)wpoR{o!r)ge83SY#RkB63vb$GTf^l(}TL6UoghBiF>xg{xZOpBt|`u z_3uwVxBu<#w!}p_u=q7I-PJ_9jJlf(eaKFy7l*=I|IRjO5!L$oB_tSjI`Sc~v;r2w zyp+5Ep-?fT5U`}F;sJV^4GpME-*$)b6^UE3r1vP|yR>=Y21T3u`w&eH4|!;CGS!GF z%C18IIF)eAFFboyTV?g1sU|ssR|{vqWWMRRtYh=4NR=o$8-yp@sEZ8Hex=quW2C7k!+>w7B%zjWX;bnXpxDG!o2YxvgorUX$RDoQWcF1enK*%$** z_o8&vO_oFGLS)*uBVq*uItJ6!A$6j4`J-Vzj~Q~p^{duR%K|@^&=9gt>DpUHcp7%p zlu&_5NriqOH)DV!|8G?tFGP6Ws{Z#2Od85{q7zlUMkC>abxnBZqo;6GZKJVw^=cvA ztHZpnu6*vB(>4)6|4f^`|9)x#Pm4{elW=9SbwOps@_Dr)S;zq0SS!rF1%7}e7Ra8UI#lb9Nqi!yj3S9trZQuQuZi< z_pGAsOH^fn4@K@{sbjXIa<0tkcE!89A82ax)!nZIXnZsAjHAx6$yc;vP+R5*Bl!d- zA}xU46f;<{?hpH(lOUFKn@KM_WGatbH*dcGSXDCu>Ikj3)3kH{GN|(o2ZfHRWdAi2 z(TQy{OXD&3STVA%b?DsJ}Cy^I6U$0~f11vj%wpyV~bS!63 z#!o_wdCnx@inpC=R7Ght9LJ;~AIbt;Xs%5+F>+D^+vg9rZxAJGnRzv^*P>m~vf~!T zF7sn+EEW|sjk@qx-Lq&S$s6&Dp^Xeu*B94zrR(TM>K)5C3NBzfdTh3TBvfj9`)fpODAQzy& zy+3W@MO+x=daPP86hDAmCcNMhAlsV?yjK)-ICI)mkyxwI^a9%mRXB)lrG0!*wHU-^ zcd4N>`Ub-dyAsI?Pji8|O0!lXPon?!*{Fb}67{Sbyjf|Q$HJP48r;S zj7}#*GSezpO@0g7FlVh@h-JOK8X?fAm6|BPT3II?&TgPu^!_O`9=;c*04>zPzG0yiffL1j54iRP9XLTf}m#9=FZd{zJ%C0+TkeV%d2v~ zLlhs39X-)8=Rth;N-}$-29V=zfXJS_US$fQ{vNEt{PvOAvd{cX*`}br{rb%ABMY4> ze}PB&(l(ows;+_21nylEtJZ17Szq&Rg?{fwznJpJ#2@?;qqHioh%lU12U(TC1q83> z7Hwrfpxs*2_0d1c9%C>YHH);Q%*?K{%$l=R6Fh`(B*!Akt%qbWPdW6yf5P5^Z5O{0 z%@&2NsvQ_S$cKY#y~;=H6$J-nH{csW^liVO+`*-N7#t8kH0RtTZnH@kqKG0K`50Up z^C#d5JT5-Ai>iTojC$PjopF?5*)Nyc2FTA}yPh;{fRbTC`TO}A_?6rWPCm*n7?vNV z5YYFnl(L7{nB9=beQ25HHP9p5u8n58Fg}_G6v2-H;;3qw7&mC>!i0(9cE=0(`)kgY zAtDRLB+d-?4;4YHAD@UxX-+&c$3eQGc~$=FIIb=l*#aaP`YG0XM#_DG%z?Lv`7cd_ zqZ;(lR_Te`5JT1YW0Y>_Gpjcw!`NHbBHiXl4eaSHz}?`M0&4xwfVG#Wp5MpQCk!-Z zB0z_l-8%L9oquM7Ur`H1p?|q(K&&i}=4=!o$GUqnUcyeZJDLRwp?avpIjOI<;HBqV z7alF-T)AZ%fQE(KkqCz1x^Pc2W=Xn>TQ5E=~W%TrObt}9gdoqhaj#k@Y~x%m#7C* zboye>4K0DzXqg?y{FClg!pOrFs6nX$HFC}l5eS-4KF{y}B!%RjX9^$NAve(Um8RIM z>%4aTX?V02A+c1wnw?|DqQe?A29A5DJA&QnfeWxzTYfDIr;wWisTQOX!Jlff$TteA zkrp!{p~cXeyy_MOohH$000LHFXxgm&1|<*SNj=C~rCo?q$K(21!W%@_iZxWVkB)#$^%l3}>{T?*ZJq#l08$YDsNwi_C6gXp!8+8tWT`zc*B^k4u4aIsg3};MJb1 z!@?X?+tMbn{I)5}p6%G>ixS}Wo~|&pEsy&FfysPDuC)0wQ@DOOkK^`khEmY#JG{}2 zxBzzca$>FRy&>Hq&|CQi+I!2M{^jas5Quup#1{ugu=F|AKIe0HXE$WR;#_ZCqKAQ}Lc zA;Agibk|?YWr z7j0(bkIY}6dpwiQh`$$XqN*!;Hz~rghPC01nwL9B*tnq_PmyNpR39Vw-B6p*hGX%=Vrz5h0p3g5`;OZqw(>LIK*{{lDJG7@m8~v_zU=N76lMv77;*e8lD5u)kf`mB?y7rT?r+pX|UncoC2si>WRUo{Fk#Mq&wu-4X)SjPDw zAe*Rxxj4kMZn43HN*6mSk1{HYr~9bi)dLP8?JaG?eI$lPb&=U~cf?6&N?3d68s@{H zvFpi?<-o=uprM(1XK zG}L5V{*2+l^-evH9f^xD+1=%H@~4&K9Enh3Ph;>tehfPML3Y3+(gqM&;J6jy`#t7+ z3peFsk9uA77QnS-rM-ZhM~YI-iDv(tOJPJAZB~0aI5`BF`@0?X`4YYKG}J}>IP0(@ zJpB`J?MXh6hhg-v*_iEfd%@-=Y*z$}%R@aNKJf zU2S58oaBt2-~&iH24739{DSvCW*VQIFsOhX5rdL+_3@1Id{VoN6QTaY-$||4FxPNN zHCh4B%(PrVr7KqZM08eSW%`ny?vfNv*%U6}ZZXxmK^CO5VD(Cf>y%U^2Z&LZt9snt z2Q{>i-V1I+wB$C4(l-Gak9_&sOWSp2Q`mGC> z4NA^ddMTIyDpqFm>GN;I>`llpoLv^b; zQ(hukH^f)7F0m!t{lA05YTzBywva?|{>6MUPJ})OT@aIg?yvY1&?pFzMX~Xa`QgU- z5W8>*_)F03%EB+9FT4*Hr&&xQu4CxD0VIJL_3?@V+Y<|JOx<{nU!Uv`JuUGJF_KRt zXSl~vj~+FFbd+)hpYdiV<-TjWWX#4^g`g%IRwWSoubJ;Po>(bI2$@L*m&G8_{~3(0 z`DvNn#m8j2PV->^b*7M_ZYOzG+=MS_k-VbJUJRl>mwi$SvYst68=?MWIlI+XBup!k zp1~OFh@O8JbHR&=c#TpK015=KG%Y@qLvIH3kShatG|x{RktB z4c7}tc69BSZ`0Y)He;uSrgQ@YR0m=?1nb1{<;;XXZitjp_; zJ?8XFs0{%ayFhZvATu_dA{nBe(@&<=r_g&+-iI^Er;j!ochyxWbZuaPh&fpD;Rcd# z=PW3$Qqn2fV$@onJQ{zkCJ$oNsr&vtv?E%T@naA{DS6#xAPFkAd;*!F==bMNN0lzp z9!r5sOwH>!iZJF1Qr}U@=*ax_ujL)qnv6WxbE{z%6%bzyBp1r-b@p%cekklZB$e!V@W$wQNw^MT@#T&orJ+^`8yNwm^}Xa1m~SzqEqxkXp|w9$ic03f@XEKLg` z73FtCR(eZ3m08IWaH0ez34Q}--cyqc1w66S00t&IRu<0`rEmin zamRyT2t4#GuITh$z$1sHrYL?VrO}qlmlsiX3?-0{8o>|{7%(dAG0!VP%9 zONEX0(|&0`{wsx-iaJk37&wFy){d330ks{K17#)IooA!%10q8SM?vk*$8feALZ5s~ ziVp`j>7wrTuXyU$MiK+@F>Ol#IjTEA&IAbXNse2vh%K-|T+0w24e)%Jyj-IK`xJH$ zxgjnFj$X7*;04iYgL1 zRz9IR;k1%iuM^GDfW8`%$k`M>0vq2Ht5G+biE`yi-~h4KF9vxE<`Y#_k`_#Eg(Yk| z|1x7usTn?qn+60DKTHm)rR z*s6Z~hi4L$KBgeXz{o^9aHVqe?yfH>wGA0CRzAzl|Mz2h94Q#bCwwhoOsdN(8?8JwFp`+==SO}{LL%IgKGxC`cQbBo49118q#rW(Ns9TxxH*~doGjaQ<8RN??A_9&K&ixw-|9-;S z9?@eN?i16&rxXGzR{Jxd!)?yZgyqJNZ>?s@x_?Bs-GRZSd%;4_j$lJBG2ag_md}26 zXCmi3y!#xTsZ(WWFhp7z7*vsri4_HGB6$;AhU|OKzU5*^v%to?NA{(47;}aZ*%evx z2Sqt^#aJMKUQEghm7ZSQdGVy6j|_-UxQ+j|o`6QyQa>esuGlB7JC0K8x6kI*l^Fic z4La7Zo7UNY!P*XITL)!obpz04axaPz&N&ZK6<_9<(6!8PU2=zl4xzr$$e@j|O#H`E)4% z@Vzt@@U}_5HR#*#Rq;)*itB&YP3r}4wOjl-I4d-@aiC^dW>m;5lv!3Hivnc0=!*j94P%n~% z?C7<+NPvnL$FXQ@6!z_clTSsCNTXbxFimO^HD005unRUaVI!K!xV=R1K;kR!lArch zpS|Q$?cc;4ncf#%TD*ziBeo;-O{hwLA-^O?fcz&bhm^EznJ72WN*R7rb4LCAf=qwG zFSv$E;BbQwY*c7y#!v;NsD8EH%7Hvc(mSO{F<5wYl#g5AOQ?Il3Y}kb(yzElr-D5d zug|@)0rlNg$TYH^DIaQFicrH&xc5MoC~Gp+{a^pqFx^5#u2lg)^sC}C`2ffySN7|=y%op}&Mnu))*CuRWetAyMBa?=ek4>&FXW&WjlYaZ3)w<>> zQ?c@)D=~%}3Jp=OrhlE)(s)%rwOPE#>ZhiCP?pP}x}9)B5i8=CmPiX&PD9s1k|vdZ zVd*mjLvc8}jCfb@b7gETaT_uX90u5x;4}ea?*V~c|Yg8ekS0E@mxuSxMQa` zgQT)pe!G8F+qK>_` zfHl5;fqTy$9erZT4v@{7Zx+Y+q0BmKxqZ>3aKHYiIMf)jOf07$QtBWux3S7F?%nKp zi5B&Jl??Ys2rH{L20T+xQkIwpg;mpbF_=e|tmQIcdPQfHeAF=0u|U_8vs;8| zQ{H=ed=26<*$r~7wVd$Ek+J|H&-*$e#hpJAfXwJ6mar7MgDXjvWiO5djpA2Y9>L|+ zmg2P8^{md8zF@nG;?0Q#QvYr9m-NdTxo`KUhIY_n`o8P6$^rk8k;j?@D zx9goK&Bs4*k2DC8za{!{KBsG|^l#_v(vy|Lo{@5U=WazxGN)Pv|FlxjXpqr)3*2K| zTlH7wyHYm0aF{P`t9~-wZc4)L|C^>0l7}l_tEt^VX|VLeqf$RnG-tWF)>SgKGN*7z zX3Lh49Z<>sF#nB`S=k0Xnc9MX4pIGqi*Lj>EcqeBZpo+>=J7_3KQ!K2MkOP^iM{89 zZ~FNq1Ym+bm=@(u$8hiBVl42Y1yz0oV{7fz<||{bv#NRkS_qqq#HO!dhVjhE>qZ-S zG=N+(6rB=BEIYu^bT#9fKP?Nc@)jz_Kagnj;Pey;o$T*V&#C6}F`HqeyPq3N+MdFc zqWM=>-EXIxNtsi<3oX&E)UjY(Kb}znl09JT*4#we_g-F&dk?=*k7qdARY92Q?zz&ORD=DE5#p1i7FR!%ZzL^>k~u)iFgottoI zqDT^bIC?G&#R=lowtom$!bq5QpiMvIZ$8=3D`7O5S{txYC;`6Z#d2ajA(af0B*=4q zLd9bZN<>LhMKn-$f|SM9zK7F@o=$S)@rJaP(}4u<|0pSy|GTZvBRUoOPHn#0gZmE7 zqOwHDFnHJaTL&xd$%56@$Yv`iW-wSk)FxBz=Je{L#NG5yc_{b-y{GOj7+<~-I9|Hg zv%#nO4V^^T<{$k+DU+`7CBpa-{)9e&pkOs5p}X}6^O>q1=%+pa3FW1O+)-_iZL%UE zkBfQzQnTY6v24*qCxA&R-Gm<@p}&tMo}NMY&jS*{G-7JhD!ZC*mR8K*+}Ise+W(XE z8%JhU?h4OC6)FO5{4&5#I-x}3+QwOXh4@IOuZ z_3H9@PVs$B;&I&5fI@l6k{5FSNa@a%;^5uCmlIBo~<`pg6C)x zT@q}~UA$q!Znt~_M~jHPWaRV+N^YVCkSL8gLaeQI#A%whyXX`P!$1!F2LvV~pBj)c z*&&d$CI;pjx{Q4q;<#v~+IMF8vo(+kM#4;Ka0|MxaS+58jwORwE-@XW2mAT>9H=u7 z!0ipQG%H??`LCQxO*@x z%kfB>Y%m8bvy`1G=lF1wNTLG>TIfHBLfqU1LgiMM#%wL%P@AZ#7Rk1mFYA>O!$-)~ zd3+T?50@LlX)?~Pt9ZrM+YB1ArH4&rZ}X<|b?FnF@~U#ztwK5bSfImRMnnbxf{+ zH4R3}($@(Aj-=$%um#sm_*$eA;Fsv-LbfOh>I_(`Iu+VZ;T?v&$KvS$zlk%a(J&@s zd&yyX!d5v2JH&-Eys8yKR)d!hqphUdcr3Apa8xhxjBl?WA?j+in8zFoEuxP_8mRqp z{eTa8r+POS{cXf{?zn*e^zBwQUeyX|wyiKeIzDD57JA^yXPYxJZ_5=TD@|Kd_$tMW z3DMiq6{J4SF$?7)>v@O(t&+Ni>{Zb>J;rd7pOAUxlb#Ho!+$U*>nvzchMCmQbU^qi z+2V^j&-Znl{H6ko=y3}Opoh(!x+Wpq<)uHwVSqM`TDTr>q$y2>&as!8ap5alqJed6 zmL`dVoyhsKiP=Az?!vcwopfhMlWoF}#t3K9IAOA6%jA^INn8FyoXBx+@p;#9z~=3?@zC~tih%K- z&=~vWCVc>SrtyiKkDP!r0HuIdxD{xDEp+O|cGJbn$^TM13d=>!?h?G@VZE7_S6p9$ z_%Yvhm!`uJfjLW60^lc_auUuukuGFcaBRCstVu2IQOP$#VFC0*>euNT)ft^>9jhSx z(F$lVLrZ`Pz`#JjH|9qjNOpc5Wqs2r>tlM++|$$ju@ikN5k%w-)g>m8qI7-aTBG6Tr-+=@-~D#mBqNbrK!3vxR4y zEj|`Zlfapi8b z13b`|i&2#Bhu#n9?rwVHW|djB0gdUWL&E5AX$NQU#czpyw7c4wAq)J*AtnBm!=3Ty z&{lqYQt5%vocd`!MlDfRSGZBmuu{&yorGgN*tvvQWo}p5S`KQ%Z};+Vc;p@ zaM5n-eE|faKCAu*_~z8tLB#Di#MIr2(fDB)vUkPh)A1w4cu4)Vj#it>IF~}e$T*CO zCkWJ*8YC~tKPg=Fg^dtKg5;ah7s70SYC{^eVTIW_^1j!Q@<)f$U9zAgKtzQNxW54m znNoLMOU5);uAe?kEPr$NOI!sB?J+DxMQ1?l>YK{pKcgV!ZnOJA>j`hw$}uo#GQ;}Q zzVsKy$=+|{7RW_Ssn9D}wDr?8-y3iY3(QT*XfMo_lT^7}2bm|m<)YnjEtbF>Prfjf zT8+uIy6K8b3mE%cY84P@|9%Pb8Q@Mv7NgbyT7@1JyGe*g_^NDJhNXG=3q(EB1Xv$& zz0MgnCRZdYjmJ5sa%_OCcUGyZ(c6F-RGuhD@Pwv`uyN?}6w>X9S8KHlh!8FTdlPC8 zbP5Rh*sihSGbmvGf4y=zj$Zwoh3kod}5e%Jrrt7H0~-5-#*n2DsP~L zTNv@EHvpaLx~{!R`ZOJd8YUPpfg*i3i6Hf z4X}Ru)_d15dL6<$KkICfYg`^Lq)uz13*pIf-8T7dkFVJq-19`{VolA;LwnyFO&6_{ zJI@O96AxiOtg=%mYX3W%y)>lAqowCjD+tjpAYSjlhPZV!iS4O0q{8tt%gNjLHxE|e zt5mzk^;Ac%%rMKLL#zhCF5pY*uoZWWt(x|8{@*c<{6kp$6|LwyxFko#+{?@NSd{AS zo14Xf$>YhiOJ`@)wgnhBx;{O;R9}buB>lN{Z0pxD^XnUD9;a+*mz5~gAo99q_ZMFA zwH6={VPwW&1Z7csFJNE3^v(JGS>;i5CMIk8weG&@U1A(22cluh(}2I`-H|S5I1p<_ z?*fhB4%z@4OE|DSodzYDwh1c9%%t_ekucHJw?`3Om^5ScwE?$?3mI{s{UsI5XePf` z#yU(HZWp}Idb40vgKz7(9I&C!<)mkTKm&?t9T+IL&Py zdpcwat;*~C;6j-Z%#9o{vE(Br+Z*f7DS>x8@Vqx`IV$opRTyNr7*X?)zSTVe-VPFX z$Fzq(fT6}#n+|73!CHK9i^4>(AVK?~srZyvUgz@eg=gZkFhf_*j`;mW@j6SfJm3&b zK3Jgyqk-m>=6k4`?+_if!V7-*1q5OvI0&7i=OzEA`ttRSM=AR|reb<%Dzoa=z^8fY zk@Xl#PsNH@Xl%1f8{SzCL5-5@B7BbXYaMlOPV48ifRHreIx?j1Zfkr#Vqk85eUc?~ zb;GjFv!BHFjpcK8>%n%kM_l^IU}E=ITw;gjoMwgyb~q(~h3<$~*`_zR_N)(qEp{J` z`mSz%n#~RvW+;YMfPw^g*7~@0B$YH2lU4qUEACxuGZf_AUV7CuTg^Zi*&^8Xm3&bnY7D2V zD&wU?GU~tg9eZ5uO`Q?WX61$YR%fb^m-hzdz0q|+`LoOzV|2nKF`oW|Ji9N;lFiCx z@!Hg)pHJ3{t>MmqWvm;Sij)(D=O!lYsPewjjc2jP^~GBBM=@3$1D+s@CzQet%#cZT zIP_Y1?4t~5NxxNF&GdPOY8Fa&k1@uX);Ig(X`~QTN4T`XVs-kwsJ!?Cy65?+V>+A4 zIF0zvx}N>xq8bvu7Y{BH=}cOP)z*AMxZORE5DZ~vyMQLO$A{4bmoOG!W(w23 zXtwBIc#`dk7DSs>_c0Hd@DiBcdrN~^+%RqbTrxb}B|85MpbhByoaN{on;~TOWg*sp z3Uax~4H3$~4Qa8nK-*GrrnTOcd1Y3O94PYWeR5+>;nBD^pK(}5rCaiw>|jSNf?ZFy z@ttlmd!|0l;z@0Cqf8A11A^$=bpZDOYBN*vsN$}*&8+}mkg0W7oJfoWQ0bR1NEwnx zu-)Z?12T}Hog)M4TKr?llszBc#1M;sX(m|w%~CC}(>_B`$Tp`tL}uiFLJfO+k~&&v zz9wnd*$fX|$MpU0U|h2cay2{(@-)eAiSIUhM7L`tuHDVpT+k^bpig5M_2GXKK>J!Q z+HO7t>DFy#+VQwCRq>Rnc;|CzGp76(-6brOE0c4!_wrRSieTPlW$+dB2x^!ipfe?7 zhM1MVr?NFxl_L1p^$6bu7P^d{^wxzUVBA`H@k(--7=|^#2xEB=&eZLT4u$g4HxO@! zp=?zIHVYNv`pgF{?S7C-(wMLgo0Ls3WR5Id1{xdT9F|h1UBw)f zcWIFEeMN>lhkzG0smwZQJK^UEtFq2 zx(2m=DVT+6&2SBIvzMU8Lsz}vL-wHnCpu7PBImrvX8*vP;|~f1I~wSJ{;+->lL<4ZUw7Xmfm@t^CmP#Fhks_ zEaB}QSOal79!qz!Y`lPoWw zoWyXCQO67Bu@1L&o*26SP&7F1_orXYyHljNNV)>CKR51a)07nzBAen*1X2vXtEI^X zd6V3Qy-U6hG|YRqJuCmm%(FT#Hg98go1IufB*Zu{-aN2~5yxbGsyElaK5Aq%ei32Z zpz}qjfiSWhP|<+IMUCLy>Vi*fHfLhyp|^gLbD9xPPj27FC1m4`U|izo9PAJy{~Jq2 zJg!9#kY0W<1*-#qb)#3v_0JCsw-cl?p< zIu23$O2kvv`Bv`QXekN7|AUBO8DWnVBeR2_67aKzPmNp*JubwEctj91=;9+zAah zcbMwzABC&Ng$C)0G$;A?)U5U#nf`A*b{YGy^AjlG@R$Vj6A z+ITPXgF_JV1}&shjNJ`>_WOA&-Q-c;g)>u@0Q2IwZ#>`BpYU z2mu3Zd8cq}KYI!;*2>}W#(Ezg{D&_iiqF4U3^OJk_nVt?V*vz(yLW$E$3%c|g(a>} zL|4J#;5KvOIMYGstkVte+FSIvNE9kiEtN|-i(WC7Hva#~8kq@OSw`_>5J5MhFM4g~ ztF~4AmNX=cmfk2sBBp8;{(80qyd%kHeETx(AIz8DQZO-P5(@O{-p=!cRL<5RsSgwV z8I=eZu>h`(INLH(7%ZI@}t^YT;2usW>n~|yN_zU4pb*( zxumkv#!r-n8r20=nB-{Py$UP%B+Rx*cU0~9_wKT#*niKpF)kbWsH;PSYA`H5`z;e8 z9eRU_31=Du#b}6zDN{qUXIio27Oaod-}eDVScHtBZ_%=<%4fTCLx>gxZAOnuX}mTd z{Ltdcd;f6Tqe@ED2314;pk}pQj@OhnTHH5b5|O)POY4(iZ&5XMA!E$1om7-wc`|$3 z;ocbom@PrZ4V^_!09!i2N+HQ5ft!;8Movd)?WJN0UNmSPbE7pmg_dv|hiM>EBbPk? ztw^r|)A=DrfksB2F?$bj9rDim#G`Ftp+RjQ=1Se+48ClIk8o{P9hiGogFCQrwhth~ zjPie$_-2qUk``D)4aIN~!zcGz+MaSr8-#VZXXJW)0=u}aqD4!Z5Yo3!Q22saJ#A`y z`ucU9e#MVe0Hfp;RdgKL!2g6+hvGEYABw9nF;vf%T0-ayyM7I{oa+5Qo$lw4L8UI zkGyRs9LaFgepITwe|7)hq61t-6T3P3Usl!`Ym}kv5Bc|}6~%e3g@r=qAzEnPM?g(` zg7N7Rok5zboS=dd9|uqX`+jr%%Te{8N0Ny}()oe#%Zt2B{FGI_WY035QPky`zms;s zf0I5$n1hy?+)u^B*k4PB^2{CZe@T9azL>;6f%^RLz{xad8bi%iPi7Pv#}wH?`QBE( zgjR0PCUI=h7t@l3&1?x)Z?1~FSIy0A1bk9U?ubYq0l?~pixYzZdib5NXnYT%R1RFt zDOKP3aKsPD62YocX<<5Q&D}9E_z&Hz8ef8g%DpXhzMq1Yi{AS zRz9d8#K`E-Cf&0FVU_HzLCMn{#FN5yw5x>Il#J{d%8O%#I|6>F;5Y|NYq~WG`Wg5v z?Wov%r1m4?S>cw6KpR>1@s7;6Djj5`tb`;Oi6oK$mML}xI^JMLIQHc&&4aOHGLMuU zCO=Qu8&d~~l47YuzP<$R9$v zqNWZ5+@ZxB*H_wvhJrgOGd3*TPu&U@-P_iXWmjlBF`Kp16XtU33-|RL5{B|_{r;MV zC1%E^@lFYR^knODR5|V6!CBTzogx_QS1&ARF;tB__Uk3a^3r_|v;*gYxIW5?$@x$K z$F@91x7B!>FK~M?HR#H;*fthwpf&*uHZAc7oPBtAFJW!vY(Sg>=TQ`+ETCN+%fyuT z2i|GOn)-E$tBBP}5>w^#>tl93hj$f_H07WDoDmfP_m}2^a3`N3E@UiYk8-IbzX1=W zr60LDRpc|tC`%9KE(tysyP17vDbV{Po4?8M!a48hzwXa3?DTI9+yTEE+e^4HL?#M! zkBRuv`wSn1enj|@IP%ELWFw&+Sba0mr%@JOP0>5Phjq9J>UkLxAWV)qnkHxMY?8Ve zU8LO$1{)m`0bz*+rwmGQ80C1tfS}|J?otzrZ#kuq6os{~ldEFlXEcpnW+IFpeDfL* zOb%ckM|hPsek*LY+ngC4{;}%2g@F(1tUgEaP8b7d+UXm1-MBBuhKe`h_|zFWBA{N# z5(>-LSr(n72nRb6)c*`qxi&QA{EV;IBgy!^f2#W-C@4F~Ev+$nc&Z(+#A*w1pkNu2 z__(d=eieRlJ}CU!$y9g;`bpCk^C8L%Vs*eh)D1MEV(5g1qwq73DbsWMJ@U0RPn0j9Z8~2lR*afAlV%z@4FU_Q)}xc7rKyJ6}#z%bX4(c7Ncl|HLxr zB-C8sIQxF1eB`vFJE@aC3^IO?#!ls&M@Tbqtb@nL!;56?NQfK3 zzQyXt^6sji>Wi-Z1y*lTRLMJx&Xa);`0|thUfuZ^v@ zoSFI7j!eI$Mq{&VR}$WH~)=e3URDfN=1?9Fp5ZXk-lXHN$;TJwCu73b#AxZ zR4XYZS_q(^*M+u4(wBWFg6^kp@m0x9R|>yKY}_#f@>_J>jYE1-$&91z*)wayP9!(r zpjq54XkwSMDNKqyD2!Zv1l$z!oAA!dY}WDqh*bZ05*}*tycJ;EY*=B@Y?|860f%)Z z8{*4$t6pGQ5qFNV2(tcX0AK);gc&Tl>wdsXjfS9=w)+rp>)YbV@%{J^N&7E`Frt^@ zeG=!rH@w^xdi?5aG=>B2hP5`8Y`6r83pteHi=4`azM1T(p}UzcPK8N3?pfZug)z%C zP5)zMb*rb2Z;w}YuWOMVF4Zd~Yp8%?7OT^J-kF8z{$Fn0w{q7^tt?ERN&qPvOS^Dg zjE$fnP#ypvm{@1fz3ES9PTCp@Ave8^I?CGdYAM&l+n@FMBlza((+G+*$qIZmMCnq#G7t+x+nfJD1XX#RA6H9gnH3air6~DE z7Rf&6$)+cT0(iQN4b{HvczeRSAdU(lM7mg;as4JK4bO!k5Tw--t@ZrxS+fykOfg%P zWLNQ2`@#RlUjYMlZl0Omp+NySv-XQx_c7a^$;Dbn$0l6QNJf{exst0@RuQ}JrA@{A z1$0>bQfB|NXbEtAz&+k)d;+ClLT3+>{&pq0eGMm-Ja1rw9n8-VK=K>i8Wy8O!KfL& z3hW<4clW2nIU8fuMld>>s8DU>?vfO9NcVrI_h}*t zjg7?{qQc~ONR%0-kP$Z+k6k#?M$zhKIe;~t(wM=LtAcZc(vrBFPsO9I^WI@?v#HEH z=qyWB$A*#v{2c*@XUDR@DxhlSW^%uKl(W%{XFfvAO+Qi~t@hC3%E??|*dxn^RLN+7sE1rc(=PD5iNY-Ysb#4LiMgO4jf z?!5`bXyTOYX!{fFQr!iYI6((WlUTVwoVQn#?qkNbJH*>Z@AgexSzj+%1yIH4$VtSD z{Bx(BJVhY^7ZJFD1}8$!O<=(To=Z(901(Cs$zKY-oH2j)OML zS^rKD4ehdx70Jq%pQe`8zQ>=;$gvMSvM6+dxp_{1jsyjU9p3{W^0Hf=UccN}_Y zAR9%)s)_}ODa*;&%;5L5 za7)N`1&1)a*d$;h!bP!~LrRjg-B$x3ik-y^BxU=r(9ZKjq;=%D%ad{&Xed&Yk0nAL z3SDjQD0fKWVsuKjA_6&{8J?>n5Tu6!)uT}Cn>dfjeWumGm|L%T1fv8)K7$tC){s!4 z%ok>xePZw%@3)Hk(!K(hc==vS6XkDm_UZlV*)$g?v*jZAoUSPS1)1AZ_@sHY`0lx z{)dbJf(;J~Sx(Fe@0eMc!CV6xCgPRgfR@U8iJ7#E?|-pfZ1BDBm&|(`C@Um5t`-C zlZYQbP(?_;NuZXY&K-q-2^874IMQ->q4HE&2oAkq@rV*=k)WggMc;ZgmBC6Oh@}bQ z_xw}IfHddSJkYm_be_@5y^dgKFAiKInp zrQS~wXzd*D#t=;~ysD2{tT~PS{~A>X00-{7mR9vxxRAU0h8M_?;e%TiVcj)+5-X{N zyPafndmp_rwl6{TFyS*WpZFur((Kk57ePv>BHOcWL{kCSV8NchlzwhjyToa*PAvcu zU!!UdV+5K8Lu5~SLOX}y1-6Fl{4BGp0jJA>w7+V4ka#b({1wzM(4k7^sX599IFz;{ zP4^uxy^o!`%Lir|ul+G{(ZELM!n;i4Jfpk4K8jy-IBG5#0nv3a%UO`9A24DB(Irps z4p{>4ZV?A2fX~eQUj29d4WXO6%u(fS(r<~(Y|`$Pxh;$7MB{eWQiY%Ik9Z1$YM00p zIc6PeE@paS4Q1=21U25A+a4gFXZohJs?FLHQ`C!&i>A>rXygD9WIgDVmS!lU-~ z^ZvJQPU@qjss%cPaG=hAjtCK`<~9LVnsB+Q*?e-TeQ^HL(AXfH#H0P9Wd|~+Ah8#z zNPC6AL!aZw7yube++|Lq(A_{4?|5K z%CRnOYacZOMGqopz>Zc#E_T#OY>C(MNm1+E+JQMyTYv@UC-<{qU)@3XRLbqS9t1d zB81JD%=?Z|;)2-$yRw@Hpcxeed*m59z_F8or*Fbusj%}q!)ILk=kfk8_~apciiUkSz`a5`81YE|#CpxHFtSHM z1OE3M49ny3Z&eS4t&~6PyI5-&#_bxzpal5H=XgP~fL{B5C&iOL2gKqN!WziUhAP>1 zI?)F%af09}U*pn-DgY`3Cp0+5N#6Z^e7{){A?fy5yyxgWxETHY`(?&r{If6*FUhBM zR1{|<148167}SfuYbR=HHfm$1*b*r`2|^QLP8*V?cOXM)#C*e%04!Q!Bv+G+49RGh zqjKWrLJr7S6bN#XrR{oT7x%iq5HiF-J3CT|9Lc*o`M8zu@b*LgOolKc?|pZsSbz7y#cyZ6&5Z_UrE53Ric2J zu4gR3HjIf$qKG#2%&_6p<~Umsvw1&}5Nwi-KUq@7a?nmI$NWuA|=Ax=-}osgcHHOun4;PTc9_;-g8xWucgM} zGe`S7<|Q;eQ4+l3@Gl>`$Dg;B77mm*SrTF8qnb(TQ83<^OwCwd?Vw@ zYvN0}>o)*i`S#pMpf#I!hFew9yVuw0R8m0&5l(OHx6j(7Opb0&i3rNvpTCbwC6u?&6=M9YEgSK4Vw0 zS4L5F{D9_KBwD{!rtqJ}>;;cQ^KnpNtgH%zoME-ZBYiM)xpK5@7lNo{slEig`EF1G z`7W7?b^I$gI@U3|v=qB%3GT*{W5nX<9E_9?y!HAB^r~k)FSJP`OG#*VSK8QQQoQfD zIA{>tV{LybdJbPM#@I&R?n7Hohp9B}l#JggeuXU$cbK-Pevq4@yGda|Mlqa{qW%+- zd26ZS{J_ys2M>6rA`B03!4L0E65|6x@z}|7ksW}ygSuklyWa)qpXf2mSnducMQ=&wJvv#RDc(Wk$cZw zb=vN>l%JnD{mgjGsS$?hiJ-rB0358SOn&B+{-JSTM!h{5@#cdr;(t_Hom?NbAr)RG z5{c#WQ&K&e8t8YvxmYmSesk8*fa(CuaDfmhQw{avqG0it{VU8K1Lx$+|~xY zt>InYa29_@+qX3Sar4#Lhlu1^9NORY=Qu2d2Jnh;Xp&zcEqJv~3xaT~1G??>jvh0$ zzi%tv%)@N0PAZ`={rnX_`;-y68wI~KiIh3ROylYRauhx5MN&L}=cwTn44^W?nG02` zJuC@j1hv}` zlR2wjGr$aR&fR4imxTSwGf=-kOh4LvbENXN6b_X1m z>*5HH%PHzDd*vsn<{vg_@A7c6v~dFuXOg=zLtpC*o_}!`CRhgRj{A)IQhc&xpt>Nl zQwTgwDMkF>7KgW%SNdd75_?wnrte-zxbVOs&pSY1m3}+gDPOc&$d8y}kqQezFruY& zyPT++mQVPUbLb|oz3J?|YOGhoZTlU+!ECrXEXxNl3jA;!cbrP%!ByJ&8hheV%7bBa zexIbj4Y5uv4w9(<;$&R~%RkR|+o)od3lhm#Xw>$1UPO3SwpGone`qM>JcikuW8@@f z5gyhAYS)|9t(k1BVSsn5GMUkswTz!{DghFnPMoXayYpxIiQ~_Ls~D~gp;QyeZEqtY zgn^TNBf2RjUU7#rf`=w#w+;Cj{Gk!9@S{7d0W-n}O3HB4?e@NzacqSE-o>tjQ7inZ zglxo^{z$-cSdlmh41KbR6FX5lTSfP>68&U?@=un}H1;$=`fv@lD#REY14^H(6kH%H zAtrgV%Yv)&M@m65^rs1z(8`PV`LYK_7QvhE#^Yo(GIu|eB8d(W5M zMhhCGpRAPiX`yZug^-l_L6pj3l=Mu%e7eqf)Pn-IFG|rOsD6}%v!`=ksS1o%ItWeD zp6k0q^ANN}7XQj8wDKfEfm1UhU1d_V^{L#>{isxhVNaj>X$8o$@F~PDr}J5Z{du&~ z3M74C>KNm+a7Sy>tz5MCjq*6Y@@maFnnhY5ugnG!!zj2!C4q@AfrvAE0?yBFB1t$M zY&cE*3o`Slb1ws_0gm z%GLJ3&aG?zn^eaMTpZVuN!if`Wx;p?@&&b+ptWd$$j*S5+)_JwpE2d>lHWMkKc5?ynNYN>k4H&7~ZPy?7plB9T&le3I4ZR#r(y{&m)Wp nk?f4w%R4R(_cSr_vI#PV5+b_GU=m0UF9^BRM3|BB{1LkEkOZrR literal 32784 zcmV(=WdroFxh_FfYNuc;W zS(Dw|yI^(Bh95j9G!x{S4MNRPQ0q==hUD4HnyP#)-!+aqHKz+{?pTL-zc8Hr)m&WKEvOP2HVJ7ZW4duu$T#bXp5f1VG%FXa zKh61qLOZU3yN*Z&1B}&*p3Yt)vza^T#gOfhYUSBU)YY2Ex`Nz@2H#8F)_uE1t5sC0 zU4GQOnWEj(g*5MEqz(Kp-U-<&Fa)`;W2}g}cbDZZ$c29ifA0sf6t3t((+$ph$I|e18&PuJ3@lP>R zK|Aj2wu|70m7TRS<-9N2v zI|+`)b-nA%pfhZ|0}uaZ<>L} z-VYNjE{;a8l3a%wHanrPIHXe@-d|J4q}k?GDv%uuHGcCPH63A?Np;!vn=MMm0ESPA z#!v#Z^w=fB5a$O~h-!=pM*1lo(N1aBK<4_0uw^w4%@XC`31|>fF>UB0VXN`MD@^al zh~9>%rL&kPIuFXmrxAfORF*up_LfWZ;s4TsvNo(B#9}Ef1EuR_|5jk!9vg%@Fclzo z8uuIBNVQ99!APkEoituOPL><~mW-rQ`@ba2e;`X$X47D+sd+5fCKdFKYe^+I4}pR| z((3GzTPA4Lk#>#66rxiK-@7#BnG-A8qv0WfP++myirUEW_1K9VO&9{{YFTh>;-}+}eb!?Y#7|b00L=7-nMtZPFljTBTlu$bhvLae5S)CR zFX3Qct&Vy(%8hgtu_S=NUw1px;;#jJ(Q@9aHRRXri!Bc^^=~luQLu1NOH;B z>N~n|nG{)^`m9VHdok|>>z0j964>$gU*?~~YA~p^s|FL5r}`b$>?o1z)Xo!0VSt`1 zg0KNODzWH>mZWUg7#$EYHqkoFYhx_Dclbu@jum}~Y*qJOf5kibYJ66+2{*WTuwl}B zAwtu;X{SDainAR=+IbwYr=@PlkOH2j92Ur7x*7~prOy{Hi)FD9|LQu#4;$A?9GwE0 zxopgw!$d%vf+H5rSaM(rqPbfoYTez);lOOzhf$)Bnj*N>(6dqSwnQ|6O*cm2n2+1i z%&qAz2z{9q{%64C1Rtp-tIsu3Z5E+lpBpwzUaR$?Q`hSCmjw${%1xbD*I%|;%^Dqu&8sMap?2j@%TPN>NiO% zvGV(2ChigNlF94(+{%4e4|9C%&-TzY2*KcBg8b4A$_O|Cc;Kwx8U3%FZ)TS2r|y&T zAz3&@q*0=1C?_7^iV9|ZvD37k$Os_nhU@?oBCajg5|&fL3xSWG51q=nGZwFmSJ^8N z#a?a~fwTky(jqp(dcv;8(VIu>I0-ZDYvLB(C(aNwjsK~)RiNqOu~GnzqXVGDR(;;eaH(ki%o%M>IVTM*cEB`?HyYb#d^t~}KC z)q(C;{~dxHNU5ewHA)2vS8JCSbAnofqFi?Y6k(F5jxFG{)!1QT{N)1~E|Dl;tX@1G z?iF7~$X%Qc+8BY1)L*THLEC`0l=;}<_;KVpWB@e8FBigL#gX8r6MErEnGx-awA!+% z-o~?QlLT=A7~V2OBSH61rfguGb3wt6YCz$nat{*{Rh)dVEetL5)yRjhL%DI($zCJ* zJym_UVXc-yzaTKRP5mlj48DXY2I75pqG7a`B7NiDqa98SerW)?v-sbJg5PKf}J+Z!R0osxV=qF^YWnh zXhzpeCBxHXTOHK8bix&!_UsrBNpZbBZd%oq?mGhtuC-ydqH{5sx!{buXDW$3Cibx? zi|MMXDV0x@7tC%OQhKzzF7KZ2k*?hT{;Ig;vE~Ren>cb7C_L?}2)}%#u*>FoZ0o;{ zZH?VuWRm|8djuPX^(^bko)^<@V502_v95ev|HJq&yaB%96S{_5QsRk9Y^R4*?$1AD zI8BwqE$!o-rm1%stuanihHkQ-_vT?Q^qGlVUgle!g#Z|zjA)556sV+4!{ivW$AS|V z7f(m-8bRO%4k}OC^T4Csa6sUz6@h$#jE##?5z+YJD!?;|rZcaf63sQHIhPC7#5(Gu zHBmj=MbR*Nh@SOpvs(nxwo_o!L*q6qRxQcXCp(5Z678xFBE8u%NNlN3?R!J&2)~n5 z-OCQEEE=%vMPyyip;kvHq@$cMU8TG9QL-!i5xqqwK<;~H5ZnqZxMfAv7D%ctAw=3r z`i=NMitqlxnMwO2b>=KMUK}25WlMrZOo-8Ujp-pA^kNw6a3uTPbi`zw`4QiyOaDf= z`MryiWSe!2UZ213iP5Pf*Kw7*&U~!U2;>x>`lzElf8*K3t;y$x6~=uhAskF!uDW$U zCHAjXg8D^oG=AO^^2Y8^2pF?Q_nMjKA*Gedu$54M3zOD5i~ko=gX;b3WiObqI;#7z zh;@~=hLFs%+=Y&m&>@RW0M$mWDGE%T2-e?i+b9owR<*zj`tF&hr^5~0h7&syJ#RBP zPW*asMH86Cn2!qT4YMUqc{yJF-{Je$;SSf9!x`*7R(CaP&8Py`w?iXN6K+lmOeo`x zXHAaI4jl7us`~=Vx;GLEE2;&+zEtVy1 z|B-7b57rdL69<_$4x}OCeOcGecyZDiCEA@W2IXFPJZ|>vj(3*}+T$#N8>@qKp1K`{ z(4NMv_e>zKP1eQ^7-a)3oBb*h(I0%F?tNy38VV3uD~45s^T)}7`27zh-;i`qmt)^#^BMPM;f~Jt;@5p)Pw!-PnNxs@C_#YI-&gAD47`>XF`A>MII$ z|2D@-6_NVc*hdSyz{Eu!E1{DmC$l>gAtsTQgHf{9?DbgHhr}KQr;~&)p0dhX5>j)K zlS!XI&=xi$Zp$y9|AZY;3H0*A7<%#A?g1d(`6`Pfs~QAM2YB9#YD~m&`Wzw6mP7g39pT- z`Xf0K-okMeKi|q&U7w8nT(<4jGL$y}*VbklWnB`oPhmjI zb7}OoL?N2iViq5ejgCc&g4SycOBmTa?C_fwq^G=zmP)v^{4m&7u4-{4P{CiupZ}{} zQy@IuZR_x29{xO*ld&lavih3S&>^u9q-~JL8X&F^vZ?D|b+C^-S;f?f3&#n|54ix1 z4XmYF;o1^oYfc4Oy-|c3;tHhVYd=g&6ntYM%lb3;)}wTGfuXF09MXyCJ>gEe<|4O@ zpPr(RPZKfGfrq=$y>u7C4^$dR$BV1*6HVmo{i~=O7&8s3(W25D?WZ&c2va|fXR>zk z0p*eZ7u0;TIcXTVe}`AM^q5#PePP3j0;Y2=D>(k)1Ec@1^NI5rwl4vC&n~atL^f}+ zO-BK;O|s*lu@xt;czP^|WC3?Ud44TxfydnMi+aQuvS?FqBhagdAo2Fx$hX zM`_qxj>wNxd#SndjF^&bj21rM^ewv8#GE2+ni?77BEZ0ay$Y$&kM+;@y>Imr?3CnN z3%MYSg3(wN0X&Vfu(Nq=T`iku%vo%&Xg(5EwF5baVo2+O$Gt3@#)oJN z{=Kl4R~bvSM~{Ft!TiABdc13!<2*w)^!-$8WgTw>eX`{V1= ztRpp&yN5qCjjQ3|()wtI*=T9Lp5x@BRX+;`Fa>kBQXX3~0meX^`^5};+n72I0oULlB(-n&jQg1&T!-! z%i!zZ$7}oZj^=A3zXqwraQyFu9ACny{6m%E;LE^uK_iEt9U|jYBu_{xe)1Ov!hNim zGU=QB zboZU1M(3X9DI`Qjbs;DXu#aT#gzCFdGOF~W$F zvO(yqD&U{ePSkZV|BfCRUUR8qh~Atkph#@HTDu6X}IeCuWv{Ev}loYA?tQY;1;JZp}P7&k`pK+EtJ z>fGNHcRm`-oK}%W%~bOaE$%BC1Db`uq)w z!pp(E^GpW-E3KyoE{+`i$EX5q;}T-==+)CsYdV`vD{$lL=DmzU%{)Ugr76^=sH{Iw zb~Rr3;L)DeR01=3K5BT*CS=l1e-mgY`k1iKNn@b-6A-9x(srMe^sK^_gDt)1b+w55`;(Pim6_*N`% zr=v)DlIhw;=tsn6Q8XA+xnCPfX8F6c4{re;L=4+!gPZpaR18JrIZAe&;zriq)FPkH zhDsF6C;d#aeyL{~PqQ;?1amcGsJ;SQY4UI6HDF6Y2f;^#+0tg;0_M4e1t^K5HsfI~ zUHDYCR(B8Y-8kP7FaNxLR59C)s*%8r+GJGWuPj*}DRTQwH^>|Ld=u^M8Eii7$$Ac` z75;g#^8g7bNE*NfKGAf6Ydd^K%VR%@y`K4Vrs-mG#3W7JCjbxLa6nGj5=o5nx_s~tk1^I7)5#)|*AbKvuVsjNL_v8T>&l<}4B!+WQ&x|74l>+>P)^CTF`i8?ox zGV^WJ_+mIIldjTJpw@5=gm+6C!T3@$X`BJsbt)^FuvG@Ye_Ql3Scv%R-L9oKs1yx5mqCE4*UFo-v;8MQe_MJpJYiIg`_Nqm~Mob6WCabE&> z3uC~b9)al>@Uqgpbw&>?$bE`&^^M4PX?aWe|H_o_oL7j`*x}cy?=8hB^9y3kb*N6d z+yV%CvAV!Yi#rs}V*)d_ zApjTgC=Czdl>Y?Xy(H^q3~Rz31jMh7=uU(-%&Md6mR0)tdeyftcsa$o%`>k4qpj)1 zBq@gx*6Y2*Q4Xw5ij;I}g5+H*k*vb_*|6prf4^$V?T6t~1Vc!TmwZL*_(%VONcGYd zn7e;E?i$<;%}|-(VusbpRW^D~YGYHlRw*FBO)q1MH2DU#L)cw8Al9WjC}x9BzqdnRmu@1wjxJ*(eEJZ0Cc$3N1pqW6CCCsY=^ND-UUgpKD7)}!># z<$#HW-8)&WVGG9xc4?OUcT_$brVM;_2?iiyhvu6Mk{lGa)@@7pdkl1GZsB0@rLJJ$ zuEfi21+}33tD3W*S>oN4eb*4|*ZiW!Bn4U$r|fgA{dV;MPWGwZ5&{H!)hGzo`!I&D zXsfMZk)!SPyh@BbSrWW3Gs_bKwsV%K!xc&O7IB4-Y3Hz%V<}j`HEqhe9lOM9bQ%xI zOio$6{;LGtJAnj`ouM$GS~1+?D=Ox0%bi4%(#Xf>&-=9TA~3}uML=1_pgz5 zDvCc4;BKxX0vQdg7}F`E2kj$r$CAu5nWo>^NOqKmgJP&a%6{OUmZ`~UYuIEA%nG(? z?Yd)lA#@LoNn8yZUelBmRNAaL;6>vCT&_N$>~|bxUw@ZzOA4ZYAC@zXB|N@v)SsvAKpy9!TFbj8;K33%srB1orlG^Ger*clo|R3~gz6SLZsh z^~QSmLxxe$F97LgkTM*k22#k#~-)bhGSgPeO=m-_?Rpg5CmsfBpO z{u(bgF!*hIc_3?0$vfJ&R9@`=UMqheCyQcLUei~n;CM<0Mt`(4KkYG*dZe>;&QJ`> zi--sv|0gQUA20M5 zH3r!cg0eFeG%pZUhZnP5t#lSMkDhf>cKD$|VN59nBuvF->7=ghDJBp&Gd+*_^*9(l zmLb#P3M*ZZTuwruo;7(3?0^{Ior(i{bHOW^uPIck?ZlT4G%>qcp}qB zF!1oOEYNuY)5hzATa|n5&+jsed2zH4M-9kmpsl*)*^ZjopP&L{en45$!IE*Fky(5c z@VBvZP%2zxw;Ro93Vz3LFLU&ob(CE>?V6IX^}TDl_Y$Js57xx3l%qXa+FQ+>jA59K zR{s=?Z15`XBD)4W(n)47oeEY1RBn;^y%Y{^Iac}?F&gLwjWJ4Q6N6w3q2UKvFl-tF zg28vWBtQg>d?=Tzqsd0~v6vaX2;-!NB<@RzfVNri0hvo5=O&$klA_DTT0~v^xkm4z zDNk4H3yOYs*)Bk~9f!RECKkBb+-YWm6Xs}AL*&Zb7IFBVwHb@i{NgFoZ`}uGBd8wU z#El~II+DBn4=X;p&8%N9nsd?^y3}qOPrvQ**ly(z=3ww)?rBC5*Nw15sqEjej^>VM z+)XAri+QvYMs*iecwjpACu0@wf-#z=5zp9c7aG6|cRP_9U&*sS^#j1R3K6iCw_>!)Dc)$`_NH>6<#E2r*mP4O0Kj}U;4)MXbMY>jeM zkOzNL{j!&9@r~-v_^2cIc*7rdoNeI{;2tJjAPJis9k;tER7+5P^*zYQ`5ZkjrR}64 zSFJg(XJ0b;(JNvpK;aYql=WFxT``a&QF0JzA6t&{0$K~}>_owieuYH`Te-M3>O;Wc zQzK^Es;M#KBrX@|f?oGleHqdZAFWd=3KgUUNVnXE&JTss z1WiXj01hd4Gl~Pe{DCyS^z<&HKgAdq`vkWyf*x)I0du))EY< zw?{Zc?!EX1vp8d<3Td;cXz>Zfku+C}y;_ra;2x%rr2~-MN8o3PCy-x0s-X&|pn;Fy z?0PYl0x()-&YZh6_;JnnSB(6EpGOp(gYsO;omIHxoV|r+UPGXIO2f1vlOAI5$qJIL zQC?8Nqk}>*v={02pVw?h!Onw8htrDtYEF21 z=e(gc2z~2Ss}_h)5^)Gtbdfg88-{CDYu?#f62#ohpPV!5dnb21>>h3ZmFh?Ip&Eov z_!feU5@A=!aFA~pfPBaEV@~#O;+)Qo`@-XBFXQzbIBy<%1{evlek_V9Xwyh z?7|nt+(8YtpoCg5V&daV#RmGe`jbD<7_%%lYq*!g(#X0xkJ3>-cY0*$Rper9wSnh`@G<64tW7p4MuLu}*Xp9wnDz&&}zo;R5u8)KR@@uyerL!eTxq zerVQo4Y>^T%0-!9&!3G1#BAu(C>Udt-_HOC6T+|%cUnl$fB9bKj-Thz62l7U@@d8q z9pe0feQNOWn8v@W%U(=WlN4*D?hd@zk`}TZ{>wffxd|Doq_B827z}+QiQiz`b66HJ zL33l@&R|^4x{!F>7DN7jV{Xwn2TVR)(LIyUK6&W(a@G>AuM!iwGa12*AJ2}zWzoMv zes5}0F+K8GgU|uhthSt$QR|&QWvADV)}@_VQ5d6J;5vgE4{q_me6rRwvU2xR*Idp%GRf@hC ztFA&oLMGH6gvZi!&y>Oz}O)xVGIgP;kaAE+kx|AyQTK)SB^~jcYC>K z4Zu(x9+L%_t3d773@a5$JDqY;$esaz-zalVA1Oax3IQ(o0SW`652BXV`-1hY`M6Ie zUN8tX3n}U-vvfkigdbHT=Wnx47^JYuCz}_&Izyvj#sBDw^c(~xaKA~LbW&Lw?$y>O zaUL3@kILxEo{Ot_;*Fca$v5^IQ7FR1ep2n)ct z+;|*^#~_ogXOj&}??}RS!g@WSUu@Hp(Zv)zWcM|Qq6gWV}xy` ztDp9XO|-*Zj`3wv3d~kK%V4<;NP`F_y)AVhXzw2+!yJbqx{SPqrPnH0ulB)aDh+mC z9@?410LsXFyCcMf_Lhfg5`Do5NK%*04~s|G4=g~+t{t+Ix1{|GQKMB8jxre}d^^JK z1Wj;H`0_Q|j;H9t!5^f{HsTa(r2pA3sxfD7{;Exf@Y4?aCz70m3-=?w8iS9zDzJDt zZ(<0K*R_b7*2GKcu1bh3P-}ihRT_Ypqp1^o12kISZ624)mWrz%n1LF)OY?g_Jd$_Q zy%Iyhisefr@(Hmh!Nkz_dg51*0fFl!`>8mB@?c^vW{1CC1)}dG`s}SCjMi70ed+0N zF5?F4CeF=Zrd4wI^=dQV&%c4$$a|Gc63K8iQ#to#)L`PA zcwsTH%sL32?#w_pPeOr<;|e^)7CnnygWB@A^p{^ZKaRC(ZLoH+IN^|BscSxK_sQLyX>bG(5&laF7)Rp|%o&pGPxP_YKgY zeSslyV;nLEMI=xY?L~J6`0vU3$Y0{k44NbnIPtrOkoZ1Sn)iI<2vZ6CY!gGSah%u0HHw*&X_M$+NWLTZTgvZ`|-E= zQAGZck_s^!6DoqMlhI}8nP%cxhX8E$=p{NyLfk%*6G*}FDh$N9pI9 zIQ_3%RWYkv%t!U9=I&mHO`^`)dOoL?#KvyREC!k@y~hQAXZ>=`E244@G$V}&s#m}Z z`luHas*t|MxhVi$k^CZ9e14jte8bk>_cf~iXRA4Zusv^(F9B1iDJhaIV)U(v zQN3b-2=*aeV$=HP+k@6Lr;=~j76AvZ$?G^xippAm#Pm8#=t@nH__X$x4_jXBl=`tG z?7LCJc`f7!Lemq)ew|DBi7N(`l)tX#cczdaH^JNQ-DI+qMOR3D5YTz~WI4!EF@_1r zN#kz;0n#j2O#t?54LQ@^z2$>R!3kxWWUC05s^L#XsM%IQ(RV|mQbq?-C^vgdE-Io} zog6v7Egu>m25nOFhdxQeFvs%8$J}ppillgLdP>M||M{3M60?=to1y|;{^FqMxmeZf z^&FCgKr}wHBgU#V6X}$$BPtkN+C$k`zHeCj3xGtGJzi7&CDy&3XV~tJ(@RW(Lkmtq z{2n|lS>sy2bCqA}ZHIDF4bLyNuQ?te1;JeE>smpYG#Z;=Z`Qmy4_hOY;TU=(P|MB^ z*_llU8A5yhTOr3E1&c-uddrTQeSzD$@D=hWw8d1(Up%8_n^JibL$Wn?_%#LwGPet% z`9Ul2sfJj&;WB7{-crW3)_#_J3uA6j6%XXTJF9fLXjd9}n4IoRpi0cY)A9dJw?ndDDO!_n1awbJ_6B9N zC`hGtTKlfFm98@+5BKN3iMT{Q_~BIAroOHOV$q63Ti*MiC8Q||oY~^sc)&;}>1ULi z7jM&qDC)FCUL2k0(-}YB*GJ{6&k!HSFVDucTu4!=qj4*3iKueqH{H|;A#D-Rt=5}k z@w@S8SEeHDgAbFU0CIUz53(@|JF!wsDMqjr3y`D9wOp(%+|mPf&5N7N`l0nFQ05W@Co#XQHki8N7GdYyOkikk~_!)2< ziv;D6`2?K*8BF>ukHRJ$5*=w)u9QU0dT1^pNs^a+XFrd;75#Y*(+0s6V3> z8Qs*4iK)?K??aFC{VWb5OmkkGPZVe*<{asQv&!7%^7iKu;ybiS>f*jn!ZQpCo|x*1 zR1N1HNyiIQ@n3iaAU|SU{NXMNLVTCyvatdSbS_P%kU!J!sIqVD39b; z)9k3JyU@#$-SRD{Meg+2ZIpby=mb_NBn}7eQd6;J13YRLd+0&TVAH3Q8{-@my>4nU zhK4Zpd3z)7e0gESSv1!Q2TwKB<5;%qK-cR)FANB8(qac;dFhv#97=qU1U3RPz*c#1l0Ge4mYre{9hSchUHN zZ#STWNfPi!)<1oR1WjfUI6VPHQ5^d&=z|GE-Vn6Bj8XRhz z^~DrM&i7d93`@$m_f~PsWTHiBb>po<_4*brXtqEyTH9232D=gX_zfxW4+5Kkq2GM2 z&TF6C$+)&C$DEv=Z8G2Rq7QI)6ASqJ#=o3aweec8`(>(OTEB!OcVxAZd_MaVt|_47 z&GPYl`m`Ld#z4`|qbSkiqeV9>^a|jxBPL{f+FkmmF1qp)2IhgWc6eScaQ<#ywy!rk zoI{(UM^AO$0fP^PHYq%xHQL16tjK2=R-ov+IU^Md=4lmQbtfeb;my-*rQ16AjY7Rd z4dY@?>%~14sFEX;0>DfKdFI9{-6o4y0#xvL#ZH5hYjDk(l$yxHrY&ZMDSK<;T9}1n zpww)Lyp42r!9NO2RQ< z@(G*8l)FKUTvNA0^Upr`L?ZGYp=G4OLv;QMHXDalugLny1pt$;m?0hSv51-P&gvhE z_IwL7_eZRlyqQb1CvG)p+7mxFQPvjBo>=_nx1Y{chh)B1{@rDcC0hd09k9A;9bsUb zP_cPd^Htzl+hfUg-YvSebkkst9IX7CecA&^Rno%4IaUEpy&tUnz`gD$-H10kyhgF; zQ(_8UHc~0WhHqZ1ivxfgA{13X-piC-a8_eRq!K<6eEdW+s%lsLpiZYmHnV8_z=^_u zDchcC$E*}b&2xmcHlvF?USOg!J}Tn|j{f#QXP8`c)CKyU09zs2XrD8-FefXi{4bZC zB#4+3`3ItRI*Oo|?BTm}OnvEHqo3Lv>BqufsWSWHvVW(&-h0NFwC8rH#0@U(zU}jr z`QcNMx<%9Xj`DVKAm}4GH3Ns^Zj`WAJHrl)*ZM7z=9Qp5!(^+vG{XG4P=*%+Hsf70 z5u2L_C5gYQPhh_t3K9Y8K-1qXUzcpk#CJtf)=;dK0AZn4H8Dh9dj{I|=wG;f{+wm5 zZdotxT@DX0*#vBYLR;$@i|&f!^(gxy`iDOOKoD-Kf!9nE{PV&x`D-1A(RW(wI+wR3 za3GJ9STkEwniWqYEpUpaK(?vjh!*x15=(hp=x1T^?K1JSuo%HU5VW|5jTlYtx_vgta^L|z4}nB;qNo5zRvQrfeQ;C=8~8jr!f$eP~O zaw3HQR=j-u$07bG4JxdW&ejWywBo>*6-_E_fyv^=paFY)DGgmT;*F4!(E93y6Re3k zX2|lT&AjjnP^G^X|C}<=6`blmg&0BahhvcX=6q3?h{sL)5Zmi?L)r`aNmr8HUDFZj zBGYNeM}uKyC^E23Z0u^r+k~f>CwMq8L+R^=yI!qdEQn~MgECxEC^);h1FY07hKB9q4Eb)6p}M&WMv;jVKZ z8f4NLO!o>KNS!fp;$GkEV<_c9So5S8rYBiFR>~1~WHZ^n0z#Dfia)xPK1Z(V&S|44 z?+#|wwEXUMT+io~r;Jx7%!s?8hl`34)BS_-S!>K@HB&T_nWKjKD&USsocP_?6ujO_ z{_0hCMTp9((cre_G{>{r{BTG`Mah)yuD`#~f0lQ-8hCxbr?l09lu3|JMTb(CUB+#w z+{=-#MerIAiV?nA=~ER5b&@B=i*i@}l136@5Jm=Q`>akJy}+FZ*vUV0Vc&giuiY&F zqOWvRb6v!c+V=S%Go3)}&~?sH>6d5Dr79$jPdKI4A-rAV7j`yrjBKN>KN{~#RDz3a z-Tn-oqx4_YF~_W6v0MeQ5LjOwk3bKgNN>;o9R#06!*_<(?|hBDI||z)?Dn zAxIU0TULpdjVEfWS)mqTq$-L;^!kxBIiF5ROoA8^#dT0}qx}5Z*^ny{)RL=kjCZ-obw0#X%W7{ z3>`LbsaJqR=55)};95VedqJw93jPua0^v47arLDe24#PaAbLXH%@VVfEK&RE(7Yt# z9bGrI>P-xk#EXqSwf6b69VpaN8ro&6pf5D)5~ z@0dFdeaF5W+U79U7e6vRXVrOLB4<6%yrNoSZ~}!*Cwub^(XtArc(!Eh z$at*G=;{N_U;;luOdr3uwl*T&1tI0-8m7aoh#9wJ+^HACO*W8#B!@9etZ` zLNUfIFH}@vk)M$8=x^d>1v;J7mqu~7IorqAKcc{ZPKM&sn~(i_%>9+udPDV{t?8{& zruiQ1RDfU`9-tVc%a9Ce-a4&x@#fbz zxujjczfB-EySM1*2W|<3O)&AurcV+iJJKi@R>9}LyF}%R%DrNwh#xq|*C>@3qqvZz z|J)=O%)Fkq(>ZI%A>V58bVtiAAIRMHfy*OM;`IP7acsba-e_dOd1Y~MIP$(_oq`vq zV<@e)_P93JZCdPEE7+W4d~z+XnmMyN0vO_KQ{7vs!0Hk}DNZ6T((M1daDIP>WGTW83Hc<|M{j-OE9u10AjW=zJ(c_@tPi>a zq9b%0v>SZ#`0ds{6O8#Wr-AL%(r3zoza*H%T;HrSU8j)B12i~7{lp+5H9+n&_Q7EE zqr)zT8rtiZ`y(mYEMyjPs7W?iRDj@qBikkKOcS)UzfaB;YpRuanH_#KiE|OQV%}0G zNSBqSbIEMHm9M3B30T@H?K47lC-!gf$_)^Y?sZ_&~ z34K?17lN=TCQ5`1JUgPyG+w%K=@hjnFNLAZTCvY2IVh zp1^!R$^4UrqLZv+36D!fKOPA(Ef+_@9E;<#WD$wW*I}m`O?tBPU@3gi8KrzJt$@%6 z-tKcw>pyjC6P!oxZLHCuf^#8Tj4YsUO{t;|*d9vWF6q~k>8PKjYFe5aoJ~y4xa-v- zGyX8$^VPymDUr+`Z3C%u9)kuQctjmcSeX!(q_riJzAOK=iXC)ZXG&;Jb9h8enzu9$ zZu!}`%ritkK5U0CSqyUzj2?iXB4sp+DyP0in;hrs$^4cOEt{RQ3$hojd#uajHP5YJ z^6e6Z+qdhKz@si7=<)m=>g-Qg8|Tk576d9QJK1$!b=9evkcb%GS2E}hK-($q^76(t z6mt-hckS!M@VZx4F?m%@q7I&q2Z0s%nv@}3J*oDwe zTP=;&7OGv_K>T+5^w@Kd74d(j0kT_t`dn`{K^{thgUc2&$&@|k_ieBrO?q5DmB2t{ zP!W|(a_Ig>C6c~XNULKEb(eT*zXd8bm2PaB{B8QKgQ z(V%?>Cx=87SWPrc$Xr7akA3Z*KS&fFJ=zr4pA$4>wH6l*ouT%tQEUdTs%f!r?f8Od zBNcdjc}5*|JEDIwkWsC}+WVQQ&(fx}^OMVFy{UHF6&_C8XgwF$%%#zHXrPf=sN_ts zq*a0^33mUBjTz*g{n-()d?Lyrm&?TGYLnCo?>dVLNaYbDz|{hImNZ5;a!8$*S=e)Z zYtf=zhCHeyys<=T)`8t~zA0oU*Do8T=z%Qw?INnPM_GTDmlB@Ehk)}zfW?sE~FP=M&I8{a@Wsc%w z-;pZZ=Y#?7=1NxLS7m;II|7%iHgh<+eTc1G>b?+Ewk$opm z+AxooT63^i{#v{Sm@qsUzQaWAwG!QP)n1%#1hC1v|NG{dt{naS>UncI`(j~EP8FXP zi6AiDaoa&x?*eafyHLbT+_}5Z3xp|`2Lz}b^WpiHDq4pHkapkh*ko&GAE2L(>ZJ%e82fyv-{I83>~vPReP(| z2&;rPYm}!biuyLCUCW}Rfh^o2w59-TOW*e1TFr_qLpA4)z!a~RDI#8JMukDPSGjP%2a39$y9f8-#n zKbG%1ntC=n)4V*Mw73);R&*HfLly^T6$qC>ahR#e{hN+}M&A@Hz};s^V=t&Gxr^JM zgfy^3+WRa29%~w>qo|-2<&Fx%{)yF52a$#>a`RvB;x}~M`9&wmJ#Lr!7Lx)oCP7iR zTRXF?Q<+QruB#$+B}x4e+sQ5lDL31$;DuT+#2p`!E-=6Po&n@_O~zsu#&O8JY{~GJ zb1;jG)Kql`wpz^Igw1YH;{byP8K&I|=IJXqIk^#MTzk!kg;0nvp*HOD>$((O9K0}f<2(n?XCPXQ9gt&8vLp1JxjMd0TU&||ZW?C?M_jsIq+Isij zw!5$`C3hh#FG|+2{DLr;RhI9Z;5o+0mO%{r==@bQnd zm$yGTqnkM|4D;E9rzF0%U%)BxK21lQEIxRiUb_DXW$m{C@H5kl;|UO-3U6(+2mN-Z z6__!G|E=4lfx4Ffbb6Nka%-O8pcY~-NXwy7k}j7u*o+gr{NxV?dd;#um~5fXCAn%l zLPBc9Gxf?^tQIrMlUSBtl(7)djj4%5c;-;JyV|2PUdZgCe&AV*z_5hYI?M4!<1Pk1 z^DWji7s~;BKs5iG^UG~l7!nIm4@=8so~ax8dx%IhNE31ktYfN-`|Sw1cu1$Xox7`X z>Wy#%=Yl}*;EgzeIx&h}ViEZ59Pll_MEb#@Bspa~|5ZXZP@__XcKl{xj-MH*E8cj5 ziz|gw=x1Lb7dC5`h~6`+4@5YpSQe!tDY`TGF|+{ z639~?bzN&~@NwTkowUaxtvA0s^S96BZ(bB!we_{VwJ31oR6qr$D1L^jE8*)wCHP`& zl8cz%w^M%oamzu1Wx#0KNuGm$%SrdGc>Mw@U+N_~gmG6swHQY1Go@_;c9);?9GVFo z21MgRd9DvCcVNm^BfAg{yAL;hf<64qtcecL?f=y6%D^UxAC!=m4)=L^Fxb4*WE-G6 zG(+fmLlXJqTbh3?PZ8&UVlrHId* zGVb=wzv_5bv+`K0y|}h0nZ_Nv?$VC51$aVcp1x{rQpw&Ed0aee{bz=23BGbVEp!^q zZNJ?y)!O{=t4_sg9r={>0HHDmxA-F0GUG%@4n>u{bwqB6eKpror(%u4+Jo4#wQgLW(A>0#2I>Erg^_Y|M~L0qZ{$ zz#bwYF4{@#X7XuAT8A{D{#@1)ZH7Oa$sD0`KkMFNwj+8eT637n#fWPR9C@zkyJ<_O z*3sE+8|(Ti5W{wvu`LDGCG~pb0z53aIh=vD?eC7Ek=P5j*R8uv&9RU7H1g-K6vnY! zb#;}fj!HQYih8wZ+eV-K`K%E6>pZ~mI11w>L`xPCP?+S`Hh8E+Li{KUP8umDhG+hc zcPfk>3qFXFk}a`x0LBZEdl?G-LO^Lid-%t*dA+lY8Uk<$^Y-XPNY8mIM?ov{-Fhal zdZl}wjNPp}>jaSVf&6)`c~4p5&=jrtWWD*SAihUY0t$b|Zf&4CujWfd`){@Ulpx9* zt4Q*?jo|FqvMP~=g;&iXAKC9@~>M(qm?sN^`*}{esHN) z*~+|#RIlT=1DxMf(@j|V%Do4x3N-3uQB)Zau6_2emhm@)k zJK%8T7bNO=h8lwtf1|r%mYeJYBZzK9aXQRdf$W;{h{zrohU?6{MO`J#(*ysaf5&&Y z_EKgMtK1nh$fbx!3D@>Udr~Fppc!N!q*vTuHjh%6&K1pEnI0y_;}%Ku5)NVSzjz(k zlM@z+kI%dDap^BmWkoH{@z|X*3WxD(fdtd1yWhfRqxQ~ILTxc)HERVMTq6CLhsw}5 z=8n^SVA*q2@ExfRWW3+gjd!$z6e7MDj=DeL{nEQmO zq7aUDzVn(CoF@`x9H<{47Y&$yWkCrd{*`T1af=@0iWrZ$4v_96 zmwy{vGLAx38&Tzzh}7?Jg`*uzM~(DlcApzEfBtbuklnlvtSd`~%G%QDwd>Av%=6o7 zM?$*SJPn&~yAm9oMgjgLP(@1p#Vs&kI zFvyY#uS0;SR!uHwT_DtV#{h=cvQp9<3KVRWj1-gi&$rNu&=G{<@}r)(A|8VJA(mYr zy#7f*I?Mwv$m}Xj%oq^SkW$?=L~}e*ry%O^JQE|t-yPohm=t8~&64%rQI2rO0HG#C zGbGcy!qD8eT7W5iaZH_cE3z#A5@S1VjrgnA%!farz)izvXA{+!tIsbBk3+` zifTyhQ%A!wf@-Q7l*xLCS>o= zjr&Uw;J(C6jM$u8%RW!!?wB0S;ap`irwzk=UlwtFdFSlZVCVVx&^Ht@; z$fMXCLLN#ft~~)F1zuIJ(3gi8UA`*Hd*RrE>GK)_+_7&NCkyKRbFy-tE2?oRz_^tV z8_YduT8Y;e|rl>k`WB;=wU!jn@W9DdCKN_Bf{c@5%d#`~3{%4bZ@ z$DAjeiPl&|11rYsGeR1_yG)340zmbm9ZJEalwwx#4Jg1L_MW#&1kH;0!HFC+7%z^D`e|aD zpLizG_n=&FlWIbgd+GkVaf#d|pnL51J8q*}0bpvLyUO}vt`ec$Fwi(f%~O!pUOwzn z0tgfusNs4fRMx;AWt79s9fS%V!devq5idY~@#v;uUO?eJB!=|i?S!r--fju|v zcUVkBd%%n*=gu_(c^0Obf1uBXWkW*8@#UxqL26t}#nTXH0j-nO zw|w*`Vqvy)B{SCnlNI^$z!gQrjYjzzwempJ{W)HG0Rg zx_rtaS%GOZ{06!QmQ}$2<)DXyC6p{DnGh7gCA+-DgWlpxtXFt!@!^P#zr6sou*gVz z{faPErCelOtxMDeu3EH$OylvC_WCRCz~fOGuInx86H_NAmj-#I#C{k3jL3f(a$s2 zEq>eEw?GUUy#?)kpw$-fZ=!96QlHIAVs~C-c@Gh>a*T05JJK8|7Rc_LBi4wJO&kkK zLS7de!KT)|%eLwrQk6OopQv#Tk`uoN5{>_@=g_>;MZm3lJlR4uGy|vfuXbCJV6t?6 z)yW&DyOJX1ZsTNGX=csZPzkoy({B48tq5O`%Sa&FV`EYt8%b9{c-BUY!0~+_*HnYh zI6)Zscb6N1k5S@n!#7^8FEvp6>Ow=t$0l{`zha95dz&C zPi{j$$s0gHGP!e+zFX)u#N<<>`Ww-b12$?2n8KCKaBI&4iqPti4<-i~9B`zFfa=Zo zf6Y692U6j0dFRXYV>VmitqS}~cUpO^CjQslu*@UlO0Z{+W`lgyL@Ph?i9*aVC zUQDeEhyb==2>ZhlXQX?Rud)>wXK-3TCC(3o55UdvAnu$sn9FwQ>Wg=v1}JYb zRG}(8x~zzX@B=fuQiw_CS=804ng?I^=QUD~a#@WoUw$dNBbfsg=6}ny1M&~&2pncI z!Qr20#_seC@KpGWw?^FjSZ!mN0|rJb+(YiWT*ad_E&n#j0N@xZPvk82{q9Ai?7X6) zaTfHhvY&TG<|QJ}LF*h1-8%8VfxA{$FO;jJv(5W$#H3*|r|!qGES7!hpY#wl(xf=K zhJ4H{ZN2ihP4HW9bLMz*-E~^WtdCP0runh!#}$Wv%UZ3);KzIyQ_mMtV?D#R7UrTW*?zgNstB zH9Gj?B000+v_H+PRhN`11vA^| z%S_Tlb%kGM-he!Ep5XunxqDcWftezyaLQAnVXnOX%b1$w@JbS9)+fp;MBnH&3x#wQ z?n)K!wNE?yc?tl#-o<5MIzn#q&rul%A;CX~i}3sqs=SgdJk3RPkR}AHsT3vWNVT4$pAt*Z|zpJpIG*oq( zE}UK0HhHX%PY4R-+*wm2T7xFnHS)be^~v7dZB**bW>3*fe1q^u0;?h)#l~gaR;^(#*&bX+BP)WQU|p(%m{!x2y) z8_Y1Hii!Ekx&lRa%IEdf6dw)#3$%+BA&s9Cu_ya%UXDzC*VgQB?0l4bUbHcPKkR;v z?a650Kc=n4%?NaiKsp<#`n-p!WO4XbFySTbNJxo#dH}IF(|uM~0&*hxu+3Yx7~D5v z&vAM>sW0pb>g+M>rDXnGlwAh`cO^+AK-dnRZ(iHsy;f&j?OJ-z!c4cF?L6=YXkmiz zxiFZRdL2<{KX%(Xy(3pQiDOV6eqa{FFq+qMD+_-b1sq*N0uH0V?1bQooBEBLO1p@- zbsN!AfZk-Dd*|Vs*Ut}54V1kL6Cv^4m%aD9M z1t!mmr<@N1&na_r7k>OU<&qWkvb2>qfFw}&=_W_>UU*i1U*l8QFB;`?G5Oq#?NQ6uO&8drLjml4>e6*cR93( zi=y`XQ{ZXDbn5S&gi1*2syV5lW4dZ9GtH}u5LSWD?B(^O72|MS@+>Vu*z{%xa;?@T zDLnkyTva^vM`m~zCnk=cxLUT9hbAMUQAa}Uz#aZnQFdrLT0r0RXR5bxXInjH?A$XJ zFQ~)%ay*Uv=OHZ{417&1j&%vnJ|HUX9OsWmC^IVT%W{{b@AL(qnba=P>2o|Q72F+# zb;Ue;-~#bR^Af$NDb>}Lj%LbJNuV_F*{-i-L2h#yxqiwR1Z{woxD^h;n}lk3tCPLt zQEUyFf+UZ_^poQPK~#*D-DLd;D3>1(T~>I5Du2RAId?6Cr@XrBXfzEIyP+IZ$j6J> zrA2K>QC3@=7slV`r;g6mJ=@Lf-v5Y=M{QT1<3-cO?VqMaLfMO+55Q>eOu+e>r1GZ_ zfw4Mq7jdtfFK6;)%k3H#O2CpvmfrW^wLK44wGVM-RM+sHk--3!4Fl%>EZTB;e-&qg z`nY$DINYOIkOgaMH;SLG0x=bzS(Y4%$c&r5KbO}6beQp2izdiUN`)gU1( zr9CP`v*P5j0)+$H&^=X@5m_r|v=O9FuCz+9(9uMctkys)cOFkyw?N5N#E{`=-mUQx z9rQee;|Kg{u2VP5F<*h>KVO5V=++Ep@=1!gN*g_Oo&PKf0sCcw9;__kO`jlc8nR_b zFhU*<4fZ-jObuKqjjBxf`rJeFM00s0$QEmLHm;AIRv5j7{^R@{Qq%Y{=O)JRvU(^R zM2ab}?#J`obv)8m!jo$+Atz@c2H{8BpCj1D?(%F^FC`5HQ*;e2Oiipxcnj}}_7Dg1 zgP7hjZe6V4CnED@lJ9iGU%X@e&2KVp$KJkA`Fpj=%8DSP5uhnqP9Ql$hTF7!oQRQz zADt+V1wv2ci`rQYpsh03Ng<*c1QT|tb*3)P{peX^Ae zd9;EdBj%Fxeg=flJ48C#DEt&qDv`{OrH(4FrzA|oIJi|19#$3=LAWn#%N()1l0>`6ONG-6gCBy-!hnbecbua*y7hz zUhT_NXFt-rDD&Bn&Seg1Zd8gQq(|0JHHe|WyW6Gm6R@PB9e*#>Z68AD6 zuEQo3y$48s3y0F28x;I|;Dt8QCF+l*n&pxdhzy@(1Bd2Tem%u(*#kGl0#QUyuqw)PcS=-wQk}RK zenNjf$y-!XEafYu6I9v@&tN0VAdgmFREjU58pn>2<+&@~e*I#ejo7>!aYWKGKDZZt zPBM~Va^rvJm~-|bp3;Yu6t3iwrXT$uX-#}$cK)RAVw&7Ov%0WFI_FzB9LX)TdV+hj*eS&9#ax7`4Bp$^p%KfV&_K+TGLD6+L^q zLbe7us0$3uBi~n)6dLu*q#h`4%8JPnMb;Z$F^tk4XR3!fpMPEm89H4V6bnS8H4*^t zxLjSVZ*>Tv)-B{I<%@m0p+D=wyv2E@>Cx4Md~cb4|}Nw}Y`j(b0k6?j$U?+0A4|95q-EjdVYOoT<8d zKErjvF{lz{sCcVlFw{ zT?6dL6*L#*Ecfu6Fe>g%xH^xt_ZFTbLO{gWGdAck!80LnL}_3Zfc0VfugY6GcWoau zMZNK+WaDzTrvy&d=wTXm?46O^_2W# z06!AM{R+n;+jdY@V7H%iGI$mu?)u9@t!)K}G*}QZS|#PIN6rILyvcwptsUK+Sb_+z34GWy zWXzI8;!`F+B9SPfh%F=A!G3#d4WgF9wK(u7ga@!-N?P^9`zW7ufk-)gMSH_P-(?}I z<8ScziG%J*4;FNeqhqr7E)2vZGZO^{9A0u_?BP+yceZM87g{UD7xdj z+32I$wZ_eTn9LKl(%2%8a(lEvyfi8o-QmXU?+@8r;F%>HpaPf}v8Z-8Gb`06{I8sceL-Q?9I%ks^L^b&`}) zb)9k7JB2B4r#}OtNc;b2%ZMKs`|GX?^@Tk7Mwn!hd(!24S+cwH*%-wcyLGHPJ0eyw ztVv(0#)XEsvTn>rN~F-TE4}r;i?pdcXg%uF>U?s*cJh~D2LP;iC>+*J5v>i}Rp9Wo zFX}Zv7nkuD(WzYb_0F*$I{Ii|GO|b7NS$!$`>h5<2<#1W=Mab|<&p*I93JB+*mc;@ zS1lxZkbLl01B`5oeJ~OF+a2l)qR~`UF)vQd1D+7%YocCMVqW8fHQT+X9#QHmO z>}}wjvSx`KoV1xPrX=buMH(z=_}nOUfDa(H?2^8|&tkTw>=x<=f%bhm?RV{owQekI z9Pdbt`xaM_gKF)Io>$Y$7V|k8^oT?;D@tQ{>NeJe58A4f1wrzfEe{ombk|yn3DqDG zV$n5{3ZvTB#O8{jGA6`pS)_#0#m3C;j`1EDcSn(2L^I{5Z#q=Kx-fkE#gWgEw5{r| zC!xdm=;i&o$4B^OD1vkpfo@V-XAf4TByPH0rDjq#!(Q%hEYDiZ_;3gFDrw-E*}dZa zk1V2Ig3zp$-!Q_=tRWqoq#V6qyTf&v4l_iMlaS|{!iBlbE7Y!Cw~jud*1@C{XZ5Sd zK=OS6xWDtZphMKk(vR}Jr_6xNxZf{b8N#u!Bgp>KlsDv;?n%`$H+i~S-DkRAaMmEY z%5Q_8G{}JaQ3&>R9>k9roV=RdZWpE-kF0zAk|Ac1O>w0QL=eqN<=3;;{5?)|Ei4FYe3wK>~R6 z*dW3H`haWD@jDHxOzt}v1}%QpaS=wVt6dI$^mh9grEyUQeAKb;|8Q(Ec@^nt-% zGFIO@@Os#%43RE<@J8GCI@+v98Ob@OFFf9oa2V8&`{0!luX(YZ9~fzo-W5D0iTPil zD`A!r?x5YI$p0lNBFdj?B#{12X%Mw6Tl;t!yBepNItfay@11A-iF3PH5Y^s03aE$J zou!gj#l(`+VU28u_A0>D0OHlVC81Kj>b{`E@mQfMBtt&Bk{OFf1ngiW$+9LsLrzRCJxKmN(&xwQ{WiJi{aDau2+Az>GHc(Z|N(U9V%l>=w zj={~hq`UvKJ@OU#SyaJ#B!%TVkVfycc2-dVx8BCEl1hT-r#s2wZ8JtW(|PpLSU!fS zJNGmq=05XV)#7d1$qhvjYDm@;5Dw2Q-YeXz?xtr{E%?%AU_fz``4dk>f$+!&q&2IH zND$V@C(TFOV<>fD{sqVu1>b(LGU2_G)r9EzOOYn0owft4HIbn&^GJ-;P3&^NKs)CK zjRt;VwoF(!=WhXB$#NW-ibrbrGXAG_M5zIGuY=kdo2S~DW=!?{W~ICgp)r7=rElA< zPVFqixnq^#i3CR++j}IGZ@#{c(YL+JT8v;@6+%ct^HkO?ZhgtK4?9HexFX1Q2QFvS zH$^%bb1M`zEFZ?K{bgqkQ&+U;Af}^Msvz#ZpJNFUv9>wHV*nTJy$u%SQa$YcI9jE> zK5CGTzY*~Mg?uC(^*A<~q8Z}&7ymZJ5|=}fqTJj5^?(Bw=TDE#3BNNd4jN$yw++Oo zC&BbXt3`S-mR;!%L()brmbbXGu2g-YiAt;O>!)K5#!g#26SnAh=5})Hk0CyZW~A&h zQ6;bb9}l_4pttXMLP`%gi^bQ<*YsTQ11#2ws`>3O;%h_pXM#Qz&3->N;=3XP ztL1iOfKvAz7|}U&r8P41tTp++TD=7xK|3Op`h})ctl1?^}6lp(H16FXU>s)yYL(bG+g% zuk&Ia2($|AlVSM54nKX=lG+{6+k|Ev)lrF$m2xnldUh;ye~80jJSZzTuK=$(XP&pV zy9^Q>OwMlRYCStbq?6hf>YHs`gJgCl{d-W=!igeQ)qPl!goONjo#a-{2Ko5j52LIu zd?>U&^MY;YO7#?+7K)FC<1}D6!yME#&L<$ z%mksWq|_b)A0<{F7#g%_)%eL@_;+yV-gaQTt`2pxvF|a2=u9ErQ0$kMw)J13^I7fm zd3TL#M{O|vhs+D&Kpc&sAp63=PB=;2SLz{2(W8d_@52jIbmtK&?+757_@lLx*Lswf zY4!`63jGY2n6g#A2Mrc?YtvnoEHUR_S4!}rrY|Gn0fnX(rB9^G+nu|7;JVYlIJ>pj z&Ntid5kt`K3~xfrhmf(lnXi^0|AxD#D|b8PO{F8%_MPieUdbO@>3SG2{Gdk_`_E{I z7{Ip#@VH*fDBmD*8+AupKAmkW7=Q%SC&-laxL71M7Ht(i@7HeI4LZOzn< z9rIUcxMyI04VyM`bJ)BG^gLzU$mq7y78(-2s3@5eN{p~qb|DJb6$!s>YacoHA;dNS zRt>>9a;tzkq1bm4>)?r9Vb2iLD(XC8Jq5VM3G9csR|}1`#|N{@F_GI2*F3ps>4a!g zuG11~iM0$n=@8n)V+^5Yj&68st9(Wzvj5%#sdhY1r-$NZ*NqrDxt$eyCJhYIk)Ex4 zG*0psm?Rx~Pzec0*mlHQ$YAmJ??85za;_q`g}u?S1f*V)xV;N5!kuodoaA^zC5x6S zo4E=h?%u96zEM2gSwfU__GNZ*+bR1Wps8c16R|dI;~`=s$je~ddfB_oA}LK=$u~|ADqJt1MLPrjsPtup zp65@q#6tN2@I`TBj*Io#r2_IAC!&IPz*#m zFf=Hdb*jIQPkjgwNa+QKlk<{BzGj`8rgDe04lo(8JVXMj0&S07S$2&-T{P5zX&8v2 zPEIL48>}y8YkF_B1Z3_^+F4>F$>vp(gEh(eeO9T$*KWSvgGC9USumbtEloL6$hh%? zesyP$1@q+_pm=wx4%^aU)yIRUclzzdyr7<|6SX2R;0xf)QU;ONMh!?wB|O1Ag-Cwu zdCRrWf)o?t6-i9aXTC=8q};@>-tR%4|BFz3kR*<`;3#I!Fx(Ycs!bS<%0@&Mf4dfL z635CE*4$0iIajW0J?%8yx%H7v+g~^@^Z%yTWK*oKnzgv~JXPSsLu zpe!vE#_MnYqlyxgrK@=0&Q}@yd;-b}Tc=G2NHX^RTy60Hb-jBnYX=V=0)c|Hm%2N& zuX=*!Hes33aTFfHU6y+d?1WGQz8Qoce@t$C`~p^k(l#|<$-yAc9Kv!;RzGG)Mvbof zwHDSC5%T&@Uh??K#q}k{>`;sQYRwH;@T|GRGizlJAP146L-L~qx5D2s3A^vcUO`R@nuW#LEwR#9`N)HT1H&nLV_zqsO ziZh}$=N<_~r^XR8Oq^COwvSZr3Jw);0GwD*n47Qqr~YK(-|E1NHz+-O`R?GkR$qHwobY>ZJj(&lPl|{fOx(wu$S2@Q+QM+F zrqL}WH6Ii=7#5tFbCa=k?+b3p+8}(}^&TUOd1c30;EEKk1h``#>*7*G-@d4gNH8KC zCJx|u&a%%zK?<^z7%)L<{9gzz@p3@eo=1Yli;~~rP+B;d;#>8*%N07|7=~_k%T=LC z!=#)*!69>7v$m{t-6p1hlgejI$bH$M^zJ1teGY#d&O~@&kI-aRE|$`_4az0E+!Rzs zizQy0fR_n(dOy>KSwMP}_od;&xjankRgjQaa5Ie~5$T%=Q3$&_g=x-?6YI^1y3rAX zcmR&dP{D`@0kY1F4tn#LOHY)p&T_*pEg3DQkNYi;0iy+vZnW8-kpF^EjzzPi8L>lx z8pPC)wOQODq)=OpU>84?>IMg;yMqi>l}$TmHuJXd2#ne2kHXcN!LX!GHA(rcIdsk| zCTGU7%tEIg*)SUUv5{Q$c}XCQTSulpQt6H_h(M8I*3`FL<*xQ^+M|L<@CgSx65?VO zc781t{Jk(pj41NCzr9oJ>5UF{Tfha)Ber>9~8DLs@6Uscmp$!GGJ!8$=NGV|uq6Fee7-e=KempJOC~G@1)>hN#$?aJj69ddi~dKb!c>VJ45gdl&z`Q#?GmvU{Ey3yNp@gE zfC$hJ>{&XtTy_DAeI6LkNrM%q=fxH!mT=^kpO}j6cO=Pbb@^Ok zML$;)ToAIAR#xOoU#&u6ys;_U;_m9GX2qP1w!+zneZ7zBJM_dF>z|aF(<%*aWGaGLH~^@O%NX{ zET8^}est7?bLBL#R?~rpCpz1&n#DtZGprZKG@iP10}=F5_J$j`H&z2p>bvQT zN!w!iQi#g!CDfhcQ3*&NZc94W$BGS{wz^j5E~Z0*Lk%VYR~41iASzY4|jgCEYrUoN2( zG``D6#Z+NXcSL5gZUH5T!T1~jBtuBn5|&yxEuuLSIz=1jwCl>{E9EPYdK_XD($Y1u zn{VM-LRf3ansaKHV6l(ye(kj3ekEk~y6gbg14|&Y2RPn&%1EIzql!PB8xy8CuU9|; zMhG(1`Fu&?uq<=A>PN_mm71+k{M4fes;dhdc9j`YN0Vh#Pt(pLhxPXm3s!-GD9N)% ztCH$ZC6fC4?VBJjsxXy0mwrND2)~@LW}MNCiT3}${e&1T@cD>1fPAtG)I6F@jJT3^ zouc1|0p|)iJvc?G-4K5m6Vg{WaDdcUYyemJjNn1Ts+$vK58jsY(uuoYaWc@59+aQ; z&0e3?R^w8arE!$gQ@I3YoXFU*B`+(q#ZAj?{Gr{fDyOK(brK{12Ua41E{aW8PGFb6BJh^ zDw;WgL4HYKR5iRuo4WBYOeQnoO_--S0tg^yVJ_z*L^hRI?Yy1(;e(*DVJp4{W^8sZ z(ai5ML)l>Lu|kM7Qx~CH<(~wdMVJv(U#kXdqM7qn{x8F&6lkMhFb*BDjUC=vH`iKp zv0O9t(H-l0RuUOa(AqIVm2oFy{B|*<34d3n-g=SV(M5`lJ<4^K1(Gz4sUC25eW0|+ z(<+AcW3pl8+ahnqZPQO{Q;ewKz%xcDc^x>6NV4d(;xOsU<|#RFO6AzLsPqY$cw%mhS%HxG7dIT(yRer zAx05L&tU+1kV95OvcF@rrs>^P$3?$Q<}8~5^5hLS#?^vVNQ{O-Q!9XtN>N*p)B07E zJgz*xT12`C+AXCB`1T@h{#xc=$81OWTU<$$6&(TxCVOz#p4`2KvnFSC`(-%BBZuxUk{-60gum68D~ML=SM48Gru2^t=)a2 z_GJhv&{D7v2|bf@uR4-7iZxvf6AH5V-8z7E#K}i|kr@1j-_5UxGsfOO;XW5a<$V@U zju2X@1h!wdw&6nz*ezeY^YeP16#e)`R6(ai>H|JzdSU8#K{kEJ?u|LEOjn!YwmLH_ z@L|s}c3|G_d@IjUhQkN{Xd-n2K`wxS4IuoU>*KWP&zi75Hm9Q?W?`#u^>TDV{G#s3 zNIL}I0}Yf7z$h8siqA1HZ`Wv~ts6eZVbeOw*3@R1si+F6+5_InTpFi&^_l#UZvdTl zB!GETVqwf&hy3s*L3aVPGm&w}N|Hr_|A2}>vm9qoP$!QoIc z7e_q(`d$m|pF{SvVU_R^=2Ba!bwX#yPR^8WDqR)*Mx#NLwr(s2eDgO|?b;^QEqSZs z4O-`u&$6C%4m$Rn_VOSz4I&OO z#^S>$rPRn{WApAAl{xi;2#>km_@ruRs|$}hZc&7PJW37fsZF0Br+ragF>UbfP_vO*OC zUqRk;AxNi&VYl-6?J18OT}?y7+^UH_&fyQcEI7wO@Y|nA&x?!HF*?e%cR_HRe5xuCeQr@+4}s6lhGQf^F=Hs5eZZ{`2p%Y2 zV-`D8HF&y~-zLyG(r>#^@;6a_g+BaR>rFxT(^ zrozKG?nbzi;A(koDp8}TOm*?tMaO_#1cU3#f-x`@eX6Ht5xj3yn?m3hrf~(k8ZX5o zn(8mhTw0Nlk}-6vmrJEehA%apbC?nc#LnnZrxM5VK&hG7tD!Sx>@R!1myQJ(jVXs3 z(gUBg<7qlGODbQ@{Nf|4>!?!CO1y0>#22Xwlh9vsQ2MF&Mi^hnNB$T6+$!*EBpy99!Owi;d@hk?F-ew|y@L)(7(farY~e`6+>))|8n1%ni(THwH{` zuTU0H|LV;fF(w@xvvkj>l8bIiojjUrpFG(|_qAkLzohIq{CedpMSKmJ7G z(yj#Pc5C+Wd`}SMm~lJ;wb2ea6WNJc`KO%`2N(u%9WW1{6&kC;=3f{#xcVJXZ%qv> z)V0yfW-SMd$ouVSRwNJL&Llt=i4&oa$XK48KE8t3h*PM2-SU;>7x21b{m&tjR%ON8 zi(KG3VWFGL;Q8_yMD~Nx49k?taCJ?cA<845d8#UDJeW}MJ%6TZ{0y8diCV8%gaoJD zeW6^GukL@wTX1QlAQk48N&FS}$_h{COjUhF%s@oZ>^fGMK2HxVC0ihpgYZn+yFZX3 zWxBw)T4w4@+q@Wt|DW&0lY|YS4M$Yc|4{+Z*}n7t7J4Bjyi|4egL=-ee12x&DHNpw zt~-h%+MtVZPA3^jk;IZOm;56f<#KogXE+BP+_rr7vDZ}!@v_R73&=!ydmq3blNfYM zD-mFv1?;fyk<3OgJ8pSt3yYie4v@YsIendg){yt?BTlqfmDbeAO~t&WT97$f7Ga~3 zp!<-YS@Ws*)byy{|PvJY5ZwTRS^(lgi8#|1|EzCEpyUP&p0gp!S|GvUXf z#2qu6_`C;&GW?umtqIL?`vbQblo0R-1!3s0KEBYK!IN*_=@(f9q#YTLK!Y-8N44>W zNyRbkw$v)qn8ss5&`-B|Ouda6Dhd_< zRcD<2gcI;>_Hy<-@6oZ%A3>i2UO#!nteP}ep z7#h5MAonCN--yKRXZlrw|Ji?rzGO$o`tn@z)2w-z9=STgQLTyZ>b+CNOye{)QaIRi z_|WTz@Zh4oI!Obm8EKY5$s%|;k>Z0cj52$i2ty-hN~4^eUrfdfkZ$179J#>Y^Jl!w z5F(a|m>FmGvdPwwZE4qFSRon2?ifgy?zzA@>6 zT17UXt)}Ljg*kv}O!olemh*OID}TCoai;H%bEgtvmRpCro7}G~LM_St0;;we)C!;? zi9>=TlE$s=_#{)jsZ4fLJ-q!RH+K0dZJ|uZ%2EBl?%4qe0t@SHZDDLJ`=~%%FUpcB zB{OlpJ7kMnSDJg*5y0%PXJ5zd;tF|2)Ah9x3Itp{+9iLN!}PT!L%aebdQrj$OtBvG zn#sQ(7scA&;x0Ynl^n_AL7N4Ne>p>~)7L~OaQb-QD=qN4L=J~EPFU0yKLBQFNJ7ex z#lbM!gQbnzH&(P=U)F7MAA^$ip*Dj5U%9!nvlbEB{U}$&Lm}qhD&H&}x4D`#_qz~3 zV?F(t3Y+C6bJn0?-vcisT_<%?PbTVZwg#hOiTq}bh)N&t<#?y)%FCMIr0VENz|X!B zG>5d!!#A+3$NTx#qi*Z&lpi(9o5D2r}Nb^>6sLg^t zz$UkbUw*Jbe5SBa^MOxJ;=n|0K#+E=hCxLmLJzJlywZ%KYI_e_peu#hwd#-Mg1>}n7ZoY8RxBR<}9_dL_5!U(%G(}$QwrkZc>`% z9Z{RZzLykUBWHU?1DP}HnAS8KDK-O!81FES31Dc{7y#H^06&`=NqkCWxIgOF5=5w& z(=Vt!c|+U}#yzoO_!Z$rUdO?}RwBXJ_;MH%P_n9sY~jn+vZe$#2>BB-ZUzmN+7AwY z#)7GMtyKwrXBo4Dl$l~HLdV&L&(g~dJYhHNyjv?){au|8cVW}@=%rx&{H7rWxOKNeE2DyQ z7RBw|)u+xcBzfSHaeM{`8U8b|q+B9_5MF2O_*#RkPa)JDav$yFYvLd(SWqvRT$~i3 z2Kal-J-pqI{mNkJDpqy60g>>efXte3sfd`6>0Agke|gT1Tpk36#i+VV)*Rh^-kD?_ zr(BYSA3)2dMSlpHdqrYeLDv;6%@;?aXgry!9+CR&qtFX8hBSsbT-j05UTxJ%|BxyP zfBND)j>N4IrSG>PkPfG*w>ShatKZfI@xWumWXxf~Q0;4lHb-7HnDCWpPOe*2$(^rZ zmWzabv(W!O=?w?YVqA(|8E(J=dHl0(!$qv8#?i&uGcK-R%rK;XbA>*rSy|c?g)FM? zDfK+*W#lXe@m4ZnH76L;(*Fd+Rp!=;eBs9&)34IOKc}{XI@ka%#0wtzNX{{N{UN@L z;aKDp(lvT?KhNHKFM?Wr`=bvlNlBC&k-(x4JJ6Jfy&`nFBY{p|zm8tUWd1@3pD*uvmBuh4G|4;)&?Yx+D|f%+vr%VpkV; zc>R(1v2GKoD=m%Th&b5NX{}(YJb11%Z(>Q)+C()V`VnAX3rm9FGc1|Hgx5ygI!# zLS``kT}^PcK&pJt;g%#Z64+}{Yu>~ZNky2(oim3MUO_xBuFg&ilwif&Q9%b636qH9 zxHW^=Q(A(Sm8rMKrwM#yu8V1av{OhwlnnJ*6}+eNN@>ZrR;#nLrx>8P0?|*Hv19qY zE$FC#YZH15x!vgElz?Y&m-v>m3S06DrK2&|0@vc$Y~=oH$O4-e-wpf9)j zS3Y8QY3u_qtLLqVBqic$a8uPXwKi}_POrBx?|s?+yvTMrN>^`SUva){%hXs;!8aJx zKFrp-f{U>ord*c(`EyK@7loY2YKutcCi0Is$3nx8$64rjo1Vsrxbw*DfE@w@;03sw ztJnn(Ogm&OjA#x{;zR(aNyOLcM!q3|Ntm$>CdM;^k*(Cnu8Q#2mS65C_WA#>zH-j< zJnBk;{1)u5%Xd8Q?1H5OZ;z_%JIRtfDj-y&v8<`! zHdZ$eYHy7^b|v-)0x|5qmAz4yIXR#f1KYb}i28fSYa$-5lQQBDlE9}`&A_jeE}PCU zk~ zrBuB%l{x1MQ>@jwy}Z_dtz*13LA#~RCttWq0olt(vGOZq4CGR{qfvRCf=vxIiZUxbLyu?e>`OI~oBg{*0jnrd}u=JtvIo=sy3&EvCre%zTHm zGmhnd=`7M+SA;g!VX#SmzYTOymcZCJR2K@uLX#J?UX)M!Ejf*0#NE^f%U_xc!_gDuD=tSRHHp#ov8{v>wy<=;JB+6 z^z}+MI9di#E7K?tp$DOPCJSpZVh%sPn(n3Ni5x8Gu^AZm=i&^rM(0OF$&J*`!?&5E z(BUty3fb95C#AR-dq7`@&J5Yt2T>~p641Bi!81YFOJiGja|@8iPrJLMLsi2UDUw6v zO+gl;18S$tj;LM@;fETN_s-IpJazU*Y&pD%;_A!sPV&9gA7U8Nf;>7noQ;^g6Rim$ z^UmRBMy>$InRXT@Vk;81xlq)CF{rC3D~WDwPk{bof7e#DE7kFsqQ&h|pY>JCrC9sc zxjrP)lbY{|o517EvX=f4Of$`==dOs;{h|zjp8p4E-@oCI)YSdmN!=<0(2LMf0?h9L z_ZlaCB0gftIuiq6T73N-_-OxX5`@|2bYc9NEGsd?@EDuLmv~ri0S|Y4-Ax?^ep9ey zSZtPK?XMxYDcUA$6iW&0$f4t5+3@|Y6YUrNzYtVMtDpy%HLj~;qKz!$n&Y6T4*nT6 z!vG@Zj`s?1AWbet)hOZ2ZF+gbo!*Ed_|&gXPx(#k7B)pskFU@E>w09-?5>5wBy_*kxn!)T%u|j%HMj z#5Aigo#V&_^ZU^UpD;J;z)X9uv#M?9=em;luqmG^G>$p@Fqyn{UX-Rd#Xvo0NjN4w zl$$=Hfp0eSv)bxW&6#x15Y)JoZfOv$8nhA8e2Q*eSWB0KqxKZ9@}rQ47+06V32z&M z{=ILzkrWdw@cv-7S%hF5H_*L8md1LJm)dA58|p4AkkPDLy-8>ZSskIQBne9BK&Qdv zhysHYPhL5YotSC)$smz(a*bzOn!4%D$OuD+BkdHXT43KCe6Pbf-du5Ji4-|b}+PG&jfPXQhwH*C-{n;{Z@Ia z4L6ZqBz6gMS7=Y*7IRYcIdnXxZKBrjaJW6eKj0wp#hURiS_uI$r!jfgc%?pXBr&7I zqjR;zrDujYDL({{ZcW+u6BOpPTAm`Qz2eJ-oU_dd5+9( zZik>>5Y`S#HW@*QCD)QNKs_}aJ0mubx&5qFScIxs&2vrW0lrVg2omcnSa1F%b`H_+ zpoR1C7oa^&_V~WRW$Q+Bxk`FNU|$`?#11H2S@7b9Q6x!O+;wO4?HO}~ok=UPhK@7N zDuFH@{~u~$ty9<*W4T||tBlxF_s^24_^1!Z;kvkQ=@)eUEWn&E+vM;U{E1ehx0OX> zrBCDXqFuXVqN%)BQxzK?H6mAG^G~zZwRo@d7>8=cc(i^Z#v-Xc4B7H z*9+6!LhtjdZHuZjq)G%~3kiDv$edoc35$Eu@9g;J{xp*mxQyTE&|Of^i^USaMJtIsC=>$RAWGEynAM~JY9F> z2z-4<(Dc}_W(m%AdISsVb8g?;l3%^)bHdq6%PRa^+oqS^IFMq-7dDFei|h zoAz_3j*j7^RYcm}0lMbDZDgpv4UjbL^MDUqy3p;v#B2W9qK_UALDaAS6oi()Mw2}0 z@PQvXa;H?_pozQ2WpOk%F{+c^LxV#h0erA;>-jc8!LBQh@Eiy@?U9bbs+*GC|N11w zrv*``GgYT3Bi=&xJomnHPUi=xRJ_BE7JVlO$nEs4;*`V9JWbC1ptwa&#Eg{VK@<+- z&t#S4K34`C7bXu5lY|L5K;Vy&0o(i(7ObYJ!z4|{pe5=Ib+wW^72gWENSinO$_!r) zO3OL$ZQcJn7I#QKjNYu#ZU4vuO-1{shKEUel7 zyDk`$CAIXFVZ*C#5@z4@t+3)I!m1gP7Ae%kjk{*$2<7JVr>{~N?Kqeo-Y+8fSjdt; zPtpf$Y0k>%pinh3?<6coFH#aR0d@B;PV3%We#QHt&~?Yn@1K@d6s|QrtkXYweTN(R z)gfKsp@HzMXF=J{N5A7{=8%MmN`P;aYd)vke_uSM9Np^Uz=gn3v){23$v0C(I)AH< z8yFBz26Yc+wO@OREJo|*POI?SVXt7w*lCBp2f{5zB>4L3;E;q_w&c7ry1I*dDoYPC zF@!p}>(XnMHh1@PK+~_Zs86Ou+{QJN?7Q-*E0=O{gCn z&s)~Nmru0@swIOz4os^zea`|+$MIuV?T7N=YPjZrmTlE7xcg4$whw$xao@bSRhBTa zPLK+80t_e>Yf|y}5|+H!9aRZFAV*?|wO*MC28|2`n?N&O{@Pywf0-ClJ6Fk}eMy6; ziaP&Qe?xzWPhLOI^y8u{cE#gs2^-K>oMB{r{dX|)%oVqcr|P|OI3#l1u`PMbnd#mcqxE>uu~hx&>Q>=t`!Sh%&xJqchd&3Ik9%zto1iig2r8 z6$u1Euw15nM6eWR!cZjtcUaqvMqxBi;@ea|!+ISlB*O7cW#2VmJirdzz2){ljfT@$D;{TK$cQZ01HerXeqUb>r(0WbOZEs^pFk*sTaET3U}D z2Hj%nCc5eO{*VjF)iQ?PW0!bu7RG`ZKgJz87is(SytRs&O{%qF@N{Pall{e|;IU~{ zHikOuAA=A??v#Ciws{k0Em^JavR7awU_4`viCrpV?oeN&9o5-tv0qr+$|yiTV6FqR zvFB4QH(G2>(40K(BIRB-gT|PbVgUEQ%{asvvhaj2@kE@MBzf}|I%>cMp&D>8!zddJ`$f4j48#-T#|#3i;O z!ZI~Pb&;9;5Y&>#MR_%r<{%fVyuo)+2-w(cSRY~f7Z4qlF-ARg*t$xJtvXT04N$zQ zJp6zywN{Cbj& zA|;yhe_QbmR)^3qW&x=k@I3$h&YTiPly4^nA3{R49C{;j4Rwk-Xq09~c0M=Wa}s`t zL0F)peP2u*Fv!2d9YrX!TFe=Jo7_%uDYBSGs8&E?RU1#1DEiAtMwdPmg-8LAH+O}< z8Al4Lo)z!i{V!YMe~|XCBk*I-h$4K=j+;A)>w-UU#jvlo3qyR0OtXJ|H>rcbp*D)h zTEa9S@%pi(vf5xX-siPoZ@a+nyjMjR8^2Me-K!3p0+soWs0>M%Y5cc0@p*oM;_){n z9<4;dBOG&WR@$_)dj*rinmDv;0XGlEds6#|$dwkjp_`?{pK7tj`VQzg?o)(5nTi$X zn&{trf$Sjyz2;9td)L0sH?^5&?P}RaeJyeFR`}T(Ru3f4;#c#>A;#f56w83iVx=PC zIM`+Jn1#GNCUFCiZZ=69vxq&431VG&0jX zWRa_TN*ESc1e}DgA~R#Jd@^7H`8m0w((d-fNGhQG@&!siDAoaftnhDG6%!$QS|^*v zBnKYK0l{9Ahw)8qOgx!SI7`-7?drvWQXFi2xlK>R(a!0N+XTk-zznqZdY|mvL=1k4F@`gDD!1Vmf{cI zbNQujIU%wm>Y*u$V3fMD@kql8j6OkSUoJdR8K#pIXHu0qY|zQOVE?204di&>A_4qi z@w<^^tovoU9DYhU1P8QgiGKf=D&&X*GZGsX!lIh(rb(m;R;7fy*|&m~aWo)brdMeI zR(dpG$nm`csnW>Mq6ER5lEI@@8b1`on0>6=Vpza{mOADoT$a zDM}u?Jc#{Rd~@`R%p~h*IcHxCr0Jni3z~MiGh3&B3dhnlt8H}3`QjjZD7{wxLA%La zC6C4gm5T4k-56}c3wgD-w&NbF#EW>=mvIs+Thom?7qKjKh1CB3O^c)Q)B-Pcc8^G= zHq2Cvl7Ds|Eq9=gK?N)LXR6u7j_eT=%GFi!i6nO{_13{J>&n{G1WehpuN<9A|D;CK z42hGeT043B!`MlKiC6&Pxa_aBhgO+<;s%{6muQ*)iBl%r>u#02)!*TT0#**56>5(> zsbM z&9sa0K70c^c(IYWmI(TMQ-JftIeO?+pS1%us?C3^%z;x{McmM)SrOhCJjm8ji~Wj9 zGw<+59JCU{CV0*01JO%SYr5;xy(sqKBVnPOiTa8q5)4oe*Q|C!bAf2&lA~vO1 z=JK2hbUrtN+MhO%^O=&m;bFLJA}>F215hojh-9H0LnY z;HM_3{45c$_W>Nq!xdwUGJdI);Y!)LteEKcXANQGXZp)eShk(ihHK!^RtR6Z1`5zJ zlN1EWYZRTx!M)t#(TqE~jZGVw#XrcJ83uEtX#%D?X1;FkrOCbHzwdY7m>!~loa zh(wm(uBspXxn{f3GNZ%}bkFUZF@z+n*MwSVGeSfJoUwQa)38^-;@=rQQ2t;Z^n)== zIPR&YlM6sU{&of8IJF&CYh4>US_IpT-K8To&`nsX-OPG-XEvS*gdaE4oyQI$o#tx? zKsP?60klHrPQ2;<-wYyp{cdU#_sbFiz7EqiDUuX|o?Zn(ASGNdCWDKGGEHWnc1?Fx zxFQ0o_Xb*IzEr`<geO7VM#) zQH(mOW_X2!tHMV^2i8!NZyob=vj?ho;HT`UkvSk@&#k}j!r2Y^#CxaaNuujoht}@ZFiT=|f3N3)Lg-&uCoBI(w)wYbrs-~H}B6NW-pERQ6-+sz- zWeM!6?R|LUZ8PW3-z9=KoGDIN?{<`Sf3YfsT8Z1O@1Qx;!9kmbT)wUH2R<`VBp+Xm z3`vCCPyfY)g#0#ZOCn35NJc;Z4kL~)8Id$I{$#AnR|wF66xOSmClc?QpAjB@*#F z!T0WHSg?S~qvVbf+kG&ySKjfP`OQ_GOw6dV{1^DpXFsi0C(j^5b6XiiirRl=wsq?i z0<%Wp9@W)q-p}dSf_YO~jvc{*fC5A<%c9ms!eAh-$oq`orx#QJ15h4mDcx>>u&-^C z3Q5~&@w^ePlr9*p8zxM&gBIke5877k@23DD2*Hp5+hnSV4!-(gq8Dv%|3^o4!h}P~ zR~>=m{ulCK&iG@HU;QCUYa;EOG_h|WOd)#%R~DOf$YG042+fICxnWo@G18=v`fl80 zZKw_e&-_79>qECAvGttpw1tI_IDj@tpq<5^EIaK}8)?$L^{4=H4W3(!*is*eY`kN6#Yam(ie zS_0%elzw#Hs7(h#R)-m+G<1Vv-e3&K z@UlBl)7ErF$#knBJ%f zo?LL6Pr-X>bixuKiYHHgT<$0}V%<@?ST65|_}9EJ>>T+;6vwTXyV-qS(3_>68P$r( zCUnH1i|jzY@V%;#wTYn z6k=R&rJagwVtwsRbecgL+Ta=9@4zx_R704aW-}v~K$B*fhC<R(g!QOdLogI3g8@UUKKNs7)SA?@>a7SwU{jz5#-35le@5`k%bWr5>DBoDIrdJL)iX-Wn_LB3 zV$R)!ZpZ;p*Pqofn0|W_ox_&;y{w9MG?9h6P96?Hq5UHP9<_jaZZGn`=QYXb*7Ke9 z1L@nif*KaAhape3O>1fL5spxV{U2zv3#{;pRpy2;K*mOs&lv#xE#Sz*p)HP)B(uI# zIP!VnCxdQy>)kQ}u{$z2HTzC2WU_}_83=Hq!8JeTo{TDS=Ah}yiw^8$<%43HNKdd% zS*O)zlf2!lN8{?7$4syg>)6pon&sU)fFgieA{2BBz>^z#wwyz1#i&-uf+rL$=fg>* zTCsAo9Ar4JPP$I4%|rw?_RLcs1Gu_|xj6RJVB-gZz(yL6lv~K69RUoOS7ZrNc)pW9 zaNggaRmr^k2DbiJ`E2Ua=Z2CXRUQR7t0>F!J{i?Scgos^!vh~7@ucMz9Ew6%`H|E+ zdROzE+mwz5Q&|ayJ>RNgBKeyN*gVeyq(fXo(S1-uZ!4wJ&%!(F!_thqqZkwA~k7gT{QyPa03tMQM6q@m^++A-IN731{P}GF!Y#utX zWrow#g;E_LL4H=LVOd*C*6{t7YL2pT%Ptn1gur?`=dsxB3h-CE)I)VM&b%yiVp|-G zJh8Cb4ea#w>f2$ADpj)8q_hdGxp2!$#Mz{@_p_}y_7}(bkLqq$WM)-zCuXApHMh@M z#f@r2TAT5Q1*yFDQxi4h_cfm~ptp2iy!(m-z^ik&D)T za1qKg0!ZY0V#&^7WBmV$HO8z4f6w<~!Cbq1_Ygg>1{c^#dgdC;Ctz#!Vrq2Z>9BgT zzZ0h0sa21jTngTsJ1R9FY4e=k6jAKjfEmTNE#+cKpX^X?!Qo`jIyo}tcOpNO$#A5S z2h?#aQeI05)g0)|**0%Bthy=;tT(*m|ULX&)jX@{}ZzKu30clxC%fXC6x>~hE zoC}lMl^)zAPFv-(ToHN+)DLIuBJ8O~-D|uh2HkO>Ta`ZJ?D2QVi#9!sK6)U;I@g>o zGERrYAxvHEmFwOoaWnUDw&1go2Qv2h@>;kr_?Aq8+}Tlj(_3M$j8Ej%JBxlfG*DA( zfn@Z#UdQ!tIjc}B$U%F{PsSKTHGuF>QwUC!>aS_^GH}ap!lE}JW+0QNPxv=rN{5vK zMnn{h4j8Xprg8+eyCOL5D&1+g!@0Tdn_4P1{G?~po`5n{O_`82pI2AG77&Ed2;rbc zlNPbz_nyEqFM-u>1?a4P1&64-78uMAiPX=|S7 z{%)Z~__1HMCD3(-`$S`&S|TTitBq+g1lR9(NZ5RNh{o7vV*Ew>Oc=0e*AfB;7zq|M zfxraslmA zqu-NsxgA2bZFahc@ue-AeXzSLx)7l>ZfJmRzYMoL-v?qWOGxCES&JI8`;B@ON=hsk qPv&dLzc;4b?WcMmzzq!0P-fu^#q&}p5$6hfFp@;D}QF&^{) literal 8196 zcmV+fAp75%h(~7#B_cR;URf;fWee2xho?EBS3y$5O;Fl?Wlo5CBu>y_@>v;qQ|+xx zGG4NU9b8uZ0GRT~?8Z;_Lst;`J^x8FaHGy(bUÀZqTzp9jL#AEvGJ(9lW^lU;% zQfZcl>~JJVS84>OK z>pTn|mHa%XKU$vr%k8}^{V-1-KyLRfe;{(os+=bDp7+A1JW#o^W+yl5BN)$fF6-mR zsbhiwGqthdPk~S~2~y33M1}K?65$vF3Xi24JoPHBO!t`XG0eYfv?laNbNw#fBiY2~ zLS^Hu&>%aWMi#l*>UpxKAb7zyZ`*Y)e0t_UQRY&@(dQ(8xlV6yw{j`bcVjUhcYWyq zSwYV}6Gbz9MWHo4Dx4G6tO0XsEgImshtGdCn+$L-$BERGdQ-hIT%OjcB?5kbyAJ#j z_#jPeoaXbFrlkH%(W=a0GWs}@6gG((3A4*Zn`aZYNgb-bYx)HSJrN3dEO)YoZl&B8}QJo0yVWr@60`;|MHi#bp@jno~6Z(Z78yY(y7h;5G zweKmjOH?);i5a_T!vAm$00fKNU(7+@FN>Hb@EarhOg@&Sa4cKDBx2JJXMce|7^AUd zJg3XCN3DYQkNrNp%Mq7dH)qV5rg}7XJFJ1*@D5Fws81$b4r$R#%+E3<qGQq(>L;R zPRCaW@~T8ZdJ2NGXUFM}_DE6#YgWjj$Uvq-`fA7Us?e_A2K-B|gv)laF;1o+ID#i1 z?#jBz|MFAD_89n~Hj%MYI%qz9!z#TEz4QM_QgJdeXXGZVCKM+9#lZo3bq#p6)HQ#9 zPqKZ|(Qhu4%&VvjW<;j0Ox|t*iIjP7lZ)|}^vFbpMa>`duvG-^1XVCPaPX%N z+y)xL4?OU9imp(*_Ir44ACsPg1LV3vPS zT%&+$)&3vhH+$CGT`HRrFa$2WQ4IAyd0!{};(RATv@__iv-Pa%)6-C9LH$Y0l_Lyem9-cN;-7d6c2p%BLpOp$a~zl>CAaO|`sH)e!Bvw0tKY^v`p#WpB>#JcLMR!d{B5XT6MZgFD- zO=+au&$qAgW+3<{C7H_H+20t*r8HhYp2Yk{C|w1mF0pD**sn|CiE?ZtO*if(bh{=B zV4M|3fQLXYzK{JvBn!}$+Tbi`&4Lf_+GSIL?4Mofs$P~}gJcz69`g3apr6{O%a#4I zrOUCl0TeE&R4_0&WNK&Mx;u=SxWODCP|^h)6xy5_>-Ka=_GpUz{jAWlqd7twMkV_d z$I+^mMgx*H=e2X}X+gfGO4@{5{bZhTzqeF%-;2)sHulYhT9C1Xtl#vB@XB2Jx(Q4* z7FrBy``B-4pIkuPnbhi`uL_uKdFEA#6Rkx4oR$4hP4z=%cC zcGg-HX44y^6ER@PMAT5txXp9PyxS}6#)stefDqdI*W}GZ57PZCsfOjCG;z!m&)ZNy zA^(jJG6u4k0JjT`of@+OWqgPOe8T6eMxLlvPx5-cR>#9%7S(e`koE0|1pRylmMlDh zx4mQG?(Q@y%t4D{)m+moV4|Ej00uE<1THg)kg9FrIV|zgJW&y>VBC~pDMgTzq5uTVA#s2yU%oiMc@z1(A715l6GUG~`~3_}{u zPGRXqEE~64F0r*3*Ij~J{2s0VsA2;3M8yO_>r=l*ryv;Pj=mFvCh4^?YC%I?zOZf~ zia>9VZMkAb0?{s1CF_1Z(dRJ@vdn&ln0z<$sX`nZM2g;Fg*cWg22g0!->vFt@uv1P zRn?OW!S!0-p8FpT$zCOC%+o0uP#VgVw2qNPN>ooxt|DW-y#%mZCfzurAzzZN&7G@U z*1Ta5=&N&Fk9=GvDmyiXDG}?{S$BF)`q=wgf>=hEyMnL| z{srz|*6;+@I@cwFYI~@lvgU{A0k&xr-7wL5sU6OBBYA&8n&tE0{GNv^m6dyHZP#A) z0RFg+WUdo~F&J2unYASV=#h#Zv35pOS^M)Z)(z>ZDz5FNpcEgD(l!ADUlN2;5tE6` z#4WNR^ZKZ0qbtgF`+;yhC66(a{nBnT6e7l{J};4I-<7?8KqxT>7_X}R)mbR`sPAJR z(uhAYf&%cHTR`p6ALtvv>39Xz;I9ITnhMJk{h5GAZ9f?=EfXGf#19U>k42p2{?2n zptev0c@Xqq{`_bRL5?aGJBzdVYzMnuzG$LAX+6Oog{oe5&uLmTw_ z|Mv;7_tObRyl_e2hRU{z9Bz6H{Q}SsJ5BXY_Ja-BJj8gmG!d`*;M6WSp{WG~4VZCp z8#gJ-UI2iAn7YnnoV=G>xX4Hx57wPaq?Ai;qk$1T8kCcDJDoG!yxfy>f#U_F3vt_1 z!#!Tg4LLP>(>fUz=wI^D6b-pqeREdGz;MTLsB59-8{R`IERkF-Bh);WeQN^=H76uz zdy!FpWR?H0_!*RTvD-Ap;!Kyws>Fs4qLTvq zeA~b-c#%MZtb-HO)9%cF?J#<##hYDov)Eg0Y~I^3Fg{a3AbvN`zzh}^|KR>o#c4Su zyf+~8Yubb$lfxwFn?D0Cjod%w{4*PwV+ur1c`&_{<|Fk9j(Pn0W-^G+hwUn_!~ef)ed-Hyh7o=Sp&bg0D%4Y&zn zbm-nP{TcwQ{VjA4LI*9QbA1Xo3$z&k$C};c9DUf`_bE>(CdR zx79|MDgYoNOw2{QEQc!_D(4$6L3-I|9RD6T_h8(3>4u8i%W495s~?>2g@8Rt^%7q& zzt?Q#AbUQjt1q%f9)$J)|3}OIZ{SL-0>M@V7ob-fr?`CtYsTL}YC$xU?Zx$VdNRdm zrm`spQ`;3BvG!(eKr;yK6~(*RZgzn=5L3hw1O3GHf>qn2kMt8VB9ANWMTCanz15qs z>VbQPcLf@=_I#w|GKUA`r9PL7Xz39tj|$^n0zB!bWFEG&-2LC{7c?Dxw|rK<&dd&En+p|k`VZ;3**Bkf z`KtIO(WOb}CP==BUiFRtF8c;#MS2s6f^w2zNw_JN#iG9g9r<2YWs6gM0PW|?a61+72Q6r?_crY^ zmHbgj^pUL+*grrd=;bk{MIBFjHRj?3o&fhPyQP1N6PNEr{MiIDEw+=NRx+J_@VMAuP3G$8=9LfH+5 z!3f1)WgzXNus1-=zdO3qchzBgM0$1R^pMUQPEtTO6cxa@8SaLNF!00RLvDgafYG`% z3Q0W|ClA^QZo!Rj-o{?SQ>ND}qx`K|>;m66#D3(64CRJ0jR>4%orjOjOWWvY{!CRG z1Z=T~)UGIY*CUMI;M8SFX2MCXN#XjPdp(el3+QID+8-Ef(x8v{aw9jH)DYeO4vgtE zg1|EwrO8*Y!#GY;5!TKsag*IpC6d|q6PL-n(9~vk&c}H^SOW<|Vk&9fP%|G-mv?Z) z=``W!$0^KV6roGQ-!x;ck>!R(oXKTIT@)xgcZOm6kkx|SjBV4d@0#&1UtogsHyba5!P&FH&}SkA~W&|SJj^qVqS z04BSmm&6D=Z%(jp%PIcCfqIz6qv7fCCt;kjywJV4PZ8@!t|TY%|9W&;#=*%LZ!)MD z$_`5|Rg~a=Qq$ENDv(}s)ktgR5Ncm2*f@qrnjEZ-j&uZZf%Ik1!M3*MTuLV+>m9Avvg5(k7Z0Bk z_{%QBa7i%P`w;7$DF9qT`T#p>6?kv+IKcGPr`Ok?461@L#kM93I zjUDJ?XR#raA;#H*NXF-3&f&taRSNVhd5E-Vz2m_jK^8LQSl6fW9D_XA8uXM;RvrcsvxEu__6>Gu!20L0Or2Qh5`gdzFBE#~Xc}_7n0!SxjTYRJR>v*O`d)%5k5AY*K!^WOxJ9NfWkV z!J1IImGkN~=>Sw|6NCW+GLpLZ9m$q1G0&a1xy4S|o6q_M1srn%Mhf}^H)@1bKhd@lI{D%gX_wvq^5oqm` zq|=6>Gh8fi&nc}79FkccJuJSRn|K*HRNaD_5FS&l8@OPuxQ++xOT{ob%kRp9XsPTC z#Iwa^C!8OD4+G+~KaBe+&1kqmhL40-q_0$aAFke#(BIj?F2!{|%+oP#LL^uP-16c{ zdhCvxV56?9i|k?2dt9x^`RZ8{`T+J8;5j+<84e-&sn6U=)ofEzz*mayt;W&+`YxX- zrmXEtZbKT~EHj0#+nE9O0ewAWB5z1T*Sk_lvnL|6kXCG71&sQ81spHX5M^qc7sEs8 zceIoBoK|W&poVN_$$z<(4ovwKui#+GWEw$6%(3N7V@7FLGt65i)b<3oxqYFQawCv_ zA`!Wipz-lwy_cEB=o>=2GxNWHN%xrw%5_p2PgC!wPO*n1B1Djv`u2yiMarYA-i9S~ zm>N5L;=Ybt`=@DAtNA^{dS6k3HZ+G~NOG zEm!1xM#-9bADP{}72JhFm=O ziy0gT?^KVD$ruawu&@LQTjdE{iomU6>FpQU$8F^e)gCLnTS+6wK~9mu@IEN&LG$N0 zm0BZq%U?FbO?ppY&{c7~-U43%ziY^EnS9@zF{8UpJRI~mvH$RPhNHx~=b?+c9(ysx ze4xe4+Kr#m`y39M*8g?YlH|__341#z`1fVbSzE2k~rvMQ?#Die_FCJ2QVhJ_J6cbHK#ElvO z=Z42AtPns=in>h)D`wGYBw%dBGg&3&$(N;27ya`2{-GQ^jYZSd`%eQ#_GQDiRM({^ z=@NC2$|eI)ekDM7*}J2pTK9N(+dW*hQrGexCyTslGJrcTJ{b0aZ8BwkZkykmDyE2m zqAxfpcv&B;uk!oUA=eZPl1U;2*;%~jzhsfflx}1)vJ=(`kRD$s&dcnXmofZIiZ%IB z;-o*Smb2N0k67{Xam9xZcB^@{O(OSfx6*9*c15%V7#x1Se(aXu&6i>nO0al%pLEZ) zyUAD%ElymC9&zqeN5(qI+)9p8dMUwsxYRr?jqJ@pH>`#($F|wOQu`eTN(Jv^+9r2; z?i*^lF^q1|zS8H(Qnv=@PK?Rb1OM4=w4M&WE)PKl+qk%&W5ijl4()*Kge7s{6jhww z5L5)pp@38yg?`?7deC^gy_4R$nR)`@T#Bojf^>eEFkRIcc9!@&d*c3;w?Vjg?RQ*G^Q$3OaqNS?^<%2 ziCE)J;skp)n!_Xmet4}YDo3eh+i;DuT&58 zD@NtF4Sa85=YELZW2b3^TP7!?FwU5+c{mp1xzs$C;y4;SjV6BzHJ~!5Y&DOTBp)A| zR7c2v2PJrPR$5LOrT2yoNvE%;4**1!31$Gai*vNLyi*#!fI#oG#w%rO66rTv_$G#k z)Pa#ZN~ds+T*NhUwOo}@N~_9fe(644mUv^QLRAAGF=_c=e1KU3Y`)>oH655t%Rg(s+=cwU#Dw{ z@Grb=s+orF%v37bc`G_n6S9TB=NG;v`FyZZubiI2TV}Y0R;^9I7Zq#WOcuRt_^ny< zaFWOIu;&W+t=;6>1>tGt@3zxRsg=*o@^V*MJ5u$yYwWpwvB=9|>A<+oU%KmAi! z!Cr@~e3BSrfl->NjjT7yas!9a8;{&vHT-tD2_xXn7(ydsCtr6*XsOU$eD!7g39t{U zIurhV*Kk03nr~EAe4K-}>d6+tq6K(12Vlad zXFEo1{=K$Y!3?bM>IInw2A~|@lu{yl8+`7WI;cRKoL$;-!{wDdmhm&gdPHD+S0 zSJsmHvGi9j2w<3h8HjYTYFx(+AqFkpY=*bgJ54&gp13fxvxu(xXk+%J(UGW3Hr9=a zSQZSqo0`p`J6Le1gQKDx+fUH?*EaJ8;jDwhu<|&{oJ$2#iA>J|xk1BBDACjW{&Oxr zrJDLs5k=z_E3vjvKhs*j2UivwTGZt>oqpelU-5|HdF{s9MDyCZ2yfPH`Xf{`g0%L1 zO4%#nLn3jvXaNaWYZER3Jngg1bR+PHNegUE&ThstyDO?_~R+qA&RiuTZU1RSBx1q9H z)v)jo_})O3%H!I~JluZxCTL%rz4i~?s6bf;#)3@ClaW~3ISw_;U4-x8j?VU4Vf<*| zBdrF5?*13}AZt)AoBS5`PPb)t3RpP&ajNkU)S3y-8d${xBE)l@OTxe-=Zr zOtr-Vrh8IwfQ2(4|LzJ>SKbWY6y?8w4+7@XIqebsBa5rkOm_@KzDYrGuc)Oc<=zOw zkZV2F2k#c;C3%`BM&X#S*`K}BDZ*R=Ux-SLH_kKJ*;q=rlWGe522TJdwag6dn@1Mb zZ$N**GnuFw)uo?&KA>dcquH_GKzR$yh#{I&MDiM^*(D1+lqUe_E+Cr0k%>F_^TfiP z&r!r6*c3@n-OcYN=a!O*hAlG;HAXLQMku$3$C`LjOZa(wFTl9u)hf4BYy76`UAaQ^ zeKnfT6-*ttQa0*6csiEsR!OU$0$S#hYkh~~*KPM_P}63T^h9EmA4zGj;zdHCLoGiW zUba?>#V2+P4x#KAx3Jc@Z8Ra~PPK;kK@8SwjX?YrbQWVEMe(8xaX&$q(%2B!25NUr z>xbkYqAVmgNSUQt-~$lc?(nKrL+fhd|H!2oWtd*S-bRFUQ-}IA&m1o_KaW5W z2z3Lg#55IdgQwi}OjgBCJt+y?q^=$PB-rsf)+%t$nUkFA7d@5gjCE&CB$MjHS8}2O zN8zkSx?u``sAI`s*#S}WbZ-pW?{{0;2}c|}B1pVn(-|K||96{I>Y6yq^L4MwFe2CW zs2TTXFrk$fj$nY2euoWmv=`)JYA4VBkMH_wQhtNopsUTM6SK(0t0R<74^9Q diff --git a/src/tests/hash_functions/key_array.bin b/src/tests/hash_functions/key_array.bin index 51ab341e8ed3d45e01ed7ac621f0e789937318cf..1106f69bd29570b37051ab62b2dd80e48bd84caf 100644 GIT binary patch literal 2048 zcmV+b2>Gj!2K0v$Sl(bcM=wiF8OrvXdwyI#E5xlrPWS05m)G zzUhT#pu23S>-L(DE z^inq8c+TOgLGcgOT$GlVj1fLz5$DPkFx1=Pjphn@DwjTF8K{yug0v65p&DG>AjnzI zwZhPs4fu<3jI?qVIKgzAky?}AO`7)x69$3s(IwdhW8SiC;{wJIHb(EOrRxM1+O{j#bu-|)1IPeU;6;ZvGV6h z2sRDPJzsi!A^{UpdC@qZVr&kkal;W)r0RHB0#O7tkd~~^kNthbyeUlNS}QgWssh;4 zUP#oM>y}jl{Jt2XgvOh5v)L1(iuis=j+bTBrRNh6A({CPWS4-_;~QW$%eQDZZX_=8 zWh+C)a_>B8J!kSegUlJl6rGvxsk$c)BR?J?3;M6!n+qht<_BQBgNhW44uBaugR#h| z$A|b)>g?`y1d46DAJmM_o87$z(65;$MP-aqCe5$-@q$4+EgaCCQaNOX^-4vgY7CE5 z4|(<}#P_UUnC)!0CLHqsB4Cg5`1fEf>$v+OMOq`Qp#hIIgVmUg>!~poB=eqOAre=i`8-rk?EYDoeQ_e#j-Q*=(7p&U+bC5_q@!{uGB@BC<$}MeZM!95==lRp z1A5h-D4O$@&OuzQ9y-&DcIjDPv<@27S2LBW7t06)#IrhM0kAT?%z z{yiX|s2xc+5*jC%gk!NH1iqt}C@P`;ZAeoAVkXmVO~_E$uA_gdeEC#LJUgx#9gJ-W z3#XHjBd*IROWk7(8e+)FEzZgl&ZOP)OZEJ=ZvI3lzGQ1?3HbVW?OKSB#`R`Wj$m8; zZT&!tASvR-L}?#%$oW%{Wv-~EjGt;cLbJ>pVr3`@0|ovTpc*F2&4jtQjEosrta^e% zS=cv3Wwk=(A7d(=nj4qAo+$<5E49b0Zu7`4H`nnTM<>n1#NwVST$?5Rr!bmayvL?t z+hvg1G<7y1FPqe$cH70w2fT)nj@pbHaR*K!+SsPOLJ{iebM)!7I7=LU;j)Tci*upD zh5w{3-8uP8gdx5K;hBpSw@3F?t=k1{0?R37BV+71=QJts2MmYnLQCr2rhlV+8Ao=1 zZu@ee7JnPVq(%5aFO~i-rBFjn;v)r$1^C>|<}a}d*4+Wq7ym0D93MeN^}&Bzj|q+J z_`T=-1GXFIsc_o-QpIC^b{@R#0HBaSH5Hc9wr zO7j$Z#n4~8miiyNo>)XD8}e-qPR>%K8}hgHtD(KjxSN3>LOXC1%yAdSTfYj(R2> zB?0zAPhI+-U2LN1)u(xwFVSNV0!yDU8`LO6$ElntGB_`voF5hbVkbYRRRY$pdU^H% zghWK#$J|5G1FFC39~#~BS`3a=jMmP{JAN$U9rTXlE76`k-iaHkc!K>?3UP@xxG7!0 z*{rt)kOHH!)Vx21XH>nBvJc(N=M{$IpE}=N_hSt`epjxbsQV&xcqTSUq{oZpb$E36 zIm@!p%|8ZLesryHzlmhYgEz8Lj+dp42;!0&FW%;=ywLN-h@zeIO)}!_yAJ-IY$++F zLxNSs*Yg&CrDv$_2ntN82fWg)C3AqK3{j+6wB%#^xXS~WVjQ;RT^XZ|LRUa%@`A0Y zR_9_zUp|25PJ*esikF*zUKg&xb8wWBCn~X`v%)w0+g^}W`O6OmM8sjMMrJiwkes55CfWwwky0K@c(=p@~#R zsdSDokB}%(bcUVy7a3c&Q6v%9txb9RM-25%@9|!F?rPUi$?qJs9xM*-(rwqil4&U e$+#I#EoTx@Ma;iu#IDSJIc(I2s6q*=n#}Js&j$Pe literal 2048 zcmV+b2>+w_&x=`XyxpNSID#2tT#*4u{&pY>J+@Rk6{Sqm@-xwdZ8=4PP(-V zvM>W6lfpPReKO?k%PkR;=cOIs)3w%!i>4V2`bLuSQX{FC5*y1NB&zXAEH5pt2Byir zC?VkV!`yVgye;hu!I}>nD7rmqSg>n)gT$oz4^Rd*t<1xyexgnh){9UCDYF5HoyvgU z15<%L$3RVL#TRPbnK~;GB%8X1nuU{LC|J(FxD-%vlOx1Cee9i9nuy(0X!W~S_14#q zBVPtVbS^=&A@h^*?RyWAO8ypc3nar=!w^x}_1+SM) z)DNHx3^E|?MjY@I1kuWQ2l10EOtJCgI(kPYv9%1k24a`mwC7OGXDqu2zqyaW-Wmrn z+ALQlwITDRo0I%#6QMenjAc68bmjE$2AC)XeV?MJ!>|HPTisxWN)~^&W)4K<{&#LQE>X zf_d)G;y`Kk#&E3q4sSCKx-*_3G;Yr$T#s5$K5+29t0G@|CJ#oq0Gtgd>6yiu z(%ta&#XNtVTyeVT6)Uul_iikDWo1g$Imkd+X44-N*O6-n1|;*K3s9|18${kP1a5Qq zw#K$s)LxqPQKAXupI*u|zYNbznAbWg)=OUv6`txVzy;SnQpNd~O88^zchJovg=WXO z12A2_II@7cG#^i7pCGqvBHFh1*XSE@L2Jv@CUDgt*6 zfw*wmjWmyF5Fz3`a!*;Xz$+=gUdoHTTIi-6bCT*;TuCF5s`YXRS0cf~V9b@}x1Trx zpS>?|hl&z57))n)OKz3aIy|!%Sr?KWpK931HGEt~jnbC4gxZMjZ5hmPq|o@qvnAz* z_t$}K%9-!M;!UKjOIL}F7Ne(C4rVKBT%12+yUR?zd{7l z3C#{ltt~I47v=zBm+(Cw1Sd~RfTgVtH=-G*vHq(l=r1dU?*gnKff za+OI=Aj2Y{C5uhjuUrp&$wC>j9hmgre(9W(|2gj$u5B`QJ>Ejgl~j9>oesF_sL2$j z_g`#}d#X57W72TI+N4!|kl+o4YUg$}Bzam2KV9ZCbehz(o+S}s-~?c>V&hmhsn>ITzTrpi*o_rb{4(*?fYwScNDM|V#kdEnE1B*j~&jAg++&Y$4 z%TcQnambaysR8$gZ>%VV!4ogG!!fl>bW&=&KG|&u4L;xucG!I)VZHoJGGlyP0QpYO z^OJ@2y{3i;I7bz`)A~H~v;SMOs37-ZK6}HQZP7B)c8r^F7pmfPPb6wyns!8i?mn+I zBE>sh&6P8`k5ch3vgnBt#g-JDX_4rd0=8nPyp*ACE6K~i?juTNc;xrI!0o<&x4bE# z9MXiV%xk0d4;k(n>t;oxkgJ0x=x;@>zA@xk=l>I9+(X%B;UMaAp4(4f&WG*dFO8HT z_9llW-?G>WUU{eycVdI%0SaS}6iLr#>;ClX$9qN?c?rmvx7mP~0rw|<+}dw#%3rW^XY`zA6ffL#f2M4k_Le7j zwLQ*y^W*p|$5^!I-@dFmTgkM4j)3ZHLjTTM>bW8-W$QW)G_^qC2Nl_EkRGu6A{Lul zg5k}XUda8`**ZYxe(I=WaQ4&sc3;zv6ZN1*E&w*I_$$Pqwxkzs(x7=5(kfO%4qoL# z_#}lBe}EVEd@-B6+PTiMri+CvyqFDYgXNyuZo6EXbE96Fej~F=L%>b$D-ZZuz8*Qe zz7JaRb{i&EsptQ>1dCQnD#HpS8@o_{=K}C_KsicdzUW7GL{6UV95RkwwNDN=qxUXF z6{?ob5NPx#P!@>_A#jrMPZ7Ti!~PiiB4TzVq~31&wg7gnCWsc4!p=X=BGXvGUZus0 zfw2CS7|aNYaZ;r{=b#ITqRn?l4(u$yUw>&S1GCmdN<@KJXsTFkau*$VR}x~3(S2|i z#Gb$LOyChtvnrgIrBvecSRM{1+;ui>K8lj2Zf2+}2_+2Ni2W!M1Q;=fn@#Pw zk8a51a42>M+5IT)1qY~n;{^HL6J{jSnX4YM^aU4#MnH8d_0od|u~SPFaDMig#mxj; e0 Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) + + #:set IMPLEMENTED_TESTS = ['is_square','is_diagonal'] + + #:set NUM_TESTS = int(len(IMPLEMENTED_TESTS)*len(RCI_KINDS_TYPES_SUFFIXES)) + + #! set testsuite dynamically testsuite = [ & - new_unittest("is_square_rsp", test_is_square_rsp), & - new_unittest("is_square_rdp", test_is_square_rdp), & - new_unittest("is_square_rqp", test_is_square_rqp), & - new_unittest("is_square_csp", test_is_square_csp), & - new_unittest("is_square_cdp", test_is_square_cdp), & - new_unittest("is_square_cqp", test_is_square_cqp), & - new_unittest("is_square_int8", test_is_square_int8), & - new_unittest("is_square_int16", test_is_square_int16), & - new_unittest("is_square_int32", test_is_square_int32), & - new_unittest("is_square_int64", test_is_square_int64) & + #:set TESTS_WRITTEN = 0 + #:for cur_test in IMPLEMENTED_TESTS + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + #! note that one has to use set directives to increment variable + #:set TESTS_WRITTEN = TESTS_WRITTEN + 1 + #! last test in list should not have comma + #:if TESTS_WRITTEN < NUM_TESTS + new_unittest("${cur_test}$_${s1}$", test_is_square_rsp), & + #:else + new_unittest("${cur_test}$_${s1}$", test_is_square_rsp) & + #:endif + #:endfor + #:endfor ] - - !testsuite = [ & - ! new_unittest("is_square_rsp", test_is_square_rsp), & - ! new_unittest("is_square_rdp", test_is_square_rdp), & - ! new_unittest("is_square_rqp", test_is_square_rqp), & - ! new_unittest("is_square_csp", test_is_square_csp), & - ! new_unittest("is_square_cdp", test_is_square_cdp), & - ! new_unittest("is_square_cqp", test_is_square_cqp), & - ! new_unittest("is_square_int8", test_is_square_int8), & - ! new_unittest("is_square_int16", test_is_square_int16), & - ! new_unittest("is_square_int32", test_is_square_int32), & - ! new_unittest("is_square_int64", test_is_square_int64), & - ! new_unittest("is_diagonal_rsp", test_is_diagonal_rsp), & - ! new_unittest("is_diagonal_rdp", test_is_diagonal_rdp), & - ! new_unittest("is_diagonal_rqp", test_is_diagonal_rqp), & - ! new_unittest("is_diagonal_csp", test_is_diagonal_csp), & - ! new_unittest("is_diagonal_cdp", test_is_diagonal_cdp), & - ! new_unittest("is_diagonal_cqp", test_is_diagonal_cqp), & - ! new_unittest("is_diagonal_int8", test_is_diagonal_int8), & - ! new_unittest("is_diagonal_int16", test_is_diagonal_int16), & - ! new_unittest("is_diagonal_int32", test_is_diagonal_int32), & - ! new_unittest("is_diagonal_int64", test_is_diagonal_int64), & - ! new_unittest("is_symmetric_rsp", test_is_symmetric_rsp), & - ! new_unittest("is_symmetric_rdp", test_is_symmetric_rdp), & - ! new_unittest("is_symmetric_rqp", test_is_symmetric_rqp), & - ! new_unittest("is_symmetric_csp", test_is_symmetric_csp), & - ! new_unittest("is_symmetric_cdp", test_is_symmetric_cdp), & - ! new_unittest("is_symmetric_cqp", test_is_symmetric_cqp), & - ! new_unittest("is_symmetric_int8", test_is_symmetric_int8), & - ! new_unittest("is_symmetric_int16", test_is_symmetric_int16), & - ! new_unittest("is_symmetric_int32", test_is_symmetric_int32), & - ! new_unittest("is_symmetric_int64", test_is_symmetric_int64), & - ! new_unittest("is_skew_symmetric_rsp", test_is_skew_symmetric_rsp), & - ! new_unittest("is_skew_symmetric_rdp", test_is_skew_symmetric_rdp), & - ! new_unittest("is_skew_symmetric_rqp", test_is_skew_symmetric_rqp), & - ! new_unittest("is_skew_symmetric_csp", test_is_skew_symmetric_csp), & - ! new_unittest("is_skew_symmetric_cdp", test_is_skew_symmetric_cdp), & - ! new_unittest("is_skew_symmetric_cqp", test_is_skew_symmetric_cqp), & - ! new_unittest("is_skew_symmetric_int8", test_is_skew_symmetric_int8), & - ! new_unittest("is_skew_symmetric_int16", test_is_skew_symmetric_int16), & - ! new_unittest("is_skew_symmetric_int32", test_is_skew_symmetric_int32), & - ! new_unittest("is_skew_symmetric_int64", test_is_skew_symmetric_int64), & - ! new_unittest("is_hermitian_rsp", test_is_hermitian_rsp), & - ! new_unittest("is_hermitian_rdp", test_is_hermitian_rdp), & - ! new_unittest("is_hermitian_rqp", test_is_hermitian_rqp), & - ! new_unittest("is_hermitian_csp", test_is_hermitian_csp), & - ! new_unittest("is_hermitian_cdp", test_is_hermitian_cdp), & - ! new_unittest("is_hermitian_cqp", test_is_hermitian_cqp), & - ! new_unittest("is_hermitian_int8", test_is_hermitian_int8), & - ! new_unittest("is_hermitian_int16", test_is_hermitian_int16), & - ! new_unittest("is_hermitian_int32", test_is_hermitian_int32), & - ! new_unittest("is_hermitian_int64", test_is_hermitian_int64), & - ! new_unittest("is_triangular_rsp", test_is_triangular_rsp), & - ! new_unittest("is_triangular_rdp", test_is_triangular_rdp), & - ! new_unittest("is_triangular_rqp", test_is_triangular_rqp), & - ! new_unittest("is_triangular_csp", test_is_triangular_csp), & - ! new_unittest("is_triangular_cdp", test_is_triangular_cdp), & - ! new_unittest("is_triangular_cqp", test_is_triangular_cqp), & - ! new_unittest("is_triangular_int8", test_is_triangular_int8), & - ! new_unittest("is_triangular_int16", test_is_triangular_int16), & - ! new_unittest("is_triangular_int32", test_is_triangular_int32), & - ! new_unittest("is_triangular_int64", test_is_triangular_int64), & - ! new_unittest("is_hessenberg_rsp", test_is_hessenberg_rsp), & - ! new_unittest("is_hessenberg_rdp", test_is_hessenberg_rdp), & - ! new_unittest("is_hessenberg_rqp", test_is_hessenberg_rqp), & - ! new_unittest("is_hessenberg_csp", test_is_hessenberg_csp), & - ! new_unittest("is_hessenberg_cdp", test_is_hessenberg_cdp), & - ! new_unittest("is_hessenberg_cqp", test_is_hessenberg_cqp), & - ! new_unittest("is_hessenberg_int8", test_is_hessenberg_int8), & - ! new_unittest("is_hessenberg_int16", test_is_hessenberg_int16), & - ! new_unittest("is_hessenberg_int32", test_is_hessenberg_int32), & - ! new_unittest("is_hessenberg_int64", test_is_hessenberg_int64), & - ! ] end subroutine collect_linalg_matrix_property_checks !is_square - #:for k1, t1 in RCI_KINDS_TYPES - #:if t1[0] == 'i' - #:set SUBROUTINE_LETTER = '' - #:else - #:set SUBROUTINE_LETTER = t1[0] - #:endif - - subroutine test_is_square_${SUBROUTINE_LETTER}$${k1}$(error) + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_square_${s1}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error - #:if t1[0] == 'r' + #!populate variables dependent on type/kind + #:if s1[0] == 'r' ${t1}$ :: A_true(2,2), A_false(2,3) A_true = reshape([1.,2.,3.,4.],[2,2]) A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - #:elif t1[0] == 'c' + #:elif s1[0] == 'c' ${t1}$ :: A_true(2,2), A_false(2,3) A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - #:elif t1[0] == 'i' + #:elif s1[0] == 'i' ${t1}$ :: A_true(2,2), A_false(2,3) A_true = reshape([1,2,3,4],[2,2]) A_false = reshape([1,2,3,4,5,6],[2,3]) #:endif + #! all error check calls are type/kind independent call check(error, is_square(A_true), & "is_square(A_true) failed.") if (allocated(error)) return - call check(error, (.not. is_square(A_false)), & "(.not. is_square(A_false)) failed.") if (allocated(error)) return - end subroutine test_is_square_${SUBROUTINE_LETTER}$${k1}$ + end subroutine test_is_square_${s1}$ #:endfor - ! subroutine test_is_square_r${k1}$(error) - ! !> Error handling - ! type(error_type), allocatable, intent(out) :: error - - ! ${t1}$ :: A_true(2,2), A_false(2,3) - ! !A_true = reshape([1.,2.,3.,4.],[2,2]) - ! A_true = reshape([1.,2.,3.,4.],[4,1]) - ! A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - - ! call check(error, is_square(A_true), & - ! "is_square(A_true) failed.") - ! if (allocated(error)) return - - ! call check(error, (.not. is_square(A_false)), & - ! "(.not. is_square(A_false)) failed.") - ! if (allocated(error)) return - - ! end subroutine test_is_square_r${k1}$ - !#:endfor - !#:for k1, t1 in COMPLEX_KINDS_TYPES - ! subroutine test_is_square_c${k1}$(error) - ! !> Error handling - ! type(error_type), allocatable, intent(out) :: error - - ! ${t1}$ :: A_true(2,2), A_false(2,3) - ! A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - ! A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - ! cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - - ! call check(error, is_square(A_true), & - ! "is_square(A_true) failed.") - ! if (allocated(error)) return - - ! call check(error, (.not. is_square(A_false)), & - ! "(.not. is_square(A_false)) failed.") - ! if (allocated(error)) return - - ! end subroutine test_is_square_c${k1}$ - !#:endfor - !#:for k1, t1 in INT_KINDS_TYPES - ! subroutine test_is_square_${k1}$(error) - ! !> Error handling - ! type(error_type), allocatable, intent(out) :: error - - ! ${t1}$ :: A_true(2,2), A_false(2,3) - ! write(*,*) "test_is_square_int16" - ! A_true = reshape([1,2,3,4],[2,2]) - ! A_false = reshape([1,2,3,4,5,6],[2,3]) - - ! call check(error, is_square(A_true), & - ! "is_square(A_true) failed.") - ! if (allocated(error)) return - - ! call check(error, (.not. is_square(A_false)), & - ! "(.not. is_square(A_false)) failed.") - ! if (allocated(error)) return - - ! end subroutine test_is_square_${k1}$ - !#:endfor + + !is_diagonal + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_diagonal_${s1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + #!populate variables dependent on type/kind + #:if s1[0] == 'r' + ${t1}$ :: A_true_s(2,2), A_false_s(2,2) !square matrices + ${t1}$ :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_false_s = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) + A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) + A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) + A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) + #:elif s1[0] == 'c' + ${t1}$ :: A_true_s(2,2), A_false_s(2,2) !square matrices + ${t1}$ :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.)],[2,2]) + A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,1.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) + #:elif s1[0] == 'i' + ${t1}$ :: A_true_s(2,2), A_false_s(2,2) !square matrices + ${t1}$ :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices + ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + A_true_s = reshape([1,0,0,4],[2,2]) + A_false_s = reshape([1,0,3,4],[2,2]) + A_true_sf = reshape([1,0,0,4,0,0],[2,3]) + A_false_sf = reshape([1,0,3,4,0,0],[2,3]) + A_true_ts = reshape([1,0,0,0,5,0],[3,2]) + A_false_ts = reshape([1,0,0,0,5,6],[3,2]) + #:endif + + #! all error check calls are type/kind independent + call check(error, is_diagonal(A_true_s), & + "is_diagonal(A_true_s) failed.") + if (allocated(error)) return + call check(error, (.not. is_diagonal(A_false_s)), & + "(.not. is_diagonal(A_false_s)) failed.") + if (allocated(error)) return + call check(error, is_diagonal(A_true_sf), & + "is_diagonal(A_true_sf) failed.") + if (allocated(error)) return + call check(error, (.not. is_diagonal(A_false_sf)), & + "(.not. is_diagonal(A_false_sf)) failed.") + if (allocated(error)) return + call check(error, is_diagonal(A_true_ts), & + "is_diagonal(A_true_ts) failed.") + if (allocated(error)) return + call check(error, (.not. is_diagonal(A_false_ts)), & + "(.not. is_diagonal(A_false_ts)) failed.") + if (allocated(error)) return + end subroutine test_is_diagonal_${s1}$ + #:endfor + + + !is_symmetric + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_symmetric_${s1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + #!populate variables dependent on type/kind + #:if s1[0] == 'r' + ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + #:elif s1[0] == 'c' + ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(2.,1.),cmplx(4.,1.)],[2,2]) + A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & + cmplx(3.,1.),cmplx(4.,1.)],[2,2]) + A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & + cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix + #:elif s1[0] == 'i' + ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + #:endif + + #! all error check calls are type/kind independent + call check(error, is_symmetric(A_true), & + "is_symmetric(A_true) failed.") + if (allocated(error)) return + call check(error, (.not. is_symmetric(A_false_1)), & + "(.not. is_symmetric(A_false_1)) failed.") + if (allocated(error)) return + call check(error, (.not. is_symmetric(A_false_2)), & + "(.not. is_symmetric(A_false_2)) failed.") + if (allocated(error)) return + end subroutine test_is_symmetric_${s1}$ + #:endfor + + + + + +! !TEST TEMPLATE +! !is_diagonal +! #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES +! subroutine test_is_diagonal_${s1}$(error) +! !> Error handling +! type(error_type), allocatable, intent(out) :: error +! +! #!populate variables dependent on type/kind +! #:if s1[0] == 'r' +! #:elif s1[0] == 'c' +! #:elif s1[0] == 'i' +! #:endif +! +! #! all error check calls are type/kind independent +! end subroutine test_is_diagonal_${s1}$ +! #:endfor end module From 009e22c73707005c41704c851dc253bc385b4705 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 27 Dec 2021 16:17:02 -0500 Subject: [PATCH 27/33] Implement all tests with testdrive and fypp --- src/tests/linalg/test_linalg.f90 | 583 ----- .../test_linalg_matrix_property_checks.full | 2068 ----------------- .../test_linalg_matrix_property_checks.fypp | 365 ++- 3 files changed, 329 insertions(+), 2687 deletions(-) delete mode 100644 src/tests/linalg/test_linalg.f90 delete mode 100644 src/tests/linalg/test_linalg_matrix_property_checks.full diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 deleted file mode 100644 index 1d054dcbe..000000000 --- a/src/tests/linalg/test_linalg.f90 +++ /dev/null @@ -1,583 +0,0 @@ -program test_linalg - - use stdlib_error, only: check - use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 - use stdlib_linalg, only: diag, eye, trace, outer_product - - implicit none - - real(sp), parameter :: sptol = 1000 * epsilon(1._sp) - real(dp), parameter :: dptol = 1000 * epsilon(1._dp) - real(qp), parameter :: qptol = 1000 * epsilon(1._qp) - - logical :: warn - - ! whether calls to check issue a warning - ! or stop execution - warn = .false. - - ! - ! eye - ! - call test_eye - - ! - ! diag - ! - call test_diag_rsp - call test_diag_rsp_k - call test_diag_rdp - call test_diag_rqp - - call test_diag_csp - call test_diag_cdp - call test_diag_cqp - - call test_diag_int8 - call test_diag_int16 - call test_diag_int32 - call test_diag_int64 - - ! - ! trace - ! - call test_trace_rsp - call test_trace_rsp_nonsquare - call test_trace_rdp - call test_trace_rdp_nonsquare - call test_trace_rqp - - call test_trace_csp - call test_trace_cdp - call test_trace_cqp - - call test_trace_int8 - call test_trace_int16 - call test_trace_int32 - call test_trace_int64 - - ! - ! outer_product - ! - call test_outer_product_rsp - call test_outer_product_rdp - call test_outer_product_rqp - - call test_outer_product_csp - call test_outer_product_cdp - call test_outer_product_cqp - - call test_outer_product_int8 - call test_outer_product_int16 - call test_outer_product_int32 - call test_outer_product_int64 - -contains - - subroutine test_eye - real(sp), allocatable :: rye(:,:) - complex(sp) :: cye(7,7) - integer :: i - write(*,*) "test_eye" - - call check(all(eye(3,3) == diag([(1,i=1,3)])), & - msg="all(eye(3,3) == diag([(1,i=1,3)])) failed.",warn=warn) - - rye = eye(3,4) - call check(sum(abs(rye(:,1:3) - diag([(1.0_sp,i=1,3)]))) < sptol, & - msg="sum(abs(rye(:,1:3) - diag([(1.0_sp,i=1,3)]))) < sptol failed", warn=warn) - - call check(all(eye(5) == diag([(1,i=1,5)])), & - msg="all(eye(5) == diag([(1,i=1,5)] failed.",warn=warn) - - rye = eye(6) - call check(sum(abs(rye - diag([(1.0_sp,i=1,6)]))) < sptol, & - msg="sum(abs(rye - diag([(1.0_sp,i=1,6)]))) < sptol failed.",warn=warn) - - cye = eye(7) - call check(abs(trace(cye) - cmplx(7.0_sp,0.0_sp,kind=sp)) < sptol, & - msg="abs(trace(cye) - cmplx(7.0_sp,0.0_sp,kind=sp)) < sptol failed.",warn=warn) - end subroutine test_eye - - subroutine test_diag_rsp - integer, parameter :: n = 3 - real(sp) :: v(n), a(n,n), b(n,n) - integer :: i,j - write(*,*) "test_diag_rsp" - v = [(i,i=1,n)] - a = diag(v) - b = reshape([((merge(i,0,i==j), i=1,n), j=1,n)], [n,n]) - call check(all(a == b), & - msg="all(a == b) failed.",warn=warn) - - call check(all(diag(3*a) == 3*v), & - msg="all(diag(3*a) == 3*v) failed.",warn=warn) - end subroutine test_diag_rsp - - subroutine test_diag_rsp_k - integer, parameter :: n = 4 - real(sp) :: a(n,n), b(n,n) - integer :: i,j - write(*,*) "test_diag_rsp_k" - - a = diag([(1._sp,i=1,n-1)],-1) - - b = reshape([((merge(1,0,i==j+1), i=1,n), j=1,n)], [n,n]) - - call check(all(a == b), & - msg="all(a == b) failed.",warn=warn) - - call check(sum(diag(a,-1)) - (n-1) < sptol, & - msg="sum(diag(a,-1)) - (n-1) < sptol failed.",warn=warn) - - call check(all(a == transpose(diag([(1._sp,i=1,n-1)],1))), & - msg="all(a == transpose(diag([(1._sp,i=1,n-1)],1))) failed",warn=warn) - - call random_number(a) - do i = 1, n - call check(size(diag(a,i)) == n-i, & - msg="size(diag(a,i)) == n-i failed.",warn=warn) - end do - call check(size(diag(a,n+1)) == 0, & - msg="size(diag(a,n+1)) == 0 failed.",warn=warn) - end subroutine test_diag_rsp_k - - subroutine test_diag_rdp - integer, parameter :: n = 3 - real(dp) :: v(n), a(n,n), b(n,n) - integer :: i,j - write(*,*) "test_diag_rdp" - v = [(i,i=1,n)] - a = diag(v) - b = reshape([((merge(i,0,i==j), i=1,n), j=1,n)], [n,n]) - call check(all(a == b), & - msg="all(a == b) failed.",warn=warn) - - call check(all(diag(3*a) == 3*v), & - msg="all(diag(3*a) == 3*v) failed.",warn=warn) - end subroutine test_diag_rdp - - subroutine test_diag_rqp - integer, parameter :: n = 3 - real(qp) :: v(n), a(n,n), b(n,n) - integer :: i,j - write(*,*) "test_diag_rqp" - v = [(i,i=1,n)] - a = diag(v) - b = reshape([((merge(i,0,i==j), i=1,n), j=1,n)], [n,n]) - call check(all(a == b), & - msg="all(a == b) failed.", warn=warn) - - call check(all(diag(3*a) == 3*v), & - msg="all(diag(3*a) == 3*v) failed.", warn=warn) - end subroutine test_diag_rqp - - subroutine test_diag_csp - integer, parameter :: n = 3 - complex(sp) :: a(n,n), b(n,n) - complex(sp), parameter :: i_ = cmplx(0,1,kind=sp) - integer :: i,j - write(*,*) "test_diag_csp" - a = diag([(i,i=1,n)]) + diag([(i_,i=1,n)]) - b = reshape([((merge(i + 1*i_,0*i_,i==j), i=1,n), j=1,n)], [n,n]) - call check(all(a == b), & - msg="all(a == b) failed.",warn=warn) - - call check(all(abs(real(diag(a)) - [(i,i=1,n)]) < sptol), & - msg="all(abs(real(diag(a)) - [(i,i=1,n)]) < sptol)", warn=warn) - call check(all(abs(aimag(diag(a)) - [(1,i=1,n)]) < sptol), & - msg="all(abs(aimag(diag(a)) - [(1,i=1,n)]) < sptol)", warn=warn) - end subroutine test_diag_csp - - subroutine test_diag_cdp - integer, parameter :: n = 3 - complex(dp) :: a(n,n) - complex(dp), parameter :: i_ = cmplx(0,1,kind=dp) - write(*,*) "test_diag_cdp" - a = diag([i_],-2) + diag([i_],2) - call check(a(3,1) == i_ .and. a(1,3) == i_, & - msg="a(3,1) == i_ .and. a(1,3) == i_ failed.",warn=warn) - end subroutine test_diag_cdp - - subroutine test_diag_cqp - integer, parameter :: n = 3 - complex(qp) :: a(n,n) - complex(qp), parameter :: i_ = cmplx(0,1,kind=qp) - write(*,*) "test_diag_cqp" - a = diag([i_,i_],-1) + diag([i_,i_],1) - call check(all(diag(a,-1) == i_) .and. all(diag(a,1) == i_), & - msg="all(diag(a,-1) == i_) .and. all(diag(a,1) == i_) failed.",warn=warn) - end subroutine test_diag_cqp - - subroutine test_diag_int8 - integer, parameter :: n = 3 - integer(int8), allocatable :: a(:,:) - integer :: i - logical, allocatable :: mask(:,:) - write(*,*) "test_diag_int8" - a = reshape([(i,i=1,n**2)],[n,n]) - mask = merge(.true.,.false.,eye(n) == 1) - call check(all(diag(a) == pack(a,mask)), & - msg="all(diag(a) == pack(a,mask)) failed.", warn=warn) - call check(all(diag(diag(a)) == merge(a,0_int8,mask)), & - msg="all(diag(diag(a)) == merge(a,0_int8,mask)) failed.", warn=warn) - end subroutine test_diag_int8 - subroutine test_diag_int16 - integer, parameter :: n = 4 - integer(int16), allocatable :: a(:,:) - integer :: i - logical, allocatable :: mask(:,:) - write(*,*) "test_diag_int16" - a = reshape([(i,i=1,n**2)],[n,n]) - mask = merge(.true.,.false.,eye(n) == 1) - call check(all(diag(a) == pack(a,mask)), & - msg="all(diag(a) == pack(a,mask))", warn=warn) - call check(all(diag(diag(a)) == merge(a,0_int16,mask)), & - msg="all(diag(diag(a)) == merge(a,0_int16,mask)) failed.", warn=warn) - end subroutine test_diag_int16 - subroutine test_diag_int32 - integer, parameter :: n = 3 - integer(int32) :: a(n,n) - logical :: mask(n,n) - integer :: i, j - write(*,*) "test_diag_int32" - mask = reshape([((merge(.true.,.false.,i==j+1), i=1,n), j=1,n)], [n,n]) - a = 0 - a = unpack([1_int32,1_int32],mask,a) - call check(all(diag([1,1],-1) == a), & - msg="all(diag([1,1],-1) == a) failed.", warn=warn) - call check(all(diag([1,1],1) == transpose(a)), & - msg="all(diag([1,1],1) == transpose(a)) failed.", warn=warn) - end subroutine test_diag_int32 - subroutine test_diag_int64 - integer, parameter :: n = 4 - integer(int64) :: a(n,n), c(0:2*n-1) - logical :: mask(n,n) - integer :: i, j - - write(*,*) "test_diag_int64" - - mask = reshape([((merge(.true.,.false.,i+1==j), i=1,n), j=1,n)], [n,n]) - a = 0 - a = unpack([1_int64,1_int64,1_int64],mask,a) - - call check(all(diag([1,1,1],1) == a), & - msg="all(diag([1,1,1],1) == a) failed.", warn=warn) - call check(all(diag([1,1,1],-1) == transpose(a)), & - msg="all(diag([1,1,1],-1) == transpose(a)) failed.", warn=warn) - - - ! Fill array c with Catalan numbers - do i = 0, 2*n-1 - c(i) = catalan_number(i) - end do - ! Symmetric Hankel matrix filled with Catalan numbers (det(H) = 1) - do i = 1, n - do j = 1, n - a(i,j) = c(i-1 + (j-1)) - end do - end do - call check(all(diag(a,-2) == diag(a,2)), & - msg="all(diag(a,-2) == diag(a,2))", warn=warn) - end subroutine test_diag_int64 - pure recursive function catalan_number(n) result(value) - integer, intent(in) :: n - integer :: value - integer :: i - if (n <= 1) then - value = 1 - else - value = 0 - do i = 0, n-1 - value = value + catalan_number(i)*catalan_number(n-i-1) - end do - end if - end function - - - subroutine test_trace_rsp - integer, parameter :: n = 5 - real(sp) :: a(n,n) - integer :: i - write(*,*) "test_trace_rsp" - a = reshape([(i,i=1,n**2)],[n,n]) - call check(abs(trace(a) - sum(diag(a))) < sptol, & - msg="abs(trace(a) - sum(diag(a))) < sptol failed.",warn=warn) - end subroutine test_trace_rsp - - subroutine test_trace_rsp_nonsquare - integer, parameter :: n = 4 - real(sp) :: a(n,n+1), ans - integer :: i - write(*,*) "test_trace_rsp_nonsquare" - - ! 1 5 9 13 17 - ! 2 6 10 14 18 - ! 3 7 11 15 19 - ! 4 8 12 16 20 - a = reshape([(i,i=1,n*(n+1))],[n,n+1]) - ans = sum([1._sp,6._sp,11._sp,16._sp]) - - call check(abs(trace(a) - ans) < sptol, & - msg="abs(trace(a) - ans) < sptol failed.",warn=warn) - end subroutine test_trace_rsp_nonsquare - - subroutine test_trace_rdp - integer, parameter :: n = 4 - real(dp) :: a(n,n) - integer :: i - write(*,*) "test_trace_rdp" - a = reshape([(i,i=1,n**2)],[n,n]) - call check(abs(trace(a) - sum(diag(a))) < dptol, & - msg="abs(trace(a) - sum(diag(a))) < dptol failed.",warn=warn) - end subroutine test_trace_rdp - - subroutine test_trace_rdp_nonsquare - integer, parameter :: n = 4 - real(dp) :: a(n,n-1), ans - integer :: i - write(*,*) "test_trace_rdp_nonsquare" - - ! 1 25 81 - ! 4 36 100 - ! 9 49 121 - ! 16 64 144 - a = reshape([(i**2,i=1,n*(n-1))],[n,n-1]) - ans = sum([1._dp,36._dp,121._dp]) - - call check(abs(trace(a) - ans) < dptol, & - msg="abs(trace(a) - ans) < dptol failed.",warn=warn) - end subroutine test_trace_rdp_nonsquare - - subroutine test_trace_rqp - integer, parameter :: n = 3 - real(qp) :: a(n,n) - integer :: i - write(*,*) "test_trace_rqp" - a = reshape([(i,i=1,n**2)],[n,n]) - call check(abs(trace(a) - sum(diag(a))) < qptol, & - msg="abs(trace(a) - sum(diag(a))) < qptol failed.",warn=warn) - end subroutine test_trace_rqp - - - subroutine test_trace_csp - integer, parameter :: n = 5 - real(sp) :: re(n,n), im(n,n) - complex(sp) :: a(n,n), b(n,n) - complex(sp), parameter :: i_ = cmplx(0,1,kind=sp) - write(*,*) "test_trace_csp" - - call random_number(re) - call random_number(im) - a = re + im*i_ - - call random_number(re) - call random_number(im) - b = re + im*i_ - - ! tr(A + B) = tr(A) + tr(B) - call check(abs(trace(a+b) - (trace(a) + trace(b))) < sptol, & - msg="abs(trace(a+b) - (trace(a) + trace(b))) < sptol failed.",warn=warn) - end subroutine test_trace_csp - - subroutine test_trace_cdp - integer, parameter :: n = 3 - complex(dp) :: a(n,n), ans - complex(dp), parameter :: i_ = cmplx(0,1,kind=dp) - integer :: j - write(*,*) "test_trace_cdp" - - a = reshape([(j + (n**2 - (j-1))*i_,j=1,n**2)],[n,n]) - ans = cmplx(15,15,kind=dp) !(1 + 5 + 9) + (9 + 5 + 1)i - - call check(abs(trace(a) - ans) < dptol, & - msg="abs(trace(a) - ans) < dptol failed.",warn=warn) - end subroutine test_trace_cdp - - subroutine test_trace_cqp - integer, parameter :: n = 3 - complex(qp) :: a(n,n) - complex(qp), parameter :: i_ = cmplx(0,1,kind=qp) - write(*,*) "test_trace_cqp" - a = 3*eye(n) + 4*eye(n)*i_ ! pythagorean triple - call check(abs(trace(a)) - 3*5.0_qp < qptol, & - msg="abs(trace(a)) - 3*5.0_qp < qptol failed.",warn=warn) - end subroutine test_trace_cqp - - - subroutine test_trace_int8 - integer, parameter :: n = 3 - integer(int8) :: a(n,n) - integer :: i - write(*,*) "test_trace_int8" - a = reshape([(i**2,i=1,n**2)],[n,n]) - call check(trace(a) == (1 + 25 + 81), & - msg="trace(a) == (1 + 25 + 81) failed.",warn=warn) - end subroutine test_trace_int8 - - subroutine test_trace_int16 - integer, parameter :: n = 3 - integer(int16) :: a(n,n) - integer :: i - write(*,*) "test_trace_int16" - a = reshape([(i**3,i=1,n**2)],[n,n]) - call check(trace(a) == (1 + 125 + 729), & - msg="trace(a) == (1 + 125 + 729) failed.",warn=warn) - end subroutine test_trace_int16 - - subroutine test_trace_int32 - integer, parameter :: n = 3 - integer(int32) :: a(n,n) - integer :: i - write(*,*) "test_trace_int32" - a = reshape([(i**4,i=1,n**2)],[n,n]) - call check(trace(a) == (1 + 625 + 6561), & - msg="trace(a) == (1 + 625 + 6561) failed.",warn=warn) - end subroutine test_trace_int32 - - subroutine test_trace_int64 - integer, parameter :: n = 5 - integer, parameter :: nd = 2*n-1 ! number of diagonals - integer :: i, j - integer(int64) :: c(0:nd), H(n,n) - write(*,*) "test_trace_int64" - - ! Fill array with Catalan numbers - do i = 0, nd - c(i) = catalan_number(i) - end do - - ! Symmetric Hankel matrix filled with Catalan numbers (det(H) = 1) - do i = 1, n - do j = 1, n - H(i,j) = c(i-1 + (j-1)) - end do - end do - - call check(trace(h) == sum(c(0:nd:2)), & - msg="trace(h) == sum(c(0:nd:2)) failed.",warn=warn) - - end subroutine test_trace_int64 - - - subroutine test_outer_product_rsp - integer, parameter :: n = 2 - real(sp) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_rsp" - u = [1.,2.] - v = [1.,3.] - expected = reshape([1.,2.,3.,6.],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) < sptol), & - msg="all(abs(diff) < sptol) failed.",warn=warn) - end subroutine test_outer_product_rsp - - subroutine test_outer_product_rdp - integer, parameter :: n = 2 - real(dp) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_rdp" - u = [1.,2.] - v = [1.,3.] - expected = reshape([1.,2.,3.,6.],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) < dptol), & - msg="all(abs(diff) < dptol) failed.",warn=warn) - end subroutine test_outer_product_rdp - - subroutine test_outer_product_rqp - integer, parameter :: n = 2 - real(qp) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_rqp" - u = [1.,2.] - v = [1.,3.] - expected = reshape([1.,2.,3.,6.],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) < qptol), & - msg="all(abs(diff) < qptol) failed.",warn=warn) - end subroutine test_outer_product_rqp - - subroutine test_outer_product_csp - integer, parameter :: n = 2 - complex(sp) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_csp" - u = [cmplx(1.,1.),cmplx(2.,0.)] - v = [cmplx(1.,0.),cmplx(3.,1.)] - expected = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(2.,4.),cmplx(6.,2.)],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) < sptol), & - msg="all(abs(diff) < sptol) failed.",warn=warn) - end subroutine test_outer_product_csp - - subroutine test_outer_product_cdp - integer, parameter :: n = 2 - complex(dp) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_cdp" - u = [cmplx(1.,1.),cmplx(2.,0.)] - v = [cmplx(1.,0.),cmplx(3.,1.)] - expected = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(2.,4.),cmplx(6.,2.)],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) < dptol), & - msg="all(abs(diff) < dptol) failed.",warn=warn) - end subroutine test_outer_product_cdp - - subroutine test_outer_product_cqp - integer, parameter :: n = 2 - complex(qp) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_cqp" - u = [cmplx(1.,1.),cmplx(2.,0.)] - v = [cmplx(1.,0.),cmplx(3.,1.)] - expected = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(2.,4.),cmplx(6.,2.)],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) < qptol), & - msg="all(abs(diff) < qptol) failed.",warn=warn) - end subroutine test_outer_product_cqp - - subroutine test_outer_product_int8 - integer, parameter :: n = 2 - integer(int8) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_int8" - u = [1,2] - v = [1,3] - expected = reshape([1,2,3,6],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) == 0), & - msg="all(abs(diff) == 0) failed.",warn=warn) - end subroutine test_outer_product_int8 - - subroutine test_outer_product_int16 - integer, parameter :: n = 2 - integer(int16) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_int16" - u = [1,2] - v = [1,3] - expected = reshape([1,2,3,6],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) == 0), & - msg="all(abs(diff) == 0) failed.",warn=warn) - end subroutine test_outer_product_int16 - - subroutine test_outer_product_int32 - integer, parameter :: n = 2 - integer(int32) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_int32" - u = [1,2] - v = [1,3] - expected = reshape([1,2,3,6],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) == 0), & - msg="all(abs(diff) == 0) failed.",warn=warn) - end subroutine test_outer_product_int32 - - subroutine test_outer_product_int64 - integer, parameter :: n = 2 - integer(int64) :: u(n), v(n), expected(n,n), diff(n,n) - write(*,*) "test_outer_product_int64" - u = [1,2] - v = [1,3] - expected = reshape([1,2,3,6],[n,n]) - diff = expected - outer_product(u,v) - call check(all(abs(diff) == 0), & - msg="all(abs(diff) == 0) failed.",warn=warn) - end subroutine test_outer_product_int64 - -end program diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.full b/src/tests/linalg/test_linalg_matrix_property_checks.full deleted file mode 100644 index 4f5c5f768..000000000 --- a/src/tests/linalg/test_linalg_matrix_property_checks.full +++ /dev/null @@ -1,2068 +0,0 @@ -#:include "common.fypp" - -module test_linalg_matrix_property_checks - use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64 - use stdlib_linalg, only: is_square ,is_diagonal, is_symmetric, & - is_skew_symmetric, is_hermitian, is_triangular, is_hessenberg - - implicit none - - real(sp), parameter :: sptol = 1000 * epsilon(1._sp) - real(dp), parameter :: dptol = 1000 * epsilon(1._dp) -#:if WITH_QP - real(qp), parameter :: qptol = 1000 * epsilon(1._qp) -#:endif - - -contains - - - !> Collect all exported unit tests - subroutine collect_linalg_matrix_property_checks(testsuite) - !> Collection of tests - type(unittest_type), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - new_unittest("is_square_rsp", test_is_square_rsp), & - ] - - !testsuite = [ & - ! new_unittest("is_square_rsp", test_is_square_rsp), & - ! new_unittest("is_square_rdp", test_is_square_rdp), & - ! new_unittest("is_square_rqp", test_is_square_rqp), & - ! new_unittest("is_square_csp", test_is_square_csp), & - ! new_unittest("is_square_cdp", test_is_square_cdp), & - ! new_unittest("is_square_cqp", test_is_square_cqp), & - ! new_unittest("is_square_int8", test_is_square_int8), & - ! new_unittest("is_square_int16", test_is_square_int16), & - ! new_unittest("is_square_int32", test_is_square_int32), & - ! new_unittest("is_square_int64", test_is_square_int64), & - ! new_unittest("is_diagonal_rsp", test_is_diagonal_rsp), & - ! new_unittest("is_diagonal_rdp", test_is_diagonal_rdp), & - ! new_unittest("is_diagonal_rqp", test_is_diagonal_rqp), & - ! new_unittest("is_diagonal_csp", test_is_diagonal_csp), & - ! new_unittest("is_diagonal_cdp", test_is_diagonal_cdp), & - ! new_unittest("is_diagonal_cqp", test_is_diagonal_cqp), & - ! new_unittest("is_diagonal_int8", test_is_diagonal_int8), & - ! new_unittest("is_diagonal_int16", test_is_diagonal_int16), & - ! new_unittest("is_diagonal_int32", test_is_diagonal_int32), & - ! new_unittest("is_diagonal_int64", test_is_diagonal_int64), & - ! new_unittest("is_symmetric_rsp", test_is_symmetric_rsp), & - ! new_unittest("is_symmetric_rdp", test_is_symmetric_rdp), & - ! new_unittest("is_symmetric_rqp", test_is_symmetric_rqp), & - ! new_unittest("is_symmetric_csp", test_is_symmetric_csp), & - ! new_unittest("is_symmetric_cdp", test_is_symmetric_cdp), & - ! new_unittest("is_symmetric_cqp", test_is_symmetric_cqp), & - ! new_unittest("is_symmetric_int8", test_is_symmetric_int8), & - ! new_unittest("is_symmetric_int16", test_is_symmetric_int16), & - ! new_unittest("is_symmetric_int32", test_is_symmetric_int32), & - ! new_unittest("is_symmetric_int64", test_is_symmetric_int64), & - ! new_unittest("is_skew_symmetric_rsp", test_is_skew_symmetric_rsp), & - ! new_unittest("is_skew_symmetric_rdp", test_is_skew_symmetric_rdp), & - ! new_unittest("is_skew_symmetric_rqp", test_is_skew_symmetric_rqp), & - ! new_unittest("is_skew_symmetric_csp", test_is_skew_symmetric_csp), & - ! new_unittest("is_skew_symmetric_cdp", test_is_skew_symmetric_cdp), & - ! new_unittest("is_skew_symmetric_cqp", test_is_skew_symmetric_cqp), & - ! new_unittest("is_skew_symmetric_int8", test_is_skew_symmetric_int8), & - ! new_unittest("is_skew_symmetric_int16", test_is_skew_symmetric_int16), & - ! new_unittest("is_skew_symmetric_int32", test_is_skew_symmetric_int32), & - ! new_unittest("is_skew_symmetric_int64", test_is_skew_symmetric_int64), & - ! new_unittest("is_hermitian_rsp", test_is_hermitian_rsp), & - ! new_unittest("is_hermitian_rdp", test_is_hermitian_rdp), & - ! new_unittest("is_hermitian_rqp", test_is_hermitian_rqp), & - ! new_unittest("is_hermitian_csp", test_is_hermitian_csp), & - ! new_unittest("is_hermitian_cdp", test_is_hermitian_cdp), & - ! new_unittest("is_hermitian_cqp", test_is_hermitian_cqp), & - ! new_unittest("is_hermitian_int8", test_is_hermitian_int8), & - ! new_unittest("is_hermitian_int16", test_is_hermitian_int16), & - ! new_unittest("is_hermitian_int32", test_is_hermitian_int32), & - ! new_unittest("is_hermitian_int64", test_is_hermitian_int64), & - ! new_unittest("is_triangular_rsp", test_is_triangular_rsp), & - ! new_unittest("is_triangular_rdp", test_is_triangular_rdp), & - ! new_unittest("is_triangular_rqp", test_is_triangular_rqp), & - ! new_unittest("is_triangular_csp", test_is_triangular_csp), & - ! new_unittest("is_triangular_cdp", test_is_triangular_cdp), & - ! new_unittest("is_triangular_cqp", test_is_triangular_cqp), & - ! new_unittest("is_triangular_int8", test_is_triangular_int8), & - ! new_unittest("is_triangular_int16", test_is_triangular_int16), & - ! new_unittest("is_triangular_int32", test_is_triangular_int32), & - ! new_unittest("is_triangular_int64", test_is_triangular_int64), & - ! new_unittest("is_hessenberg_rsp", test_is_hessenberg_rsp), & - ! new_unittest("is_hessenberg_rdp", test_is_hessenberg_rdp), & - ! new_unittest("is_hessenberg_rqp", test_is_hessenberg_rqp), & - ! new_unittest("is_hessenberg_csp", test_is_hessenberg_csp), & - ! new_unittest("is_hessenberg_cdp", test_is_hessenberg_cdp), & - ! new_unittest("is_hessenberg_cqp", test_is_hessenberg_cqp), & - ! new_unittest("is_hessenberg_int8", test_is_hessenberg_int8), & - ! new_unittest("is_hessenberg_int16", test_is_hessenberg_int16), & - ! new_unittest("is_hessenberg_int32", test_is_hessenberg_int32), & - ! new_unittest("is_hessenberg_int64", test_is_hessenberg_int64), & - ! ] - - end subroutine collect_linalg_matrix_property_checks - - subroutine test_is_square_rsp(error) - !> Error handling - type(error_type), allocatable, intent(out) :: error - - real(sp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_rsp" - A_true = reshape([1.,2.,3.,4.],[2,2]) - A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - - call check(error, is_square(A_true), & - "is_square(A_true) failed.") - if (allocated(error)) return - call check(error, (.not. is_square(A_false)), & - "(.not. is_square(A_false)) failed.") - end subroutine test_is_square_rsp - - subroutine test_is_square_rdp - real(dp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_rdp" - A_true = reshape([1.,2.,3.,4.],[2,2]) - A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_rdp - - subroutine test_is_square_rqp - real(qp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_rqp" - A_true = reshape([1.,2.,3.,4.],[2,2]) - A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_rqp - - subroutine test_is_square_csp - complex(sp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_csp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_csp - - subroutine test_is_square_cdp - complex(dp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_cdp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_cdp - - subroutine test_is_square_cqp - complex(qp) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_cqp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) - A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & - cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_cqp - - subroutine test_is_square_int8 - integer(int8) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int8" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int8 - - subroutine test_is_square_int16 - integer(int16) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int16" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int16 - - subroutine test_is_square_int32 - integer(int32) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int32" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int32 - - subroutine test_is_square_int64 - integer(int64) :: A_true(2,2), A_false(2,3) - write(*,*) "test_is_square_int64" - A_true = reshape([1,2,3,4],[2,2]) - A_false = reshape([1,2,3,4,5,6],[2,3]) - call check(is_square(A_true), & - msg="is_square(A_true) failed.",warn=warn) - call check((.not. is_square(A_false)), & - msg="(.not. is_square(A_false)) failed.",warn=warn) - end subroutine test_is_square_int64 - - - subroutine test_is_diagonal_rsp - real(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - real(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - real(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_rsp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) - A_false_s = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) - A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) - A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) - A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_rsp - - subroutine test_is_diagonal_rdp - real(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - real(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - real(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_rdp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) - A_false_s = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) - A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) - A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) - A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_rdp - - subroutine test_is_diagonal_rqp - real(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - real(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - real(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_rqp" - A_true_s = reshape([1.,0.,0.,4.],[2,2]) - A_false_s = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) - A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) - A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) - A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_rqp - - subroutine test_is_diagonal_csp - complex(sp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - complex(sp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - complex(sp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_csp" - A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.)],[2,2]) - A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_csp - - subroutine test_is_diagonal_cdp - complex(dp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - complex(dp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - complex(dp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_cdp" - A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.)],[2,2]) - A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_cdp - - subroutine test_is_diagonal_cqp - complex(qp) :: A_true_s(2,2), A_false_s(2,2) !square matrices - complex(qp) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - complex(qp) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_cqp" - A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.)],[2,2]) - A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_true_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,1.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_cqp - - subroutine test_is_diagonal_int8 - integer(int8) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int8) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int8) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int8" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int8 - - subroutine test_is_diagonal_int16 - integer(int16) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int16) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int16) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int16" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int16 - - subroutine test_is_diagonal_int32 - integer(int32) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int32) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int32) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int32" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int32 - - subroutine test_is_diagonal_int64 - integer(int64) :: A_true_s(2,2), A_false_s(2,2) !square matrices - integer(int64) :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - integer(int64) :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices - write(*,*) "test_is_diagonal_int64" - A_true_s = reshape([1,0,0,4],[2,2]) - A_false_s = reshape([1,0,3,4],[2,2]) - A_true_sf = reshape([1,0,0,4,0,0],[2,3]) - A_false_sf = reshape([1,0,3,4,0,0],[2,3]) - A_true_ts = reshape([1,0,0,0,5,0],[3,2]) - A_false_ts = reshape([1,0,0,0,5,6],[3,2]) - call check(is_diagonal(A_true_s), & - msg="is_diagonal(A_true_s) failed.",warn=warn) - call check((.not. is_diagonal(A_false_s)), & - msg="(.not. is_diagonal(A_false_s)) failed.",warn=warn) - call check(is_diagonal(A_true_sf), & - msg="is_diagonal(A_true_sf) failed.",warn=warn) - call check((.not. is_diagonal(A_false_sf)), & - msg="(.not. is_diagonal(A_false_sf)) failed.",warn=warn) - call check(is_diagonal(A_true_ts), & - msg="is_diagonal(A_true_ts) failed.",warn=warn) - call check((.not. is_diagonal(A_false_ts)), & - msg="(.not. is_diagonal(A_false_ts)) failed.",warn=warn) - end subroutine test_is_diagonal_int64 - - - subroutine test_is_symmetric_rsp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_rsp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_rsp - - subroutine test_is_symmetric_rdp - real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_rdp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_rdp - - subroutine test_is_symmetric_rqp - real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_rqp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_rqp - - subroutine test_is_symmetric_csp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_csp" - A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(2.,1.),cmplx(4.,1.)],[2,2]) - A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & - cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_csp - - subroutine test_is_symmetric_cdp - complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_cdp" - A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(2.,1.),cmplx(4.,1.)],[2,2]) - A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & - cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_cdp - - subroutine test_is_symmetric_cqp - complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_cqp" - A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(2.,1.),cmplx(4.,1.)],[2,2]) - A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & - cmplx(3.,1.),cmplx(4.,1.)],[2,2]) - A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & - cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_cqp - - subroutine test_is_symmetric_int8 - integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int8" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int8 - - subroutine test_is_symmetric_int16 - integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int16" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int16 - - subroutine test_is_symmetric_int32 - integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int32" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int32 - - subroutine test_is_symmetric_int64 - integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_symmetric_int64" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_symmetric(A_true), & - msg="is_symmetric(A_true) failed.",warn=warn) - call check((.not. is_symmetric(A_false_1)), & - msg="(.not. is_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_symmetric(A_false_2)), & - msg="(.not. is_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_symmetric_int64 - - - subroutine test_is_skew_symmetric_rsp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_rsp" - A_true = reshape([0.,2.,-2.,0.],[2,2]) - A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) - A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_rsp - - subroutine test_is_skew_symmetric_rdp - real(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_rdp" - A_true = reshape([0.,2.,-2.,0.],[2,2]) - A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) - A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_rdp - - subroutine test_is_skew_symmetric_rqp - real(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_rqp" - A_true = reshape([0.,2.,-2.,0.],[2,2]) - A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) - A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_rqp - - subroutine test_is_skew_symmetric_csp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_csp" - A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) - A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) - A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & - -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_csp - - subroutine test_is_skew_symmetric_cdp - complex(dp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_cdp" - A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) - A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) - A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & - -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_cdp - - subroutine test_is_skew_symmetric_cqp - complex(qp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_cqp" - A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) - A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & - -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) - A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & - -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_cqp - - subroutine test_is_skew_symmetric_int8 - integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int8" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int8 - - subroutine test_is_skew_symmetric_int16 - integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int16" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int16 - - subroutine test_is_skew_symmetric_int32 - integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int32" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int32 - - subroutine test_is_skew_symmetric_int64 - integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_skew_symmetric_int64" - A_true = reshape([0,2,-2,0],[2,2]) - A_false_1 = reshape([0,2,-3,0],[2,2]) - A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix - call check(is_skew_symmetric(A_true), & - msg="is_skew_symmetric(A_true) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_1)), & - msg="(.not. is_skew_symmetric(A_false_1)) failed.",warn=warn) - call check((.not. is_skew_symmetric(A_false_2)), & - msg="(.not. is_skew_symmetric(A_false_2)) failed.",warn=warn) - end subroutine test_is_skew_symmetric_int64 - - - subroutine test_is_hermitian_rsp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_rsp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_rsp - - subroutine test_is_hermitian_rdp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_rdp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_rdp - - subroutine test_is_hermitian_rqp - real(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_rqp" - A_true = reshape([1.,2.,2.,4.],[2,2]) - A_false_1 = reshape([1.,2.,3.,4.],[2,2]) - A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_rqp - - subroutine test_is_hermitian_csp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_csp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(2.,1.),cmplx(4.,0.)],[2,2]) - A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & - cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_csp - - subroutine test_is_hermitian_cdp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_cdp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(2.,1.),cmplx(4.,0.)],[2,2]) - A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & - cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_cdp - - subroutine test_is_hermitian_cqp - complex(sp) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_cqp" - A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(2.,1.),cmplx(4.,0.)],[2,2]) - A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & - cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_cqp - - subroutine test_is_hermitian_int8 - integer(int8) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int8" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int8 - - subroutine test_is_hermitian_int16 - integer(int16) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int16" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int16 - - subroutine test_is_hermitian_int32 - integer(int32) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int32" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int32 - - subroutine test_is_hermitian_int64 - integer(int64) :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) - write(*,*) "test_is_hermitian_int64" - A_true = reshape([1,2,2,4],[2,2]) - A_false_1 = reshape([1,2,3,4],[2,2]) - A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix - call check(is_hermitian(A_true), & - msg="is_hermitian(A_true) failed.",warn=warn) - call check((.not. is_hermitian(A_false_1)), & - msg="(.not. is_hermitian(A_false_1)) failed.",warn=warn) - call check((.not. is_hermitian(A_false_2)), & - msg="(.not. is_hermitian(A_false_2)) failed.",warn=warn) - end subroutine test_is_hermitian_int64 - - - subroutine test_is_triangular_rsp - real(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - real(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - real(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - real(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - real(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - real(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_rsp" - !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) - A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) - A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) - A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) - A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) - A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) - A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) - A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) - A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_rsp - - subroutine test_is_triangular_rdp - real(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - real(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - real(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - real(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - real(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - real(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_rdp" - !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) - A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) - A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) - A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) - A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) - A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) - A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) - A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) - A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_rdp - - subroutine test_is_triangular_rqp - real(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - real(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - real(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - real(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - real(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - real(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_rqp" - !upper triangular - A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) - A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) - A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) - A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) - A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) - A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) - A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) - A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) - A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) - A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_rqp - - subroutine test_is_triangular_csp - complex(sp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - complex(sp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - complex(sp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - complex(sp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - complex(sp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - complex(sp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_csp" - !upper triangular - A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_csp - - subroutine test_is_triangular_cdp - complex(dp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - complex(dp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - complex(dp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - complex(dp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - complex(dp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - complex(dp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_cdp" - !upper triangular - A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_cdp - - subroutine test_is_triangular_cqp - complex(qp) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - complex(qp) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - complex(qp) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - complex(qp) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - complex(qp) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - complex(qp) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_cqp" - !upper triangular - A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(6.,0.)],[2,3]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.)],[2,2]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & - cmplx(3.,1.),cmplx(4.,0.)],[2,2]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(0.,0.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & - cmplx(3.,1.),cmplx(4.,0.), & - cmplx(0.,0.),cmplx(0.,0.)],[2,3]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_cqp - - subroutine test_is_triangular_int8 - integer(int8) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int8) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int8) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int8) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int8) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int8) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int8" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int8 - - subroutine test_is_triangular_int16 - integer(int16) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int16) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int16) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int16) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int16) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int16) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int16" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int16 - - subroutine test_is_triangular_int32 - integer(int32) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int32) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int32) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int32) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int32) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int32) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int32" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int32 - - subroutine test_is_triangular_int64 - integer(int64) :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) - integer(int64) :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices - integer(int64) :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices - integer(int64) :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) - integer(int64) :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices - integer(int64) :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices - write(*,*) "test_is_triangular_int64" - !upper triangular - A_true_s_u = reshape([1,0,3,4],[2,2]) - A_false_s_u = reshape([1,2,0,4],[2,2]) - A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) - A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) - A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) - A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) - call check(is_triangular(A_true_s_u,'u'), & - msg="is_triangular(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_u,'u')), & - msg="(.not. is_triangular(A_false_s_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_sf_u,'u'), & - msg="is_triangular(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_u,'u')), & - msg="(.not. is_triangular(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_triangular(A_true_ts_u,'u'), & - msg="is_triangular(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_u,'u')), & - msg="(.not. is_triangular(A_false_ts_u,'u')) failed.",warn=warn) - !lower triangular - A_true_s_l = reshape([1,2,0,4],[2,2]) - A_false_s_l = reshape([1,0,3,4],[2,2]) - A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) - A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) - A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) - A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) - call check(is_triangular(A_true_s_l,'l'), & - msg="is_triangular(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_s_l,'l')), & - msg="(.not. is_triangular(A_false_s_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_sf_l,'l'), & - msg="is_triangular(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_sf_l,'l')), & - msg="(.not. is_triangular(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_triangular(A_true_ts_l,'l'), & - msg="is_triangular(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_triangular(A_false_ts_l,'l')), & - msg="(.not. is_triangular(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_triangular_int64 - - - subroutine test_is_hessenberg_rsp - real(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - real(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - real(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - real(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - real(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - real(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_rsp" - !upper hessenberg - A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) - A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) - A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) - A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) - A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_rsp - - subroutine test_is_hessenberg_rdp - real(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - real(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - real(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - real(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - real(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - real(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_rdp" - !upper hessenberg - A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) - A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) - A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) - A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) - A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_rdp - - subroutine test_is_hessenberg_rqp - real(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - real(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - real(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - real(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - real(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - real(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_rqp" - !upper hessenberg - A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) - A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) - A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) - A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) - A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) - A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) - A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) - A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_rqp - - subroutine test_is_hessenberg_csp - complex(sp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - complex(sp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - complex(sp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - complex(sp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - complex(sp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - complex(sp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_csp" - !upper hessenberg - A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_csp - - subroutine test_is_hessenberg_cdp - complex(dp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - complex(dp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - complex(dp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - complex(dp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - complex(dp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - complex(dp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_cdp" - !upper hessenberg - A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_cdp - - subroutine test_is_hessenberg_cqp - complex(qp) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - complex(qp) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - complex(qp) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - complex(qp) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - complex(qp) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - complex(qp) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_cqp" - !upper hessenberg - A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) - A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) - A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & - cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & - cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & - cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) - A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & - cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & - cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_cqp - - subroutine test_is_hessenberg_int8 - integer(int8) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int8) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int8) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int8) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int8) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int8) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int8" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int8 - - subroutine test_is_hessenberg_int16 - integer(int16) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int16) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int16) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int16) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int16) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int16) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int16" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int16 - - subroutine test_is_hessenberg_int32 - integer(int32) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int32) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int32) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int32) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int32) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int32) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int32" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int32 - - subroutine test_is_hessenberg_int64 - integer(int64) :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) - integer(int64) :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices - integer(int64) :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices - integer(int64) :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) - integer(int64) :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices - integer(int64) :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices - write(*,*) "test_is_hessenberg_int64" - !upper hessenberg - A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) - A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) - A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) - A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) - A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_u,'u'), & - msg="is_hessenberg(A_true_s_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_u,'u')), & - msg="(.not. is_hessenberg(A_false_s_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_u,'u'), & - msg="is_hessenberg(A_true_sf_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_u,'u')), & - msg="(.not. is_hessenberg(A_false_sf_u,'u')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_u,'u'), & - msg="is_hessenberg(A_true_ts_u,'u') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_u,'u')), & - msg="(.not. is_hessenberg(A_false_ts_u,'u')) failed.",warn=warn) - !lower hessenberg - A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) - A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) - A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) - A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) - A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) - A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) - call check(is_hessenberg(A_true_s_l,'l'), & - msg="is_hessenberg(A_true_s_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_s_l,'l')), & - msg="(.not. is_hessenberg(A_false_s_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_sf_l,'l'), & - msg="is_hessenberg(A_true_sf_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_sf_l,'l')), & - msg="(.not. is_hessenberg(A_false_sf_l,'l')) failed.",warn=warn) - call check(is_hessenberg(A_true_ts_l,'l'), & - msg="is_hessenberg(A_true_ts_l,'l') failed.",warn=warn) - call check((.not. is_hessenberg(A_false_ts_l,'l')), & - msg="(.not. is_hessenberg(A_false_ts_l,'l')) failed.",warn=warn) - end subroutine test_is_hessenberg_int64 - -end module - -program tester - use, intrinsic :: iso_fortran_env, only : error_unit - use testdrive, only : run_testsuite, new_testsuite, testsuite_type - use test_linalg_matrix_property_checks, only : collect_linalg_matrix_property_checks - implicit none - integer :: stat, is - type(testsuite_type), allocatable :: testsuites(:) - character(len=*), parameter :: fmt = '("#", *(1x, a))' - - stat = 0 - - testsuites = [ & - new_testsuite("linalg_matrix_property_checks", collect_linalg_matrix_property_checks) & - ] - - do is = 1, size(testsuites) - write(error_unit, fmt) "Testing:", testsuites(is)%name - call run_testsuite(testsuites(is)%collect, error_unit, stat) - end do - - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" - error stop - end if -end program diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.fypp b/src/tests/linalg/test_linalg_matrix_property_checks.fypp index e638c5dc6..ebea3bda1 100644 --- a/src/tests/linalg/test_linalg_matrix_property_checks.fypp +++ b/src/tests/linalg/test_linalg_matrix_property_checks.fypp @@ -37,7 +37,8 @@ contains type(unittest_type), allocatable, intent(out) :: testsuite(:) - #:set IMPLEMENTED_TESTS = ['is_square','is_diagonal'] + #:set IMPLEMENTED_TESTS = ['is_square','is_diagonal','is_symmetric','is_skew_symmetric' & + 'is_hermitian'] #:set NUM_TESTS = int(len(IMPLEMENTED_TESTS)*len(RCI_KINDS_TYPES_SUFFIXES)) @@ -66,23 +67,22 @@ contains !> Error handling type(error_type), allocatable, intent(out) :: error - #!populate variables dependent on type/kind - #:if s1[0] == 'r' + #! variable sizes independent of type/kind ${t1}$ :: A_true(2,2), A_false(2,3) + #! populate variables dependent on type/kind + #:if s1[0] == 'r' A_true = reshape([1.,2.,3.,4.],[2,2]) A_false = reshape([1.,2.,3.,4.,5.,6.],[2,3]) #:elif s1[0] == 'c' - ${t1}$ :: A_true(2,2), A_false(2,3) A_true = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.),cmplx(4.,1.)],[2,2]) A_false = reshape([cmplx(1.,0.),cmplx(2.,1.),cmplx(3.,0.), & cmplx(4.,1.),cmplx(5.,0.),cmplx(6.,1.)],[2,3]) #:elif s1[0] == 'i' - ${t1}$ :: A_true(2,2), A_false(2,3) A_true = reshape([1,2,3,4],[2,2]) A_false = reshape([1,2,3,4,5,6],[2,3]) #:endif - #! all error check calls are type/kind independent + #! error check calls are type/kind independent call check(error, is_square(A_true), & "is_square(A_true) failed.") if (allocated(error)) return @@ -99,11 +99,12 @@ contains !> Error handling type(error_type), allocatable, intent(out) :: error - #!populate variables dependent on type/kind - #:if s1[0] == 'r' + #! variable sizes independent of type/kind ${t1}$ :: A_true_s(2,2), A_false_s(2,2) !square matrices ${t1}$ :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices + #! populate variables dependent on type/kind + #:if s1[0] == 'r' A_true_s = reshape([1.,0.,0.,4.],[2,2]) A_false_s = reshape([1.,0.,3.,4.],[2,2]) A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) @@ -111,9 +112,6 @@ contains A_true_ts = reshape([1.,0.,0.,0.,5.,0.],[3,2]) A_false_ts = reshape([1.,0.,0.,0.,5.,6.],[3,2]) #:elif s1[0] == 'c' - ${t1}$ :: A_true_s(2,2), A_false_s(2,2) !square matrices - ${t1}$ :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices A_true_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(4.,1.)],[2,2]) A_false_s = reshape([cmplx(1.,1.),cmplx(0.,0.), & @@ -129,9 +127,6 @@ contains A_false_ts = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,1.)],[3,2]) #:elif s1[0] == 'i' - ${t1}$ :: A_true_s(2,2), A_false_s(2,2) !square matrices - ${t1}$ :: A_true_sf(2,3), A_false_sf(2,3) !short and fat matrices - ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices A_true_s = reshape([1,0,0,4],[2,2]) A_false_s = reshape([1,0,3,4],[2,2]) A_true_sf = reshape([1,0,0,4,0,0],[2,3]) @@ -140,7 +135,7 @@ contains A_false_ts = reshape([1,0,0,0,5,6],[3,2]) #:endif - #! all error check calls are type/kind independent + #! error check calls are type/kind independent call check(error, is_diagonal(A_true_s), & "is_diagonal(A_true_s) failed.") if (allocated(error)) return @@ -169,14 +164,14 @@ contains !> Error handling type(error_type), allocatable, intent(out) :: error - #!populate variables dependent on type/kind - #:if s1[0] == 'r' + #! variable sizes independent of type/kind ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + #! populate variables dependent on type/kind + #:if s1[0] == 'r' A_true = reshape([1.,2.,2.,4.],[2,2]) A_false_1 = reshape([1.,2.,3.,4.],[2,2]) A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix #:elif s1[0] == 'c' - ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) A_true = reshape([cmplx(1.,1.),cmplx(2.,1.), & cmplx(2.,1.),cmplx(4.,1.)],[2,2]) A_false_1 = reshape([cmplx(1.,1.),cmplx(2.,1.), & @@ -184,13 +179,12 @@ contains A_false_2 = reshape([cmplx(1.,1.),cmplx(2.,1.),cmplx(3.,1.), & cmplx(2.,1.),cmplx(5.,1.),cmplx(6.,2.)],[3,2]) !nonsquare matrix #:elif s1[0] == 'i' - ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) A_true = reshape([1,2,2,4],[2,2]) A_false_1 = reshape([1,2,3,4],[2,2]) A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix #:endif - #! all error check calls are type/kind independent + #! error check calls are type/kind independent call check(error, is_symmetric(A_true), & "is_symmetric(A_true) failed.") if (allocated(error)) return @@ -204,25 +198,324 @@ contains #:endfor + !is_skew_symmetric + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_skew_symmetric_${s1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + #! variable sizes independent of type/kind + ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + #! populate variables dependent on type/kind + #:if s1[0] == 'r' + A_true = reshape([0.,2.,-2.,0.],[2,2]) + A_false_1 = reshape([0.,2.,-3.,0.],[2,2]) + A_false_2 = reshape([0.,2.,3.,-2.,0.,6.],[3,2]) !nonsquare matrix + #:elif s1[0] == 'c' + A_true = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(2.,1.),cmplx(0.,0.)],[2,2]) + A_false_1 = reshape([cmplx(0.,0.),cmplx(2.,1.), & + -cmplx(3.,1.),cmplx(0.,0.)],[2,2]) + A_false_2 = reshape([cmplx(0.,0.),cmplx(2.,1.),cmplx(3.,0.), & + -cmplx(2.,1.),cmplx(0.,0.),cmplx(6.,0.)],[3,2]) !nonsquare matrix + #:elif s1[0] == 'i' + A_true = reshape([0,2,-2,0],[2,2]) + A_false_1 = reshape([0,2,-3,0],[2,2]) + A_false_2 = reshape([0,2,3,-2,0,6],[3,2]) !nonsquare matrix + #:endif + + #! error check calls are type/kind independent + call check(error, is_skew_symmetric(A_true), & + "is_skew_symmetric(A_true) failed.") + if (allocated(error)) return + call check(error, (.not. is_skew_symmetric(A_false_1)), & + "(.not. is_skew_symmetric(A_false_1)) failed.") + if (allocated(error)) return + call check(error, (.not. is_skew_symmetric(A_false_2)), & + "(.not. is_skew_symmetric(A_false_2)) failed.") + if (allocated(error)) return + end subroutine test_is_skew_symmetric_${s1}$ + #:endfor + !is_hermitian + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_hermitian_${s1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error -! !TEST TEMPLATE -! !is_diagonal -! #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES -! subroutine test_is_diagonal_${s1}$(error) -! !> Error handling -! type(error_type), allocatable, intent(out) :: error -! -! #!populate variables dependent on type/kind -! #:if s1[0] == 'r' -! #:elif s1[0] == 'c' -! #:elif s1[0] == 'i' -! #:endif -! -! #! all error check calls are type/kind independent -! end subroutine test_is_diagonal_${s1}$ -! #:endfor + #! variable sizes independent of type/kind + ${t1}$ :: A_true(2,2), A_false_1(2,2), A_false_2(3,2) + #! populate variables dependent on type/kind + #:if s1[0] == 'r' + A_true = reshape([1.,2.,2.,4.],[2,2]) + A_false_1 = reshape([1.,2.,3.,4.],[2,2]) + A_false_2 = reshape([1.,2.,3.,2.,5.,6.],[3,2]) !nonsquare matrix + #:elif s1[0] == 'c' + A_true = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(2.,1.),cmplx(4.,0.)],[2,2]) + A_false_1 = reshape([cmplx(1.,0.),cmplx(2.,-1.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_2 = reshape([cmplx(1.,0.),cmplx(2.,-1.),cmplx(3.,-1.), & + cmplx(2.,1.),cmplx(5.,0.),cmplx(6.,-1.)],[3,2]) !nonsquare matrix + #:elif s1[0] == 'i' + A_true = reshape([1,2,2,4],[2,2]) + A_false_1 = reshape([1,2,3,4],[2,2]) + A_false_2 = reshape([1,2,3,2,5,6],[3,2]) !nonsquare matrix + #:endif + + #! error check calls are type/kind independent + call check(error, is_hermitian(A_true), & + "is_hermitian(A_true) failed.") + if (allocated(error)) return + call check(error, (.not. is_hermitian(A_false_1)), & + "(.not. is_hermitian(A_false_1)) failed.") + if (allocated(error)) return + call check(error, (.not. is_hermitian(A_false_2)), & + "(.not. is_hermitian(A_false_2)) failed.") + if (allocated(error)) return + end subroutine test_is_hermitian_${s1}$ + #:endfor + + + !is_triangular + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_triangular_${s1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + #! variable sizes independent of type/kind + ${t1}$ :: A_true_s_u(2,2), A_false_s_u(2,2) !square matrices (upper triangular) + ${t1}$ :: A_true_sf_u(2,3), A_false_sf_u(2,3) !short and fat matrices + ${t1}$ :: A_true_ts_u(3,2), A_false_ts_u(3,2) !tall and skinny matrices + ${t1}$ :: A_true_s_l(2,2), A_false_s_l(2,2) !square matrices (lower triangular) + ${t1}$ :: A_true_sf_l(2,3), A_false_sf_l(2,3) !short and fat matrices + ${t1}$ :: A_true_ts_l(3,2), A_false_ts_l(3,2) !tall and skinny matrices + #! populate variables dependent on type/kind + #:if s1[0] == 'r' + !upper triangular + A_true_s_u = reshape([1.,0.,3.,4.],[2,2]) + A_false_s_u = reshape([1.,2.,0.,4.],[2,2]) + A_true_sf_u = reshape([1.,0.,3.,4.,0.,6.],[2,3]) + A_false_sf_u = reshape([1.,2.,3.,4.,0.,6.],[2,3]) + A_true_ts_u = reshape([1.,0.,0.,4.,5.,0.],[3,2]) + A_false_ts_u = reshape([1.,0.,0.,4.,5.,6.],[3,2]) + !lower triangular + A_true_s_l = reshape([1.,2.,0.,4.],[2,2]) + A_false_s_l = reshape([1.,0.,3.,4.],[2,2]) + A_true_sf_l = reshape([1.,2.,0.,4.,0.,0.],[2,3]) + A_false_sf_l = reshape([1.,2.,3.,4.,0.,0.],[2,3]) + A_true_ts_l = reshape([1.,2.,3.,0.,5.,6.],[3,2]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.],[3,2]) + #:elif s1[0] == 'c' + !upper triangular + A_true_s_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(6.,0.)],[2,3]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(0.,0.)],[3,2]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + !lower triangular + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.)],[2,2]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(0.,0.), & + cmplx(3.,1.),cmplx(4.,0.)],[2,2]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(0.,0.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.), & + cmplx(3.,1.),cmplx(4.,0.), & + cmplx(0.,0.),cmplx(0.,0.)],[2,3]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(0.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.)],[3,2]) + #:elif s1[0] == 'i' + !upper triangular + A_true_s_u = reshape([1,0,3,4],[2,2]) + A_false_s_u = reshape([1,2,0,4],[2,2]) + A_true_sf_u = reshape([1,0,3,4,0,6],[2,3]) + A_false_sf_u = reshape([1,2,3,4,0,6],[2,3]) + A_true_ts_u = reshape([1,0,0,4,5,0],[3,2]) + A_false_ts_u = reshape([1,0,0,4,5,6],[3,2]) + !lower triangular + A_true_s_l = reshape([1,2,0,4],[2,2]) + A_false_s_l = reshape([1,0,3,4],[2,2]) + A_true_sf_l = reshape([1,2,0,4,0,0],[2,3]) + A_false_sf_l = reshape([1,2,3,4,0,0],[2,3]) + A_true_ts_l = reshape([1,2,3,0,5,6],[3,2]) + A_false_ts_l = reshape([1,2,3,4,5,6],[3,2]) + #:endif + + #! error check calls are type/kind independent + !upper triangular checks + call check(error, is_triangular(A_true_s_u,'u'), & + "is_triangular(A_true_s_u,'u') failed.") + if (allocated(error)) return + call check(error, (.not. is_triangular(A_false_s_u,'u')), & + "(.not. is_triangular(A_false_s_u,'u')) failed.") + if (allocated(error)) return + call check(error, is_triangular(A_true_sf_u,'u'), & + "is_triangular(A_true_sf_u,'u') failed.") + if (allocated(error)) return + call check(error, (.not. is_triangular(A_false_sf_u,'u')), & + "(.not. is_triangular(A_false_sf_u,'u')) failed.") + if (allocated(error)) return + call check(error, is_triangular(A_true_ts_u,'u'), & + "is_triangular(A_true_ts_u,'u') failed.") + if (allocated(error)) return + call check(error, (.not. is_triangular(A_false_ts_u,'u')), & + "(.not. is_triangular(A_false_ts_u,'u')) failed.") + if (allocated(error)) return + !lower triangular checks + call check(error, is_triangular(A_true_s_l,'l'), & + "is_triangular(A_true_s_l,'l') failed.") + if (allocated(error)) return + call check(error, (.not. is_triangular(A_false_s_l,'l')), & + "(.not. is_triangular(A_false_s_l,'l')) failed.") + if (allocated(error)) return + call check(error, is_triangular(A_true_sf_l,'l'), & + "is_triangular(A_true_sf_l,'l') failed.") + if (allocated(error)) return + call check(error, (.not. is_triangular(A_false_sf_l,'l')), & + "(.not. is_triangular(A_false_sf_l,'l')) failed.") + if (allocated(error)) return + call check(error, is_triangular(A_true_ts_l,'l'), & + "is_triangular(A_true_ts_l,'l') failed.") + if (allocated(error)) return + call check(error, (.not. is_triangular(A_false_ts_l,'l')), & + "(.not. is_triangular(A_false_ts_l,'l')) failed.") + if (allocated(error)) return + end subroutine test_is_triangular_${s1}$ + #:endfor + + + !is_hessenberg + #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES + subroutine test_is_hessenberg_${s1}$(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + #! variable sizes independent of type/kind + ${t1}$ :: A_true_s_u(3,3), A_false_s_u(3,3) !square matrices (upper hessenberg) + ${t1}$ :: A_true_sf_u(3,4), A_false_sf_u(3,4) !short and fat matrices + ${t1}$ :: A_true_ts_u(4,3), A_false_ts_u(4,3) !tall and skinny matrices + ${t1}$ :: A_true_s_l(3,3), A_false_s_l(3,3) !square matrices (lower hessenberg) + ${t1}$ :: A_true_sf_l(3,4), A_false_sf_l(3,4) !short and fat matrices + ${t1}$ :: A_true_ts_l(4,3), A_false_ts_l(4,3) !tall and skinny matrices + #! populate variables dependent on type/kind + #:if s1[0] == 'r' + !upper hessenberg + A_true_s_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.],[3,3]) + A_false_s_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_u = reshape([1.,2.,0.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_false_sf_u = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[3,4]) + A_true_ts_u = reshape([1.,2.,0.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + A_false_ts_u = reshape([1.,2.,3.,0.,5.,6.,7.,0.,9.,10.,11.,12.],[4,3]) + !lower hessenberg + A_true_s_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.],[3,3]) + A_false_s_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.],[3,3]) + A_true_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,0.,12.],[3,4]) + A_false_sf_l = reshape([1.,2.,3.,4.,5.,6.,0.,8.,9.,0.,11.,12.],[3,4]) + A_true_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,0.,10.,11.,12.],[4,3]) + A_false_ts_l = reshape([1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.],[4,3]) + #:elif s1[0] == 'c' + !upper hessenberg + A_true_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_false_sf_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(0.,0.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_u = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(0.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(0.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + !lower hessenberg + A_true_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_false_s_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(7.,1.),cmplx(8.,0.),cmplx(9.,1.)],[3,3]) + A_true_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(0.,0.),cmplx(12.,0.)],[3,4]) + A_false_sf_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.), & + cmplx(4.,0.),cmplx(5.,1.),cmplx(6.,0.), & + cmplx(0.,0.),cmplx(8.,0.),cmplx(9.,1.), & + cmplx(0.,0.),cmplx(11.,1.),cmplx(12.,0.)],[3,4]) + A_true_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(0.,0.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + A_false_ts_l = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(3.,1.),cmplx(4.,0.), & + cmplx(5.,1.),cmplx(6.,0.),cmplx(7.,1.),cmplx(8.,0.), & + cmplx(9.,1.),cmplx(10.,0.),cmplx(11.,1.),cmplx(12.,0.)],[4,3]) + #:elif s1[0] == 'i' + !upper hessenberg + A_true_s_u = reshape([1,2,0,4,5,6,7,8,9],[3,3]) + A_false_s_u = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_u = reshape([1,2,0,4,5,6,7,8,9,10,11,12],[3,4]) + A_false_sf_u = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[3,4]) + A_true_ts_u = reshape([1,2,0,0,5,6,7,0,9,10,11,12],[4,3]) + A_false_ts_u = reshape([1,2,3,0,5,6,7,0,9,10,11,12],[4,3]) + !lower hessenberg + A_true_s_l = reshape([1,2,3,4,5,6,0,8,9],[3,3]) + A_false_s_l = reshape([1,2,3,4,5,6,7,8,9],[3,3]) + A_true_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,0,12],[3,4]) + A_false_sf_l = reshape([1,2,3,4,5,6,0,8,9,0,11,12],[3,4]) + A_true_ts_l = reshape([1,2,3,4,5,6,7,8,0,10,11,12],[4,3]) + A_false_ts_l = reshape([1,2,3,4,5,6,7,8,9,10,11,12],[4,3]) + #:endif + + #! error check calls are type/kind independent + !upper hessenberg checks + call check(error, is_hessenberg(A_true_s_u,'u'), & + "is_hessenberg(A_true_s_u,'u') failed.") + call check(error, (.not. is_hessenberg(A_false_s_u,'u')), & + "(.not. is_hessenberg(A_false_s_u,'u')) failed.") + call check(error, is_hessenberg(A_true_sf_u,'u'), & + "is_hessenberg(A_true_sf_u,'u') failed.") + call check(error, (.not. is_hessenberg(A_false_sf_u,'u')), & + "(.not. is_hessenberg(A_false_sf_u,'u')) failed.") + call check(error, is_hessenberg(A_true_ts_u,'u'), & + "is_hessenberg(A_true_ts_u,'u') failed.") + call check(error, (.not. is_hessenberg(A_false_ts_u,'u')), & + "(.not. is_hessenberg(A_false_ts_u,'u')) failed.") + !lower hessenberg checks + call check(error, is_hessenberg(A_true_s_l,'l'), & + "is_hessenberg(A_true_s_l,'l') failed.") + call check(error, (.not. is_hessenberg(A_false_s_l,'l')), & + "(.not. is_hessenberg(A_false_s_l,'l')) failed.") + call check(error, is_hessenberg(A_true_sf_l,'l'), & + "is_hessenberg(A_true_sf_l,'l') failed.") + call check(error, (.not. is_hessenberg(A_false_sf_l,'l')), & + "(.not. is_hessenberg(A_false_sf_l,'l')) failed.") + call check(error, is_hessenberg(A_true_ts_l,'l'), & + "is_hessenberg(A_true_ts_l,'l') failed.") + call check(error, (.not. is_hessenberg(A_false_ts_l,'l')), & + "(.not. is_hessenberg(A_false_ts_l,'l')) failed.") + end subroutine test_is_hessenberg_${s1}$ + #:endfor end module From 03306f1df31ac154e35d36f89159600f9cfd39ea Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 27 Dec 2021 17:28:37 -0500 Subject: [PATCH 28/33] Add missing source file to manual makefile --- src/tests/linalg/Makefile.manual | 1 + src/tests/linalg/test_linalg_matrix_property_checks.fypp | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/tests/linalg/Makefile.manual b/src/tests/linalg/Makefile.manual index 89d905d89..25d5c7fc2 100644 --- a/src/tests/linalg/Makefile.manual +++ b/src/tests/linalg/Makefile.manual @@ -1,5 +1,6 @@ SRCFYPP = \ test_linalg.fypp + test_linalg_matrix_property_checks.fypp SRCGEN = $(SRCFYPP:.fypp=.f90) PROGS_SRC = \ $(SRCGEN) diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.fypp b/src/tests/linalg/test_linalg_matrix_property_checks.fypp index ebea3bda1..0d517b631 100644 --- a/src/tests/linalg/test_linalg_matrix_property_checks.fypp +++ b/src/tests/linalg/test_linalg_matrix_property_checks.fypp @@ -105,7 +105,7 @@ contains ${t1}$ :: A_true_ts(3,2), A_false_ts(3,2) !tall and skinny matrices #! populate variables dependent on type/kind #:if s1[0] == 'r' - A_true_s = reshape([1.,0.,0.,4.],[2,2]) + A_true_s = reshape([1.,0.,0.,4.],[2,2]) A_false_s = reshape([1.,0.,3.,4.],[2,2]) A_true_sf = reshape([1.,0.,0.,4.,0.,0.],[2,3]) A_false_sf = reshape([1.,0.,3.,4.,0.,0.],[2,3]) From 58fc9a2ff416f29647f75b61f37e0a8e3ab90b20 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Mon, 27 Dec 2021 17:34:26 -0500 Subject: [PATCH 29/33] Add missing separator for line break --- src/tests/linalg/Makefile.manual | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tests/linalg/Makefile.manual b/src/tests/linalg/Makefile.manual index 25d5c7fc2..c74d7a578 100644 --- a/src/tests/linalg/Makefile.manual +++ b/src/tests/linalg/Makefile.manual @@ -1,5 +1,5 @@ -SRCFYPP = \ - test_linalg.fypp +SRCFYPP = \ + test_linalg.fypp \ test_linalg_matrix_property_checks.fypp SRCGEN = $(SRCFYPP:.fypp=.f90) PROGS_SRC = \ From 09e333f245bde3ce45bbbc2e08a0cd8b5421f662 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Tue, 28 Dec 2021 12:42:00 -0500 Subject: [PATCH 30/33] Correct error in fypp templating --- src/tests/linalg/test_linalg_matrix_property_checks.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.fypp b/src/tests/linalg/test_linalg_matrix_property_checks.fypp index 0d517b631..037be53e6 100644 --- a/src/tests/linalg/test_linalg_matrix_property_checks.fypp +++ b/src/tests/linalg/test_linalg_matrix_property_checks.fypp @@ -37,8 +37,8 @@ contains type(unittest_type), allocatable, intent(out) :: testsuite(:) - #:set IMPLEMENTED_TESTS = ['is_square','is_diagonal','is_symmetric','is_skew_symmetric' & - 'is_hermitian'] + #:set IMPLEMENTED_TESTS = ['is_square','is_diagonal','is_symmetric','is_skew_symmetric', & + 'is_hermitian', 'is_triangular', 'is_hessenberg'] #:set NUM_TESTS = int(len(IMPLEMENTED_TESTS)*len(RCI_KINDS_TYPES_SUFFIXES)) @@ -51,9 +51,9 @@ contains #:set TESTS_WRITTEN = TESTS_WRITTEN + 1 #! last test in list should not have comma #:if TESTS_WRITTEN < NUM_TESTS - new_unittest("${cur_test}$_${s1}$", test_is_square_rsp), & + new_unittest("${cur_test}$_${s1}$", test_${cur_test}$_${s1}$), & #:else - new_unittest("${cur_test}$_${s1}$", test_is_square_rsp) & + new_unittest("${cur_test}$_${s1}$", test_${cur_test}$_${s1}$) & #:endif #:endfor #:endfor From c7c8bcd84eff8865e4f8725c27aa7a025fd0b3da Mon Sep 17 00:00:00 2001 From: GHBrown Date: Tue, 28 Dec 2021 13:17:53 -0500 Subject: [PATCH 31/33] Fix GNU makefiles and cleanup cmake and fypp fixes --- src/Makefile.manual | 16 ++++------------ src/tests/linalg/Makefile.manual | 4 +++- 2 files changed, 7 insertions(+), 13 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 610ec6e31..424bb4c8f 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -122,15 +122,6 @@ stdlib_io.o: \ stdlib_kinds.o \ stdlib_string_type.o \ stdlib_ascii.o -<<<<<<< HEAD -stdlib_linalg.o: \ - stdlib_error.o \ - stdlib_kinds.o \ - stdlib_optval.o -||||||| 089f325 -stdlib_linalg.o: \ - stdlib_kinds.o -======= stdlib_io_npy.o: \ stdlib_kinds.o stdlib_io_npy_load.o: \ @@ -143,11 +134,13 @@ stdlib_io_npy_save.o: \ stdlib_strings.o stdlib_linalg.o: \ stdlib_kinds.o \ - stdlib_optval.o ->>>>>>> master + stdlib_optval.o \ + stdlib_error.o stdlib_linalg_diag.o: \ stdlib_linalg.o \ stdlib_kinds.o +stdlib_linalg_outer_product.o: \ + stdlib_linalg.o stdlib_logger.o: stdlib_ascii.o stdlib_optval.o stdlib_optval.o: stdlib_kinds.o stdlib_quadrature.o: stdlib_kinds.o @@ -234,7 +227,6 @@ stdlib_math_logspace.o: \ stdlib_math_linspace.o stdlib_math_arange.o: \ stdlib_math.o -stdlib_linalg_outer_product.o: stdlib_linalg.o stdlib_math_is_close.o: \ stdlib_math.o stdlib_math_all_close.o: \ diff --git a/src/tests/linalg/Makefile.manual b/src/tests/linalg/Makefile.manual index c74d7a578..db51c62d4 100644 --- a/src/tests/linalg/Makefile.manual +++ b/src/tests/linalg/Makefile.manual @@ -1,7 +1,9 @@ -SRCFYPP = \ +SRCFYPP = \ test_linalg.fypp \ test_linalg_matrix_property_checks.fypp + SRCGEN = $(SRCFYPP:.fypp=.f90) + PROGS_SRC = \ $(SRCGEN) From 8d36da6d873db5f2e5f330bd9367c828df00b343 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Tue, 28 Dec 2021 13:44:36 -0500 Subject: [PATCH 32/33] Blank line insertion and deletion --- src/tests/linalg/test_linalg_matrix_property_checks.fypp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/tests/linalg/test_linalg_matrix_property_checks.fypp b/src/tests/linalg/test_linalg_matrix_property_checks.fypp index 037be53e6..b2e8b2116 100644 --- a/src/tests/linalg/test_linalg_matrix_property_checks.fypp +++ b/src/tests/linalg/test_linalg_matrix_property_checks.fypp @@ -58,9 +58,9 @@ contains #:endfor #:endfor ] - end subroutine collect_linalg_matrix_property_checks + !is_square #:for k1, t1, s1 in RCI_KINDS_TYPES_SUFFIXES subroutine test_is_square_${s1}$(error) @@ -519,6 +519,7 @@ contains end module + program tester use, intrinsic :: iso_fortran_env, only : error_unit use testdrive, only : run_testsuite, new_testsuite, testsuite_type From 60f0fa653df88921d95b777c472a579aa20d4754 Mon Sep 17 00:00:00 2001 From: GHBrown Date: Thu, 30 Dec 2021 19:21:36 -0500 Subject: [PATCH 33/33] Remove hash files generated during testing --- src/tests/hash_functions/c_nmhash32_array.bin | Bin 8196 -> 0 bytes .../hash_functions/c_nmhash32x_array.bin | Bin 8196 -> 0 bytes .../hash_functions/c_pengy_hash_array.bin | Bin 16392 -> 0 bytes .../hash_functions/c_spooky_hash_array.bin | Bin 32784 -> 0 bytes .../hash_functions/c_water_hash_array.bin | Bin 8196 -> 0 bytes src/tests/hash_functions/key_array.bin | Bin 2048 -> 0 bytes .../32_bit_hash_performance.txt | 43 ------------------ .../64_bit_hash_performance.txt | 35 -------------- 8 files changed, 78 deletions(-) delete mode 100644 src/tests/hash_functions/c_nmhash32_array.bin delete mode 100644 src/tests/hash_functions/c_nmhash32x_array.bin delete mode 100644 src/tests/hash_functions/c_pengy_hash_array.bin delete mode 100644 src/tests/hash_functions/c_spooky_hash_array.bin delete mode 100644 src/tests/hash_functions/c_water_hash_array.bin delete mode 100644 src/tests/hash_functions/key_array.bin delete mode 100644 src/tests/hash_functions_perf/32_bit_hash_performance.txt delete mode 100644 src/tests/hash_functions_perf/64_bit_hash_performance.txt diff --git a/src/tests/hash_functions/c_nmhash32_array.bin b/src/tests/hash_functions/c_nmhash32_array.bin deleted file mode 100644 index 52081e7b8a41a6641e3e3c33020ae14f4c49b23e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8196 zcmV+fAp74%$l0)1IuxMq*xiXY5h$REk(Ub;1+Er;qR+AL`n2{zXXmmgAc7T$Awo(g zgrkC6IZ7O%nq&oG@#8m5x90|j)3naG+Y-54#hNu+w@5|mu*}(OzpNQsIVvowL#`=sl1~cRgazMfSnK~(>DtlxRKY4L2h7%^gS=TC* zM|0c6G0fy&Fecll?vzDNfUmn^`UBht95Ndm_95~zl$ffql)Z=BOh0}F^i31@qnRaE zn?r&u6hvyqJ;Xd#)3uYDU3WBt=FFn0HF>}5uDt$!V%Ah9rl8i2{6B*4FGNE-l&e3@ ziu=^2VRURZIsrXrp-=5?*gsedsOVQc?d(+Eat{J%-pxR-$G6JNt9pJt7H=mkJD4hW znix;@7|qbaR$74iSZknu?^m&Ljym53#I8pro()(fGd1@Sd2^aN_?p<`rw9oo^-&33 zsVP7nyT@RV6r_>Y_`f-a<4V=Y?u%Qaaug2-OC~n~XolAub=g)8WZ7j=o%nQ38Wxd7 zyyuTTW$QiH`YZNK&A8vaC5^ht0tLExDWoGn>M=(~Qfq!!24{KpY1x#z2I5boF{FMbJ(~Y_e4b_WH1LmU>xfoJ%9n9ZE~I zq6x!A-B($xu}F`G^A(q)E<{o*{deH>9!ImXvphV$L?0ZHOIlHILBHjqpU@UOxzoA)GbhYKRpk?3RP$wm zr~ZRYychm~Nc2iYN~+78z9VL*=OOdlttmL77YtfeS~yPu4cALuel@msUG$%KelU@> zb5*3_dg6y}tlg>FFH|)i!pvAbuqYPBRxkM96@xBogxjv`qoTUfG3OYHzgdHW6d_w>8`Xg+J;_U^4y8U z_pO0@kY=S~^;6_vG6lWqvnbsixMbg1lpaKll9p%O7JYd^jx!ik?c3>baBaECV#P4S zE@Pv@>%s-?7*fgsF7!x`1{!ba4p$}Mus2qhHh zxz&x&zqbRTsqfytp_ZFtNj0ITD5~f|Fvgrel&$9Rr2Gw_gmcpp8 z78FaoUY9@lrH?MjYl74O$V9$Qk?UGauv78)&&V;@&VOK1AqvMM6ke6~i1gwW89-LIOxFt`K0n=HvP`x^C)vpnEW z#~Upy!WmzpdZ6M8L%6qIfDj<%!qw_&q}0LBHn=jK41UWGO5+{a-P^&SL^>0ZeqB;S zpaP6}?Ba%y#~t4*M>sFx9R3R;<@YdX_|oI!RfJ}rp*iDHP>YJYBbAZWG&@N}^ks(G zG;wQc9sL0)yMgWI3*!*rXnvW z2s?Bq;4D6=TOmq9W)DCUE%5|5nMQLun&`JSgbluYi{EqSas z;GwxfW)7@^cjW5ZX)^$KpK>zYn|Qr$)T-eLpT;9`X3n&I5!p-us|4;RXTPl59KcTf zCIDsce*S}Fm4y)qR-qmhzQlW;i--~{=AAnifAEz_AGM7j=@gH`789StJ@I`^tvCgx zznhbp?&ILCSZ+;=B-CG0A&ixw@K)}6?zoCRmlWa&1V3shu!I%T$Lv~dQsG{@{@)!; z=j4+@Y&q{7$3_}i{qKOy(iQOi2Tmsv6FfW^V22XcsO~0Eg${wAus?e`tG(#hfcMLa zh6^OSsDJkX>g6y(TBS-Dvw>lg1snKmP-fA!qQTNQ)G*D2(%?=xI<}vzk~buqb9!#~ zW=aXE*I(^M>T{=@Y(Bk7HKQOe+IbV4>OP*wjXwi+*<;u5g**2T>p+g?{7r^(mmrL7 z<&r&sa=Mb9+2$7C11@65MP~Pz-=op6bK2iFg{nNYEAFx^yn7GoxR za11PJIO))WW_HZL@Rf$^MkORZdzoMrS5p5Pz;E%jb!uXgiu@^k@MO6^IZ+RCa#Zb~ z`UnKNTMnFsaChF*GY%_qA^_Stb8tmZKC}St9a(w=4b7)4BpbiBC+fguNp^$fbZ+YD zsf?*j4oytPTm25QUAq9^V7~*43{EA}rv; zF!>w`oWQuhD`2Uom})aW(ILt?Hm&*XpFbj6$h-?952|2)IJDu)mlaseC2()dW5_+v z+ApajkiZE^;5|&_^c3X#K?3~!z(F(_Sfv0ufj9Imsdqgeu~x~7B7$wttqg1uFopWt z{VN|}9A8e(FVV|B&kb$!3f{p67ON)7!vTb_dBatVI@qXUv9`u2=QMPOPKn?l-l?J3 zI_5O?%SOro#*B|dk?wgMwq$R{j2T)*(W4&t<-Izc071HS>Z zY@KGX9D>C7nLFqAvl$yM8II+E-_ZJOzyvMT>y4Hv>4n9b_{8*(lGiCb5IBxbquisV zN2nIl6E^8D(&8l6>JoMe#HL_6u3Jm@R;{uKp|Y->RTaDagj=uPzMKb87fGLM;==l? z{;WE=hs=vz23IPi$lDLqJ8{7>;fANRRQ)BHY{QfqbuwwRml)fdi6GhmjmP^m#4VU4 zSM>L3^f7Nt(7@kiZzO0@DYCwt44?XGY8^88r zS`3lC>~rsJMK7)C9dc1OOxEiG1F8-y>hPEZu3g`PCzU-xPC+;|9tz1qmi{_YO$`MD zhStgZvUwrJOhhd-0}i=0R1<k`6Qc%Y6X|m1=H~1(-Fm>ZfNV$K&o3itmLwl5=u{ zEvnN|u6I38!^WI6((mKr(NU4WT@<^3C{CYEFzqWNS{lF?0g67zZ~tVQ z27zqf$`V!$OiKDx+Z!*!Tf}v=A4!e!2X!X8Idzv|w`*gH+~&kG>!8zAEn=0|`lxRk zo5sxk^OLg1rnH@Jol3>9Z)kMueok>!>~lo=D>gK9)`4W2g5#GBwW%bKPX0KdLu&w7 zrF4gEiGhP}yo9f=3h6LzTVYzV5i$^8Bmm;Gk+O;_^B?J7yla|rz9lHQ8OZ$g;wMV7 zK1Y#mcUnnv>W?F1|JFZ8o=FLp!9*gPh>CY9LLe8u65h|M2P9mcq>^fL_2 z^r5|@!DfIyB#@Zy$rGzXJ2w|t#QPRzjkn~0ZdMu=?Nej*4?z+?G5mAbq`!R$SIgr1 zgu4U&t(8sz^Qk~Fk4AGcApT{)c4TP*A)lk<8XxD<$#a6MA?f|fqrYs;9gkjKBF0Zo zCvPx@rRyToJdc}6BHtuI_d#<8>5yD>i*uXeT*Tu^7Cm+&5KU0OWbUsZV6WzBBgy0~ zi#;STJi>zRcv4uMia^>N$;E{8E-*<~FI-j>0GBYj&4vXc2CsKr%aaL>ioY7$V^>LmG5^~%pIy4=Q}q6{_u%t}tJ(^~{gaGI zow?GzAUj0vPZb`-g4^y^TP&1G0%S!ZOAk;{AuV5?5b)y>Ea+MQ4Q%3 zP|WIez`xhi^n-B8TtsK!iZhT5)X9%Ppb%l`;yBKCR*b_&=^3Mb_P64NsT5=zdt$U* z+Nv$7{^hbP4xYIU$nEr%$hD!AQj_OeaMqVyd4e@cD(cx!`F7%NA%ony?So`GY%IU# z+Qn8@^ta`5eQQ9qXrC%(lcanDsNSJp+TZ)F*;?Ft07%91eplgtEbDS4ePz-4ays4fb0Cn+H0PUXi zAdfT@4?@Mn@}u8&0^=D2f9evG%Y}D0R%wgu>}j5%xiq}f1aqZx&n|6081 zVGN3`8eNmOQBz_j)}N|3PLdHnB99q=W9PX~k>*C9D&NVuWl)Suv6WIO7z>9`f4ngzW3=fHQo@qpZZgrG79-~9Q5z!fTAX% ztg|v!kNzPz*(jCYsGF)VeJkD{-_uRv)+=VjqNwwIoyuo-l4q1H+igxs+K?dlO+_ z6Bd{gm;@rv@g#s83_!$~*#lAhYvuhzHA zXa-pZ0y9kUa2_o!$ycQx%*UJM0F@tHT*c~b{;h_3^LAM|>lDQ%I|>?|t3Eta=F+F0 zhuK)GEBmY+ni6GHH?K9oG7kD9mn~z0iDPLs!N~0%9(jbfEv(U(%>Mbs!5wVcas~;hNG{s*;sPTGn z?3#Gx5U}_+x-ebcDL;Z0b{T;dsuPL;LfxYLddYOe#Eb{RFdVA;`7_wmx(oXmtfekp zLkEPGDFLr1c~A6C3X3QQiv_K&9J(GuhV`P@FJxSaO3Qxuus6c2O5oL!)}Z_*36}$M zNjx4MVew#gfJtwuXwrWRSqEM}3mks6sJZWx8SM6`Xg$xU?y86jLO0RI1jJ6!&bg0x zYfQbS;yQUYA{_~z^X-6U`PQ=`6y&{WObrl2-$dzAlWO@y5)ie!k2R@wW8N(y$FO)v zxL8g}yZk$*%KfBzJ6gff>BB%X^mD;;Iz|DBq=Rp0w)hW}JXHCXUXBs@g|VJ)Q#4$+ z`B%a;-F<+2R{WA+lh{<7+xFSG=+8rE(c64Ent1TjSjP81FKMa#-HhjgN(8WfieiyU zlA!Yk?jAS=Adu`5iwWqpYlwwZBdF_oTkjo4Nx|00ghiFJAFd(b%+lk~!*E|aTaunQ zuyb|s-S!4F}ktC=~T6Lj>N}kaUB_nxjZPrTnDj00f2%>L{I$WiacI5}oZ5 zFzYGZl~MRzXR{YJ zyMX6UkOE}Rc^>D6<3-`w{p_Pyln@=MGijKvT7f|8bAc`ZBUVosr?Bjm;NS4{vuT&B zUx^^s7kV9NmAjVHQHOW2ert4WU2_yqRSj6k#xC3PVZ>~rgtVw!n9vlIb}qK+-Rzn& zwEL4Y+Nvzm-17jB2-L3A0@cfF8{+jXvacG$c+;2>zyJvDl>lJVk&g|XVxw?12u#{A+c8wQ>2X#hhBgl&#SR(m6e+9 z(Awe4u%JUTj8--|?#yha;oT7G*jHWB{sFWg*mhGfe}9qPAnb1>b%jxylt6AFCEWgJ zTin-(QjW4rH?Yg*iSY|WeL~_}z`c+pgbLv{{S~{Fi$=2T6V~ykkeVu`M@L1(*$%PA zrS@v;bjF;BSz0m}4OwIuCB88PlhtqGXw*%LXCVPWCY zj{cvt)yH-8Ze0#6bU|wLVD~xWBnb0)2Q{l?oubAGW1XE?Tbp{^5q7LUnM4SV;*=X0 zD+_hLx#p?H7gGDbAc_fbt5Y9#V7k;nLNxsaNStVjdbt*aTI(Z6>(0J;emY&=Pqr6) z%RP&=0wavo5*%7hDy}ob?zGaLN!U!sAy1=otC4YDzz_SKEf>sw?p>IWr3r7U)P9J> z6iu87sLSYW2$Zpx^;bv=g4c<;b^R1*5!wc*28T+u0TG{*lSa@Qoo@Ps45<jQZ_HCLXH|ZkjejTji*m%AeS-Q%|1Hp+i_mCxx@Lpra}zfu?X2dWzhEeVw@Rl7K|f<#+^HnmhsptZu_{A@BZ9 zP$U`qQx;lmQzty;_IGyILGPPgKgrvLf`dBNVFD6X1#L8hNji)9cs`BS`}3>k!^22u zay2+USgy5~P?q&Xz*h7W4TbRvV;$VyIZh7^#NTuH=01p~;qZ@~PnhocJW?e{?Niv6 z?bgcNSDs{NZj+ai$Cmds3*Yn52c>|f)IC%x(h|zlHYh9&zY*`GTGauW=nNnqCoLCE zph4XPCu_MB0;N*YOjuOHnf5>GC(o(30^XsLZHX=ockw}ZrNIIy07*werDv(Iuf&29 z=kXDm+5&bZ_D1Z^0DRQEx0#ySdaP-2@RBDE zgZel*wLUb%JPzpWKlW4W(ntcW-m_bz3*_~AW6wu|4FKAUy`}0+S zOF}D`A{Z5(17t_oorz#U(PJl-VI_KuguOj{Q^#@35m!4J<9FHffX--|-mhPo(GdP{Z&Hz`*=hl1Q z)3S_0iX6^Az>(5^|2t_KA^Sk{-V8|IDIT;&*(FmW*}7pp0l{jcEm=aQQTykNW`?Cn zaVvuW{FDleBugi?R_5*7Vl1WD>qCLEhH zGmY4Ma+!q0`SbW*U8p2Tc)PZ}9LFM*aY8a_&Q_o?6Y1~F@9w2f`5Zs7Y1cQLykt25 z*AZcEqgS0^mB7a=7C4wFgx}-;1{eb|3iNu~!0s6jebqR8n1kttHb5DtypAjP4}_-c z#n_-5un|c!nj7uJxJPZYq4l2HXsD7D=7Jf5`HJ<@6W~4JCh>5LEf`+`H2L|jBJupFETQ>(ro(PdZdY$HNsd+{+4t=e@MdlD3$OxauOp%3TptLWD zfjAg{j8Pw_7g;lTm??3aKN(cuuU$Rx7Plp{;{fCVVbSn7b4EKGlR$7w1`^fQ1~+v4 z4uffa=*cV`4(sI$^OwrOM|zMl;Jcn7qgV}-6Dg8W6c?~&#Cs$Fr~a;gtCmE4C26X^ zI$jL92`J&PV=QkMgyZa$w?;6X%4L)p=s@CItAa)9WYq2RuS%nOR8p4cajZ%BOeCLTXpO-ev z;~(q9RZ<-LxHpCd8y2>Cib#*FWvpzvAuTwG-SBfn0_;~OdV6zaZ-g@K^*gOpu+%OtA5`XFNJz&Iv6NgKw7 zDya)StQR>kKh7Wm6R}JQ9^-7y&wBy$Bz57VYG<`E(Xu%Pg^{2?i(IEhHVLiew6H@Z z$dXuaYT(6-l5+$G0UE<0G5$(&Xge0;x_Ge4X1t&Rp}f&?zH~;z5|$^G4BC)b&~PN49pu=NoRJ248u;-Dsq1KY8F$Pl6cM+_Uv!Z{02O-Z zg1;uk1W|pZsxg?x9ce| z0#^P!OJ;Uv*k|R;J#AX(zThz4#c)@tVfM7u^L`OrL#R+CVg8!QOM@6ssf*utc~G8s zR!`Wi>5gT$4|%34Cv}#gcx;kWiP5o(SY7c;!a^Txn-n`n?mBQ0+FhYEDcTD(_GbUF zF5Y3?yl;Ga!(be{Pjn{GymQ>oRZO)ymI*!9l5FQ7W>+T1ST-z4JBgKGU90hitUtjU zu}Xt0ckan`9Iu!}0d52m{%Rjisrvid+sYakA($vld2-q1V13sMdE~@tW#ie}zXl%9 zhzlyxi)|ePF^0}+qX(;FlTVB1IS4#k<3OfL19nLSzgf`Z`&>@g0IkNO8z#_T4ED8f zE4y~E62=$~v^;0Wsk9>Ri|e!XmVr+W`f6`niMC{vEo1;%PPOrwqkn>x@9PGztTb!f z2^_G+zEHi1rLBu7FW0@< z3CEU@$ohfO!S%a9A|wIFYRPW-K+bRuKy)M3bblFo@{e=5`Xg=J*%FgDf=h(j<{upIiY-eH9xLyup z*5_Xo%dO4TF8oaLQmjF4uOven)a69`~y*{wC-*Bo&>1xwZpLc=4Xe_PkEBVwQlf~e- zg;LXb{phl*XtwFYSOc)BffCAM2WjDpx#DCZ6Yjy*?lnTn@t|nw_>yPbs+hQJ zdgJVtuyqOp({ddDbzP7`AJeH(J2wza(=Azch9WLu9k}#KKD`Anm%f0|4!cD9TUwyW zFc_p!Hb7+{1lj|0c-ksjPm3Oz1ce@+sPHpxhfotz5g38Loyal|jy%Eiircj$tf_Td zFk|Y35CwIl4Ns9=S<__czB}2$v|tJRFBI8+ue3%TL(ZIWUnnU;W&g1kNlS9~zR$x1 z5&2+KQ9w<=CUL>pI1b{1H=?_MTxS~B^Ygt?$X#uE_fS~avL((uZXm}?TR(*?{$9pb z%aVme5wh^ooJ!qSOlCdQNoQD;m%-Qr6uxgN0(GvENK=Gm2^5`6W54+VL2T;3y^K`l zq2pv|VbtZ-mkPbMqaTTV89V{P@obCML&{xw|;+)*LHNrkH-< z?)H>YAKNh^O1^kc1RNvxxwgbOfWnZKe$ZEO+I(L^KX!)t^9h&eQ1d{ySHDOJAqI-I zF612jrnE;8P4B$M0;gWdC~R&frL@@43L~NBZl8es9?CBORkmnNtxE6c{`!9tVe9nm z>h{L6n2xN9ibpqsK`c5&h${IGn~+~258gNPDvfD>)u~Ps&HN_)<-l0sz#oOHvm8?W zSLwD~hQPCPN8eT0jILvOYK+iFk{g3+sp}{U*m+5NayIt#IFA;UU+eO#xuUH4J0$|{ z(TLYBK@xHHWVVmLw^8naxN?Vv5+Kn zde;v`53`&`$+CL)4~nl)(dloIO%{7|6adCb!^sx?IXdz3Fnibwmw2|!@oc{KG$j#K zSn0BPg@Kf6D{kBmNk9)tNngF`Lo_s+$kz^a#TN2iu%!-}zH#MLb_;eGk@M(cMpj$5 zRlI84>VsryRkm7>zX_d+^iBnO5B-+E2Y+K7{sU(KYr8T^2#ju2DjBg%&+1XS; zrBq32c>#<&#c7vGv$4N){q(L`adtqm5 zI*p=&-|TruuVHph8LO4-S+i+PG;LBH+M0U-it;GC>tt^ikWXY9bBgn zKS)*rHQdhu*s|-5y2HIF=W!wV1Etv>9o3drBnb>_(_vYr*KE!rg~ls`rBUU0ao+Dd$>Uufw4X{&35q9jGZO}n?EPYdH)ohA@_lj7Bh zZ0U0K_Tba?W$>`0{Jw%=!H+Olc$$VS>q?@+@@O)y=>{s^88F5;WEiDio zf67PG<1Rh|h7=wCtk_R&W~ptgQc{LXcSfg#^QTRgVr58MrcE}-i&k%|vgyEU8vmfr z(}aEDuWT=-?I*x6ygIBYchWe#TdNoXotsd=ZJ45I5dox8wq$O(+I9JUI6E{y32>#z z{$IS5xPF7IPx_+*6nc9Q3g*4>H*XlN&OrOZxlXZv22a!?4Yt3Mv_Ra8HD#0{Tc5#x z&L7kw^5Bk`yZd37dY^+r&3`#P9jzC)l-ku4NK!|da6jgW32|-{!K4Eq#uUI4XhrsL z2ne1pf>AK|NsSdI66_mE<(HxeQ2~>?{)`rwN4+Xa)XG><(zdlGRyvvlwN@-8de}p7 zKxQe^OZ2pOVsX|%Q+)h(Yl!);`OyU)oqJS`nGaB4(Y<_@KzxgK>hwB2Z_r&8jFQ=? z4iDLHqbv6j`}Mg%SChurWc=k^RP>G|h-pJCC-Yryi9Mly3QFIIb&qPj>YtH-;h}l9 z*RQ)ruh-pFf0QnKx}_R7iBt4K{nJQ8H|d?Hy+?@+Ufq=y!wH!nJ5`4nFDCulSot>0 z@p`a0o$H)qG>z4HlsVby@JTLih=*mWL1^$$*xX6swssQSvbE~JTS@mWWB-%#$v7{4%geInE(gjMsT${50Vzrt;4#67OV2 zE8O0HT0a(U)e9@lR6*OZ9&w`D8qs8&_NGh4NGH5tfLS0S z0U-3GH4t^&|2;XhY0F0$$;Hckga*_rF7iB$?G`bz{pV!n6E)?;%ZXRlHpr)UYeog3 z{J13@$2uK8b~3|qKt_y2R`b@r(g;!^B+Uk77uC_B$OPUh;@ z97&XE23@*5I11AJJ?XAJ@AMUOdCAx#gAWdT3Ggso;pTJ251I?#F=@oasYIxZ0YAa< z3KEB-@hw%8uug7cjJ1a=SguKVN$HWvv$FhNVCu>U#Mf(lQkpq1%u1)##I{^?9v)3= zgHjxdezr-^ynz%dEl%r%na@u9Kw|_K8@C~qS;Vj3sdQfBx!QlR?$-V#;dBNT_v>&K zOlL9AS!!fQw%xjdi?WJvtghC9%Z*F_`c{r=df+#2)tvy&;3sB${Y!70cGfslY zy(OaKd}dQvtc|Ho8JwRnsqibU-<2`VH+A(IqGZp5>GR}7V#=NfkQ2_cvbuo z+04g3Jj<)SA3=Sg^8h%s6}sqB+6W$*Wb;!{x|P-@RgnHa#Pb7tJo$G9{mqF0Vw6e% zWfTNI8H`EtKhtH37bb=+9LenMUC4K018MW1mT)h#ZZEB8NU~x5?t)5Fx#{g$-6w){ za|gKC79R*%L-eg!XUN^^e&_B?$G`p!3_%Otm`7ukja`IJ6~6aW(FN&)h~!qb+otS% zXCg0cEM@3OMxcE42gkKz``QU! z9(P{hl+C_8g5@~vzNH$ca-p4(9vLOz7j@|k8%=Pv77U+(w~R8QZ+~?^AUJzW(Ioni zbZoYxmql^z+yh}8`a4;?_E%8>E|5X?W3D)sLyJt_?3vH9EimDBkm3aoOBj-tEf+oJ%2imX zsqTl9G?Y?k66@1~WG8vBr#GDtLIAckt zRjX==Zy(C~LIZFSF17{4-=#JC>Fs7JE{kem9ms6y|bGqf8$*xbL>B zeG;mgBNOK)vH17A`plVMiZwbEEdcvD1Cq#Wxo`&i|6jbZ)CPB{st1$6h+<^;CBjTA zTusezw=1>9-htC>x*{0diFGX{M{of(thrZ|_W)d4{KBjqqEl{*ff*ikwHbbUB$6UV z_6`Gl8NUnuH-rjXe`flqt9LPcl{-w?{f3}n>kS4nN`5LyfTd5J?KSM4-c7mDjiix_ zV-E)S_sm<5ZvHOlP|~au=WCW0+H8u=`%tBZ9Xa7dNt=s?-ZB>LVlA(&o6Dfz_F#;+L5BC06->Vt(O)y zWEJTU&va@BX_zE#=gVUl|1fjQk-a{G0h)v&ZJ=O*V;=+G>*<47aPZe8F2dtDnk$NJ zGBsH2LjoYHyt2$r8`JywdN>qd)G%w4BcJ_=8d7fY)iK62UNBB|m{ z(knaD<4De>fhjXi)t?9|e-tua%Qj=v2ss3pkc85|vwq#&${X&I_a*js#ZtBIH8jzK zmTa-aE&Cfa2UeOE?qIRA6rxaawJ5-lyOzoL!D1yFZl@8Y@V{{`1VE~WA^OkJvpZRj zJ{?-i9=9JKR|E4PzQ)-ehx!U4LV zL4*0ZdZP*$< zT&*92ZY1^>?t#;`BZRshsv8cRLRe!~Yxdi)Mu2D?H?xYr+IKBHcYNXIS|;hZ*H04L z?)ngbOo#ij_90qKG{ABO187G%X@2CIWB?9$5QjztYm8I@y^%8~`nt?qPQi6B`z>vw zdl_hHc=)kaFqdfFIMjkE_Zp-=qoQN=P7D>L#S-*q!sUDnO-|zbcmIdb3jzawc3EgQ zdr@fAawbFbkY1cxVPksms&x=I(Q4yI^5wN-rdxu#oEUUz9H(^ifmUlil%gwCi4M%kTUNu}K}& za-W!xCJQ5UzqnUL7d5^n#?Pd_H$aGE`bSS6m&|iF2vKT*wE0ZDIwZJvH;=f%CNF&? zEb(z*{am-ilvfIchzj>|MT4wmpoNB0znqsJCh(T&&8i;u3fL#B?A3}qhG9@qr zmS5V%_-oeXl{#62@T+Qf*pA)ySm#q4kWz@5Z!Q7K8Q& z$eIeDDf<#H0;t*uQZfRT_eCi&-os!*KoH`puStTU=JDRh-=*t75^k>fBvjYC?5xCC z`D^?_oz@%uB6Ilz)|JORGnuE9_H`f&)YZzrkEj8~?tb1RH(60cyQI3GJP zD$D#}RK%OI8|$NMu@NGCrC**i&$e9~Hs{;)>>98oObPA6QV@}KkLoeuTkHA)&^RHR zh~pkAJPmtC8$a`E2P=06%ByiOJ&9i1&FOgJ&@PVsDM!r-o}}WzbigOQXWH(1k?jj8 z$Et1llGJ;DK)Q#H@|y@TysUdxMZ46KF6eA(F7?Yfch+v6dTSK|^djo3QaMoq-zgBq zw-mWEs*n$&NX1d`E(->|o)PNm1nTth4}<@_b{6b#dv%7sB)5_Gw@KWmIrr;unQuXd zr~|@7;@$BZHAn=bCj!}G-gr^O*JH80gEP{Qokcv*2h~Id0ou`x%lh!ENGG_ zU-bSJ)96Qf>DTW{i(1c9LeoFK$^J8kkgTZ^@Mg>o*_sLtel|?3al}00xZ`nWvC*ZN z4u!eZvk^_8-UB)f=?N4s;mnDz`GWnoe)U#;hoTzQw>Kh3F1Cr7414|mZOh>G$)E;} zA9-IyqI&o2`I5;p53xYV*>uugVa#E5*@?lz(@hoz?a2cGW&uNvAN-wX;3gn@@J=Kd>ZDR4=8@%dKr2l_WIga7l1$v!w6oOWbW!qmLfSLKp3wJ#8M!Q( zu4`dRcyy}B4aU0t29uO1@F?x&YwafQlly5Hx&lJ2g8@&rsOnK+;11;fZ?;KH(v=q{ z3~_%P3$Jm~?B+NS+fP^74%kWP*Rt=XF0Y}=md|ppQnp4eFKv4jODPsd(+k^M*G!uY zI6qY9Fdj54iJ1e)({B1$BMmeO@cN9R4v9Ua6dM+1(-F1;b|&tiGM)f>qJUp#B)p<9 zb}8_I`<`S%+hQ5pdC8YG(I0fHgda!+3!iqzyc67I>g3=%qU$B@KbTpt6k2u!KpR%O z33vq9LL{yF3aVv-8GV=J%u+?9nap5E3e#s(8`U_JJpz}f2g7O#q>8i}`rqqXWfO)a zKKU~RLE0~lq>75x36Ik+s{}|*G#k2IIsnegTAIp6bNC6GUjy|^=u68q{%#;!x>|A6 zy&s97^jsZ6-BXziB=&JyeqxU+n@vP``CBq6dU}I`TQqwoUGm1Z3(N{kxp_26wP*n% z&&wd%V$^KLUS?vmtMz!0&Nmr7bB@?%HiC2%ceRGC!^ET7y&?8vQ#QMLTKu1 z!bWm&`I}qNFX759+Fqgp*)7)7e%=1YM}@RFprjs7YRE#V5zF@x_+zkycgf~^tru^) z@?8GQ+8>Oh?~nonTLKAKoPLg(fw|$d`eB6l+5=?SZ_{9Q_LhK~;?v?Poa)Hv@W;i? zg6Q7|9`mc^Jz&(51B3LII4MB4Lr6i$ag#U*I4(MJ+6WO5A1*+KKn=-urETd~^IJOp zmckS*t-~Et9nWKg67Ba*sqMI2tPZwgSiaKoCEA&v|FXEF4o(vLr9lCb2E`0aFz zpA`4FA029Z`o za3A&tY6`Y|KukgsZ8`&gNg4WG`&N-7-a*)KAw|^`E_wPwS`6z}L_h|{M$911Wp$5p zqC18?`_C^bb7u#7I*-(x#kz_6Xk)|6z$rP>VE=?h4qSAyE$E@nlp-d(sowOZ*Pwv1 zf0zXAD2x~A;St-`HSk&48)a-(jt*{3&m(33eGhS*&GobOE*AkLQ=p(taRr!gj&|$% zP9wXm$am?8Agy{NY(~V+ypX0qfFTZQnuBEbRmy(ErQP>x6N)EEuGl;^(anwnZ^8;7 zJ;O8U3F$y0GZ+=s{I#Euk<-|PpYYtd1|Hf>UVf8kT)~&m$L}C&1!n8-g{S;6qkAt)C9V%ED*SQf<`_RiC+! zqi^<3F4xz3;Ci$q=m`z2`YEU}&z$_ZeaqQua>0$3s6Dt01H{t2jaoaZO?WH7^vW z-Mt!`jpC~`_0BPUB`RAcEVntOjZ9N6;Z)DHxI$bVTm+JV-;!btKkyQFcAFCksBF~M zU&;tCLwKJ&I`diHze`~(h_LdHi0SMwp4LW4d7fFCupJ(s{iPK8a z<~!W~RhetmhS=WkBT3P^zgm`!_{FQCAbJAC%q+bv*R8n7i(ZBj&{UK-k5)8sP(Qk zqI9w{iVlwZq};tnPj8mR%iKKh2JpS^9f|D%vNwe0bGQ~P3Nc?BZ;sV^gdDGL6^MM% z$x7rdPw1Qq6}hnLzNx`25ZE&j0}fV(|C}=bz90ED^(m-wwP!eY(I$XPc0}Dm{RXicq?%CdWLjo#~aP(Ig+Rh@a0^K5PA;-u~7>+{+RPWj){1MWI! qBo2AbH`f^FT{mkIV4UPJIL3LZONkv4;iDr(ye2QZN|eODM^7{1HR5jo diff --git a/src/tests/hash_functions/c_pengy_hash_array.bin b/src/tests/hash_functions/c_pengy_hash_array.bin deleted file mode 100644 index 7c6c453710f384eddcfad302313ebe4236901019..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 16392 zcmV+jK=;4A+iiz$2b+lZTH`fu*+Pn*>nu~s{A)-!s@4ndSz5V?soK!aA-H+S3kJ*| z5eDO9ZdB`VFt`NTfGam&DSZ&If)WQ%2@)vB9fr$%vw_~Y`*mYV+jpe+L#ZLvW!X`! zNXPQ=%$%_bo+j*zVTJ%o8VtV$Q^};T2rU;8=#^Yr$mC2orzETL;h69pW{wU2%X4!z z+#5>{JnNL2EH>hnf9$^;wdhNEcc?|FyV(IO|Gw=sVow1_ z%o^x5cllraSGUn+$nw{(+*l9qeCG?`TJUZs*76hlaZ=>LA?~Q`{8t>~_1wH7foM(0 zrU{p}4wmoV@FGL}RmY0}bn^5xT(aT5d{w(rB%nQnL>Tpu-oHXY(DgHUPepk4o`ey6 zuK-WS_P7h*-_BE)AdN@40W{!;v>*Qkx7!nN_y3)_c9K!GG1027!Mj6{VZX+tzSDT{ z2T@Hqr59R0Q@YVVK`1B?V@+35kDL5 zGD8;l(EM@^l1Rm%BcS9hm}2g=Ua*i)k|QF6zquOCZa~XBCn&J!rO-q%iYq-^-F0>@ z)NL8)=X(dJK(AbJr}lR6j^Pzcpap()4CPOjrF(0w0d#C|8JDC+BGb094`w;BTY#|u zD`tJC!?-G)^}I5!A8rCz5hR^NanXhPys6zeL69yaGpE3^9YGOS>e!T;A(z;Rh%6Zd zq#tfoY08se*8ur5DD0ghpFj9bQfn4tlqrJwXQsKKG>`q3nj+aL`)F)DZb4UnzaIZ0 zMGCDV`-+Pen%qp+8Qgz^BWH!Dqu;`vUm|+D(y`; z9*zXQ3=V-PO?DEA52k$4f{b>?o{c2XxqdBt_GP8wGq z^iN}O z!8v5TBBDJ(Uywa?o#OBo%Me&O$h#muQ|Uuoyrocq(KGlk-0Tm{+(59wxDNd}`{KZ` zuGQ^%szLuL+kNKbz*Q~v=(^zgLkEdR;9!4qZ-f7C2Vw3~^eA*Q_gj}%vIfgpUO4U9 z&vsTFe-uCdv^#`ITXEApVhQqToq=b?rwqm79^OGGoFZi* z@=ic2DS-ZwbLJ`l)NlanCZZo9bgqnf1}nP9WH1JMYA2UVeA?TZfV}^rLl-#toJhs? z!p?(rnsI2K_2>%06~<}dWN1a=#ZtOEdNBANBw1{0F>sUnsl>KMSzem;p${PytONwk zh}YSLmPCdy+>~#~W(VDp`qEQ9mP5G*K;XJIMB0W48wVcI<40k4%wU$_qL#{yt^WXN z5qN>6_FUtvhqixnAmGZ=dh@V<7HI`f54cK-dsydp@lR&qF8L&1$S^{KYBw|pN20!FYY&>`?vSJumo%lFnTO6oRqtq@F zs$5w3cY0tSO8T)#gHlhce=>I08%soTE1818T5pj}K#J)bcd@j8>D`(1I zF3bseJF5lQYh$Rh@&~7T_D!J{Sc;jBK<5lhEU*@D=ZrBDOU3oD6Y5Dd`@Uix;K&-H z5lJZQB*W|d((-4$m(%c$Gn3Nr*wWL(^m9fn8v9qq!KQvfhK;a5nnT}9>3g1YJmc+9nejP{bdZLMDeB3c?vDeg<-ujdQ3eL z3$M|+o$3z|;8a_GAE_5&2ycJ?B)OZDw5j)kM(+e=CI1S2EG_z}jW2XFV)iwPi%=`y z&aL7V-fQ6I@2mxkrvTDNJFk!dDe$W_qcZyZEcX8B{kRZmlBmXPHvq}RII(`AK_s`= z-2ujl%MuSTUM5A@ZQ8~LYJmVEWD)`?4d$+qyl@xqxP(GLA)5i)MF`ZM#lZ>kg_zv> z;*QU#2AWixouoZLDG;C5RMs;qHu$8r+r1+!9xPQxu_b&MSOUUbmAyweSCuX!CA%4sN$(iM8rE315ZK) zyUos`f;4WwO>a11wIG~eXpIhPv?y9AZO#FVn~kzz3HOWsy2PV`SjZi=n)`Z#-I4IP zm6U@HjXdX%sTA}!cKZG6gApHbLYgO_RaMQLOTHWg&iPjY3d}&;6=amLOd>!>o_y>D zk_7%Pqi}p!Wdz{ZoP^0OPU!!7VyPgCW@ij~^SgDjM>lO$7)a)bv{m6XCAKEK`9(?ZN73q~ z$!_qMo4pBLkH47Rk{}dVL+>;mI1V_;YC`qZ%j^l=l@w+oBd)2$Z7HriL-^XB8<=6d z6%uBP(n((v8d9pPUTw5XLB1S&*U-{*Jl(;Y2hNGuhb!(zDR2Zr@$6&2kg!NH(OGS0 zBw1d@!D>`d?_+7|1!*1+!eVW^1!MaDfaOq5y$Dn@gE!^RsjZQ?$x% zb5(@Q319#z+(f3D_{@ayQnD=%?9g56qz*Oit<-d0w<2lzvTHC%a;6wuTNMYKrteP> z7>~r4?rhl%mEG#52^#q%rLaZPUq~4}^)LyE^x9RvqJq1c*t^kqY3cxfoxuhdvx~R)a?SOPNQ~i9W2(S3B*P1a z%0*LEX=k4wkHCSZvU@F%s{G>{ZLwreUR5;JZ=-N@+>hbuC1ODkAf$zPyh1y99Yd?E zi=en|F-4w1X;gX64=vyLL9eQ8P*!ZG<)81|^DdrMkHbwvstBy~gzQa=-pVRtv%W)| zh_xy7gy5o!t}$HaO3>@kF(!GTYbSL=p3unrFd`W(vq|9!-<8z$+A3K%PJm|;ECda+ zwu&o8m0$(UI)IeT6pdYtZt&^$%|(FvC@FmC8=$&m zJjU8L49EzZlbB$}PM}KT0#t@D1TqOsZ|7W5X-iOd^7!^Y@kP7|7T-m(B-OE@JL$;c z$lRA`GCn+mQAR6CKkkVez(c%!jhl2;o)zn=mmVO+JWB$(iO> zo<59pRz2z0M3bnsuA+%5;kmM;t3sy=!wUsc1AQwydCgc7`sIr-S3!XYq!Vzx@R^t! zDl#=RZn2<)Y*pvREegA@6g5Tzzs*3S_PO-zGdIfu7WZ6?w(LSD4U7drU$$(7yYqA5 zId)D;;g#FQoJ>y3f|%;>U2*f;U7N#>icOr;ACbuE?pm~%aZGtXfpIfNRMe{4e=*d? zdp{G1msjds!xEoM^Gl|C=uBAl0)l;J6233QIy~=CSSNQgFH&S$5F{#?f2!JtZ=WvL zEdOLsN5bcLRs>tKx6>&0ShgSzTS0`72(D}&*5Vfa6Q+*_zu44nH=ob432rU&9x~g4 z&FAzJ^z{-8DKE?-(9bDgSJK@5YX_$fWU-rA!(GowJXC_8;rH7t1k+9da`-W8mq|+1 zW;2gcW9ersHQaoudBS3;F_16*ANVZX&PgxQ({_ww>bwBQRL>-!YQhtXsg28Z{7 z%W{nSgN`p3)M+I3szCqq4{Q+6?Gf7ZU>@(I+TE8%SGdV|=)){4e0AoK0o_~O;%bX~=izQ{X z%C{nM2#K*Wk*~Xt7Wa9z%@)7uBKJc@l+)tEy4E}p;gurCRwJh_C#`r7wG$o1O@CxZ zOIGE6c1hRWm}-wHNNK!7b`G;=6?4x$5as-;S7ZQmuj}K$NnO+=3-BMI?udYB=0~Aq z%w8V)SQSi^NoJNzk1HLIbfDw5r>twb!2v&@)?emc{9a`AX51pz*>E=E5m?nxx0|Nh zL{;#IDWK@Qxax++Mw{vix%2V^aICsmbG*X?$ZXWKc$Cy9FtHJo^X*B z|N7XN#TTQ-9m`hpVLCTpDOvt;E|-*@;-ZP5q?C2q+b45XpWDGgAMwoQnn>Ta%DJPd zrzL`$5o!f<83~lw9n+AsYFCG?%jyyaF?OyxDd>%%e37B~tt8G7ISO3CyR*&3j`fQ9 zc6)2``jkVbpENxlGt*cSFt@H)x8EO1H-3&ikm|>*#5W0`N+->q!^jMYf7y4dVAfx9 z*C#{h-8Sdg#z59rNW*eJ31FQ+pW(QZI3;AF%}-cc%HX<<^JMDg%ME2Ad1>KkaK&|;7=^2$}$Ik!GDckKk z6;^%TQV><(dN3(!`r7WI83Km6hEEu5*u-^EZZsRE$Fe{G&WU;g(GAFkvz$x{87XS# z=c3roJ@Rnc64`A*KCqm1&(QP5hD1 zY7@zpz$@6j|Im72De&(QDJFe+3Dzp{ragQe+|KXDrcw0?@@dQ6FDV=84Yiu!huwEm z6SO%@=ALH}TgKK)5@TVhmM3&~qpKhuw$%$ON_6kXiWiBh?x$Fa!0W*4&b2?+Z=jQs zh5yLtZdX5Rg$krdD>&~qKDa<>=Aul~962DHQ>^3=zAvia@5+*xa=r>7=%BOLBaYCJ zGIzkE2V~aQ!gs;B`YpM@OnZ!q?Hpkka>(jG9H5%#KYRGse*l1DY#JZX23Z*~);6vbH`T~`a0 zZ%A?*V9372K!0hykpHkotTDm9s5s?=Y{C(AZJXj7-D9ECJ$>5v;vTk%Dd{>QP=hx_X*2i!LtiWB?c$^ko?SUh~cS7qM-pRCXa%Ws`4xf<+XWSinc(dP2-uL znGLkRkvapwvFQU}i^gcbWjw6MMVEEV@YoXpwWwa+ek5CpfF~j#<+Rv-ZiSudfp>UB2S=ZNc%9tcX9c ziP*H5oCcH76R_@rz3-}a%at9r1sAoZdt3n=OT@E0%0TI9Ys~G&mBIY~4_9m#5EG3k z{P-3xck_H0Z`9(u1W#>!=L>jABd5S}?`*aEBjcTnMr<+Ejs0p(P)t9BDM(K)SgA19(kEH|h= z3z38vT@JMMSGa$rUT-4hvxCr3ic&v}ZM>@fUWZ~w{~S=37=-Fko!sTC%A!x15Yi-T z4#g-V=K|1I`5p#h+Qt0$(vN0jszaOt_8k`-0sdp(nrOjEoTK}jGeN06qZdIgfW;%7 zr2iu)X+`X7B;b3<#F-nr31j1mB&A5z!vXTgLPO-&`!JILrAW>5=yZnZAJTn7IW>sm zRBTpoC|JD8%!~_td$|e<=iZp!v+ht^F~GGYIV#Q~+KW;GkDL5a)ujO>ubWTAelRaO z@`lDO+;v4)&UM3fMJI=e2PeNUQeJ_X;ro_zQ!B!xyk1opmJss$%#{$s?;MJ>IsX!Z zW=9SZ(k^+^wVkBbok~EfweS52EJ+t7f)ZT!fMcqEl{~Jw5fcpluGRbjLz*C`6io)z zp~|+#QjY5GFooE~6xgE3;C0Z_SY2SzNU}9$+0UB#T2rRdv2C2>U{D;ZS^(?}w zRQDb>1+usDZkcQ@L0B)$_5#+VYs&7l)T{EGWp2a=n>9a>!-nY?&tL~UR>G1^fZ=2z zJA&V32Q>h+C}Gkldp@3&;Jvvx`uK;F%>=p!h7qT-d$C1R(NB6ha^#D#*7G}F^uHid zErAQVmw!B-A5!Zsbn{ziA4z)9G2mOqV+1d@`fJ*9<9Pa zh2@9Rt{kS8A?;t7NJUV}k>I6`5j~+8AkzML^MWcOL{Px=8_Kj+3I2vz1uLDZ7xqQ@ zSYrDTTq~pdn?{<7rL7?alagcZN^(6H%3T0C3JIn`<>!UCXB1wui7RU}Wn)nGQi96$ zBcp`71D+VdEYGgEF!i8T5lT>7B}5-js6v;2X|cmqF%KbqU860KuFm(=hh$4$Is$D9 z(4Ph{K^)n8bx%jm%Qakja)xWp?KGAzA=TPT04JOTD^OTEjhO0r)j(?E7Q$G9=}xpB z_?{5Xph#Zh_=mQgOv7EW5vBLHnIxNx{s*49VyhE%4}|yU*GF)nmDF*;N&bA8pzqZ~ zaRW#;Px2Pcu0CVO@)*?ITG#KjTgVW+H2Iubwp2WiwObi{N$VyMhc$oIMG`6cLB7`p zgI$9Dq`IfpW@Ynko)T%84)?(rnm%UrG`xK$ZUc&Cju# zMoZcLx!a|`LY+*xKISF+Iy_D*^l^){g?d9_I=9e<8}no-ecR`PZ29aXWq}h23p8(* ztDG^j&z=q11D>mzN11a6F<1U)0?5%jBgTAT(V>}vqWCC?T1Q{%x2>4?!cJ=!Cdux2 zJu$KKcTfyVL^)&4`@g|gvi9@t8k0RD&<=l>t}x=oRLP#%(exm%bE$PAxTzOiaf;y! ztqM;re7+(DQG!0tuhi59sdc11U{C>G$OZJE&PcmnI9S*D-L%n;rO4S-hqN>iy@?sx zfkXR{2`Z3J6%?JR*FvkuFuN74PcEYPL+!RGoBt(KH#A z;fWECKhq=L~PE)oo?jVtL4Eowcce1nMrck#ormS=SaxQ*h4T~b z@S=t0t6l4>g3{CThJk;>*Hu>>Gii9Wdp}IoF%C3;P&hObkCF|v!4(#F$Yk@gQra8U z7^^Gh+vp4hh02L&aV$Gn8PFn0n8NA^|8FpDo(>;XfM_Zt<)5Pl@0X3Wz}k7jOlTzvmq4x${GL^} zu)ZK)-S*d~K|t4Fk~eCxWzoNYONGC9{4HQqxF(yW`Hsi<;c!g|VwW076k&8uUh}QkQ{sNb$vT2(tNAJ`^U&;ipZ?A{ z9PB$%7PZGJQA?K^`IhnB7cD(r5CA#?Upizb5cyM-$00!>{9&xI3~hfA4%DIp zz8EqIfelTFT^}QZk9S*wZ-ySGQxB8(LPN}HgnL0{NhTdXD~ABf^s%j#px6&9;3%c{ zuk>SBzO9P?=`yi^Pm}(LtOkp=To2L7WWR+9Mk;!icdrp(7g0`qDO;mLr2$_oVlEeo z`|5#D{g}?iFJpPtNG|F4amHv!qbpANk&_gHYWj=(E)xNh`$podJvh_WKlMRRVYzeL z2qvr9{YtXdntr*ZT{G$URkCI;=9miFy~@_>d-eqE#tbfaSunj}kjmg%2xfwE5jp@e z1rPw_n0v_$Sa_i}xTzAB=YpG=!A(qY%4n56N!EhLcW~HwO$0Aa-Gr$2?;r1+OLXHQ zfGCC9$Typ#?O^qzyiyp zZFsD_NtKoKVYes=pt?qQqP{<8)pYCaMUk5T@>pB6@%|(@^NMib5)oR`Y~u!$^lgOe z*2ka1Zhp`?;>HeJA76r@r5J{Q2^ufQupBR1#j?LYire;|MSg0 zK9j*r-Fq#!8=0WceDIh=`3>Y2HW#nJL^4ZoUB)Qr9?#+%9Daq6iMGlD{4kaz=mUxM z=j&OT#=5P&Lbd-rZ0EtyHxi#kvj#kmxe1Piqn*v|eR63ay%YfF&d?9SGd&YAfq(4B zn9doXezjyzo%-C3-^N=XBpkewhc8N7)+YyJY?hPC_BVV1jy3hcAOkdx9dy>sW#QoJ zE@BE>T@o#5Pwfo*pN<@cAPsht3Uzi%L>4)cY{RPwd$XDOd2ivqT9^^8$YjQ%0+!tQ zDl%s6b%tRtYf6a1sfaHTuNuT)a-+N()R`#a8%&D~O(YW6| z3&!twW{VApeTB1~$A0XdzTW4Z5A^2<*F_vd9{wMW5e)cyU7#C(a8j`puJ2O3+7vp- zRDe~&-;CWKSAtfmXL{K9+cADKgEtu?I^OXTO?T#9$zSUlG(lMvyM3>sYHkQlDKT0! zoD*h=QUAImJG0*=f0KSx21P%t zyi+dh0ZN-?qds_e*y1uSXgyqaf9wA{{hgN&t87)9O|ax#F$JgnKB~I@P{|u(~M0K*tUc}E0i_f{mej|vCASz(Ne_Bu}}XI}Z(%&?8Q;K!xVQ(}bk*bN&$UDC5b9cqjJn5hWY1rFh_=E(ok6vqR-cQ5vXLSFPdA;-SyYsf9daxoC;*-5m#m5S9F%ZXw|+`uPOnYVo84{dMy{CQqFIHADQ6}%i58%6yu|*C7Z02Fea&a z)qgiZ_>h=lWz~{3pDN>4M?dVS`Yvi`ymAI>HA_a_1`ouynJ!aL?4pmSnLHq@cHae` z2?zJujI}_^_*5!a=T6=fkMO*n-0QGlhNxo*`T{bA_j53V$=#5%^lYr=3bQ!SQJP{Y z`*qeGut#=~dTgRHb+|n0(dF)_$BCAPM=E%S_0~qNDv(2Jm1QTc8aBs~Gcs3n!GPr> zA!4!oPG~U$0b_#dPJFe>M;qvV%~diVE@Sb@KXXwrh@`DfZ}DW|aVsm96gQ@|Fth$% zqf?&${UWE0eSH^2UK89YtQQ+f1%Xo9!RpK@`ze_1D??CGRRP zp3Y(d#d3qSP^)ISB@0bN^kPf<%poD!!%6=tWPt8jUu8-KJ?$~iTa9sm*R=(novZEw zFXiQ-0);5Om9ZziFIy4)H(@RcL((?MSJNv8{?g&Rt zPgCiupUXq?YVB~D12WLe2o>x78Q=I2$|v|!+?3k!AzJ$X<`DJV$&iOMGa7?$yLG>} ztQF&SU|*!Aip}6Cr&FABHLZfY_sTBG(UT%PYwrTSKRJi9`XX(66j%UUE?pyJ7?k4J zp=yeUtg2_|hq2Q*5Rc~i9GI^VjmLNYfml%gJm>8#=7CQ1c@2t;`;=zY^H?vnL&7C8 zbXgHfAD{Bh)wa%u0pL-Y^G3Fu^K-Yn4BBJwC|-&A06BsuX>D=QH3RPM7lEy!j8s!Q z;|~rvtyQ++^yv2d?M8Z1oy;@6h1kyq(Qd$4pIx12u9zr*iKOtHAx|dtDPD_nZ4p{g z4;7W5ghgwE!HGmp3t^sNpqmdvAe%Guq4H8e&~dT39JN?8P2ZY14GD z-u!yZF{43<)Ba?L4wG@7phiLT3iRslF4s|gF>Go6BR`q-s1NMCT8NkQF%vS1YDoLB z;OOHUX9fx1MxrP=lT2$>$fp=JZMBIf8s670}mJr>YRGGs|~*4!0w4f+-WT>wdmjarN^ zDeZldUzAbN`SpSEj$pWO1eh(n5r}s$F84KE;Ao>$lZ(-eP)_rtT{ck7VtGMs8lF6} zol|*$)4=B*Pk-vTyz+NCNc5x31uA7S*&3SwHw8vOwYWmY0E06hhCQSo z9UjUAiZd`;t-LDGp|IAc|MVptXa}e?7Y;bI;s@VbIR#mZ!_qwpz8;DX?~l_d7<~7fhuTEUafgu?Ll&9` z0#{KfWM93nt@6OCMOC|rQEN7bATvN{%l=;~3%CBjoHipf2}PF!amWa5SW0e?EH&7V z$j=ke5Hfh=XrZAV)8=#fN$*d0E88cbm#RLZct8NabYdK?0Q(&TE!;fDH%e)?)5Naz z5qHD_BrG+P!QPMGyO&xQO9r8#o0EK9F_#QxFAuNs%lj0U1&IAb!T)9bj;c>A zOq>;W!dc_`wIUg2`m0N74~N%`STWniP63R;r3FD$cOx0e2ah{GQH=M!%AX?-di4j9 zBH)q%`?&+iIm9e!IvKG%VM^5B@)tgzW?e)HA>V(xrk#QbStu5@ZgJ%>#sd$OD z8Ak2 z9K-f16t8QvpCorXM;f2{L8_blwx12n-dEfekms0b=cXj+P@gi{(_8Y!9iK7#HdaF& zi9`3V{Q~c)>PkSd37}B?5MlwvmS(q2L)4yq`8k)RZXxe$ygngg!wG(4-zo28>CA<9 zk(B(Gw6c8sVtqA_^o3?8oSazL@pgl`H@NAXM>LG(+y@B&k(0RR{e&cp+=>RzPGv3f7`5nJXKGXm3qKdO%^--HJ`b znrv;3SFV>3>`#zjgr~(`{fQLRZ}ri0x(l@_N!HQg!%Zd$}9WN%AfLwfCgugTVsm z%w`QDSE7|Vu`SZx{l2}E&aE2R5SYviU6X}gE)vz@_lY{5BQ)m-RRPm4!5O~z(l*2C zO0YgPaKm&qEi5+7n4Np6MFT#2Mw0AV8tk&|8wNm_2t#BQK#a2^! zAhc?zuQy_R-$&GNWNN9P?_-s=W@d`zF)o=Wv}2$WLc%TTMQLAJ2P(A10MK@{5;m2h zN);N3hS4t=UoyWBHIR9%s}2mnLVa+>q-@-LWTUiQ@Che9Ffg%7BjPGnE5>C!*vglB z$*c)sl~t6OAb1Ni_FFkE2MDDNe-*$ypa#G@tNPW5W zh`LwSCmFm+9UGHdqCi~?n?vN#i?t3ED~n#1*Yl7Klh4a5=w7N!5gsXyH3r$}T?H7W zYjyZPW-%jCWs#_)H^kV22rmNXM>&f+$6QtN@9O)BH(V9f5gSwE7?dZmw<`ic+^+Gq zSOiOk*gRbm>Kxqo6EVu#CRfJwz$FR(@*yY;BbE0dl~F7OOCN%KM*|`sTld68C|! z-INpjnWcASxdKyB#ON#-dfQ7nFHk2I&6|nTNW}F_y)T&!jNlf7enGu!52=H6J*B{l zyF!$KA-oe^i(DHmgHea(Hw@&ERtae6PWb##ayRXgqj-e3t&@c=x1Xk1_YEe7eqp+j zYsM0=je~7XZ~NR4vc`_P8NQobYH}~wC`n3k1-f)*G)?}Ve^4U4_~E92()#7km|ve| z5>6moZRH{RZhq@^&xSzkpL(RvEi`zG5*Mtevr1rnAG%r|%8cHD=CARJH*w3+V(AXj zl9ckmQU`htf2Cb=VNQ+UU!X4laj$5-tmt(Bk z8Q6vO!2UMr5J8H|u-Y3*_qI01b2sv;2sF4A=*ec>iPL51?gK;7+(_9NI-qKq-+b9UEXkTZ$GS2w2f;}i{l9>efyhx%r+oM8 z{P`&;&ZK}2*ieGYdhzh{yB4$}w+VbgmGRZ(yW>?xBOs|h?m@<`kr1>G8KHDcpoG@- zY^L;P<6!i2M&d$XWW#b#r26A?Icv9(ZOoPyPeT6op~-|HVHSYe0o6pm?>jq2Os>P! z8<007{H`G~mqjpkv4j+W@MA)y=rb$v+GL42%VoJL+s=%Jg#Gt)+C)$58u?pUKr z74s$(Igp5{mP$@4OZA>5aJ#yi74_Q{h740QBI6KH0%-{lxjXmm9Z3Ok`;cRsxIhF8||&JoU0uAPWb^U>+QfaM_Vn&y(ltVQd|}K-nwwfwn}@D8e^1){T~aS z+5I}w4L?WqH9KTBiu8+uLyA5^>{!3Kq^NpNR+2E8yaZ74a?X6h2_W?$vZ@6IOFOSf zD-f>F|334Pz5TaFO#OTR8h%nocp+aZ`GZ-Ov#KTyCPX>5XSP}I(I&B0NR1)h9r8u1a1POXX0DJ?A=Kcd0v01`O z@Yv&!jCeAQ1NP5&vnJAA1N>n56?^T>yXDcr; zuE%XFfLh2DkL!~l--H{*Lh?DC!V45->Shz}=dP7JB^78mR1cga;sL=BFvGHAGaol- zZny~}EO4xF+#qf420yI~lm5s=? zDucq0m7V>ZT8OdkK6qOX0_CyV;-8&lngSw_17q$&02n{@K@pw`Caz_%hiKn6Eu{Dh zEck#<3w;t`Cg{kG4{i6u-s*Ukj>{f9j5jmMT-92yuXRZJLTOnkI)|854d`)X3RVX7 z7K@GIB4Uw~8rF#B$*qYLFnq#l)fUjwMHvk(X#-cgYL_e(tFAwy9vzAQOHV=s4I^eL z^6h4X)rD0RAhQI3+=ajebI7s5F6GKnl++*Bp<3Y*)n*TmdKZ@b{x2A{o%n@17;D_? zX5|B%CSgnL71jGXFt%W2Fq<|VNhZWZSu~YmR6~NkM*k;yUothahcL~w^r}n$L_+Ho z?|&q=S6u|?X&taLJaZai$?pq~b~$mRt`|EjQ~hk(JaHBWu`-I+{eVe?{{6o~tdSgI zshbsiNK?5hxa+rSJ`HySoU^A$jDw<=|FLbsSrWM_<1tb>NX$Tw$tU7WKenQ)f!Om} z(~wiSILOPuOW|~%jGWkdre^W@(PPNxAzvwk`|B7V-H1DV2>|#`@wVe>oi%uuZJcSu zMR(AevG=Gp65UMnkGfIu$u{4A5vOOKkoz5PG0@t=Lz(50)WhXmZ66ih+DX!n!EYI! zd>`FURE1@EvCJ1l>q(KUb zRS?*ms8syt7jNX>>0~+8_XbbuH3x4QduY{){BJp_u9W6NK=A95i=uCSr_ff8^t)@zRciF6LbG>4>Wgx z_mHGc8ZB_H1&p>{Lb2M!OcZ4)C#F{PNyK839pYfJY(Ci6Yh+ib{zI|)FQ{X8y>!ryS&d<~F|{Z1LRat7&~tXQA7?-#&AoHKs>oiqcE(tM}aB&327olZK1O~Jdj!`c`T4b*)r zyG$?mE52ruv2!(V)CI$`;ui-MQ9*Rcar8$2WO8nQG?gLnN}Pml_%clpY(#RPIdvOc zHDE$(sg(;G`9An&$IeogNgB{Lgu6__^xqr#l*?5@MIr2Z12-O}?!pK45en!fOc74h zBqByqJRxErK2txvP|14P+(|@)$g1b9EHlpfMC26@3L65FfZLTvF<0GeEt=_+()&R&xG22<(UlO~=@KyFHkr3qYs<&QxAIvPy>j(R zNg7LB7~IlQr}V8IB^?c~V;d5~`jIEarTXn4pSCFz6Za%PV)A$nwKUO(%Qu=mZ&jb{ zAY#)`kT)}c(CE31BCiOz@=iD^g3()-`mbaUJqe280e%2pj5yMdFD<0dLrFSMn5g|k zLl7bIb%%O0=@}uv=ISP-0KhAN074XS9l)o^ITyG5ta^=Hh_DARck1s~-gODLpoti- z)5q9{b2IHVBg7Ai-4AEs#{p^*CH=!CADkh7^O+`;3@^L&2hKN@7R9?t8VjcJPz(h7 zK4yc(@!4y0meSQOaLI(`Ag8@ry$nzpP>&X9VZ0n1sw2@FREz30$dW)MBak}hn_qqT4tCV0)t?hOT{UWad;$TTWvUS9rx1Bap%-hwNElkJkh9elph)ALSKbL|1Gy zn=VTgouw^qlv4!*-TV}S+qx2b8X9j-qP43*c>Y@rM8`w|5|i9=<4s0Ib>i^h+bJp~ zg0|Ae3`sK}S-La)B5dZRBQ$!61sm7Qo%z}94wzWSWAx(X2KK!qcy|woyi&+68~@ak zs2;f6`9PoGJMu_V`gLYvh1B0dX$$fXT2`la%xt&98NHtt_7elD^bucK94t^WVLi1+ z7Zan9R!9>LiS0}0#&hP17oR`%@67sRnnX|B0GsQ#?Kl(*XqVpz1q&hqPYarsqMTBu z@(Ov{7Ol`o8;sxOUgjU=R(`o7lBvMy3hY|KH-d3w#tC+Bu`W(LwZAuHd=ZQEj-wB($|3|?gTVPSBrE-oR30m7)pKxvf&al=bn8I;# zw`62vs^&Zg_d!VBDoP2dWZR(2cwRcpy`@%Rr-nL*6Je3-oh$ipNdPRR2DSkDQc|G} z2f`!$CNoxWG!F>)}n{ye5&$g(o*dHIZ}?z}B-Z^=~X zs600u%N?70Y9F?z$GEV2Cn4tTa$wuvv*{BNShMwH$B|kNpS$zf<;l#=LxK`kulw60r;fTR-AY$2 z5Mg~UY1swtk*KR8Xo{c$&m-6L7ms8&kUBxyzeGx1*4yWfZiHHU`il1yp(O5a;6|5O zE0FV4vzkKT>Rt><3ST8809gTBAe73{fr(Aq!#)~C*n}%#2t4N{=>zeW1XDmYb|E}{ zYNT&KpSZKWehJhA5P+xB>%xmMzemof9y$dR^dO>i8ihv7Xs$-`qp2Hx(=+YoYpOtj zg`U^MrhFo=C51_!%j)J9(^&Uk7|9h>Jh!Ae^v1>-XLbNgqGE=Yn9Q>8-+BHfgQH|W zdWWJm2SLZ5ENSHnq9VLQ#)9_w?pYk2n8o!jzDhM;v2@|C!6@F{{q3b5<2a+ zxR}!Aq;#OF*@HKcNfJQ_o68cT&J-tvHg6ck%&V=822pHJgjiZECuBQlQ6t3w~<3Pp>dEy zUWs=t)60Hg-R{ao<^D3jGbeKefkUrpK{Y&Iqg$IvJxq)J5R(O-&yW3^5}b|44BWL& zm!#>7hftxWizgLOV@a#va&L*&gZbddg3e}EM>iF~+v$*!4gRO!vFCfxlDCzjhVre9 z*0~zNXK~ij=u;nRY}stf#$B24v$$!T0|)K#A_%pvKPbSTiWLt-M;bGyjlKAG*#K^> zO#;z@r@5g`z_W$7QVmXX!uMYt6f<;b0RNs=8o==7gi5}*`(?(mx|LXSev zSrMgc#Lga_ z#-OjQVWLnELJ97?U_*g~V~(8hWKi45U?U47w3B}+C}0x8slqh*p*f-Or@+i1Iq3D% z?LIOZs37vZ{W)xtQ(He_?WYVaSGAC;6?WK`A58aK+R#U=lGO^yKL$xQU&#aUE-j>w z4h$;mf&s4}LL&DE!APZNoDSF=@4ZIeKPr1AeoGAL#xd0L27>BKt8X|JX}5fXWHA5e zbI=EM*>Z~Ap;6cYMKghywvK4E=%gqwL&1Nl45j7*`4}I)>T%+tGIT=mrqB<7aqR37 W3`TVf8CE2k80&Uj3yOHn2MPi1*uNkE diff --git a/src/tests/hash_functions/c_spooky_hash_array.bin b/src/tests/hash_functions/c_spooky_hash_array.bin deleted file mode 100644 index 8326ea147f4192d04ec0e77c67dcbfa201056363..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 32784 zcmV(jK=!{8HNB((QX0+Wc!`c^G4Oxr$XkVr03V`TD>32;Zph_4F&^{2Hcn*9EBz^~ zP;F^@g@o#MD5@d=qcr2?I4w}di>%s?vx^{kkMyPeNRBEnJFTf`7%Yhaxp@}}<4LaNx z0{7s~Op1{%9A9}HuSM&!gr4<1!03vr8b7Xwr*!c=kpspz4cVELZP+0HJArT}3onGj zmWG$=>pe*etlm*0# zI}`5&$f`d3#1y}pWHXa-6llvTj1OHNQJIvwDMQWeT>Tv(rgm9u7}}rjh%_g^(J(or zpboO*qlWS*K{{v^B5kbfkxYuNm*82h8*r$pT6LvgP3|_mie$XQ7%(*~(xT&w@k;wJ zFzm@8z5gDa)A2E2!0eW7%vb-oM5lO(D%@N@4Vg2hkC+20h)ZQ|<9ynB?T*i{^k5&& z5m0a#stO{F;D)PDJ|SKi8G1^Yy=AKK!dVSH6m9&IDmPtL7o(1kcBpx4F6sysbXkGn zz1lf>2EDJ5W60SAYb@$;pFGR5iLRUXhOP5>OB5L%2AO);zyGVS7Dq+Tfz+B5JIESh zw0JqC#{M80WT5p5j7}HN?W4|L#~BFxY#x{@#s-$#X`fX~c~(soG~kp$U?xtw@fGKN zmway^;qjE3UP!*a%@3X1rP>{v-xX)Rz9}&cH}$$%?pC)x$>O5;;nbfiqxyn{RG=f7 z@B{Ku^Q7E$)XiKY5x~wb_Vy)vZ1M?#QbM9m*bjaY)g;$c6rGB+H!78qA|+@fB~X}n zI~2o?7~@q%=L`^hE6y;iVk^8S4YlDJcHG#>B6V&n0st=ikVc@N8IE{) znD#0GtAAyyGQ^(rEg=wfMkT(!$F$X6aZ5$&Y7R#Ts`?cRDM(Xp{2*5#T*SDzm^&SE z>eie8GDa0*b2P#EIv#^{ z*i-rk0b31_bc3gJDoa0wF27AAitA6| zKmaw6X%4Hv`?=o*%U|tzJtVD*KV}-#0V)+o;X=mkdIzhY_Wi4XJuEIID~VJu`>`{| zwTMEQ^7U|}$zhn{aU7*rui4OT_*hd(Ecda#2-Nz{k1R0H{HfDMabrvh z6|y}BsxlFwzGY5&uz3DT=4|%r+h&W=IxA2)YMy?4U|eHkUF>aW%Hi7PcGGU|`IJ^m<|poSmFn>3Rga%Wz+A*3FbwOz z5f=t=Id8w#8=(J>EMQamoPH4|Sn~-c_Gp7xOi)1Eccu+1uktve_w4`2S(xL{76@_t zEY~Qyy;K zmO2~YKZv_+{@4*nZQysa+Nguk`R9^iPxRr)x3ms!rKG)v7j#Q~u{EmnhIK_kAOibC z7)D12qUV~;`Dit}-dQi#CgXP2ZIgo%H+l;nu%B#{$$6KRY#w&xa(bN zs3&+lu2pWyD7*yVh<*-b0tHru$oO~OmXzZP<1X~1tXGfU6U`u4bB5{vai(Q~4%+0j zR3xo$b}>v#JO?9~a%tsea?j%pKGVmVrdaqKI(m}XY*po-sTG%|n%kc2ARWZmvvc`> z=TJNBhy11yG}EtAkT>vz!~IMX2fN&z!u3mDQPOBu*P<)$7i9Mrf-6l0q|!y>~8PJptwOWhfPEB4v^n4BCBv45Ow2 zjBkDf0D581dvTiIr`0`z87@pjh zR(~|GQ{mNn`7wN7E8H=@sKtc-sWF6jp@(RdmrDd_Mpp#Itty&IVzxclTdG3TKPJY0 zTRVNWK?D{CH?F&UgRSK0WZRw**(X58kCOTTr9^BeIl|Vf2+F8mlj`r_lv>U(y z!Tweif~Tj}->{k&T{z~DrHQgfM@)fKD>wzRhoMlA2Z2Zr6AmoM(CFq z1M6J}vsW3DI(z(Eg?M3W3d}d;IoY3)ZK{5H)Z!U+I*oq>#xR!wQ35;orV#A${*S!V z{d1$wO2<2Ho^#eafDlwQ+Wzx|2zUAVtH0-MAsAV=p1?!B z&_@pPt~mwZM6Up*ydIYuMS^AM=W)G>A7AIT0e3I55qxE2RwLz6*b$|B&z&JWqh(#4 zPQw>lfR}&|;%8ZFT6iHm^w=oxX3A#`S8}T-D1cRs^>rZKSr9d=ETgd4&Twi11tMlB=R{g&2bTs)^Dg%Fvzc@=Dh7^`{lKN z=v{Ugtij*~zNf7a&gPVtHLVRO5bWu*M=Ji!kn!4&c0A-#fRoKX=z26Y1w<((aSMsT z&jg8G`g*Vsa%D+;17z8=xT`iKc&&?&PgG}`1g3!=n0L8v-URhnip?3CP%!ohx~jLS z0KG0#5LYl+=cDxZsLrdx?gb=xB@QaH+ex?<7Q<33-Otjv4Q=)oY78Y#)f6vdTiKBU zipp|}%|w!*g7;ugrDHNws-hK+%5}F;jM5+b~XL=lHeN(low!+7p!^(s-tef zfr(%;`Zi%^ICyKYE5@P;7mu=8dHVnx$UfQKh2BkCG2-cZ8U3oh(thQpG3~*(MN-r(61j>y!lPfdB`sdoT{Qi-kn+?y*JSa- zZ{Js-6;yd{{^o6T{1m>}u@`xyZ5RZ{zID0S0Um)P;}f4$W_Bk6d@^y+^Ec+^m}`^b z(i~Ahk9I6Mb-U;NDsc_RDLJ2#B07VbH@xOtH*m={OAIA88sPlCm+=fzq}ww>Kk6xx zpiXeTV#&qz`0W5o)>Z5tCDV-QOPekk*#Fmh&(^vfP<27W!{i(Bg>mFY31lm4ZNlx^ z?bu_n&Bce0B8ek#=1DCeH21n2^wiHOkN6#V2wm8u!=fb0Stw>#mo3s<%vV#gz(*pU8b-_<9%M>%FLANQOz(x9S9G>8Z+L|1;U(HYT8CV4@oP z@lAib^2z(I_RS{!)jr3$$#w|L3no?!e#6exvOLMxF9t)79y6RfgMB@mDfM`26u2JO zF-n;Ve8*e2IO0q%ITN8M7N(E2tJZkVktsR853TfdbekIy>vR)=t)pa&!JM}>o%G9o z+V}a*=8QOmMl#_YN(ruL#JDRZ*M>;%jo1(dP?mjAU0Bj}+4~#3J8t62Q!#vPuauV-rGJZ{~hMD2l4x zjthu>ugWk@9y&YCUu|aefsgS1xp4$l-c@)S$vQRF&c%1>z2&8tWd0JcQRRVjMX!&eIT|IHW*b$v8cdC6panbAF1}v9-li48Y2Oz5!nGWM7Z8h=pqo4MFG% zrmndS7mdm1%QdV5;rnuSZf|{iq?5X6C&Sm~7`3XHcv6Q3SM^aKRpA}2gFaPqRieX; zud7a#{j6F4M$15M8SAqnMGs?*5V{X-m{m!b@e5}?2^ill`=>Z}oo{AIsV85qQU!-x ze(QzhUp1zCNk|yQ1dj;c6sRBHySDHXTuDIC>)liXQOpgNi)xGtCELtjQeM*5>8X00 z9a_v{{DTzE>H25snb-Hc!vuNaTcfeiiJY#20}qJ3baaWKQfw-A8OKiwWsOYx1PoPf z{c!mZNzZyR0grn=B41CT?aOo*R)QalPiFO7c-JrdF=t0%V~$;IDjqepA1nWx7RV%V z^j?XT`Z=0P}uGZ@aNEd9=NLgvfWG&`}mIAZxC zFk2+keO?w7t4Vgm%2I2PQSr@v5b37uKs_m<6(Jc1YQ8}0Jg?cp6^SPSQrS7HyVqPV zi{-J{jL9Cb6hYeIyDaDLfIUDdmTZrQ12AUZcbUOC@>uCI(XP!-enQ{VEOOTxy)(CE&)+HM8d73ua-ACv80fxmVXUU360k_k0=ZWt7Tt}o#vv(p=*IB@NkySX$qJVPQcT@S~8^lZ01f>eb_+%~hEKh_&Y6*>47VSLd-73KeXIkpQ+os@F ze0YA*G@`I6h74r)o0Vq2ZB%M@(6p%@SqkGSDFP^Rx1Db)MSk+m0g82kJ8fp_PK6?`8hJ{G0mn$$Jxbdz6=0 zSiq&4^~t*@(cGb?n|a2Yv2MYQMhG)r=xon%NZODnM@k&cFx$wR`r`@EQT0@A1Q{}~ zb)dKyg!k(L!%-sLa3!~z&~!rrcVQj^K&PkMW6Z*eDqI>!LQ7^)fgKK8EQ%UICVrh& z>LVT5SnMgTbHYKCrvA=pDM0KE66$U9LECg(d5LUCAh5=(#L?n&r@ww16F{WD-D#Cb zKxQ9NzA%nV8{W_0Ym9>cGONwwEOXVh(u?Nsk4XZi@4njvrj_ju_I&BbEn8#h~$IYW3=of@o?j>F|xj^s~vx;JQfnU>KVkpNy5nf0f_=>r%qr zo5a8~^&5Z=0-<<^2Q>nY29o3r_;_Yye#EIrcZ1Ear$!FELs(8LUng9I`Kb zidlpLEG1%iYH*sbk5ZC3n=#&rxA_zFkJft1x*BFpr9pI@!2oLcH}lRmDh!i3S*E+Q zr5r0ff_t%(*0ItP=tls*nZ@A1VT9Q&*T8J0sin_P{tU7LR`JLj2kN%|dYG4CsocgS zru$-Z0Stb?0@NnQl z_;UELsNd~zj6tcPM~Rul8~1h=!$Y~|%eP|yvAYhGXZ8bhiGsD)8P=2)Z}DveU<3EH zU=Zh_^4BRVLVY5?|L*jtJ3|M$r^Cevt$6#;NDD=l#iAxHY@oW@u;=`GhGFhn3%19c z+?}pA)>TN|%0&cCz))vz#WdtRUP-Y1!M_9l?Y;@eH#~^ohzp==P7TOD4A%gl?AnMG zhX8)@Qb<~TqX>aDYd#}K-@by;&T*^g4WY20s?XBCJmRL&7j?A#E0w4tdj<9li8(CU z&NZal(VT@4o|esdT(%6LVy$UmI7;8RU|`cRS`pKXVr^HtcdAnilZ;1z9>pW7mI0LJ zv1!R2GefrGk7M3toQ{fuyjP>|IfHl5eiNix96hVt#{QY^Kalvt+;+nnuFlWUiG|z! zqZVqxNSZ!M(=>`$Gai>g4_!vK4iH~9oYeAE%)&I&%6-w9@&p1!sAs@ot8a|AV^bYt zJXH+3Vvrth3L#|VgvsP^;2&UIh8hkA4~4VF-<^zyNbE3k0JOb=M(Ib1xyR3Qps_~e zwpQ-D@i<8W1E%d66m^%Vtqh3SKb47X9GFDGm)`&zk zZ(7`xY^-K1d)3)daq1DQebAx$z*HaQFf1L{yj5k$wTUiekO5KuuA2p}LePY?82(uo z^$B}lWyY>XQduc3Er}fm@&kZWwMj_rHyw8de;;m!b$`VV8Xg3*x^(y!v16Qc>U?4~ zv{N(plMriKNc7pbwEgM9%dZ(MwYK$4f6y=~vi1Zz;_qb--HzGjNPztrp6ZHx1nHHt zU9@62@vJfrJ~qmI?KRFr9dQmwQ>Pf=xUG4ow>c9J%<2T4`#pOpq_^*&}NKN3&hRWsN-_Tm}?di{VMq z`uk&2gAxl|RVj(#(M}JIz^_CltO=YvDD|^=l-`nMpS%O~2NP3w))-v;Z9i~qpU)U> zANWcSLrY-NgVYp*bzm9hc7Jzm0x!_?R=;{n<^L48th!`+dyc%H695iD=#KI2t?kNp znopOoOQjX?yMkaFDrvQ|RCd+%u{_@Uc|5vWz3e+EnQMQynfl^rBH6;qB;ioEO+70? z%|!nhTKp+*x>F*&XALF~3X=E=3%6UV)PS=Estm2gBP5q7>065WNQ9#_FyWJ^D~>qE+4=X@CZV zplXACcvBU`5b>$nKTlnU6*eM+jmQSOGwU1MNGca7fOk`s0%-+8{OER7F3Cu(uWVP_bd^13ljgG22RP#Pp>17GYfG*@wQJJchKGi>b=HeaO z=PtTry43Th+AZ>e#mJTDw>u~!PA5`wDUM0s`z9KQHa|piJRV_qyDUrrpi}$@vohz8 zX{IL(7Q+--GLe$BT}?Fm6&cIl!BiYrF0iCzg`rJWaK-H*NcQcF2)Es#BI&ZyXQyKW z7@UO>@NF`S$U#UqI9cQZqobCKFuPO4tpTm3+Iiu=M#PC$nSnHWimnAn5(_%VNqA@o z8uyFTECI;oU^=z9xbj{L^o~aeQ5%6&%rulW52vFn2GKh=u}rHHPcSAZ>X)6J86R$k zjFS5?=gY`b``txA4NyR4{Ms6`{*wJ7CgwI@lD6mZ>yUJdCi`idm3W*`G(hjs2G`g9 zfOmrt(u)*?zP!KQB2?Z5#kVJ?FD+?u<@UEwV7(}HMMoLFwD;V<;!>18VE}u=T!ra( zO4(oBO)&;J0i}KeS(__f;DZPRV7-&IUXV4Jm^T5WlRSAnU?ql1qTBYQqPt*>Y?r0k6YI)?Ia= z@7M4fZMmpY`OuSeHCeN+v1%o&g=ikp%x|9Frn`{lGFUJ_usM8OsMng!wb(IJJxD|{Hi{g)>kCut!+lF7;ti0 z2bbc;iSaCPz(LZOd%R<$q?^F~7sGFbZ5}F}ZX5F1M2(6%)))SyA^O1)GUc-Cr= zwkrIeR3ac~ImoW=B``!+#vwJ0pSiPD(t2LcZs1zuIPiw&XHjQQaaX)|*kM^pfOq^E zJYCFLdtHA}a4}MM7v6+*r}Ut^Lv@ku00HHv?<0x}Y%XeMU>!?*!C9zgEges6OWVuV zkv7;P9{FnS>SWL3ZWZqNHP=@hYSaFpW``EGoX>mGx_1oxj`4FG)yp*faPQjRF+|ZR zwjdMp;sAYk%aO#Es$^=EbbjGADt$XPv~-(j2~isRt=|+x)w}AxggyiMtC{z~5WJO6 zeJB(yK(M6d7$Ppf`~aU%qh3409>&?oROJ>KF|50GC8!0<4wHzh0ZPyzblG- zhQL3Ui)*dA-x4kf_S6^}c|T1YQUs;pi9Fa8OO=BH;qCE$+D7X9VFIVMVyrj(9Vw>d zS-jZYti2aUr5>+OOMmMq#UCcvRz~)?E}+1VPk)Tuzw&M4@ta46nw4Ugi8sU%8_IY! zgz?U8#|E7eJ+{ej>W>hNx^>7nkPCF>5u5mw<&56UNEmfM6)`&g&j1tc{0f~SaFH|; zcSk`oXs-;61JV&_kyA(KY-&LGYARFMD7Sg8u{*fiJ%F3lBt!7tq4%|l8hA*;B+GN4 zH>G}5fXCm3%%_?CL**9>SzmeXvC6_Zg_z!Qm$q2PI6%gE7x)6S_wF`_+4uPQSl++m zi(TK8H7W^~@kq=cpF~Q&JlcE9^(+t+J zKtd=Viki@WBW9Nkcp`(LghNpr8qw7xYwxmV+kw0%@z?~SJ}DO`o&x<{IrF+V1{r|J zdG_)l19S`Av?JuMo;1Jxao7tikp1L&#r2cb2@yuKgl3Qgv}A!!wv<469I9rX69qSTW)yD_PnR=PzNodwhE%lgEtNEInH+9a@70+D zKX(VXVx0;WQFNf(lLxz_7wTSR7m+dpMI$09J#rGWe+JEREok`xe;*lmn`OUhg_$^+ zdV@n8#~!m zbgG9IpVK_gyMKIJo+NBQ!YLMISS5$FL+qQWB*RzqiLg5VteC&QDUutaK9NOr=V`jV>AOOK?d<5E*VDuwCgKLr_86r&ea*>Q%Pmz8*N0PoVrCqhhBr>#x1AGRmn_ z_MU#w%;HGdbnBy?jJolPQ8y+{U0J-G24u&B_d8pAG5QQ0xZ8v;ge$AMYA}6pMux1` zZV4MYl!Lx za@4`29L93#o`3vp!IIp}nxDeA?#Ht_<)(CGqVZ9Q#+Epw>^{lHT=<(#tGA&x;)paW zCwzQ1#OOKFgOQ13=eUE%JM4x72agv%t8c#`2z!Ktd#nsFJ&NOWj;gp+i+NZJ8od9sFsceZs@QT%IAqOYo~ zZqwi4-+ppCMK>T}ls=q_L{CXkBn>h+Jn`yJ0sG|PO8LV%%cB~1%(MR zhuN{uPkfRTN1fAnsvq5Ia^I88Kh?MQ85&pY(WbUWK`Ui}zx!HF^Q-idWF6 z>J4J5INy3E-UaFlm0IKM7*AG%Fc?;?s(Lkd62iv^`F!dEQdrwv!^EQQDs7sFkQQx% zU)?5zLGG#P#GsxRzn+U2@WKQ_q!J~pGimw}cNmtCy87;%$|m{oy9?Q7xjYnpxec7N zA-NuhfyP>z_blHJ^soANr&v~ZECG68C^*(Q4_E>6d3-5ZL(7qV-}5-EY(uW0ceAMx z_q7`p*lbbaki)I*c@yqQ@<5(@l>Vy^9>BKvy-NfWIg%E>Q&#UFXoFhXS&h)*GhW0O zy?MBmZ1N)K>Rw1Wj00HKgN-x$ba`)8-RDDb1_Z1lx^?Y8?H#xF*YFm>O} z>L_>35xhj1KGYjpM4t&0TvAFOwCmi&y}Z{L1q~-KnKe=Z)bh!={BCODzfM>8dAh$z z^B<-2fldJ;Bwp0a39wgF-7>~x&v~f-saL22wQ_)ttucGHo{CTG5#0rO$b2>S7SwX_u{*vCL2m&42B5mR1}=iuaq$g6plw2K><@{D@&Gzu;68? zk+IQI$V@%?sMQ-BBDA(J^U7~`8S?c#c?ZNShmq3=Yuu5%p?;hc$IiH6#)=ZKA-B}d zEL=0?WI+b`ZeZ$XO+>iky2oi}O6~8hqO`@u>gK3}A12t#VGi5on0N*x0i~>tM%Ee9=%54I|Eqjy#TJ>*> zRa~`!jIaSMoBR&bBOv$G(bIjTamd}QG#!8iu!iiyVH9M8rZs?)HP2v`_U1PI`I6mv zfk|a#F;QP7#RykXTs}M&wf=w2isciEN{AjSPTC8LxDLa?EYsY#A zL^G=&fw3}=KZ|0Ve+ArtW$cY6K__fdiI#4qV5lykn4LkH5({6+b{Iqo6C)_%;*67- z4icftU3_nkb~%9w)vk{KufACZdU9j6$7qJL()e$srTUx(&BiPFBRb`-DcN(?|=*2Zle0Bn*Oa^lZyh1M=oi3mCo)CZ&{nJCR0hzX%Tc90>2jw50ae@+4%+R(jN(AH z-8^2J&^vRW=upS3wwKKkmvD}%b;vtugW8HYrww9~S2QidhBuq$&n*Y9JX?Q0J{s7O z*?HV^!lORQlBy(05<^4Hm31@kk-1L!vq14Q^u_EB_7MGP3~i!3WUX3w2v}Ik`M>%Y zgt%U3+ngai=Q-JDwb1bpHQ$j2-aIK&EELJiU$8BKVg#cmwvuXchGl)#&TaPcYYYgRyLu2El zJ1^6arDDD@Nbh2}0p$KSdG942P8I#3XzO0<>DcYYVPOILvk4NEq}=-HJ~WiT;<5Hr zL*ose(*ieJNvROWK)Ni8$5sd$mlu~&DoKxzoiO&EZ7)3tH*0tt%mQoIm-s~uW{CTw z`SD792IVL9BD|nDUa&}lEB48)8kSTD4BprYFhvSp-qW#3$%4WMA?LY%%nu^i`&EV$ zY4Y{kZCyt!nU+hPZ!VCkW*E#6)S(zXXw*N871#Zt%u>hc&h4pzzAK{A1XEy~-^F>( zC<}vjtp6ai>wPQ<@uj9Rl%e{l3yuB@^3Yhb^0*Tm!h9qPp`xHCw;9n-urJ!~z=?cu z3eN5#s)OXHJvE-|%LY!O+U7pV8tw-COL;?@KTWpY($Md|vfe1>lJFdRoGM=GhIqV1 zNu0BH9@j$?N2BQxRUWMWn+tA)ccBk$IDQ5Bue#YEo^e6khdckt)IHX`L?8Izizh&bII zUuGv8ylqAXkB_Tb>sz1(&%fFiFK_zgKK2fJZC(NytwPluxYJcM1_!FfimLYtHwRKo zcm{%WNy8gSPeX*w94V#Vm$Erf+PyA66@KpJ3kaGFe!)=^tiKP_oZwxTn}CnpIEF+ZqQU_@n9?rp zj~NZrDH{Ts66e>9u+Hw|-Vn<1&txT=*3q?fCSXk=7`E2ymDF`2|E+^+h-W` zYv9`|Tm~ne_{O@}(_;s=auG!)P}Y|*KKp!>*jI+E4xx>y*nS}YY3v~#Cw=KKtvY6YuLuT(sGs6eu}&av8WHJfi=R94`hm)J>Wj@K*BrM3x8#98 zmFBZwer!NMdzR%E{qzsvlt|J<1wl*c&3ylgh$Kl*y)ZbdNP`SOA6A;t*F2~&U+f|i z(?4k{Zzpg+S?Vt4P$R6z6bL6=AS9`&vkT_cG{3myq zV?n1S1Uh&&`D2IaoY9uka_7@O_l#E#k<;3Nf^?NmSxf+8SFc{EEB|xn@+cwGKwb5r ziHOvxdqoCrV6-ALORKi!Flf19WH!P}Kc9aA*G4kGI~cokVp9v;v(+#Bp*7O=R2vW? zp(tuP{mHSM>=jVYEq<@!uHZlyo|)wpoR{o!r)ge83SY#RkB63vb$GTf^l(}TL6UoghBiF>xg{xZOpBt|`u z_3uwVxBu<#w!}p_u=q7I-PJ_9jJlf(eaKFy7l*=I|IRjO5!L$oB_tSjI`Sc~v;r2w zyp+5Ep-?fT5U`}F;sJV^4GpME-*$)b6^UE3r1vP|yR>=Y21T3u`w&eH4|!;CGS!GF z%C18IIF)eAFFboyTV?g1sU|ssR|{vqWWMRRtYh=4NR=o$8-yp@sEZ8Hex=quW2C7k!+>w7B%zjWX;bnXpxDG!o2YxvgorUX$RDoQWcF1enK*%$** z_o8&vO_oFGLS)*uBVq*uItJ6!A$6j4`J-Vzj~Q~p^{duR%K|@^&=9gt>DpUHcp7%p zlu&_5NriqOH)DV!|8G?tFGP6Ws{Z#2Od85{q7zlUMkC>abxnBZqo;6GZKJVw^=cvA ztHZpnu6*vB(>4)6|4f^`|9)x#Pm4{elW=9SbwOps@_Dr)S;zq0SS!rF1%7}e7Ra8UI#lb9Nqi!yj3S9trZQuQuZi< z_pGAsOH^fn4@K@{sbjXIa<0tkcE!89A82ax)!nZIXnZsAjHAx6$yc;vP+R5*Bl!d- zA}xU46f;<{?hpH(lOUFKn@KM_WGatbH*dcGSXDCu>Ikj3)3kH{GN|(o2ZfHRWdAi2 z(TQy{OXD&3STVA%b?DsJ}Cy^I6U$0~f11vj%wpyV~bS!63 z#!o_wdCnx@inpC=R7Ght9LJ;~AIbt;Xs%5+F>+D^+vg9rZxAJGnRzv^*P>m~vf~!T zF7sn+EEW|sjk@qx-Lq&S$s6&Dp^Xeu*B94zrR(TM>K)5C3NBzfdTh3TBvfj9`)fpODAQzy& zy+3W@MO+x=daPP86hDAmCcNMhAlsV?yjK)-ICI)mkyxwI^a9%mRXB)lrG0!*wHU-^ zcd4N>`Ub-dyAsI?Pji8|O0!lXPon?!*{Fb}67{Sbyjf|Q$HJP48r;S zj7}#*GSezpO@0g7FlVh@h-JOK8X?fAm6|BPT3II?&TgPu^!_O`9=;c*04>zPzG0yiffL1j54iRP9XLTf}m#9=FZd{zJ%C0+TkeV%d2v~ zLlhs39X-)8=Rth;N-}$-29V=zfXJS_US$fQ{vNEt{PvOAvd{cX*`}br{rb%ABMY4> ze}PB&(l(ows;+_21nylEtJZ17Szq&Rg?{fwznJpJ#2@?;qqHioh%lU12U(TC1q83> z7Hwrfpxs*2_0d1c9%C>YHH);Q%*?K{%$l=R6Fh`(B*!Akt%qbWPdW6yf5P5^Z5O{0 z%@&2NsvQ_S$cKY#y~;=H6$J-nH{csW^liVO+`*-N7#t8kH0RtTZnH@kqKG0K`50Up z^C#d5JT5-Ai>iTojC$PjopF?5*)Nyc2FTA}yPh;{fRbTC`TO}A_?6rWPCm*n7?vNV z5YYFnl(L7{nB9=beQ25HHP9p5u8n58Fg}_G6v2-H;;3qw7&mC>!i0(9cE=0(`)kgY zAtDRLB+d-?4;4YHAD@UxX-+&c$3eQGc~$=FIIb=l*#aaP`YG0XM#_DG%z?Lv`7cd_ zqZ;(lR_Te`5JT1YW0Y>_Gpjcw!`NHbBHiXl4eaSHz}?`M0&4xwfVG#Wp5MpQCk!-Z zB0z_l-8%L9oquM7Ur`H1p?|q(K&&i}=4=!o$GUqnUcyeZJDLRwp?avpIjOI<;HBqV z7alF-T)AZ%fQE(KkqCz1x^Pc2W=Xn>TQ5E=~W%TrObt}9gdoqhaj#k@Y~x%m#7C* zboye>4K0DzXqg?y{FClg!pOrFs6nX$HFC}l5eS-4KF{y}B!%RjX9^$NAve(Um8RIM z>%4aTX?V02A+c1wnw?|DqQe?A29A5DJA&QnfeWxzTYfDIr;wWisTQOX!Jlff$TteA zkrp!{p~cXeyy_MOohH$000LHFXxgm&1|<*SNj=C~rCo?q$K(21!W%@_iZxWVkB)#$^%l3}>{T?*ZJq#l08$YDsNwi_C6gXp!8+8tWT`zc*B^k4u4aIsg3};MJb1 z!@?X?+tMbn{I)5}p6%G>ixS}Wo~|&pEsy&FfysPDuC)0wQ@DOOkK^`khEmY#JG{}2 zxBzzca$>FRy&>Hq&|CQi+I!2M{^jas5Quup#1{ugu=F|AKIe0HXE$WR;#_ZCqKAQ}Lc zA;Agibk|?YWr z7j0(bkIY}6dpwiQh`$$XqN*!;Hz~rghPC01nwL9B*tnq_PmyNpR39Vw-B6p*hGX%=Vrz5h0p3g5`;OZqw(>LIK*{{lDJG7@m8~v_zU=N76lMv77;*e8lD5u)kf`mB?y7rT?r+pX|UncoC2si>WRUo{Fk#Mq&wu-4X)SjPDw zAe*Rxxj4kMZn43HN*6mSk1{HYr~9bi)dLP8?JaG?eI$lPb&=U~cf?6&N?3d68s@{H zvFpi?<-o=uprM(1XK zG}L5V{*2+l^-evH9f^xD+1=%H@~4&K9Enh3Ph;>tehfPML3Y3+(gqM&;J6jy`#t7+ z3peFsk9uA77QnS-rM-ZhM~YI-iDv(tOJPJAZB~0aI5`BF`@0?X`4YYKG}J}>IP0(@ zJpB`J?MXh6hhg-v*_iEfd%@-=Y*z$}%R@aNKJf zU2S58oaBt2-~&iH24739{DSvCW*VQIFsOhX5rdL+_3@1Id{VoN6QTaY-$||4FxPNN zHCh4B%(PrVr7KqZM08eSW%`ny?vfNv*%U6}ZZXxmK^CO5VD(Cf>y%U^2Z&LZt9snt z2Q{>i-V1I+wB$C4(l-Gak9_&sOWSp2Q`mGC> z4NA^ddMTIyDpqFm>GN;I>`llpoLv^b; zQ(hukH^f)7F0m!t{lA05YTzBywva?|{>6MUPJ})OT@aIg?yvY1&?pFzMX~Xa`QgU- z5W8>*_)F03%EB+9FT4*Hr&&xQu4CxD0VIJL_3?@V+Y<|JOx<{nU!Uv`JuUGJF_KRt zXSl~vj~+FFbd+)hpYdiV<-TjWWX#4^g`g%IRwWSoubJ;Po>(bI2$@L*m&G8_{~3(0 z`DvNn#m8j2PV->^b*7M_ZYOzG+=MS_k-VbJUJRl>mwi$SvYst68=?MWIlI+XBup!k zp1~OFh@O8JbHR&=c#TpK015=KG%Y@qLvIH3kShatG|x{RktB z4c7}tc69BSZ`0Y)He;uSrgQ@YR0m=?1nb1{<;;XXZitjp_; zJ?8XFs0{%ayFhZvATu_dA{nBe(@&<=r_g&+-iI^Er;j!ochyxWbZuaPh&fpD;Rcd# z=PW3$Qqn2fV$@onJQ{zkCJ$oNsr&vtv?E%T@naA{DS6#xAPFkAd;*!F==bMNN0lzp z9!r5sOwH>!iZJF1Qr}U@=*ax_ujL)qnv6WxbE{z%6%bzyBp1r-b@p%cekklZB$e!V@W$wQNw^MT@#T&orJ+^`8yNwm^}Xa1m~SzqEqxkXp|w9$ic03f@XEKLg` z73FtCR(eZ3m08IWaH0ez34Q}--cyqc1w66S00t&IRu<0`rEmin zamRyT2t4#GuITh$z$1sHrYL?VrO}qlmlsiX3?-0{8o>|{7%(dAG0!VP%9 zONEX0(|&0`{wsx-iaJk37&wFy){d330ks{K17#)IooA!%10q8SM?vk*$8feALZ5s~ ziVp`j>7wrTuXyU$MiK+@F>Ol#IjTEA&IAbXNse2vh%K-|T+0w24e)%Jyj-IK`xJH$ zxgjnFj$X7*;04iYgL1 zRz9IR;k1%iuM^GDfW8`%$k`M>0vq2Ht5G+biE`yi-~h4KF9vxE<`Y#_k`_#Eg(Yk| z|1x7usTn?qn+60DKTHm)rR z*s6Z~hi4L$KBgeXz{o^9aHVqe?yfH>wGA0CRzAzl|Mz2h94Q#bCwwhoOsdN(8?8JwFp`+==SO}{LL%IgKGxC`cQbBo49118q#rW(Ns9TxxH*~doGjaQ<8RN??A_9&K&ixw-|9-;S z9?@eN?i16&rxXGzR{Jxd!)?yZgyqJNZ>?s@x_?Bs-GRZSd%;4_j$lJBG2ag_md}26 zXCmi3y!#xTsZ(WWFhp7z7*vsri4_HGB6$;AhU|OKzU5*^v%to?NA{(47;}aZ*%evx z2Sqt^#aJMKUQEghm7ZSQdGVy6j|_-UxQ+j|o`6QyQa>esuGlB7JC0K8x6kI*l^Fic z4La7Zo7UNY!P*XITL)!obpz04axaPz&N&ZK6<_9<(6!8PU2=zl4xzr$$e@j|O#H`E)4% z@Vzt@@U}_5HR#*#Rq;)*itB&YP3r}4wOjl-I4d-@aiC^dW>m;5lv!3Hivnc0=!*j94P%n~% z?C7<+NPvnL$FXQ@6!z_clTSsCNTXbxFimO^HD005unRUaVI!K!xV=R1K;kR!lArch zpS|Q$?cc;4ncf#%TD*ziBeo;-O{hwLA-^O?fcz&bhm^EznJ72WN*R7rb4LCAf=qwG zFSv$E;BbQwY*c7y#!v;NsD8EH%7Hvc(mSO{F<5wYl#g5AOQ?Il3Y}kb(yzElr-D5d zug|@)0rlNg$TYH^DIaQFicrH&xc5MoC~Gp+{a^pqFx^5#u2lg)^sC}C`2ffySN7|=y%op}&Mnu))*CuRWetAyMBa?=ek4>&FXW&WjlYaZ3)w<>> zQ?c@)D=~%}3Jp=OrhlE)(s)%rwOPE#>ZhiCP?pP}x}9)B5i8=CmPiX&PD9s1k|vdZ zVd*mjLvc8}jCfb@b7gETaT_uX90u5x;4}ea?*V~c|Yg8ekS0E@mxuSxMQa` zgQT)pe!G8F+qK>_` zfHl5;fqTy$9erZT4v@{7Zx+Y+q0BmKxqZ>3aKHYiIMf)jOf07$QtBWux3S7F?%nKp zi5B&Jl??Ys2rH{L20T+xQkIwpg;mpbF_=e|tmQIcdPQfHeAF=0u|U_8vs;8| zQ{H=ed=26<*$r~7wVd$Ek+J|H&-*$e#hpJAfXwJ6mar7MgDXjvWiO5djpA2Y9>L|+ zmg2P8^{md8zF@nG;?0Q#QvYr9m-NdTxo`KUhIY_n`o8P6$^rk8k;j?@D zx9goK&Bs4*k2DC8za{!{KBsG|^l#_v(vy|Lo{@5U=WazxGN)Pv|FlxjXpqr)3*2K| zTlH7wyHYm0aF{P`t9~-wZc4)L|C^>0l7}l_tEt^VX|VLeqf$RnG-tWF)>SgKGN*7z zX3Lh49Z<>sF#nB`S=k0Xnc9MX4pIGqi*Lj>EcqeBZpo+>=J7_3KQ!K2MkOP^iM{89 zZ~FNq1Ym+bm=@(u$8hiBVl42Y1yz0oV{7fz<||{bv#NRkS_qqq#HO!dhVjhE>qZ-S zG=N+(6rB=BEIYu^bT#9fKP?Nc@)jz_Kagnj;Pey;o$T*V&#C6}F`HqeyPq3N+MdFc zqWM=>-EXIxNtsi<3oX&E)UjY(Kb}znl09JT*4#we_g-F&dk?=*k7qdARY92Q?zz&ORD=DE5#p1i7FR!%ZzL^>k~u)iFgottoI zqDT^bIC?G&#R=lowtom$!bq5QpiMvIZ$8=3D`7O5S{txYC;`6Z#d2ajA(af0B*=4q zLd9bZN<>LhMKn-$f|SM9zK7F@o=$S)@rJaP(}4u<|0pSy|GTZvBRUoOPHn#0gZmE7 zqOwHDFnHJaTL&xd$%56@$Yv`iW-wSk)FxBz=Je{L#NG5yc_{b-y{GOj7+<~-I9|Hg zv%#nO4V^^T<{$k+DU+`7CBpa-{)9e&pkOs5p}X}6^O>q1=%+pa3FW1O+)-_iZL%UE zkBfQzQnTY6v24*qCxA&R-Gm<@p}&tMo}NMY&jS*{G-7JhD!ZC*mR8K*+}Ise+W(XE z8%JhU?h4OC6)FO5{4&5#I-x}3+QwOXh4@IOuZ z_3H9@PVs$B;&I&5fI@l6k{5FSNa@a%;^5uCmlIBo~<`pg6C)x zT@q}~UA$q!Znt~_M~jHPWaRV+N^YVCkSL8gLaeQI#A%whyXX`P!$1!F2LvV~pBj)c z*&&d$CI;pjx{Q4q;<#v~+IMF8vo(+kM#4;Ka0|MxaS+58jwORwE-@XW2mAT>9H=u7 z!0ipQG%H??`LCQxO*@x z%kfB>Y%m8bvy`1G=lF1wNTLG>TIfHBLfqU1LgiMM#%wL%P@AZ#7Rk1mFYA>O!$-)~ zd3+T?50@LlX)?~Pt9ZrM+YB1ArH4&rZ}X<|b?FnF@~U#ztwK5bSfImRMnnbxf{+ zH4R3}($@(Aj-=$%um#sm_*$eA;Fsv-LbfOh>I_(`Iu+VZ;T?v&$KvS$zlk%a(J&@s zd&yyX!d5v2JH&-Eys8yKR)d!hqphUdcr3Apa8xhxjBl?WA?j+in8zFoEuxP_8mRqp z{eTa8r+POS{cXf{?zn*e^zBwQUeyX|wyiKeIzDD57JA^yXPYxJZ_5=TD@|Kd_$tMW z3DMiq6{J4SF$?7)>v@O(t&+Ni>{Zb>J;rd7pOAUxlb#Ho!+$U*>nvzchMCmQbU^qi z+2V^j&-Znl{H6ko=y3}Opoh(!x+Wpq<)uHwVSqM`TDTr>q$y2>&as!8ap5alqJed6 zmL`dVoyhsKiP=Az?!vcwopfhMlWoF}#t3K9IAOA6%jA^INn8FyoXBx+@p;#9z~=3?@zC~tih%K- z&=~vWCVc>SrtyiKkDP!r0HuIdxD{xDEp+O|cGJbn$^TM13d=>!?h?G@VZE7_S6p9$ z_%Yvhm!`uJfjLW60^lc_auUuukuGFcaBRCstVu2IQOP$#VFC0*>euNT)ft^>9jhSx z(F$lVLrZ`Pz`#JjH|9qjNOpc5Wqs2r>tlM++|$$ju@ikN5k%w-)g>m8qI7-aTBG6Tr-+=@-~D#mBqNbrK!3vxR4y zEj|`Zlfapi8b z13b`|i&2#Bhu#n9?rwVHW|djB0gdUWL&E5AX$NQU#czpyw7c4wAq)J*AtnBm!=3Ty z&{lqYQt5%vocd`!MlDfRSGZBmuu{&yorGgN*tvvQWo}p5S`KQ%Z};+Vc;p@ zaM5n-eE|faKCAu*_~z8tLB#Di#MIr2(fDB)vUkPh)A1w4cu4)Vj#it>IF~}e$T*CO zCkWJ*8YC~tKPg=Fg^dtKg5;ah7s70SYC{^eVTIW_^1j!Q@<)f$U9zAgKtzQNxW54m znNoLMOU5);uAe?kEPr$NOI!sB?J+DxMQ1?l>YK{pKcgV!ZnOJA>j`hw$}uo#GQ;}Q zzVsKy$=+|{7RW_Ssn9D}wDr?8-y3iY3(QT*XfMo_lT^7}2bm|m<)YnjEtbF>Prfjf zT8+uIy6K8b3mE%cY84P@|9%Pb8Q@Mv7NgbyT7@1JyGe*g_^NDJhNXG=3q(EB1Xv$& zz0MgnCRZdYjmJ5sa%_OCcUGyZ(c6F-RGuhD@Pwv`uyN?}6w>X9S8KHlh!8FTdlPC8 zbP5Rh*sihSGbmvGf4y=zj$Zwoh3kod}5e%Jrrt7H0~-5-#*n2DsP~L zTNv@EHvpaLx~{!R`ZOJd8YUPpfg*i3i6Hf z4X}Ru)_d15dL6<$KkICfYg`^Lq)uz13*pIf-8T7dkFVJq-19`{VolA;LwnyFO&6_{ zJI@O96AxiOtg=%mYX3W%y)>lAqowCjD+tjpAYSjlhPZV!iS4O0q{8tt%gNjLHxE|e zt5mzk^;Ac%%rMKLL#zhCF5pY*uoZWWt(x|8{@*c<{6kp$6|LwyxFko#+{?@NSd{AS zo14Xf$>YhiOJ`@)wgnhBx;{O;R9}buB>lN{Z0pxD^XnUD9;a+*mz5~gAo99q_ZMFA zwH6={VPwW&1Z7csFJNE3^v(JGS>;i5CMIk8weG&@U1A(22cluh(}2I`-H|S5I1p<_ z?*fhB4%z@4OE|DSodzYDwh1c9%%t_ekucHJw?`3Om^5ScwE?$?3mI{s{UsI5XePf` z#yU(HZWp}Idb40vgKz7(9I&C!<)mkTKm&?t9T+IL&Py zdpcwat;*~C;6j-Z%#9o{vE(Br+Z*f7DS>x8@Vqx`IV$opRTyNr7*X?)zSTVe-VPFX z$Fzq(fT6}#n+|73!CHK9i^4>(AVK?~srZyvUgz@eg=gZkFhf_*j`;mW@j6SfJm3&b zK3Jgyqk-m>=6k4`?+_if!V7-*1q5OvI0&7i=OzEA`ttRSM=AR|reb<%Dzoa=z^8fY zk@Xl#PsNH@Xl%1f8{SzCL5-5@B7BbXYaMlOPV48ifRHreIx?j1Zfkr#Vqk85eUc?~ zb;GjFv!BHFjpcK8>%n%kM_l^IU}E=ITw;gjoMwgyb~q(~h3<$~*`_zR_N)(qEp{J` z`mSz%n#~RvW+;YMfPw^g*7~@0B$YH2lU4qUEACxuGZf_AUV7CuTg^Zi*&^8Xm3&bnY7D2V zD&wU?GU~tg9eZ5uO`Q?WX61$YR%fb^m-hzdz0q|+`LoOzV|2nKF`oW|Ji9N;lFiCx z@!Hg)pHJ3{t>MmqWvm;Sij)(D=O!lYsPewjjc2jP^~GBBM=@3$1D+s@CzQet%#cZT zIP_Y1?4t~5NxxNF&GdPOY8Fa&k1@uX);Ig(X`~QTN4T`XVs-kwsJ!?Cy65?+V>+A4 zIF0zvx}N>xq8bvu7Y{BH=}cOP)z*AMxZORE5DZ~vyMQLO$A{4bmoOG!W(w23 zXtwBIc#`dk7DSs>_c0Hd@DiBcdrN~^+%RqbTrxb}B|85MpbhByoaN{on;~TOWg*sp z3Uax~4H3$~4Qa8nK-*GrrnTOcd1Y3O94PYWeR5+>;nBD^pK(}5rCaiw>|jSNf?ZFy z@ttlmd!|0l;z@0Cqf8A11A^$=bpZDOYBN*vsN$}*&8+}mkg0W7oJfoWQ0bR1NEwnx zu-)Z?12T}Hog)M4TKr?llszBc#1M;sX(m|w%~CC}(>_B`$Tp`tL}uiFLJfO+k~&&v zz9wnd*$fX|$MpU0U|h2cay2{(@-)eAiSIUhM7L`tuHDVpT+k^bpig5M_2GXKK>J!Q z+HO7t>DFy#+VQwCRq>Rnc;|CzGp76(-6brOE0c4!_wrRSieTPlW$+dB2x^!ipfe?7 zhM1MVr?NFxl_L1p^$6bu7P^d{^wxzUVBA`H@k(--7=|^#2xEB=&eZLT4u$g4HxO@! zp=?zIHVYNv`pgF{?S7C-(wMLgo0Ls3WR5Id1{xdT9F|h1UBw)f zcWIFEeMN>lhkzG0smwZQJK^UEtFq2 zx(2m=DVT+6&2SBIvzMU8Lsz}vL-wHnCpu7PBImrvX8*vP;|~f1I~wSJ{;+->lL<4ZUw7Xmfm@t^CmP#Fhks_ zEaB}QSOal79!qz!Y`lPoWw zoWyXCQO67Bu@1L&o*26SP&7F1_orXYyHljNNV)>CKR51a)07nzBAen*1X2vXtEI^X zd6V3Qy-U6hG|YRqJuCmm%(FT#Hg98go1IufB*Zu{-aN2~5yxbGsyElaK5Aq%ei32Z zpz}qjfiSWhP|<+IMUCLy>Vi*fHfLhyp|^gLbD9xPPj27FC1m4`U|izo9PAJy{~Jq2 zJg!9#kY0W<1*-#qb)#3v_0JCsw-cl?p< zIu23$O2kvv`Bv`QXekN7|AUBO8DWnVBeR2_67aKzPmNp*JubwEctj91=;9+zAah zcbMwzABC&Ng$C)0G$;A?)U5U#nf`A*b{YGy^AjlG@R$Vj6A z+ITPXgF_JV1}&shjNJ`>_WOA&-Q-c;g)>u@0Q2IwZ#>`BpYU z2mu3Zd8cq}KYI!;*2>}W#(Ezg{D&_iiqF4U3^OJk_nVt?V*vz(yLW$E$3%c|g(a>} zL|4J#;5KvOIMYGstkVte+FSIvNE9kiEtN|-i(WC7Hva#~8kq@OSw`_>5J5MhFM4g~ ztF~4AmNX=cmfk2sBBp8;{(80qyd%kHeETx(AIz8DQZO-P5(@O{-p=!cRL<5RsSgwV z8I=eZu>h`(INLH(7%ZI@}t^YT;2usW>n~|yN_zU4pb*( zxumkv#!r-n8r20=nB-{Py$UP%B+Rx*cU0~9_wKT#*niKpF)kbWsH;PSYA`H5`z;e8 z9eRU_31=Du#b}6zDN{qUXIio27Oaod-}eDVScHtBZ_%=<%4fTCLx>gxZAOnuX}mTd z{Ltdcd;f6Tqe@ED2314;pk}pQj@OhnTHH5b5|O)POY4(iZ&5XMA!E$1om7-wc`|$3 z;ocbom@PrZ4V^_!09!i2N+HQ5ft!;8Movd)?WJN0UNmSPbE7pmg_dv|hiM>EBbPk? ztw^r|)A=DrfksB2F?$bj9rDim#G`Ftp+RjQ=1Se+48ClIk8o{P9hiGogFCQrwhth~ zjPie$_-2qUk``D)4aIN~!zcGz+MaSr8-#VZXXJW)0=u}aqD4!Z5Yo3!Q22saJ#A`y z`ucU9e#MVe0Hfp;RdgKL!2g6+hvGEYABw9nF;vf%T0-ayyM7I{oa+5Qo$lw4L8UI zkGyRs9LaFgepITwe|7)hq61t-6T3P3Usl!`Ym}kv5Bc|}6~%e3g@r=qAzEnPM?g(` zg7N7Rok5zboS=dd9|uqX`+jr%%Te{8N0Ny}()oe#%Zt2B{FGI_WY035QPky`zms;s zf0I5$n1hy?+)u^B*k4PB^2{CZe@T9azL>;6f%^RLz{xad8bi%iPi7Pv#}wH?`QBE( zgjR0PCUI=h7t@l3&1?x)Z?1~FSIy0A1bk9U?ubYq0l?~pixYzZdib5NXnYT%R1RFt zDOKP3aKsPD62YocX<<5Q&D}9E_z&Hz8ef8g%DpXhzMq1Yi{AS zRz9d8#K`E-Cf&0FVU_HzLCMn{#FN5yw5x>Il#J{d%8O%#I|6>F;5Y|NYq~WG`Wg5v z?Wov%r1m4?S>cw6KpR>1@s7;6Djj5`tb`;Oi6oK$mML}xI^JMLIQHc&&4aOHGLMuU zCO=Qu8&d~~l47YuzP<$R9$v zqNWZ5+@ZxB*H_wvhJrgOGd3*TPu&U@-P_iXWmjlBF`Kp16XtU33-|RL5{B|_{r;MV zC1%E^@lFYR^knODR5|V6!CBTzogx_QS1&ARF;tB__Uk3a^3r_|v;*gYxIW5?$@x$K z$F@91x7B!>FK~M?HR#H;*fthwpf&*uHZAc7oPBtAFJW!vY(Sg>=TQ`+ETCN+%fyuT z2i|GOn)-E$tBBP}5>w^#>tl93hj$f_H07WDoDmfP_m}2^a3`N3E@UiYk8-IbzX1=W zr60LDRpc|tC`%9KE(tysyP17vDbV{Po4?8M!a48hzwXa3?DTI9+yTEE+e^4HL?#M! zkBRuv`wSn1enj|@IP%ELWFw&+Sba0mr%@JOP0>5Phjq9J>UkLxAWV)qnkHxMY?8Ve zU8LO$1{)m`0bz*+rwmGQ80C1tfS}|J?otzrZ#kuq6os{~ldEFlXEcpnW+IFpeDfL* zOb%ckM|hPsek*LY+ngC4{;}%2g@F(1tUgEaP8b7d+UXm1-MBBuhKe`h_|zFWBA{N# z5(>-LSr(n72nRb6)c*`qxi&QA{EV;IBgy!^f2#W-C@4F~Ev+$nc&Z(+#A*w1pkNu2 z__(d=eieRlJ}CU!$y9g;`bpCk^C8L%Vs*eh)D1MEV(5g1qwq73DbsWMJ@U0RPn0j9Z8~2lR*afAlV%z@4FU_Q)}xc7rKyJ6}#z%bX4(c7Ncl|HLxr zB-C8sIQxF1eB`vFJE@aC3^IO?#!ls&M@Tbqtb@nL!;56?NQfK3 zzQyXt^6sji>Wi-Z1y*lTRLMJx&Xa);`0|thUfuZ^v@ zoSFI7j!eI$Mq{&VR}$WH~)=e3URDfN=1?9Fp5ZXk-lXHN$;TJwCu73b#AxZ zR4XYZS_q(^*M+u4(wBWFg6^kp@m0x9R|>yKY}_#f@>_J>jYE1-$&91z*)wayP9!(r zpjq54XkwSMDNKqyD2!Zv1l$z!oAA!dY}WDqh*bZ05*}*tycJ;EY*=B@Y?|860f%)Z z8{*4$t6pGQ5qFNV2(tcX0AK);gc&Tl>wdsXjfS9=w)+rp>)YbV@%{J^N&7E`Frt^@ zeG=!rH@w^xdi?5aG=>B2hP5`8Y`6r83pteHi=4`azM1T(p}UzcPK8N3?pfZug)z%C zP5)zMb*rb2Z;w}YuWOMVF4Zd~Yp8%?7OT^J-kF8z{$Fn0w{q7^tt?ERN&qPvOS^Dg zjE$fnP#ypvm{@1fz3ES9PTCp@Ave8^I?CGdYAM&l+n@FMBlza((+G+*$qIZmMCnq#G7t+x+nfJD1XX#RA6H9gnH3air6~DE z7Rf&6$)+cT0(iQN4b{HvczeRSAdU(lM7mg;as4JK4bO!k5Tw--t@ZrxS+fykOfg%P zWLNQ2`@#RlUjYMlZl0Omp+NySv-XQx_c7a^$;Dbn$0l6QNJf{exst0@RuQ}JrA@{A z1$0>bQfB|NXbEtAz&+k)d;+ClLT3+>{&pq0eGMm-Ja1rw9n8-VK=K>i8Wy8O!KfL& z3hW<4clW2nIU8fuMld>>s8DU>?vfO9NcVrI_h}*t zjg7?{qQc~ONR%0-kP$Z+k6k#?M$zhKIe;~t(wM=LtAcZc(vrBFPsO9I^WI@?v#HEH z=qyWB$A*#v{2c*@XUDR@DxhlSW^%uKl(W%{XFfvAO+Qi~t@hC3%E??|*dxn^RLN+7sE1rc(=PD5iNY-Ysb#4LiMgO4jf z?!5`bXyTOYX!{fFQr!iYI6((WlUTVwoVQn#?qkNbJH*>Z@AgexSzj+%1yIH4$VtSD z{Bx(BJVhY^7ZJFD1}8$!O<=(To=Z(901(Cs$zKY-oH2j)OML zS^rKD4ehdx70Jq%pQe`8zQ>=;$gvMSvM6+dxp_{1jsyjU9p3{W^0Hf=UccN}_Y zAR9%)s)_}ODa*;&%;5L5 za7)N`1&1)a*d$;h!bP!~LrRjg-B$x3ik-y^BxU=r(9ZKjq;=%D%ad{&Xed&Yk0nAL z3SDjQD0fKWVsuKjA_6&{8J?>n5Tu6!)uT}Cn>dfjeWumGm|L%T1fv8)K7$tC){s!4 z%ok>xePZw%@3)Hk(!K(hc==vS6XkDm_UZlV*)$g?v*jZAoUSPS1)1AZ_@sHY`0lx z{)dbJf(;J~Sx(Fe@0eMc!CV6xCgPRgfR@U8iJ7#E?|-pfZ1BDBm&|(`C@Um5t`-C zlZYQbP(?_;NuZXY&K-q-2^874IMQ->q4HE&2oAkq@rV*=k)WggMc;ZgmBC6Oh@}bQ z_xw}IfHddSJkYm_be_@5y^dgKFAiKInp zrQS~wXzd*D#t=;~ysD2{tT~PS{~A>X00-{7mR9vxxRAU0h8M_?;e%TiVcj)+5-X{N zyPafndmp_rwl6{TFyS*WpZFur((Kk57ePv>BHOcWL{kCSV8NchlzwhjyToa*PAvcu zU!!UdV+5K8Lu5~SLOX}y1-6Fl{4BGp0jJA>w7+V4ka#b({1wzM(4k7^sX599IFz;{ zP4^uxy^o!`%Lir|ul+G{(ZELM!n;i4Jfpk4K8jy-IBG5#0nv3a%UO`9A24DB(Irps z4p{>4ZV?A2fX~eQUj29d4WXO6%u(fS(r<~(Y|`$Pxh;$7MB{eWQiY%Ik9Z1$YM00p zIc6PeE@paS4Q1=21U25A+a4gFXZohJs?FLHQ`C!&i>A>rXygD9WIgDVmS!lU-~ z^ZvJQPU@qjss%cPaG=hAjtCK`<~9LVnsB+Q*?e-TeQ^HL(AXfH#H0P9Wd|~+Ah8#z zNPC6AL!aZw7yube++|Lq(A_{4?|5K z%CRnOYacZOMGqopz>Zc#E_T#OY>C(MNm1+E+JQMyTYv@UC-<{qU)@3XRLbqS9t1d zB81JD%=?Z|;)2-$yRw@Hpcxeed*m59z_F8or*Fbusj%}q!)ILk=kfk8_~apciiUkSz`a5`81YE|#CpxHFtSHM z1OE3M49ny3Z&eS4t&~6PyI5-&#_bxzpal5H=XgP~fL{B5C&iOL2gKqN!WziUhAP>1 zI?)F%af09}U*pn-DgY`3Cp0+5N#6Z^e7{){A?fy5yyxgWxETHY`(?&r{If6*FUhBM zR1{|<148167}SfuYbR=HHfm$1*b*r`2|^QLP8*V?cOXM)#C*e%04!Q!Bv+G+49RGh zqjKWrLJr7S6bN#XrR{oT7x%iq5HiF-J3CT|9Lc*o`M8zu@b*LgOolKc?|pZsSbz7y#cyZ6&5Z_UrE53Ric2J zu4gR3HjIf$qKG#2%&_6p<~Umsvw1&}5Nwi-KUq@7a?nmI$NWuA|=Ax=-}osgcHHOun4;PTc9_;-g8xWucgM} zGe`S7<|Q;eQ4+l3@Gl>`$Dg;B77mm*SrTF8qnb(TQ83<^OwCwd?Vw@ zYvN0}>o)*i`S#pMpf#I!hFew9yVuw0R8m0&5l(OHx6j(7Opb0&i3rNvpTCbwC6u?&6=M9YEgSK4Vw0 zS4L5F{D9_KBwD{!rtqJ}>;;cQ^KnpNtgH%zoME-ZBYiM)xpK5@7lNo{slEig`EF1G z`7W7?b^I$gI@U3|v=qB%3GT*{W5nX<9E_9?y!HAB^r~k)FSJP`OG#*VSK8QQQoQfD zIA{>tV{LybdJbPM#@I&R?n7Hohp9B}l#JggeuXU$cbK-Pevq4@yGda|Mlqa{qW%+- zd26ZS{J_ys2M>6rA`B03!4L0E65|6x@z}|7ksW}ygSuklyWa)qpXf2mSnducMQ=&wJvv#RDc(Wk$cZw zb=vN>l%JnD{mgjGsS$?hiJ-rB0358SOn&B+{-JSTM!h{5@#cdr;(t_Hom?NbAr)RG z5{c#WQ&K&e8t8YvxmYmSesk8*fa(CuaDfmhQw{avqG0it{VU8K1Lx$+|~xY zt>InYa29_@+qX3Sar4#Lhlu1^9NORY=Qu2d2Jnh;Xp&zcEqJv~3xaT~1G??>jvh0$ zzi%tv%)@N0PAZ`={rnX_`;-y68wI~KiIh3ROylYRauhx5MN&L}=cwTn44^W?nG02` zJuC@j1hv}` zlR2wjGr$aR&fR4imxTSwGf=-kOh4LvbENXN6b_X1m z>*5HH%PHzDd*vsn<{vg_@A7c6v~dFuXOg=zLtpC*o_}!`CRhgRj{A)IQhc&xpt>Nl zQwTgwDMkF>7KgW%SNdd75_?wnrte-zxbVOs&pSY1m3}+gDPOc&$d8y}kqQezFruY& zyPT++mQVPUbLb|oz3J?|YOGhoZTlU+!ECrXEXxNl3jA;!cbrP%!ByJ&8hheV%7bBa zexIbj4Y5uv4w9(<;$&R~%RkR|+o)od3lhm#Xw>$1UPO3SwpGone`qM>JcikuW8@@f z5gyhAYS)|9t(k1BVSsn5GMUkswTz!{DghFnPMoXayYpxIiQ~_Ls~D~gp;QyeZEqtY zgn^TNBf2RjUU7#rf`=w#w+;Cj{Gk!9@S{7d0W-n}O3HB4?e@NzacqSE-o>tjQ7inZ zglxo^{z$-cSdlmh41KbR6FX5lTSfP>68&U?@=un}H1;$=`fv@lD#REY14^H(6kH%H zAtrgV%Yv)&M@m65^rs1z(8`PV`LYK_7QvhE#^Yo(GIu|eB8d(W5M zMhhCGpRAPiX`yZug^-l_L6pj3l=Mu%e7eqf)Pn-IFG|rOsD6}%v!`=ksS1o%ItWeD zp6k0q^ANN}7XQj8wDKfEfm1UhU1d_V^{L#>{isxhVNaj>X$8o$@F~PDr}J5Z{du&~ z3M74C>KNm+a7Sy>tz5MCjq*6Y@@maFnnhY5ugnG!!zj2!C4q@AfrvAE0?yBFB1t$M zY&cE*3o`Slb1ws_0gm z%GLJ3&aG?zn^eaMTpZVuN!if`Wx;p?@&&b+ptWd$$j*S5+)_JwpE2d>lHWMkKc5?ynNYN>k4H&7~ZPy?7plB9T&le3I4ZR#r(y{&m)Wp nk?f4w%R4R(_cSr_vI#PV5+b_GU=m0UF9^BRM3|BB{1LkEkOZrR diff --git a/src/tests/hash_functions/c_water_hash_array.bin b/src/tests/hash_functions/c_water_hash_array.bin deleted file mode 100644 index 5d58a4719f342f21c39d057549d81775b8e588cd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8196 zcmV+fAp75%h(~992q8C}`ja@C+IxfeGBcWIF841QM_g|9u`e350VuXi3CXzreX&3L zXGfxTtBWy$=vW0Q^9(;;Z>q0olt(vGOZq4CGR{qfvRCf=vxIiZUxbLyu?e>`OI~oBg{*0jnrd}u=JtvIo=sy3&EvCre%zTHm zGmhnd=`7M+SA;g!VX#SmzYTOymcZCJR2K@uLX#J?UX)M!Ejf*0#NE^f%U_xc!_gDuD=tSRHHp#ov8{v>wy<=;JB+6 z^z}+MI9di#E7K?tp$DOPCJSpZVh%sPn(n3Ni5x8Gu^AZm=i&^rM(0OF$&J*`!?&5E z(BUty3fb95C#AR-dq7`@&J5Yt2T>~p641Bi!81YFOJiGja|@8iPrJLMLsi2UDUw6v zO+gl;18S$tj;LM@;fETN_s-IpJazU*Y&pD%;_A!sPV&9gA7U8Nf;>7noQ;^g6Rim$ z^UmRBMy>$InRXT@Vk;81xlq)CF{rC3D~WDwPk{bof7e#DE7kFsqQ&h|pY>JCrC9sc zxjrP)lbY{|o517EvX=f4Of$`==dOs;{h|zjp8p4E-@oCI)YSdmN!=<0(2LMf0?h9L z_ZlaCB0gftIuiq6T73N-_-OxX5`@|2bYc9NEGsd?@EDuLmv~ri0S|Y4-Ax?^ep9ey zSZtPK?XMxYDcUA$6iW&0$f4t5+3@|Y6YUrNzYtVMtDpy%HLj~;qKz!$n&Y6T4*nT6 z!vG@Zj`s?1AWbet)hOZ2ZF+gbo!*Ed_|&gXPx(#k7B)pskFU@E>w09-?5>5wBy_*kxn!)T%u|j%HMj z#5Aigo#V&_^ZU^UpD;J;z)X9uv#M?9=em;luqmG^G>$p@Fqyn{UX-Rd#Xvo0NjN4w zl$$=Hfp0eSv)bxW&6#x15Y)JoZfOv$8nhA8e2Q*eSWB0KqxKZ9@}rQ47+06V32z&M z{=ILzkrWdw@cv-7S%hF5H_*L8md1LJm)dA58|p4AkkPDLy-8>ZSskIQBne9BK&Qdv zhysHYPhL5YotSC)$smz(a*bzOn!4%D$OuD+BkdHXT43KCe6Pbf-du5Ji4-|b}+PG&jfPXQhwH*C-{n;{Z@Ia z4L6ZqBz6gMS7=Y*7IRYcIdnXxZKBrjaJW6eKj0wp#hURiS_uI$r!jfgc%?pXBr&7I zqjR;zrDujYDL({{ZcW+u6BOpPTAm`Qz2eJ-oU_dd5+9( zZik>>5Y`S#HW@*QCD)QNKs_}aJ0mubx&5qFScIxs&2vrW0lrVg2omcnSa1F%b`H_+ zpoR1C7oa^&_V~WRW$Q+Bxk`FNU|$`?#11H2S@7b9Q6x!O+;wO4?HO}~ok=UPhK@7N zDuFH@{~u~$ty9<*W4T||tBlxF_s^24_^1!Z;kvkQ=@)eUEWn&E+vM;U{E1ehx0OX> zrBCDXqFuXVqN%)BQxzK?H6mAG^G~zZwRo@d7>8=cc(i^Z#v-Xc4B7H z*9+6!LhtjdZHuZjq)G%~3kiDv$edoc35$Eu@9g;J{xp*mxQyTE&|Of^i^USaMJtIsC=>$RAWGEynAM~JY9F> z2z-4<(Dc}_W(m%AdISsVb8g?;l3%^)bHdq6%PRa^+oqS^IFMq-7dDFei|h zoAz_3j*j7^RYcm}0lMbDZDgpv4UjbL^MDUqy3p;v#B2W9qK_UALDaAS6oi()Mw2}0 z@PQvXa;H?_pozQ2WpOk%F{+c^LxV#h0erA;>-jc8!LBQh@Eiy@?U9bbs+*GC|N11w zrv*``GgYT3Bi=&xJomnHPUi=xRJ_BE7JVlO$nEs4;*`V9JWbC1ptwa&#Eg{VK@<+- z&t#S4K34`C7bXu5lY|L5K;Vy&0o(i(7ObYJ!z4|{pe5=Ib+wW^72gWENSinO$_!r) zO3OL$ZQcJn7I#QKjNYu#ZU4vuO-1{shKEUel7 zyDk`$CAIXFVZ*C#5@z4@t+3)I!m1gP7Ae%kjk{*$2<7JVr>{~N?Kqeo-Y+8fSjdt; zPtpf$Y0k>%pinh3?<6coFH#aR0d@B;PV3%We#QHt&~?Yn@1K@d6s|QrtkXYweTN(R z)gfKsp@HzMXF=J{N5A7{=8%MmN`P;aYd)vke_uSM9Np^Uz=gn3v){23$v0C(I)AH< z8yFBz26Yc+wO@OREJo|*POI?SVXt7w*lCBp2f{5zB>4L3;E;q_w&c7ry1I*dDoYPC zF@!p}>(XnMHh1@PK+~_Zs86Ou+{QJN?7Q-*E0=O{gCn z&s)~Nmru0@swIOz4os^zea`|+$MIuV?T7N=YPjZrmTlE7xcg4$whw$xao@bSRhBTa zPLK+80t_e>Yf|y}5|+H!9aRZFAV*?|wO*MC28|2`n?N&O{@Pywf0-ClJ6Fk}eMy6; ziaP&Qe?xzWPhLOI^y8u{cE#gs2^-K>oMB{r{dX|)%oVqcr|P|OI3#l1u`PMbnd#mcqxE>uu~hx&>Q>=t`!Sh%&xJqchd&3Ik9%zto1iig2r8 z6$u1Euw15nM6eWR!cZjtcUaqvMqxBi;@ea|!+ISlB*O7cW#2VmJirdzz2){ljfT@$D;{TK$cQZ01HerXeqUb>r(0WbOZEs^pFk*sTaET3U}D z2Hj%nCc5eO{*VjF)iQ?PW0!bu7RG`ZKgJz87is(SytRs&O{%qF@N{Pall{e|;IU~{ zHikOuAA=A??v#Ciws{k0Em^JavR7awU_4`viCrpV?oeN&9o5-tv0qr+$|yiTV6FqR zvFB4QH(G2>(40K(BIRB-gT|PbVgUEQ%{asvvhaj2@kE@MBzf}|I%>cMp&D>8!zddJ`$f4j48#-T#|#3i;O z!ZI~Pb&;9;5Y&>#MR_%r<{%fVyuo)+2-w(cSRY~f7Z4qlF-ARg*t$xJtvXT04N$zQ zJp6zywN{Cbj& zA|;yhe_QbmR)^3qW&x=k@I3$h&YTiPly4^nA3{R49C{;j4Rwk-Xq09~c0M=Wa}s`t zL0F)peP2u*Fv!2d9YrX!TFe=Jo7_%uDYBSGs8&E?RU1#1DEiAtMwdPmg-8LAH+O}< z8Al4Lo)z!i{V!YMe~|XCBk*I-h$4K=j+;A)>w-UU#jvlo3qyR0OtXJ|H>rcbp*D)h zTEa9S@%pi(vf5xX-siPoZ@a+nyjMjR8^2Me-K!3p0+soWs0>M%Y5cc0@p*oM;_){n z9<4;dBOG&WR@$_)dj*rinmDv;0XGlEds6#|$dwkjp_`?{pK7tj`VQzg?o)(5nTi$X zn&{trf$Sjyz2;9td)L0sH?^5&?P}RaeJyeFR`}T(Ru3f4;#c#>A;#f56w83iVx=PC zIM`+Jn1#GNCUFCiZZ=69vxq&431VG&0jX zWRa_TN*ESc1e}DgA~R#Jd@^7H`8m0w((d-fNGhQG@&!siDAoaftnhDG6%!$QS|^*v zBnKYK0l{9Ahw)8qOgx!SI7`-7?drvWQXFi2xlK>R(a!0N+XTk-zznqZdY|mvL=1k4F@`gDD!1Vmf{cI zbNQujIU%wm>Y*u$V3fMD@kql8j6OkSUoJdR8K#pIXHu0qY|zQOVE?204di&>A_4qi z@w<^^tovoU9DYhU1P8QgiGKf=D&&X*GZGsX!lIh(rb(m;R;7fy*|&m~aWo)brdMeI zR(dpG$nm`csnW>Mq6ER5lEI@@8b1`on0>6=Vpza{mOADoT$a zDM}u?Jc#{Rd~@`R%p~h*IcHxCr0Jni3z~MiGh3&B3dhnlt8H}3`QjjZD7{wxLA%La zC6C4gm5T4k-56}c3wgD-w&NbF#EW>=mvIs+Thom?7qKjKh1CB3O^c)Q)B-Pcc8^G= zHq2Cvl7Ds|Eq9=gK?N)LXR6u7j_eT=%GFi!i6nO{_13{J>&n{G1WehpuN<9A|D;CK z42hGeT043B!`MlKiC6&Pxa_aBhgO+<;s%{6muQ*)iBl%r>u#02)!*TT0#**56>5(> zsbM z&9sa0K70c^c(IYWmI(TMQ-JftIeO?+pS1%us?C3^%z;x{McmM)SrOhCJjm8ji~Wj9 zGw<+59JCU{CV0*01JO%SYr5;xy(sqKBVnPOiTa8q5)4oe*Q|C!bAf2&lA~vO1 z=JK2hbUrtN+MhO%^O=&m;bFLJA}>F215hojh-9H0LnY z;HM_3{45c$_W>Nq!xdwUGJdI);Y!)LteEKcXANQGXZp)eShk(ihHK!^RtR6Z1`5zJ zlN1EWYZRTx!M)t#(TqE~jZGVw#XrcJ83uEtX#%D?X1;FkrOCbHzwdY7m>!~loa zh(wm(uBspXxn{f3GNZ%}bkFUZF@z+n*MwSVGeSfJoUwQa)38^-;@=rQQ2t;Z^n)== zIPR&YlM6sU{&of8IJF&CYh4>US_IpT-K8To&`nsX-OPG-XEvS*gdaE4oyQI$o#tx? zKsP?60klHrPQ2;<-wYyp{cdU#_sbFiz7EqiDUuX|o?Zn(ASGNdCWDKGGEHWnc1?Fx zxFQ0o_Xb*IzEr`<geO7VM#) zQH(mOW_X2!tHMV^2i8!NZyob=vj?ho;HT`UkvSk@&#k}j!r2Y^#CxaaNuujoht}@ZFiT=|f3N3)Lg-&uCoBI(w)wYbrs-~H}B6NW-pERQ6-+sz- zWeM!6?R|LUZ8PW3-z9=KoGDIN?{<`Sf3YfsT8Z1O@1Qx;!9kmbT)wUH2R<`VBp+Xm z3`vCCPyfY)g#0#ZOCn35NJc;Z4kL~)8Id$I{$#AnR|wF66xOSmClc?QpAjB@*#F z!T0WHSg?S~qvVbf+kG&ySKjfP`OQ_GOw6dV{1^DpXFsi0C(j^5b6XiiirRl=wsq?i z0<%Wp9@W)q-p}dSf_YO~jvc{*fC5A<%c9ms!eAh-$oq`orx#QJ15h4mDcx>>u&-^C z3Q5~&@w^ePlr9*p8zxM&gBIke5877k@23DD2*Hp5+hnSV4!-(gq8Dv%|3^o4!h}P~ zR~>=m{ulCK&iG@HU;QCUYa;EOG_h|WOd)#%R~DOf$YG042+fICxnWo@G18=v`fl80 zZKw_e&-_79>qECAvGttpw1tI_IDj@tpq<5^EIaK}8)?$L^{4=H4W3(!*is*eY`kN6#Yam(ie zS_0%elzw#Hs7(h#R)-m+G<1Vv-e3&K z@UlBl)7ErF$#knBJ%f zo?LL6Pr-X>bixuKiYHHgT<$0}V%<@?ST65|_}9EJ>>T+;6vwTXyV-qS(3_>68P$r( zCUnH1i|jzY@V%;#wTYn z6k=R&rJagwVtwsRbecgL+Ta=9@4zx_R704aW-}v~K$B*fhC<R(g!QOdLogI3g8@UUKKNs7)SA?@>a7SwU{jz5#-35le@5`k%bWr5>DBoDIrdJL)iX-Wn_LB3 zV$R)!ZpZ;p*Pqofn0|W_ox_&;y{w9MG?9h6P96?Hq5UHP9<_jaZZGn`=QYXb*7Ke9 z1L@nif*KaAhape3O>1fL5spxV{U2zv3#{;pRpy2;K*mOs&lv#xE#Sz*p)HP)B(uI# zIP!VnCxdQy>)kQ}u{$z2HTzC2WU_}_83=Hq!8JeTo{TDS=Ah}yiw^8$<%43HNKdd% zS*O)zlf2!lN8{?7$4syg>)6pon&sU)fFgieA{2BBz>^z#wwyz1#i&-uf+rL$=fg>* zTCsAo9Ar4JPP$I4%|rw?_RLcs1Gu_|xj6RJVB-gZz(yL6lv~K69RUoOS7ZrNc)pW9 zaNggaRmr^k2DbiJ`E2Ua=Z2CXRUQR7t0>F!J{i?Scgos^!vh~7@ucMz9Ew6%`H|E+ zdROzE+mwz5Q&|ayJ>RNgBKeyN*gVeyq(fXo(S1-uZ!4wJ&%!(F!_thqqZkwA~k7gT{QyPa03tMQM6q@m^++A-IN731{P}GF!Y#utX zWrow#g;E_LL4H=LVOd*C*6{t7YL2pT%Ptn1gur?`=dsxB3h-CE)I)VM&b%yiVp|-G zJh8Cb4ea#w>f2$ADpj)8q_hdGxp2!$#Mz{@_p_}y_7}(bkLqq$WM)-zCuXApHMh@M z#f@r2TAT5Q1*yFDQxi4h_cfm~ptp2iy!(m-z^ik&D)T za1qKg0!ZY0V#&^7WBmV$HO8z4f6w<~!Cbq1_Ygg>1{c^#dgdC;Ctz#!Vrq2Z>9BgT zzZ0h0sa21jTngTsJ1R9FY4e=k6jAKjfEmTNE#+cKpX^X?!Qo`jIyo}tcOpNO$#A5S z2h?#aQeI05)g0)|**0%Bthy=;tT(*m|ULX&)jX@{}ZzKu30clxC%fXC6x>~hE zoC}lMl^)zAPFv-(ToHN+)DLIuBJ8O~-D|uh2HkO>Ta`ZJ?D2QVi#9!sK6)U;I@g>o zGERrYAxvHEmFwOoaWnUDw&1go2Qv2h@>;kr_?Aq8+}Tlj(_3M$j8Ej%JBxlfG*DA( zfn@Z#UdQ!tIjc}B$U%F{PsSKTHGuF>QwUC!>aS_^GH}ap!lE}JW+0QNPxv=rN{5vK zMnn{h4j8Xprg8+eyCOL5D&1+g!@0Tdn_4P1{G?~po`5n{O_`82pI2AG77&Ed2;rbc zlNPbz_nyEqFM-u>1?a4P1&64-78uMAiPX=|S7 z{%)Z~__1HMCD3(-`$S`&S|TTitBq+g1lR9(NZ5RNh{o7vV*Ew>Oc=0e*AfB;7zq|M zfxraslmA zqu-NsxgA2bZFahc@ue-AeXzSLx)7l>ZfJmRzYMoL-v?qWOGxCES&JI8`;B@ON=hsk qPv&dLzc;4b?WcMmzzq!0P-fu^#q&}p5$6hfFp@;D}QF&^{) diff --git a/src/tests/hash_functions/key_array.bin b/src/tests/hash_functions/key_array.bin deleted file mode 100644 index 1106f69bd29570b37051ab62b2dd80e48bd84caf..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2048 zcmV+b2>Gj!2K0v$Sl(bcM=wiF8OrvXdwyI#E5xlrPWS05m)G zzUhT#pu23S>-L(DE z^inq8c+TOgLGcgOT$GlVj1fLz5$DPkFx1=Pjphn@DwjTF8K{yug0v65p&DG>AjnzI zwZhPs4fu<3jI?qVIKgzAky?}AO`7)x69$3s(IwdhW8SiC;{wJIHb(EOrRxM1+O{j#bu-|)1IPeU;6;ZvGV6h z2sRDPJzsi!A^{UpdC@qZVr&kkal;W)r0RHB0#O7tkd~~^kNthbyeUlNS}QgWssh;4 zUP#oM>y}jl{Jt2XgvOh5v)L1(iuis=j+bTBrRNh6A({CPWS4-_;~QW$%eQDZZX_=8 zWh+C)a_>B8J!kSegUlJl6rGvxsk$c)BR?J?3;M6!n+qht<_BQBgNhW44uBaugR#h| z$A|b)>g?`y1d46DAJmM_o87$z(65;$MP-aqCe5$-@q$4+EgaCCQaNOX^-4vgY7CE5 z4|(<}#P_UUnC)!0CLHqsB4Cg5`1fEf>$v+OMOq`Qp#hIIgVmUg>!~poB=eqOAre=i`8-rk?EYDoeQ_e#j-Q*=(7p&U+bC5_q@!{uGB@BC<$}MeZM!95==lRp z1A5h-D4O$@&OuzQ9y-&DcIjDPv<@27S2LBW7t06)#IrhM0kAT?%z z{yiX|s2xc+5*jC%gk!NH1iqt}C@P`;ZAeoAVkXmVO~_E$uA_gdeEC#LJUgx#9gJ-W z3#XHjBd*IROWk7(8e+)FEzZgl&ZOP)OZEJ=ZvI3lzGQ1?3HbVW?OKSB#`R`Wj$m8; zZT&!tASvR-L}?#%$oW%{Wv-~EjGt;cLbJ>pVr3`@0|ovTpc*F2&4jtQjEosrta^e% zS=cv3Wwk=(A7d(=nj4qAo+$<5E49b0Zu7`4H`nnTM<>n1#NwVST$?5Rr!bmayvL?t z+hvg1G<7y1FPqe$cH70w2fT)nj@pbHaR*K!+SsPOLJ{iebM)!7I7=LU;j)Tci*upD zh5w{3-8uP8gdx5K;hBpSw@3F?t=k1{0?R37BV+71=QJts2MmYnLQCr2rhlV+8Ao=1 zZu@ee7JnPVq(%5aFO~i-rBFjn;v)r$1^C>|<}a}d*4+Wq7ym0D93MeN^}&Bzj|q+J z_`T=-1GXFIsc_o-QpIC^b{@R#0HBaSH5Hc9wr zO7j$Z#n4~8miiyNo>)XD8}e-qPR>%K8}hgHtD(KjxSN3>LOXC1%yAdSTfYj(R2> zB?0zAPhI+-U2LN1)u(xwFVSNV0!yDU8`LO6$ElntGB_`voF5hbVkbYRRRY$pdU^H% zghWK#$J|5G1FFC39~#~BS`3a=jMmP{JAN$U9rTXlE76`k-iaHkc!K>?3UP@xxG7!0 z*{rt)kOHH!)Vx21XH>nBvJc(N=M{$IpE}=N_hSt`epjxbsQV&xcqTSUq{oZpb$E36 zIm@!p%|8ZLesryHzlmhYgEz8Lj+dp42;!0&FW%;=ywLN-h@zeIO)}!_yAJ-IY$++F zLxNSs*Yg&CrDv$_2ntN82fWg)C3AqK3{j+6wB%#^xXS~WVjQ;RT^XZ|LRUa%@`A0Y zR_9_zUp|25PJ*esikF*zUKg&xb8wWBCn~X`v%)w0+g^}W`O6OmM8sjMMrJiwkes55CfWwwky0K@c(=p@~#R zsdSDokB}%(bcUVy7a3c&Q6v%9txb9RM-25%@9|!F?rPUi$?qJs9xM*-(rwqil4&U e$+#I#EoTx@Ma;iu#IDSJIc(I2s6q*=n#}Js&j$Pe diff --git a/src/tests/hash_functions_perf/32_bit_hash_performance.txt b/src/tests/hash_functions_perf/32_bit_hash_performance.txt deleted file mode 100644 index 2f808566f..000000000 --- a/src/tests/hash_functions_perf/32_bit_hash_performance.txt +++ /dev/null @@ -1,43 +0,0 @@ -| Algorithm | Key Size | Key # | Time (s) | -| | Bytes | | | -|------------|-----------|------------|----------| -| FNV-1 | 1 | 1048576 | 0.00000 | -| FNV-1 | 2 | 524288 | 0.00000 | -| FNV-1 | 4 | 262144 | 0.00000 | -| FNV-1 | 8 | 131072 | 0.00000 | -| FNV-1 | 16 | 65536 | 0.00000 | -| FNV-1 | 64 | 16384 | 0.00000 | -| FNV-1 | 256 | 4096 | 0.00000 | -| FNV-1 | 1024 | 1024 | 0.00000 | -| FNV-1a | 1 | 1048576 | 0.00000 | -| FNV-1a | 2 | 524288 | 0.00000 | -| FNV-1a | 4 | 262144 | 0.00000 | -| FNV-1a | 8 | 131072 | 0.00000 | -| FNV-1a | 16 | 65536 | 0.00000 | -| FNV-1a | 64 | 16384 | 0.00000 | -| FNV-1a | 256 | 4096 | 0.00000 | -| FNV-1a | 1024 | 1024 | 0.00000 | -| nmhash32 | 1 | 1048576 | 0.00000 | -| nmhash32 | 2 | 524288 | 0.00000 | -| nmhash32 | 4 | 262144 | 0.00000 | -| nmhash32 | 8 | 131072 | 0.00000 | -| nmhash32 | 16 | 65536 | 0.00000 | -| nmhash32 | 64 | 16384 | 0.00000 | -| nmhash32 | 256 | 4096 | 0.00000 | -| nmhash32 | 1024 | 1024 | 0.00000 | -| nmhash32x | 1 | 1048576 | 0.00000 | -| nmhash32x | 2 | 524288 | 0.00000 | -| nmhash32x | 4 | 262144 | 0.00000 | -| nmhash32x | 8 | 131072 | 0.00000 | -| nmhash32x | 16 | 65536 | 0.00000 | -| nmhash32x | 64 | 16384 | 0.00000 | -| nmhash32x | 256 | 4096 | 0.00000 | -| nmhash32x | 1024 | 1024 | 0.00000 | -| water | 1 | 1048576 | 0.00000 | -| water | 2 | 524288 | 0.00000 | -| water | 4 | 262144 | 0.00000 | -| water | 8 | 131072 | 0.00000 | -| water | 16 | 65536 | 0.00000 | -| water | 64 | 16384 | 0.00000 | -| water | 256 | 4096 | 0.00000 | -| water | 1024 | 1024 | 0.00000 | diff --git a/src/tests/hash_functions_perf/64_bit_hash_performance.txt b/src/tests/hash_functions_perf/64_bit_hash_performance.txt deleted file mode 100644 index 1a0ea562a..000000000 --- a/src/tests/hash_functions_perf/64_bit_hash_performance.txt +++ /dev/null @@ -1,35 +0,0 @@ -| Algorithm | Key Size | Key # | Time (s) | -| | Bytes | | | -|------------|-----------|------------|----------| -| FNV-1 | 1 | 1048576 | 0.00000 | -| FNV-1 | 2 | 524288 | 0.00000 | -| FNV-1 | 4 | 262144 | 0.00000 | -| FNV-1 | 8 | 131072 | 0.00000 | -| FNV-1 | 16 | 65536 | 0.00000 | -| FNV-1 | 64 | 16384 | 0.00000 | -| FNV-1 | 256 | 4096 | 0.00000 | -| FNV-1 | 1024 | 1024 | 0.00000 | -| FNV-1a | 1 | 1048576 | 0.00000 | -| FNV-1a | 2 | 524288 | 0.00000 | -| FNV-1a | 4 | 262144 | 0.00000 | -| FNV-1a | 8 | 131072 | 0.00000 | -| FNV-1a | 16 | 65536 | 0.00000 | -| FNV-1a | 64 | 16384 | 0.00000 | -| FNV-1a | 256 | 4096 | 0.00000 | -| FNV-1a | 1024 | 1024 | 0.00000 | -| Pengy | 1 | 1048576 | 0.00000 | -| Pengy | 2 | 524288 | 0.00000 | -| Pengy | 4 | 262144 | 0.00000 | -| Pengy | 8 | 131072 | 0.00000 | -| Pengy | 16 | 65536 | 0.00000 | -| Pengy | 64 | 16384 | 0.00000 | -| Pengy | 256 | 4096 | 0.00000 | -| Pengy | 1024 | 1024 | 0.00000 | -| Spooky | 1 | 1048576 | 0.05467 | -| Spooky | 2 | 524288 | 0.03316 | -| Spooky | 4 | 262144 | 0.01453 | -| Spooky | 8 | 131072 | 0.00696 | -| Spooky | 16 | 65536 | 0.00576 | -| Spooky | 64 | 16384 | 0.00159 | -| Spooky | 256 | 4096 | 0.00105 | -| Spooky | 1024 | 1024 | 0.00064 |