Neko  0.9.0
A portable framework for high-order spectral element flow simulations
output_controller.f90
Go to the documentation of this file.
1 ! Copyright (c) 2020-2023, The Neko Authors
2 ! All rights reserved.
3 !
4 ! Redistribution and use in source and binary forms, with or without
5 ! modification, are permitted provided that the following conditions
6 ! are met:
7 !
8 ! * Redistributions of source code must retain the above copyright
9 ! notice, this list of conditions and the following disclaimer.
10 !
11 ! * Redistributions in binary form must reproduce the above
12 ! copyright notice, this list of conditions and the following
13 ! disclaimer in the documentation and/or other materials provided
14 ! with the distribution.
15 !
16 ! * Neither the name of the authors nor the names of its
17 ! contributors may be used to endorse or promote products derived
18 ! from this software without specific prior written permission.
19 !
20 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 ! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 ! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 ! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 ! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 ! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 ! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 ! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 ! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 ! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 ! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 ! POSSIBILITY OF SUCH DAMAGE.
32 !
35  use output, only: output_t, output_ptr_t
36  use fld_file, only: fld_file_t
37  use comm
38  use logger, only : neko_log, log_size
39  use utils, only : neko_error
41  use num_types, only : rp, dp
43  implicit none
44  private
45 
46 
51  type, public :: output_controller_t
53  type(output_ptr_t), allocatable :: output_list(:)
55  type(time_based_controller_t), allocatable :: controllers(:)
57  integer :: n
59  integer :: size
61  real(kind=rp) :: time_end
62  contains
64  procedure, pass(this) :: init => output_controller_init
66  procedure, pass(this) :: free => output_controller_free
68  procedure, pass(this) :: add => output_controller_add
70  procedure, pass(this) :: execute => output_controller_execute
72  procedure, pass(this) :: set_counter => output_controller_set_counter
73  end type output_controller_t
74 
75 contains
76 
81  subroutine output_controller_init(this, time_end, size)
82  class(output_controller_t), intent(inout) :: this
83  integer, intent(in), optional :: size
84  real(kind=rp), intent(in) :: time_end
85  character(len=LOG_SIZE) :: log_buf
86  integer :: n, i
87 
88  call this%free()
89 
90  if (present(size)) then
91  n = size
92  else
93  n = 1
94  end if
95 
96  allocate(this%output_list(n))
97  allocate(this%controllers(n))
98 
99  do i = 1, n
100  this%output_list(i)%ptr => null()
101  end do
102 
103  this%size = n
104  this%n = 0
105  this%time_end = time_end
106 
107  end subroutine output_controller_init
108 
110  subroutine output_controller_free(this)
111  class(output_controller_t), intent(inout) :: this
112 
113  if (allocated(this%output_list)) then
114  deallocate(this%output_list)
115  end if
116  if (allocated(this%controllers)) then
117  deallocate(this%controllers)
118  end if
119 
120  this%n = 0
121  this%size = 0
122 
123  end subroutine output_controller_free
124 
131  subroutine output_controller_add(this, out, write_par, write_control)
132  class(output_controller_t), intent(inout) :: this
133  class(output_t), intent(inout), target :: out
134  real(kind=rp), intent(in) :: write_par
135  character(len=*), intent(in) :: write_control
136  type(output_ptr_t), allocatable :: tmp(:)
137  type(time_based_controller_t), allocatable :: tmp_ctrl(:)
138  character(len=LOG_SIZE) :: log_buf
139  integer :: n
140  class(*), pointer :: ft
141 
142  if (this%n .ge. this%size) then
143  allocate(tmp(this%size * 2))
144  tmp(1:this%size) = this%output_list
145  call move_alloc(tmp, this%output_list)
146 
147  allocate(tmp_ctrl(this%size * 2))
148  tmp_ctrl(1:this%size) = this%controllers
149  call move_alloc(tmp_ctrl, this%controllers)
150 
151  this%size = this%size * 2
152  end if
153 
154  this%n = this%n + 1
155  n = this%n
156  this%output_list(this%n)%ptr => out
157 
158  if (trim(write_control) .eq. "org") then
159  this%controllers(n) = this%controllers(1)
160  else
161  call this%controllers(n)%init(this%time_end, write_control, write_par)
162  end if
163 
164  ! The code below only prints to console
165  call neko_log%section('Adding write output')
166  call neko_log%message('File name : '// &
167  trim(this%output_list(this%n)%ptr%file_%file_type%fname))
168  call neko_log%message('Write control : '//trim(write_control))
169 
170  ! Show the output precision if we are outputting an fld file
171  select type (ft => out%file_%file_type)
172  type is (fld_file_t)
173  if (ft%dp_precision) then
174  call neko_log%message('Output precision : double')
175  else
176  call neko_log%message('Output precision : single')
177  end if
178  end select
179 
180  if (trim(write_control) .eq. 'simulationtime') then
181  write(log_buf, '(A,ES13.6)') 'Writes per time unit (Freq.): ', &
182  this%controllers(n)%frequency
183  call neko_log%message(log_buf)
184  write(log_buf, '(A,ES13.6)') 'Time between writes: ', &
185  this%controllers(n)%time_interval
186  call neko_log%message(log_buf)
187  else if (trim(write_control) .eq. 'nsamples') then
188  write(log_buf, '(A,I13)') 'Total samples: ', int(write_par)
189  call neko_log%message(log_buf)
190  write(log_buf, '(A,ES13.6)') 'Writes per time unit (Freq.): ', &
191  this%controllers(n)%frequency
192  call neko_log%message(log_buf)
193  write(log_buf, '(A,ES13.6)') 'Time between writes: ', &
194  this%controllers(n)%time_interval
195  call neko_log%message(log_buf)
196  else if (trim(write_control) .eq. 'tsteps') then
197  write(log_buf, '(A,I13)') 'Time step interval: ', int(write_par)
198  call neko_log%message(log_buf)
199  else if (trim(write_control) .eq. 'org') then
200  write(log_buf, '(A)') &
201  'Write control not set, defaulting to first output settings'
202  call neko_log%message(log_buf)
203  end if
204 
205  call neko_log%end_section()
206  end subroutine output_controller_add
207 
213  subroutine output_controller_execute(this, t, tstep, ifforce)
214  class(output_controller_t), intent(inout) :: this
215  real(kind=rp), intent(in) :: t
216  integer, intent(in) :: tstep
217  logical, intent(in), optional :: ifforce
218  real(kind=dp) :: sample_start_time, sample_end_time
219  real(kind=dp) :: sample_time
220  character(len=LOG_SIZE) :: log_buf
221  integer :: i, ierr
222  logical :: force, write_output, write_output_test
223 
224  if (present(ifforce)) then
225  force = ifforce
226  else
227  force = .false.
228  end if
229 
230  call profiler_start_region('Output controller', 22)
231  !Do we need this Barrier?
232  call mpi_barrier(neko_comm, ierr)
233  sample_start_time = mpi_wtime()
234 
235  write_output = .false.
236  ! Determine if at least one output needs to be written
237  ! We should not need this extra select block, and it works great
238  ! without it for GNU, Intel and NEC, but breaks horribly on Cray
239  ! (>11.0.x) when using high opt. levels.
240  select type (samp => this)
241  type is (output_controller_t)
242  do i = 1, samp%n
243  if (this%controllers(i)%check(t, tstep, force)) then
244  write_output = .true.
245  exit
246  end if
247  end do
248  end select
249 
250  if (write_output) then
251  call neko_log%section('Writer output ')
252  end if
253 
254  ! Loop through the outputs and write if necessary.
255  ! We should not need this extra select block, and it works great
256  ! without it for GNU, Intel and NEC, but breaks horribly on Cray
257  ! (>11.0.x) when using high opt. levels.
258  select type (samp => this)
259  type is (output_controller_t)
260  do i = 1, this%n
261  if (this%controllers(i)%check(t, tstep, force)) then
262  call neko_log%message('File name : '// &
263  trim(samp%output_list(i)%ptr%file_%file_type%fname))
264 
265  write(log_buf, '(A,I6)') 'Output number :', &
266  int(this%controllers(i)%nexecutions)
267  call neko_log%message(log_buf)
268 
269  call samp%output_list(i)%ptr%sample(t)
270 
271  call this%controllers(i)%register_execution()
272  end if
273  end do
274  class default
275  call neko_error('Invalid output_controller output list')
276  end select
277 
278  call mpi_barrier(neko_comm, ierr)
279  sample_end_time = mpi_wtime()
280 
281  sample_time = sample_end_time - sample_start_time
282  if (write_output) then
283  write(log_buf, '(A16,1x,F10.6,A,F9.6)') 'Writing at time:', t, &
284  ' Output time (s): ', sample_time
285  call neko_log%message(log_buf)
286  call neko_log%end_section()
287  end if
288  call profiler_end_region('Output controller', 22)
289  end subroutine output_controller_execute
290 
293  subroutine output_controller_set_counter(this, t)
294  class(output_controller_t), intent(inout) :: this
295  real(kind=rp), intent(in) :: t
296  integer :: i, nexecutions
297 
298 
299  do i = 1, this%n
300  if (this%controllers(i)%nsteps .eq. 0) then
301  nexecutions = int(t / this%controllers(i)%time_interval) + 1
302  this%controllers(i)%nexecutions = nexecutions
303 
304  call this%output_list(i)%ptr%set_counter(nexecutions)
305  call this%output_list(i)%ptr%set_start_counter(nexecutions)
306  end if
307  end do
308 
309  end subroutine output_controller_set_counter
310 
313  subroutine output_controller_set_write_count(this, counter)
314  class(output_controller_t), intent(inout) :: this
315  integer, intent(in) :: counter
316  integer :: i
317 
318  do i = 1, this%n
319  this%controllers(i)%nexecutions = counter
320  call this%output_list(i)%ptr%set_counter(counter)
321  call this%output_list(i)%ptr%set_start_counter(counter)
322  end do
323 
324  end subroutine output_controller_set_write_count
325 
326 
327 end module output_controller
Definition: comm.F90:1
type(mpi_comm) neko_comm
MPI communicator.
Definition: comm.F90:16
NEKTON fld file format.
Definition: fld_file.f90:35
Logging routines.
Definition: log.f90:34
type(log_t), public neko_log
Global log stream.
Definition: log.f90:65
integer, parameter, public log_size
Definition: log.f90:42
integer, parameter, public dp
Definition: num_types.f90:9
integer, parameter, public rp
Global precision used in computations.
Definition: num_types.f90:12
Implements output_controller_t
subroutine output_controller_free(this)
Destructor.
subroutine output_controller_add(this, out, write_par, write_control)
Add an output out to the controller.
subroutine output_controller_init(this, time_end, size)
Constructor.
subroutine output_controller_set_counter(this, t)
Set write counter based on time (after restart)
subroutine output_controller_execute(this, t, tstep, ifforce)
Query each of the controllers whether it is time to write, and if so, do so for the corresponding out...
subroutine output_controller_set_write_count(this, counter)
Set write counter (after restart) explicitly.
Defines an output.
Definition: output.f90:34
Profiling interface.
Definition: profiler.F90:34
subroutine, public profiler_start_region(name, region_id)
Started a named (name) profiler region.
Definition: profiler.F90:78
subroutine, public profiler_end_region(name, region_id)
End the most recently started profiler region.
Definition: profiler.F90:109
Contains the time_based_controller_t type.
Utilities.
Definition: utils.f90:35
Interface for NEKTON fld files.
Definition: fld_file.f90:64
Wrapper around an output_t pointer.
Definition: output.f90:51
Abstract type defining an output type.
Definition: output.f90:41
Centralized controller for a list of outputs.
A utility type for determening whether an action should be executed based on the current time value....