Commit 662365c2 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Add function to compute integer cube root to tests.

parent f18ca65d
......@@ -382,6 +382,7 @@ AC_CONFIG_FILES([ \
tests/test_perf_stripes_run \
tests/test_sort_run \
tests/test_uid_run \
tests/test_misc_run \
tests/test_yaxt_run \
tests/test_mpi_generate_datatype_run \
tests/test_mpi_smartdedup_run \
......
......@@ -34,6 +34,7 @@
#
noinst_PROGRAMS = \
test_misc_f \
test_mpi_generate_datatype \
test_mpi_smartdedup \
test_exchanger_parallel \
......@@ -227,6 +228,8 @@ test_sort_SOURCES = test_sort.c tests.h
test_uid_SOURCES = test_uid.c
test_yaxt_SOURCES = test_yaxt.f90
test_yaxt_LDADD = $(XT_FC_LDADD)
test_misc_f_SOURCES = test_misc_f.f90
test_misc_f_LDADD = $(XT_FC_LDADD)
test_mpi_generate_datatype_SOURCES = test_mpi_generate_datatype.c tests.h
test_mpi_smartdedup_SOURCES = test_mpi_smartdedup.c tests.h
......@@ -238,6 +241,7 @@ XT_FC_LDADD = libtestutil_f.la libtestutil.la ../src/libyaxt.la \
../src/libyaxt_c.la $(MPI_FC_LIB)
TESTS = \
test_misc_run \
test_mpi_generate_datatype_run \
test_mpi_smartdedup_run \
test_exchanger_parallel_run \
......
......@@ -134,13 +134,17 @@ MODULE ftest_common
MODULE PROCEDURE id_map_i2, id_map_i4, id_map_i8
END INTERFACE id_map
INTERFACE icbrt
MODULE PROCEDURE icbrt_i2, icbrt_i4, icbrt_i8
END INTERFACE icbrt
REAL(dp) :: sync_dt_sum = 0.0_dp
LOGICAL, PARAMETER :: debug = .FALSE.
LOGICAL :: verbose = .FALSE.
PUBLIC :: init_mpi, finish_mpi
PUBLIC :: timer, treset, tstart, tstop, treport, mysync
PUBLIC :: id_map, icmp, factorize, regular_deco
PUBLIC :: id_map, icbrt, icmp, factorize, regular_deco
PUBLIC :: test_abort, set_verbose, get_verbose
PUBLIC :: cmp_arrays
PUBLIC :: run_randomized_tests, init_fortran_random
......@@ -534,6 +538,70 @@ CONTAINS
END SUBROUTINE factorize
!> computes n**(1/3)
FUNCTION icbrt_i2(n) RESULT(icbrt)
INTEGER(i2), INTENT(in) :: n
INTEGER(i2) :: icbrt
INTEGER, PARAMETER :: nbits = BIT_SIZE(n)-1
INTEGER(i2) :: s
INTEGER(i2) :: b, x
x = ABS(n)
icbrt = 0
DO s = nbits, 0, -3
icbrt = icbrt + icbrt
b = 3_i2 * icbrt * (icbrt + 1_i2) + 1_i2
IF (ISHFT(x, -s) >= b) THEN
x = x - ISHFT(b, s)
icbrt = icbrt + 1_i2
END IF
END DO
icbrt = SIGN(icbrt, n)
END FUNCTION icbrt_i2
!> computes n**(1/3)
FUNCTION icbrt_i4(n) RESULT(icbrt)
INTEGER(i4), INTENT(in) :: n
INTEGER(i4) :: icbrt
INTEGER, PARAMETER :: nbits = BIT_SIZE(n)-1
INTEGER(i4) :: s
INTEGER(i4) :: b, x
x = ABS(n)
icbrt = 0
DO s = nbits-1, 0, -3
icbrt = icbrt + icbrt
b = 3_i4 * icbrt * (icbrt + 1_i4) + 1_i4
IF (ISHFT(x, -s) >= b) THEN
x = x - ISHFT(b, s)
icbrt = icbrt + 1_i4
END IF
END DO
icbrt = SIGN(icbrt, n)
END FUNCTION icbrt_i4
!> computes n**(1/3)
FUNCTION icbrt_i8(n) RESULT(icbrt)
INTEGER(i8), INTENT(in) :: n
INTEGER(i8) :: icbrt
INTEGER, PARAMETER :: nbits = BIT_SIZE(n)-1
INTEGER(i8) :: s
INTEGER(i8) :: b, x
x = ABS(n)
icbrt = 0
DO s = nbits, 0, -3
icbrt = icbrt + icbrt
b = 3_i8 * icbrt * (icbrt + 1_i8) + 1_i8
IF (ISHFT(x, -s) >= b) THEN
x = x - ISHFT(b, s)
icbrt = icbrt + 1_i8
END IF
END DO
icbrt = SIGN(icbrt, n)
END FUNCTION icbrt_i8
SUBROUTINE regular_deco(g_cn, c0, cn)
INTEGER, INTENT(in) :: g_cn
INTEGER, INTENT(out) :: c0(0:), cn(0:)
......
PROGRAM test_misc
USE iso_c_binding, ONLY: c_long, c_int
USE xt_core, ONLY: i2, i4, i8
USE ftest_common, ONLY: icbrt, test_abort, run_randomized_tests, &
init_fortran_random
IMPLICIT NONE
LOGICAL :: fully_random_tests
fully_random_tests = run_randomized_tests()
CALL init_fortran_random(fully_random_tests)
CALL test_icbrt
CONTAINS
SUBROUTINE test_icbrt
CALL test_icbrt_i2
CALL test_icbrt_i4
CALL test_icbrt_i8
END SUBROUTINE test_icbrt
SUBROUTINE test_icbrt_i2
INTEGER(i2), PARAMETER :: ulim = 31_i2
INTEGER(i2) :: i, cubed, cbrt
CHARACTER(len=132) :: msg
DO i = -ulim, ulim, 1_i2
cubed = i**3_i2
cbrt = icbrt(cubed)
IF (cbrt /= i) THEN
WRITE (msg, '(4(a,i0))') &
"integer cube root computation failed for ", i, &
"**3 = ", cubed, ", but icbrt(", cubed, ") = ", cbrt
CALL test_abort(TRIM(msg), &
__FILE__, &
__LINE__)
END IF
END DO
END SUBROUTINE test_icbrt_i2
SUBROUTINE test_icbrt_i4
INTEGER(i4), PARAMETER :: ulim = 1290
INTEGER(i4) :: i, cubed, cbrt, prev_cubed, other_cubed
CHARACTER(len=132) :: msg
DOUBLE PRECISION :: rnd
i = icbrt(-8)
prev_cubed = -HUGE(1_i4)
DO i = -ulim, -1_i4, 1_i4
cubed = i**3_i4
cbrt = icbrt(cubed)
IF (cbrt /= i) THEN
WRITE (msg, '(4(a,i0))') &
"integer cube root computation failed for ", i, &
"**3 = ", cubed, ", but icbrt(", cubed, ") = ", cbrt
CALL test_abort(TRIM(msg), &
__FILE__, &
__LINE__)
END IF
CALL random_number(rnd)
other_cubed = prev_cubed + MAX(1_i4, INT(rnd * DBLE(cubed - prev_cubed), i4))
cbrt = icbrt(other_cubed)
IF (cbrt /= i) THEN
WRITE (msg, '(4(a,i0))') &
"integer cube root computation failed for ", other_cubed, &
", expected ", i, &
", but icbrt(", other_cubed, ") = ", cbrt
CALL test_abort(TRIM(msg), &
__FILE__, &
__LINE__)
END IF
prev_cubed = cubed
END DO
prev_cubed = HUGE(1_i4)
DO i = ulim, 0_i4, -1_i4
cubed = i**3_i4
cbrt = icbrt(cubed)
IF (cbrt /= i) THEN
WRITE (msg, '(4(a,i0))') &
"integer cube root computation failed for ", i, &
"**3 = ", cubed, ", but icbrt(", cubed, ") = ", cbrt
CALL test_abort(TRIM(msg), &
__FILE__, &
__LINE__)
END IF
CALL random_number(rnd)
other_cubed = cubed + MIN(INT(rnd * DBLE(prev_cubed - cubed), i4), -1_i4)
cbrt = icbrt(cubed)
IF (cbrt /= i) THEN
WRITE (msg, '(4(a,i0))') &
"integer cube root computation failed for ", other_cubed, &
", expected ", i, &
", but icbrt(", other_cubed, ") = ", cbrt
CALL test_abort(TRIM(msg), &
__FILE__, &
__LINE__)
END IF
prev_cubed = cubed
END DO
END SUBROUTINE test_icbrt_i4
SUBROUTINE test_icbrt_i8
INTEGER(i8), PARAMETER :: ulim = 2097151_i8
INTEGER(i8) :: i, cubed, cbrt
CHARACTER(len=132) :: msg
DO i = -ulim, ulim, 1_i8
cubed = i**3_i8
cbrt = icbrt(cubed)
IF (cbrt /= i) THEN
WRITE (msg, '(4(a,i0))') &
"integer cube root computation failed for ", i, &
"**3 = ", cubed, ", but icbrt(", cubed, ") = ", cbrt
CALL test_abort(TRIM(msg), &
__FILE__, &
__LINE__)
END IF
END DO
END SUBROUTINE test_icbrt_i8
END PROGRAM test_misc
#! @SHELL@
[ x"@MPI_LAUNCH@" != xtrue ] || exit 77
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_misc_f
#
# Local Variables:
# mode: sh
# End:
#
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment