diff --git a/src/params.f90 b/src/params.f90 index 5b210e73..3940b1ba 100644 --- a/src/params.f90 +++ b/src/params.f90 @@ -79,7 +79,7 @@ module params real(dp) :: fper, zerolam = 0d0 real(dp) :: tcut = -1d0 - integer :: ntcut + integer(8) :: ntcut integer :: nturns = 8 logical :: class_plot = .False. !<=AAA real(dp) :: cut_in_per = 0d0 !<=AAA @@ -256,7 +256,7 @@ subroutine params_init end do end if - ntcut = ceiling(ntimstep*ntau*tcut/trace_time) + ntcut = microstep_cut_index(ntimstep, ntau, tcut, trace_time) norbper = ceiling(1d0*ntau*ntimstep/(L1i*npoiper2)) nfp = L1i*norbper @@ -269,6 +269,25 @@ subroutine params_init call reallocate_arrays end subroutine params_init + pure function microstep_cut_index(ntimstep_in, ntau_in, tcut_in, & + trace_time_in) result(ntcut_out) + ! Microstep index of the classification cut time tcut; <=0 disables it. + ! ntimstep*ntau reaches ~1e10 for second-scale traces and overflows a + ! 32-bit product, flipping the sign and spuriously enabling classification, + ! so evaluate in real(dp) and return int64. + integer, intent(in) :: ntimstep_in, ntau_in + real(dp), intent(in) :: tcut_in, trace_time_in + integer(8) :: ntcut_out + + if (tcut_in > 0d0 .and. trace_time_in > 0d0) then + ntcut_out = ceiling( & + real(ntimstep_in, dp)*real(ntau_in, dp)*tcut_in/trace_time_in, & + kind=8) + else + ntcut_out = -1_8 + end if + end function microstep_cut_index + pure function to_lower(s) result(out) character(*), intent(in) :: s character(len(s)) :: out diff --git a/test/tests/CMakeLists.txt b/test/tests/CMakeLists.txt index 3901ec3a..1ec6d762 100644 --- a/test/tests/CMakeLists.txt +++ b/test/tests/CMakeLists.txt @@ -592,12 +592,17 @@ add_executable(test_field_base.x test_field_base.f90) target_link_libraries(test_field_base.x simple) add_test(NAME test_field_base COMMAND test_field_base.x) +add_executable(test_ntcut_overflow.x test_ntcut_overflow.f90) +target_link_libraries(test_ntcut_overflow.x simple) +add_test(NAME test_ntcut_overflow COMMAND test_ntcut_overflow.x) + # Sub-second base-interface tests for the libneo reverse-dependency gate # (ctest -L smoke). set_property(TEST test_lapack_interfaces test_orbit_symplectic_base test_field_base + test_ntcut_overflow APPEND PROPERTY LABELS smoke) add_executable(test_coordinates_simple.x test_coordinates_simple.f90) diff --git a/test/tests/test_ntcut_overflow.f90 b/test/tests/test_ntcut_overflow.f90 new file mode 100644 index 00000000..4a4e21f2 --- /dev/null +++ b/test/tests/test_ntcut_overflow.f90 @@ -0,0 +1,52 @@ +program test_ntcut_overflow + ! The classification cut index ntcut = ntimstep*ntau*tcut/trace_time must stay + ! disabled (<=0) when tcut<=0, for any trace length. The product ntimstep*ntau + ! reaches ~2.3e9 for second-scale traces and overflows a 32-bit integer; the + ! old int32 product wrapped negative and, times tcut<0, flipped ntcut positive, + ! silently routing long traces through the classifier path. Regression guard. + use params, only: microstep_cut_index + use, intrinsic :: iso_fortran_env, only: int64 + implicit none + + integer :: errors + integer(int64) :: nt + + errors = 0 + + ! 1 s W7-X reactor case (npoiper2=16384): ntau ~ 2.3e6, ntimstep*ntau ~ 2.3e9 + ! overflows int32. tcut<0 -> classification disabled -> ntcut must be <= 0. + nt = microstep_cut_index(1000, 2297297, -1.0d0, 1.0d0) + if (nt > 0_int64) then + print *, "FAIL: overflow case gave ntcut > 0:", nt + errors = errors + 1 + end if + + ! Short trace, tcut<0: also disabled. + nt = microstep_cut_index(1000, 2295, -1.0d0, 1.0d-3) + if (nt > 0_int64) then + print *, "FAIL: short-trace disabled case gave ntcut > 0:", nt + errors = errors + 1 + end if + + ! tcut>0, no overflow: cut at half the trace -> ntimstep*ntau/2. + nt = microstep_cut_index(1000, 1000, 0.5d0, 1.0d0) + if (nt /= 500000_int64) then + print *, "FAIL: enabled no-overflow case gave", nt, "expected 500000" + errors = errors + 1 + end if + + ! tcut>0 with an overflow-scale product must stay correct in int64, not wrap. + nt = microstep_cut_index(1000, 2297297, 1.0d0, 1.0d0) + if (nt /= 2297297000_int64) then + print *, "FAIL: enabled overflow-scale case gave", nt, & + "expected 2297297000" + errors = errors + 1 + end if + + if (errors == 0) then + print *, "All ntcut overflow tests passed!" + else + print *, "ERROR:", errors, "test(s) failed!" + stop 1 + end if +end program test_ntcut_overflow