37 use json_module,
only : json_file
45 logical :: if_variable_dt
46 real(kind=
rp) :: set_cfl
47 real(kind=
rp) :: max_dt
48 integer :: max_update_frequency
49 integer :: dt_last_change
50 real(kind=
rp) :: alpha
51 real(kind=
rp) :: max_dt_increase_factor, min_dt_decrease_factor
66 type(json_file),
intent(inout) :: params
68 this%dt_last_change = 0
70 this%if_variable_dt, .false.)
74 this%max_dt, huge(0.0_rp))
76 this%max_update_frequency, 0)
80 this%max_dt_increase_factor, 1.2_rp)
82 this%min_dt_decrease_factor, 0.5_rp)
97 real(kind=
rp),
intent(inout) :: dt
98 real(kind=
rp),
intent(in) :: cfl
99 real(kind=
rp),
intent(inout) :: cfl_avrg
100 real(kind=
rp) :: dt_old, scaling_factor
101 character(len=LOG_SIZE) :: log_buf
102 integer,
intent(in):: tstep
104 if (this%if_variable_dt .eqv. .true.)
then
105 if (tstep .eq. 1)
then
107 dt = min(this%set_cfl/cfl*dt, this%max_dt)
110 cfl_avrg = this%alpha * cfl + (1-this%alpha) * cfl_avrg
112 if (abs(cfl_avrg - this%set_cfl) .ge. 0.2*this%set_cfl .and. &
113 this%dt_last_change .ge. this%max_update_frequency)
then
115 if (this%set_cfl/cfl .ge. 1)
then
117 scaling_factor = min(this%max_dt_increase_factor, this%set_cfl/cfl)
120 scaling_factor =
max(this%min_dt_decrease_factor, this%set_cfl/cfl)
124 dt = scaling_factor * dt_old
125 dt = min(dt, this%max_dt)
127 write(log_buf,
'(A,E15.7,1x,A,E15.7)')
'Avrg CFL:', cfl_avrg, &
128 'set_cfl:', this%set_cfl
131 write(log_buf,
'(A,E15.7,1x,A,E15.7)')
'old dt:', dt_old, &
135 this%dt_last_change = 0
138 this%dt_last_change = this%dt_last_change + 1
Retrieves a parameter by name or assigns a provided default value. In the latter case also adds the m...
Utilities for retrieving parameters from the case files.
type(log_t), public neko_log
Global log stream.
integer, parameter, public log_size
integer, parameter, public rp
Global precision used in computations.
Implements type time_step_controller.
subroutine time_step_controller_init(this, params)
Constructor.
subroutine time_step_controller_set_dt(this, dt, cfl, cfl_avrg, tstep)
Set new dt based on cfl if requested.
Provides a tool to set time step dt.