diff --git a/src/core_test/mpas_test_core.F b/src/core_test/mpas_test_core.F index dbaee54bbc..ba9c86b280 100644 --- a/src/core_test/mpas_test_core.F +++ b/src/core_test/mpas_test_core.F @@ -242,6 +242,18 @@ function test_core_run(domain) result(iErr)!{{{ end if call mpas_log_write('') + ! + ! Test functionality of alarms with user-defined active windows + ! + call mpas_log_write('') + call mpas_log_write('Testing mpas_window_alarms:') + iErr = mpas_window_alarm_tests() + if (iErr == 0) then + call mpas_log_write('* mpas_window_alarm tests - all tests passed: SUCCESS') + else + call mpas_log_write('* mpas_window_alarm tests - $i failed tests: FAILURE', intArgs=[iErr]) + end if + deallocate(threadErrs) end function test_core_run!}}} diff --git a/src/core_test/mpas_test_core_timekeeping_tests.F b/src/core_test/mpas_test_core_timekeeping_tests.F index a2b214c6b0..57b4cfa5c3 100644 --- a/src/core_test/mpas_test_core_timekeeping_tests.F +++ b/src/core_test/mpas_test_core_timekeeping_tests.F @@ -23,11 +23,599 @@ module test_core_timekeeping_tests private public :: test_core_test_intervals, & - mpas_adjust_alarm_tests + mpas_adjust_alarm_tests, & + mpas_window_alarm_tests - contains + !----------------------------------------------------------------------- + ! type alarm_fixture_t + ! + !> \brief Fixture type for testing alarm ringing behavior with windows. + !> \author Andy Stokely + !> \date 10/02/2025 + !> \details + !> This type provides all clocks, alarms, and precomputed iteration + !> steps needed to exercise windowed alarm test cases. + !> + !> The test timeline is organized as: + !> + !> A B C D E + !> |----------------|----------|------------|----------------| + !> ^ ^ ^ ^ ^ + !> Clock start Alarm anchor Window Window stop Clock stop + !> start + !> + !> Fields map directly to these points and derived step counts. + !----------------------------------------------------------------------- + type alarm_fixture_t + !> Clock start time (A on the timeline) + type(MPAS_Time_type) :: clock_start_time - !*********************************************************************** + !> Clock stop time (E on the timeline) + type(MPAS_Time_type) :: clock_stop_time + + !> Alarm anchor time (B on the timeline) + type(MPAS_Time_type) :: alarm_time + + !> Alarm window start time (C on the timeline) + type(MPAS_Time_type) :: window_start_time + + !> Alarm window stop time (D on the timeline) + type(MPAS_Time_type) :: window_stop_time + + !> Clock step interval (time advanced per tick) + type(MPAS_TimeInterval_type) :: clock_time_step + + !> Alarm recurrence interval (ring spacing) + type(MPAS_TimeInterval_type) :: alarm_interval + + !> Clock under test + type(MPAS_Clock_type) :: clock + + !> Alarm with a user-defined active window + type(MPAS_Alarm_type), pointer :: alarm + + !> Identifier string for the alarm + character(len=:), allocatable :: alarm_id + + !> Number of substeps per interval (clock resolution) + integer :: num_steps_per_interval = 6 + + !> Steps from clock start to alarm anchor (A->B) + integer :: num_steps_before_anchor = 12 + + !> Steps from anchor to window start (B->C) + integer :: num_steps_before_window = 36 + + !> Steps covering full window duration (C->D) + integer :: num_steps_window = 36 + + !> Steps from window end to clock end (D->E) + integer :: num_steps_post_window = 36 + + !> Absolute step index at anchor (B) + integer :: steps_to_anchor + + !> Absolute step index at window start (C) + integer :: steps_to_window_start + + !> Absolute step index at window midpoint + integer :: steps_to_window_midpoint + + !> Absolute step index at window end (D) + integer :: steps_to_window_end + + !> Absolute step index in post-window region + integer :: steps_to_post_window + end type alarm_fixture_t + +contains + + + !----------------------------------------------------------------------- + ! subroutine advance_clock_n_times + ! + !> \brief Advance a clock forward by a specified number of steps. + !> \author Andy Stokely + !> \date 10/02/2025 + !> \details This routine repeatedly advances the provided clock + !> forward by calling mpas_advance_clock `n` times. + !----------------------------------------------------------------------- + subroutine advance_clock_n_times(clock, n) + use mpas_derived_types, only : MPAS_Clock_type + implicit none + type(MPAS_Clock_type), intent(inout) :: clock + integer, intent(in) :: n + integer :: i + + do i = 1, n + call mpas_advance_clock(clock) + end do + end subroutine advance_clock_n_times + + + !----------------------------------------------------------------------- + ! subroutine assert_true + ! + !> \brief Assert that a condition is true; logs PASS/FAIL accordingly. + !> \author Andy Stokely + !> \date 10/28/2025 + !> \details + !> Verifies that the provided logical expression evaluates to `.true.`. + !> If the condition is false, a FAIL message is logged and the status + ! is set to 1. + !> + !> This routine is used throughout test cases to simplify repetitive + !> PASS/FAIL logic and ensure consistent logging and error tracking. + !> + !> \param condition Logical expression expected to be `.true.` + !> \param message Description of the test condition + !> \param status Integer status flag (0 = pass, 1 = fail) + !----------------------------------------------------------------------- + subroutine assert_true(condition, message, status) + implicit none + logical, intent(in) :: condition + character(len=*), intent(in) :: message + integer, intent(out) :: status + + if (condition) then + status = 0 + else + call mpas_log_write('FAIL: ' // trim(message)) + status = 1 + end if + end subroutine assert_true + + + !----------------------------------------------------------------------- + ! subroutine assert_false + ! + !> \brief Assert that a condition is false; logs PASS/FAIL accordingly. + !> \author Andy Stokely + !> \date 10/28/2025 + !> \details + !> Verifies that the provided logical expression evaluates to `.false.`. + !> If the condition is true, a FAIL message is logged and the status + !> is set to 1. + !> + !> This routine complements `assert_true` and is used when the expected + !> behavior requires a logical expression to remain false. + !> + !> \param condition Logical expression expected to be `.false.` + !> \param message Description of the test condition + !> \param status Integer status flag (0 = pass, 1 = fail) + !----------------------------------------------------------------------- + subroutine assert_false(condition, message, status) + implicit none + logical, intent(in) :: condition + character(len=*), intent(in) :: message + integer, intent(out) :: status + + if (.not. condition) then + status = 0 + else + call mpas_log_write('FAIL: ' // trim(message)) + status = 1 + end if + end subroutine assert_false + + + !----------------------------------------------------------------------- + ! subroutine setup_alarm_fixture + ! + !> \brief Initialize a test fixture with a clock and alarms. + !> \author Andy Stokely + !> \date 10/02/2025 + !> \details This routine allocates and initializes an alarm_fixture_t + !> structure. + !----------------------------------------------------------------------- + subroutine setup_alarm_fixture(fixture) + implicit none + type(alarm_fixture_t), intent(out), pointer :: fixture + integer :: ierr + + allocate(fixture) + + ! Alarm ID + fixture%alarm_id = 'alarm' + + ! Clock setup + call mpas_set_time(fixture%clock_start_time, YYYY=2000, MM=01, DD=01, H=0, & + M=0, S=0, S_n=0, S_d=0, ierr=ierr) + call mpas_set_time(fixture%clock_stop_time, YYYY=2000, MM=01, DD=01, H=20, & + M=0, S=0, S_n=0, S_d=0, ierr=ierr) + + call mpas_set_timeInterval(fixture%clock_time_step, dt=600.0_RKIND, ierr=ierr) + + call mpas_create_clock(fixture%clock, fixture%clock_start_time, & + fixture%clock_time_step, fixture%clock_stop_time, ierr=ierr) + + ! Alarm anchor and interval + call mpas_set_time(fixture%alarm_time, YYYY=2000, MM=01, DD=01, H=2, M=0, S=0, S_n=0, S_d=0, ierr=ierr) + call mpas_set_timeInterval(fixture%alarm_interval, dt=3600.0_RKIND, ierr=ierr) + + ! Alarm window + call mpas_set_time(fixture%window_start_time, YYYY=2000, MM=01, DD=01, H=8, M=0, S=0, S_n=0, S_d=0, ierr=ierr) + call mpas_set_time(fixture%window_stop_time, YYYY=2000, MM=01, DD=01, H=14, M=0, S=0, S_n=0, S_d=0, ierr=ierr) + + ! Add alarms to the clock + call mpas_add_clock_alarm(fixture%clock, fixture%alarm_id, fixture%alarm_time, & + alarmTimeInterval = fixture%alarm_interval, & + alarmStartTime = fixture%window_start_time, & + alarmStopTime = fixture%window_stop_time) + fixture%alarm => fixture%clock%alarmListHead + + ! Derived iteration steps + fixture%steps_to_anchor = fixture%num_steps_before_anchor + fixture%steps_to_window_start = fixture%num_steps_before_anchor + fixture%num_steps_before_window + fixture%steps_to_window_midpoint = fixture%steps_to_window_start + fixture%num_steps_window/2 + fixture%steps_to_window_end = fixture%steps_to_window_start + fixture%num_steps_window + fixture%steps_to_post_window = fixture%steps_to_window_end + fixture%num_steps_post_window/2 + end subroutine setup_alarm_fixture + + + !----------------------------------------------------------------------- + ! subroutine teardown_alarm_fixture + ! + !> \brief Finalize and deallocate a test alarm fixture. + !> \author Andy Stokely + !> \date 10/02/2025 + !> \details This routine removes alarms from the test clock, destroys + !> the clock, nullifies alarm pointers, and deallocates the fixture. + !> It ensures a clean state for subsequent tests. + !----------------------------------------------------------------------- + subroutine teardown_alarm_fixture(fixture) + implicit none + type(alarm_fixture_t), pointer :: fixture + integer :: ierr + + call mpas_remove_clock_alarm(fixture%clock, fixture%alarm_id, ierr=ierr) + call mpas_destroy_clock(fixture%clock, ierr=ierr) + + nullify(fixture%alarm) + deallocate(fixture) + end subroutine teardown_alarm_fixture + + + !----------------------------------------------------------------------- + ! subroutine test_window_alarm + ! + !> \brief Unit test for alarm ringing behavior with user-defined windows. + !> \author Andy Stokely + !> \date 10/02/2025 + !> \details This test suite verifies that an alarm rings only when expected + !> relative to the defined timeline: + !> + !> A = Clock start time + !> B = Alarm anchor time + !> C = Window start time + !> D = Window end time + !> E = Clock end time + !> + !> Timeline: + !> A ---------------- B ----- C ---------------- D --------- E + !> + !> The test covers 19 cases, including behavior: + !> - Before anchor (A -> B) + !> - Between anchor and window start (B -> C) + !> - At window boundaries (C, D) + !> - Inside the window (C -> D) + !> - After leaving the window (D -> E) + !> - After reset operations at various points + !> - With anchor times shifted into the window + !> - When the clock direction changes (forward/backward) + !> - When the window start time is after the stop time (invalid) + !> - When the window start time equals the stop time (valid) + !> - When the window start time is before the clock start time (valid) + !> + !> Each case checks whether the alarm rings at the correct times and + !> uses mpas_log_write to log PASS/FAIL outcomes. + !----------------------------------------------------------------------- + subroutine test_window_alarm(case_idx, ierr) + implicit none + integer, intent(in) :: case_idx + integer, intent(inout) :: ierr + type(alarm_fixture_t), pointer :: f + logical :: ringing + integer :: local_ierr + + call setup_alarm_fixture(f) + ierr = 0 + local_ierr = 0 + + select case (case_idx) + + !----------------------------------------------------------------------- + ! Case 1: Before anchor (A -> B) + ! Alarm should not ring before the anchor time. + !----------------------------------------------------------------------- + case(1) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing before anchor time', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 2: Before anchor after reset (A -> B) + ! Reset should not cause false ringing before anchor. + !----------------------------------------------------------------------- + case(2) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing before anchor time after reset', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 3: After anchor but before window (B -> C) + ! Alarm should not ring after anchor until the window begins. + !----------------------------------------------------------------------- + case(3) + call advance_clock_n_times(f%clock, f%steps_to_anchor + 2*f%num_steps_per_interval) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing after anchor, before window', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 4: At window start (C) + ! Alarm should ring exactly at the start of the window. + !----------------------------------------------------------------------- + case(4) + call advance_clock_n_times(f%clock, f%steps_to_window_start) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing at start of window', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 5: At window start (C) after reset + ! Reset should prevent ringing immediately at window start. + !----------------------------------------------------------------------- + case(5) + call advance_clock_n_times(f%clock, f%steps_to_window_start) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing at start of window after reset', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 6: Middle of window (C -> D) + ! Alarm should ring inside the window. + !----------------------------------------------------------------------- + case(6) + call advance_clock_n_times(f%clock, f%steps_to_window_midpoint) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing in middle of window', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 7: Middle of window after reset at window start + ! Alarm should ring again after being reset at C. + !----------------------------------------------------------------------- + case(7) + call advance_clock_n_times(f%clock, f%steps_to_window_start) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + call advance_clock_n_times(f%clock, f%num_steps_window/2) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing in middle of window after reset', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 8: Middle of window after reset inside window + ! Reset prevents alarm from ringing again immediately inside window. + !----------------------------------------------------------------------- + case(8) + call advance_clock_n_times(f%clock, f%steps_to_window_midpoint) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing in middle of window after reset', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 9: At window end (D) + ! Alarm should ring at the end of the window. + !----------------------------------------------------------------------- + case(9) + call advance_clock_n_times(f%clock, f%steps_to_window_end) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing at end of window', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 10: At window end (D) after reset + ! Reset should suppress ringing at window end. + !----------------------------------------------------------------------- + case(10) + call advance_clock_n_times(f%clock, f%steps_to_window_end) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing at end of window after reset', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 11: After leaving window (D -> E) before reset outside of window + ! Alarm should ring once more just after window ends. + !----------------------------------------------------------------------- + case(11) + call advance_clock_n_times(f%clock, f%steps_to_window_midpoint) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + call advance_clock_n_times(f%clock, f%num_steps_window/2 + f%num_steps_post_window/2) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing after window', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 12: After leaving window (D -> E) after reset outside of window + ! Alarm should not ring after reset outside window. + !----------------------------------------------------------------------- + case(12) + call advance_clock_n_times(f%clock, f%steps_to_window_end + f%num_steps_post_window/2) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing after window after reset', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 13: Anchor after window start (B > C) + ! Ensures alarm does not ring before a delayed anchor, even inside window. + !----------------------------------------------------------------------- + case(13) + call mpas_remove_clock_alarm(f%clock, f%alarm_id) + call mpas_set_time(f%alarm_time, YYYY=2000, MM=01, DD=01, H=9, M=0, S=0, S_n=0, S_d=0) + call mpas_add_clock_alarm(f%clock, f%alarm_id, f%alarm_time, & + alarmTimeInterval = f%alarm_interval, & + alarmStartTime = f%window_start_time, & + alarmStopTime = f%window_stop_time) + call advance_clock_n_times(f%clock, f%steps_to_window_start) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing before anchor (after window start)', local_ierr) + ierr = ierr + local_ierr + + call advance_clock_n_times(f%clock, 2*f%num_steps_per_interval) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing after anchor (after window start)', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 14: Clock direction change inside window (forward -> backward) + ! Alarm should still ring in window after direction change. + !----------------------------------------------------------------------- + case(14) + call advance_clock_n_times(f%clock, f%steps_to_window_midpoint) + call mpas_set_clock_direction(f%clock, MPAS_BACKWARD) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing in window after direction change', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 15: Re-entering window boundary after direction change + ! Alarm should ring again at boundary after leaving and re-entering. + !----------------------------------------------------------------------- + case(15) + call advance_clock_n_times(f%clock, f%steps_to_window_end) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + call advance_clock_n_times(f%clock, f%num_steps_post_window/2) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing after leaving window before re-entering', local_ierr) + ierr = ierr + local_ierr + + call mpas_set_clock_direction(f%clock, MPAS_BACKWARD) + call advance_clock_n_times(f%clock, f%num_steps_post_window/2) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, 'Alarm is not ringing at boundary after re-entering', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 16: Reset at window start and reverse direction to exit window + !> Alarm should not ring when moving backward out of the window after + !> being reset at the window start. + !----------------------------------------------------------------------- + case(16) + call advance_clock_n_times(f%clock, f%steps_to_window_midpoint) + call mpas_set_clock_direction(f%clock, MPAS_BACKWARD) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + call advance_clock_n_times(f%clock, f%num_steps_window / 2) + call mpas_reset_clock_alarm(f%clock, f%alarm_id) + call advance_clock_n_times(f%clock, f%steps_to_window_start / 2) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm rang after reset when moving backward out of window', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 17: Outside window after direction change (D -> E -> backward) + ! Alarm should not ring outside window when clock direction flips. + !----------------------------------------------------------------------- + case(17) + call advance_clock_n_times(f%clock, f%steps_to_window_end + f%num_steps_post_window/2) + call mpas_set_clock_direction(f%clock, MPAS_BACKWARD) + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_false(ringing, 'Alarm is ringing outside of window after direction change', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 18: Invalid window ordering test + !> + !> This test verifies that mpas_add_clock_alarm correctly handles + !> window time validation: + !> 1. It must reject alarms where the start time occurs after the stop time. + !> 2. It must allow alarms where the start time equals the stop time. + !----------------------------------------------------------------------- + case(18) + ! Start time after stop time rejected + call mpas_remove_clock_alarm(f%clock, f%alarm_id) + call mpas_add_clock_alarm(f%clock, f%alarm_id, f%alarm_time, & + alarmTimeInterval = f%alarm_interval, & + alarmStartTime = f%window_stop_time, & + alarmStopTime = f%window_start_time, ierr=local_ierr) + call assert_true(local_ierr /= 0, 'Alarm with start time after stop time did not return error', local_ierr) + ierr = ierr + local_ierr + + call mpas_remove_clock_alarm(f%clock, f%alarm_id) + call mpas_add_clock_alarm(f%clock, f%alarm_id, f%alarm_time, & + alarmTimeInterval = f%alarm_interval, & + alarmStartTime = f%window_start_time, & + alarmStopTime = f%window_start_time, ierr=local_ierr) + call assert_false(local_ierr /= 0, 'Alarm with equal start/stop times incorrectly returned error', local_ierr) + ierr = ierr + local_ierr + + !----------------------------------------------------------------------- + ! Case 19: Alarm starting before clock start test + !> + !> This test verifies that mpas_add_clock_alarm allows alarms whose + !> active window begins before the clock start time: + !> 1. It must not return an error when the activeStartTime occurs + !> before the clock start time. + !> 2. The alarm should ring immediately when the clock begins, + !> since its anchor time equals the clock start time. + !----------------------------------------------------------------------- + case(19) + call mpas_remove_clock_alarm(f%clock, f%alarm_id) + + ! Set the alarm anchor time equal to the clock start time so it can ring immediately + f%alarm_time = f%clock_start_time + + ! Add an alarm whose active window begins before the clock start time + call mpas_add_clock_alarm(f%clock, f%alarm_id, f%alarm_time, & + alarmTimeInterval = f%alarm_interval, & + alarmStartTime = f%clock_start_time - mul_ti_n(f%alarm_interval, 4), & + alarmStopTime = f%window_stop_time, ierr=local_ierr) + + ! Verify that adding the alarm does not return an error + call assert_false(local_ierr /= 0, & + 'Alarm with start time before clock start time incorrectly returned error', local_ierr) + + ! Check whether the alarm rings immediately at clock start + ringing = mpas_is_alarm_ringing(f%clock, f%alarm_id) + call assert_true(ringing, & + 'Alarm is not ringing inside window with start time before clock start', local_ierr) + ierr = ierr + local_ierr + + end select + + call teardown_alarm_fixture(f) + end subroutine test_window_alarm + + + !----------------------------------------------------------------------- + ! function mpas_window_alarm_tests + ! + !> \brief Run all unit tests for windowed alarm ringing behavior. + !> \author Andy Stokely + !> \date 10/02/2025 + !> \details This driver function executes the suite of test cases + !> implemented in test_window_alarm, aggregating any errors encountered. + !----------------------------------------------------------------------- + integer function mpas_window_alarm_tests() result(ierr) + + integer :: i, ierr_local + + ierr = 0 + call mpas_log_write('Running 19 window alarm tests') + do i = 1, 19 + ierr_local = 0 + call test_window_alarm(i, ierr_local) + ierr = ierr + ierr_local + end do + end function mpas_window_alarm_tests + + + !----------------------------------------------------------------------- ! ! routine test_core_test_intervals ! @@ -252,7 +840,7 @@ subroutine mpas_adjust_alarm_tests(domain, ierr) call mpas_set_time(test_alarmTime, YYYY=2000, MM=01, DD=01, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) call mpas_set_timeInterval(test_alarmTimeInterval, dt=86400.0_RKIND, ierr=ierr_local) - call mpas_add_clock_alarm(test_clock, 'foobar', test_alarmTime, test_alarmTimeInterval, ierr_local) + call mpas_add_clock_alarm(test_clock, 'foobar', test_alarmTime, test_alarmTimeInterval, ierr=ierr_local) #ifdef MPAS_ADVANCE_TEST_CLOCK do istep = 1, 24*365 @@ -461,4 +1049,5 @@ subroutine mpas_adjust_alarm_tests(domain, ierr) end subroutine mpas_adjust_alarm_tests + end module test_core_timekeeping_tests diff --git a/src/framework/mpas_timekeeping.F b/src/framework/mpas_timekeeping.F index 659d9bb4f4..e1d1132629 100644 --- a/src/framework/mpas_timekeeping.F +++ b/src/framework/mpas_timekeeping.F @@ -486,8 +486,8 @@ type (MPAS_Time_type) function mpas_get_clock_time(clock, whichTime, ierr) end function mpas_get_clock_time - subroutine mpas_add_clock_alarm(clock, alarmID, alarmTime, alarmTimeInterval, ierr) -! TODO: possibly add a stop time for recurring alarms + subroutine mpas_add_clock_alarm(clock, alarmID, alarmTime, alarmTimeInterval, & + alarmStartTime, alarmStopTime, ierr) implicit none @@ -495,11 +495,15 @@ subroutine mpas_add_clock_alarm(clock, alarmID, alarmTime, alarmTimeInterval, ie character (len=*), intent(in) :: alarmID type (MPAS_Time_type), intent(in) :: alarmTime type (MPAS_TimeInterval_type), intent(in), optional :: alarmTimeInterval - integer, intent(out), optional :: ierr + type (MPAS_Time_type), intent(in), optional :: alarmStartTime + type (MPAS_Time_type), intent(in), optional :: alarmStopTime + integer, intent(out), optional :: ierr type (MPAS_Alarm_type), pointer :: alarmPtr integer :: threadNum + if (present(ierr)) ierr = ESMF_SUCCESS + threadNum = mpas_threading_get_thread_num() if ( len_trim(alarmID) > ShortStrKIND ) then @@ -541,7 +545,21 @@ subroutine mpas_add_clock_alarm(clock, alarmID, alarmTime, alarmTimeInterval, ie alarmPtr % isSet = .true. alarmPtr % ringTime = alarmTime - + if (present(alarmStartTime)) then + alarmPtr % activeStartTime = alarmStartTime + else + alarmPtr % activeStartTime = mpas_get_clock_time(clock, MPAS_START_TIME) + end if + if (present(alarmStopTime)) then + alarmPtr % activeStopTime = alarmStopTime + else + alarmPtr % activeStopTime = mpas_get_clock_time(clock, MPAS_STOP_TIME) + end if + if (alarmPtr % activeStartTime > alarmPtr % activeStopTime) then + call mpas_log_write('Invalid alarm times: start > stop for ' // trim(alarmID), MPAS_LOG_ERR) + if (present(ierr)) ierr = 1 + end if + if (present(alarmTimeInterval)) then alarmPtr % isRecurring = .true. @@ -555,9 +573,6 @@ subroutine mpas_add_clock_alarm(clock, alarmID, alarmTime, alarmTimeInterval, ie alarmPtr % isRecurring = .false. alarmPtr % prevRingTime = alarmTime end if - if (present(ierr)) then - if (ierr == ESMF_SUCCESS) ierr = 0 - end if end if !$omp barrier @@ -810,6 +825,56 @@ subroutine mpas_print_alarm(clock, alarmID, ierr) end subroutine mpas_print_alarm + !----------------------------------------------------------------------- + ! function mpas_is_alarm_active + ! + !> \brief Determine if an alarm is currently active. + !> \author Andy Stokely + !> \date 10/01/2025 + !> \details This function checks whether the provided time falls + !> within the active start and stop times of the given alarm. If so, + !> it returns `.true.`. + !----------------------------------------------------------------------- + logical function mpas_is_alarm_active(alarm, time) + + implicit none + + type(MPAS_Alarm_type), pointer :: alarm + type(MPAS_Time_type), intent(in) :: time + + mpas_is_alarm_active = (alarm % activeStartTime <= time & + .and. time <= alarm % activeStopTime) + + end function mpas_is_alarm_active + + + !----------------------------------------------------------------------- + ! function mpas_prev_ring_in_window + ! + !> \brief Check if the alarm’s previous ring was inside its window. + !> \author Andy Stokely + !> \date 10/01/2025 + !> \details This function tests whether the alarm’s `prevRingTime` + !> occurred strictly within the defined start and stop times of the + !> alarm’s active window. The check uses an open interval: + !> + !> (start, stop) + !> + !> The boundaries themselves are excluded. If the previous ring time + !> lies inside this open interval, the function returns `.true.`. + !----------------------------------------------------------------------- + logical function mpas_prev_ring_in_window(alarm) + + implicit none + + type(MPAS_Alarm_type), pointer :: alarm + + mpas_prev_ring_in_window = (alarm % activeStartTime < alarm % prevRingTime & + .and. alarm % prevRingTime < alarm % activeStopTime) + + end function mpas_prev_ring_in_window + + logical function mpas_is_alarm_ringing(clock, alarmID, interval, ierr) implicit none @@ -824,7 +889,6 @@ logical function mpas_is_alarm_ringing(clock, alarmID, interval, ierr) if (present(ierr)) ierr = 0 mpas_is_alarm_ringing = .false. - alarmPtr => clock % alarmListHead do while (associated(alarmPtr)) if (trim(alarmPtr % alarmID) == trim(alarmID)) then @@ -882,10 +946,12 @@ logical function mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr) integer, intent(out), optional :: ierr type (MPAS_Time_type) :: alarmNow + type (MPAS_Time_type) :: currentTime type (MPAS_Time_type) :: alarmThreshold - alarmNow = mpas_get_clock_time(clock, MPAS_NOW, ierr) - alarmThreshold = alarmPtr % ringTime + currentTime = mpas_get_clock_time(clock, MPAS_NOW, ierr) + alarmNow = currentTime + alarmThreshold = alarmPtr % ringTime mpas_in_ringing_envelope = .false. @@ -900,7 +966,10 @@ logical function mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr) end if if (alarmThreshold <= alarmNow) then - mpas_in_ringing_envelope = .true. + if (mpas_is_alarm_active(alarmPtr, currentTime) & + .or. mpas_prev_ring_in_window(alarmPtr)) then + mpas_in_ringing_envelope = .true. + end if end if else @@ -913,7 +982,10 @@ logical function mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr) end if if (alarmThreshold >= alarmNow) then - mpas_in_ringing_envelope = .true. + if (mpas_is_alarm_active(alarmPtr, currentTime) & + .or. mpas_prev_ring_in_window(alarmPtr)) then + mpas_in_ringing_envelope = .true. + end if end if end if diff --git a/src/framework/mpas_timekeeping_types.inc b/src/framework/mpas_timekeeping_types.inc index bcabf595fc..3b9405f530 100644 --- a/src/framework/mpas_timekeeping_types.inc +++ b/src/framework/mpas_timekeeping_types.inc @@ -25,6 +25,8 @@ logical :: isSet type (MPAS_Time_type) :: ringTime type (MPAS_Time_type) :: prevRingTime + type (MPAS_Time_type) :: activeStartTime + type (MPAS_Time_type) :: activeStopTime type (MPAS_TimeInterval_type) :: ringTimeInterval type (MPAS_Alarm_type), pointer :: next => null() end type