From 88a68be227e1a9a833b313c969357bf3db07439f Mon Sep 17 00:00:00 2001 From: Mark Cianciosa Date: Tue, 15 Oct 2024 17:51:38 -0400 Subject: [PATCH] Test random number sequence by checking that autocorrelation is a delta function. --- test/CMakeLists.txt | 1 + test/korc_test.f90 | 12 ++++- test/test_hpc.f90 | 11 +---- test/test_random.f90 | 101 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 114 insertions(+), 11 deletions(-) create mode 100644 test/test_random.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 0d39adcd..16fbc64b 100755 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -8,6 +8,7 @@ target_sources(xtest $ $ $ + $ ) target_link_libraries (xtest diff --git a/test/korc_test.f90 b/test/korc_test.f90 index 47935466..3dd9479d 100755 --- a/test/korc_test.f90 +++ b/test/korc_test.f90 @@ -2,11 +2,17 @@ program korc_test use fruit use test_io use test_hpc + use test_random + use korc_hpc, only : initialize_mpi,finalize_mpi implicit none logical ok + TYPE(KORC_PARAMS) :: params CHARACTER(MX_STRING_LENGTH) :: path_to_outputs + params%path_to_inputs='TEST' + call initialize_mpi(params) + ! create output file for testing call set_paths(path_to_outputs) @@ -15,7 +21,8 @@ program korc_test ! run tests write(test_unit_write,*) 'Testing MPI initialization...' - call test_mpi_initialization + call test_mpi_initialization(params) + call test_random_auto ! compile summary and finalize fruit call fruit_summary(test_unit_write) @@ -29,5 +36,6 @@ program korc_test close(test_unit_write) - + call finalize_mpi(params) + end program korc_test diff --git a/test/test_hpc.f90 b/test/test_hpc.f90 index 1fe32a47..efe2e225 100755 --- a/test/test_hpc.f90 +++ b/test/test_hpc.f90 @@ -6,17 +6,12 @@ module test_hpc contains - subroutine test_mpi_initialization - use korc_hpc, only : initialize_mpi,finalize_mpi - TYPE(KORC_PARAMS) :: params + subroutine test_mpi_initialization(params) + TYPE(KORC_PARAMS), INTENT(INOUT) :: params integer :: ierror integer :: size, rank integer :: size_k, rank_k - params%path_to_inputs='TEST' - - call initialize_mpi(params) - size_k=params%mpi_params%nmpi rank_k=params%mpi_params%rank @@ -25,8 +20,6 @@ subroutine test_mpi_initialization call assert_equals(size_k,size) call assert_equals(rank_k,rank) - - call finalize_mpi(params) end subroutine test_mpi_initialization diff --git a/test/test_random.f90 b/test/test_random.f90 new file mode 100644 index 00000000..13894a3c --- /dev/null +++ b/test/test_random.f90 @@ -0,0 +1,101 @@ +module test_random + use korc_random + use mpi + use fruit + implicit none + +contains + + SUBROUTINE test_random_auto + IMPLICIT NONE + +! Local Variables + CLASS (random_U_context), POINTER :: uniform => null() + INTEGER :: mpierr + INTEGER :: i + INTEGER :: rank + INTEGER :: size + INTEGER :: localsize + REAL(rp), DIMENSION(:), ALLOCATABLE :: buffer + INTEGER, DIMENSION(:), ALLOCATABLE :: counts + INTEGER, DIMENSION(:), ALLOCATABLE :: offsets + REAL(rp) :: base + REAL(rp) :: test + +! Local parameters + INTEGER, PARAMETER :: totalsize = 10000 + INTEGER, PARAMETER :: window = totalsize/2 + +! Start of executable code. + call MPI_COMM_SIZE(MPI_COMM_WORLD, size, mpierr) + call MPI_COMM_RANK(MPI_COMM_WORLD, rank, mpierr) + + IF (rank .eq. 0) THEN + WRITE (*,*) + WRITE (*,*) "Starting Random Test" + END IF + + uniform => random_U_context_construct(0, rank) + CALL uniform%set(-1.0d0, 1.0d0) + + localsize = totalsize/size + IF (rank .lt. MOD(totalsize, size)) THEN + localsize = localsize + 1 + ENDIF + + IF (rank .eq. 0) THEN + ALLOCATE(buffer(totalsize)) + ALLOCATE(counts(size)) + ALLOCATE(offsets(size)) + CALL uniform%get_array(buffer(1:localsize)) + ELSE + ALLOCATE(buffer(localsize)) + CALL uniform%get_array(buffer) + END IF + + CALL MPI_GATHER(localsize, 1, MPI_INTEGER, & + counts, 1, MPI_INTEGER, & + 0, MPI_COMM_WORLD, mpierr) + IF (rank .eq. 0) THEN + offsets(1) = 0 + DO i = 2, size + offsets(i) = offsets(i - 1)+counts(i - 1) + END DO + END IF + CALL MPI_GATHERV(buffer, localsize, MPI_DOUBLE, & + buffer, counts, offsets, MPI_DOUBLE, & + 0, MPI_COMM_WORLD, mpierr) + + IF (rank .eq. 0) THEN + DEALLOCATE(counts) + DEALLOCATE(offsets) + +! Check against 10% of the first peak. We could go lower but I don't want to +! trigger a test failure on noise. + base = autocorrelation(buffer, 0)*0.1 + DO i = 1, window + test = autocorrelation(buffer, i) + CALL assert_equals(test .gt. base, .false.) + END DO + END IF + + DEALLOCATE(buffer) + + END SUBROUTINE + + FUNCTION autocorrelation(sequence, offset) + + IMPLICIT NONE + +! Declare arguments. + REAL(rp) :: autocorrelation + REAL(rp), DIMENSION(:) :: sequence + INTEGER :: offset + +! Start of executable code. + autocorrelation = DOT_PRODUCT(sequence(:SIZE(sequence) - offset), & + sequence(offset + 1:)) & + / (SIZE(sequence) - offset) + END FUNCTION + +end module