diff --git a/autotest/TestTimeSelect.f90 b/autotest/TestTimeSelect.f90 index bf00c988d52..d9cec57d7d0 100644 --- a/autotest/TestTimeSelect.f90 +++ b/autotest/TestTimeSelect.f90 @@ -12,12 +12,12 @@ module TestTimeSelect subroutine collect_timeselect(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("is_increasing", test_is_increasing), & - new_unittest("slice", test_slice) & + new_unittest("increasing", test_increasing), & + new_unittest("select", test_select) & ] end subroutine collect_timeselect - subroutine test_is_increasing(error) + subroutine test_increasing(error) type(error_type), allocatable, intent(out) :: error type(TimeSelectType) :: ts @@ -25,18 +25,18 @@ subroutine test_is_increasing(error) ! increasing ts%times = (/0.0_DP, 1.0_DP, 2.0_DP/) - call check(error, ts%is_increasing()) + call check(error, ts%increasing()) ! not decreasing ts%times = (/0.0_DP, 0.0_DP, 2.0_DP/) - call check(error,.not. ts%is_increasing()) + call check(error,.not. ts%increasing()) ! decreasing ts%times = (/2.0_DP, 1.0_DP, 0.0_DP/) - call check(error,.not. ts%is_increasing()) - end subroutine + call check(error,.not. ts%increasing()) + end subroutine test_increasing - subroutine test_slice(error) + subroutine test_select(error) type(error_type), allocatable, intent(out) :: error type(TimeSelectType) :: ts logical(LGP) :: changed @@ -49,63 +49,63 @@ subroutine test_slice(error) "expected size 3, got"//to_string(size(ts%times))) ! empty slice - call ts%set_slice(1.1_DP, 1.9_DP) + call ts%select(1.1_DP, 1.9_DP) call check( & error, & - ts%slice(1) == -1 .and. ts%slice(2) == -1, & + ts%selection(1) == -1 .and. ts%selection(2) == -1, & "empty slice failed, got ["// & - to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") ! single-item slice - call ts%set_slice(0.5_DP, 1.5_DP) + call ts%select(0.5_DP, 1.5_DP) call check( & error, & - ts%slice(1) == 2 .and. ts%slice(2) == 2, & + ts%selection(1) == 2 .and. ts%selection(2) == 2, & "1-item slice failed, got ["// & - to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") ! multi-item slice changed = .false. - call ts%set_slice(0.5_DP, 2.5_DP, changed=changed) + call ts%select(0.5_DP, 2.5_DP, changed=changed) call check(error, changed) call check( & error, & - ts%slice(1) == 2 .and. ts%slice(2) == 3, & + ts%selection(1) == 2 .and. ts%selection(2) == 3, & "2-item slice failed, got ["// & - to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") ! no-change - call ts%set_slice(0.1_DP, 2.5_DP, changed=changed) + call ts%select(0.1_DP, 2.5_DP, changed=changed) call check(error,.not. changed) call check( & error, & - ts%slice(1) == 2 .and. ts%slice(2) == 3, & + ts%selection(1) == 2 .and. ts%selection(2) == 3, & "2-item slice failed, got ["// & - to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") ! lower bound equal to a time value - call ts%set_slice(0.0_DP, 2.5_DP) + call ts%select(0.0_DP, 2.5_DP) call check( & error, & - ts%slice(1) == 1 .and. ts%slice(2) == 3, & + ts%selection(1) == 1 .and. ts%selection(2) == 3, & "lb eq slice failed, got [" & - //to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + //to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") ! upper bound equal to a time value - call ts%set_slice(-0.5_DP, 2.0_DP) + call ts%select(-0.5_DP, 2.0_DP) call check( & error, & - ts%slice(1) == 1 .and. ts%slice(2) == 3, & + ts%selection(1) == 1 .and. ts%selection(2) == 3, & "ub eq slice failed, got [" & - //to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + //to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") ! both bounds equal to a time value - call ts%set_slice(0.0_DP, 2.0_DP) + call ts%select(0.0_DP, 2.0_DP) call check( & error, & - ts%slice(1) == 1 .and. ts%slice(2) == 3, & + ts%selection(1) == 1 .and. ts%selection(2) == 3, & "lb ub eq slice failed, got [" & - //to_string(ts%slice(1))//","//to_string(ts%slice(2))//"]") + //to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") - end subroutine test_slice + end subroutine test_select end module TestTimeSelect diff --git a/src/Model/ModelUtilities/TimeSelect.f90 b/src/Model/ModelUtilities/TimeSelect.f90 index 1939933a221..3d8057b971b 100644 --- a/src/Model/ModelUtilities/TimeSelect.f90 +++ b/src/Model/ModelUtilities/TimeSelect.f90 @@ -10,20 +10,21 @@ module TimeSelectModule !> @brief Represents a series of instants at which some event should occur. !! - !! Supports slicing e.g. to filter times within a given period & time step. + !! Supports selection e.g. to filter times in a selected period & time step. !! Array storage can be expanded as needed. Note: array expansion must take - !! place before slicing; whenever expand() is invoked, the slice is cleared. - !! The series is assumed to strictly increase, is_increasing() checks this. + !! place before selection; when expand() is invoked the selection is cleared. + !! The time series is assumed to strictly increase, increasing() checks this. !< type :: TimeSelectType real(DP), allocatable :: times(:) - integer(I4B) :: slice(2) + integer(I4B) :: selection(2) contains procedure :: destroy procedure :: expand procedure :: init - procedure :: is_increasing - procedure :: set_slice + procedure :: increasing + procedure :: select + procedure :: try_advance end type TimeSelectType contains @@ -39,19 +40,19 @@ subroutine expand(this, increment) class(TimeSelectType) :: this integer(I4B), optional, intent(in) :: increment call ExpandArray(this%times, increment=increment) - this%slice = (/1, size(this%times)/) + this%selection = (/1, size(this%times)/) end subroutine expand !> @brief Initialize or clear the time selection object. subroutine init(this) class(TimeSelectType) :: this if (.not. allocated(this%times)) allocate (this%times(0)) - this%slice = (/0, 0/) + this%selection = (/0, 0/) end subroutine !> @brief Determine if times strictly increase. !! Returns true if empty or not yet allocated. - function is_increasing(this) result(inc) + function increasing(this) result(inc) class(TimeSelectType) :: this logical(LGP) :: inc integer(I4B) :: i @@ -69,17 +70,17 @@ function is_increasing(this) result(inc) end if l = t end do - end function is_increasing + end function increasing - !> @brief Slice the time selection between t0 and t1 (inclusive). + !> @brief Select times between t0 and t1 (inclusive). !! !! Finds and stores the index of the first time at the same instant !! as or following the start time, and of the last time at the same !! instant as or preceding the end time. Allows filtering the times !! for e.g. a particular stress period and time step. Array indices !! are assumed to start at 1. If no times are found to fall within - !! the slice (i.e. the slice falls entirely between two consecutive - !! times or beyond the min/max range), indices are set to [-1, -1]. + !! the selection (i.e. it falls entirely between two consecutive + !! times or beyond the time range), indices are set to [-1, -1]. !! !! The given start and end times are first checked against currently !! stored indices to avoid recalculating them if possible, allowing @@ -88,7 +89,7 @@ end function is_increasing !! through stress periods and time steps in lockstep, i.e. they all !! solve any given period/step before any will proceed to the next. !< - subroutine set_slice(this, t0, t1, changed) + subroutine select(this, t0, t1, changed) ! -- dummy class(TimeSelectType) :: this real(DP), intent(in) :: t0, t1 @@ -107,8 +108,8 @@ subroutine set_slice(this, t0, t1, changed) u = -1 ! -- previous bounding indices - lp = this%slice(1) - up = this%slice(2) + lp = this%selection(1) + up = this%selection(2) ! -- Check if we can reuse either the lower or upper bound. ! The lower doesn't need to change if it indexes the 1st @@ -131,7 +132,7 @@ subroutine set_slice(this, t0, t1, changed) end if end if if (l == lp .and. u == up) then - this%slice = (/l, u/) + this%selection = (/l, u/) if (present(changed)) changed = .false. return end if @@ -143,9 +144,24 @@ subroutine set_slice(this, t0, t1, changed) if (l < 0 .and. t >= t0 .and. t <= t1) l = i if (l > 0 .and. t <= t1) u = i end do - this%slice = (/l, u/) + this%selection = (/l, u/) if (present(changed)) changed = l /= lp .or. u /= up end subroutine + !> @brief Update the selection to match the current time step. + subroutine try_advance(this) + ! -- modules + use TdisModule, only: kper, kstp, nper, nstp, totimc, delt + ! -- dummy + class(TimeSelectType) :: this + ! -- local + real(DP) :: l, u + l = minval(this%times) + u = maxval(this%times) + if (.not. (kper == 1 .and. kstp == 1)) l = totimc + if (.not. (kper == nper .and. kstp == nstp(kper))) u = totimc + delt + call this%select(l, u) + end subroutine try_advance + end module TimeSelectModule