Add function to compute integer cube root to tests.

configure.ac

@@ -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				\

tests/Makefile.am

@@ -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				\

tests/ftest_common.f90

@@ -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:)

tests/test_misc_f.f90

+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

tests/test_misc_run.in

+#! @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:
+#