Loading [MathJax]/extensions/tex2jax.js
Neko 0.9.99
A portable framework for high-order spectral element flow simulations
All Classes Namespaces Files Functions Variables Typedefs Enumerator Macros Pages
fluid_stats_simcomp.f90
Go to the documentation of this file.
1! Copyright (c) 2024, 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!
33!
36 use num_types, only : rp, dp, sp
37 use json_module, only : json_file
40 use field, only : field_t
41 use fluid_stats, only: fluid_stats_t
43 use case, only : case_t
44 use coefs, only : coef_t
45 use comm
47 use logger, only : log_size, neko_log
49 implicit none
50 private
51
66 type(fluid_stats_output_t) :: stats_output
68 real(kind=rp) :: start_time
69 real(kind=rp) :: time
70 contains
72 procedure, pass(this) :: init => fluid_stats_simcomp_init_from_json
74 procedure, pass(this) :: init_from_attributes => &
77 procedure, pass(this) :: free => fluid_stats_simcomp_free
79 procedure, pass(this) :: compute_ => fluid_stats_simcomp_compute
81 procedure, pass(this) :: output_ => fluid_stats_simcomp_compute
83 procedure, pass(this) :: restart_ => fluid_stats_simcomp_restart
85
86contains
87
91 subroutine fluid_stats_simcomp_init_from_json(this, json, case)
92 class(fluid_stats_simcomp_t), intent(inout) :: this
93 type(json_file), intent(inout) :: json
94 class(case_t), intent(inout), target :: case
95 character(len=:), allocatable :: filename
96 character(len=:), allocatable :: precision
97 character(len=20), allocatable :: fields(:)
98 character(len=:), allocatable :: hom_dir
99 character(len=:), allocatable :: stat_set
100 real(kind=rp) :: start_time
101 type(field_t), pointer :: u, v, w, p
102 type(coef_t), pointer :: coef
103
104 call this%init_base(json, case)
105 call json_get_or_default(json, 'avg_direction', &
106 hom_dir, 'none')
107 call json_get_or_default(json, 'start_time', &
108 start_time, 0.0_rp)
109 call json_get_or_default(json, 'set_of_stats', &
110 stat_set, 'full')
111
112 u => neko_field_registry%get_field("u")
113 v => neko_field_registry%get_field("v")
114 w => neko_field_registry%get_field("w")
115 p => neko_field_registry%get_field("p")
116 coef => case%fluid%c_Xh
117 call fluid_stats_simcomp_init_from_attributes(this, u, v, w, p, coef, &
118 start_time, hom_dir, stat_set)
119
121
130 subroutine fluid_stats_simcomp_init_from_attributes(this, u, v, w, p, coef, &
131 start_time, hom_dir, stat_set)
132 class(fluid_stats_simcomp_t), intent(inout) :: this
133 character(len=*), intent(in) :: hom_dir
134 character(len=*), intent(in) :: stat_set
135 real(kind=rp), intent(in) :: start_time
136 type(field_t), intent(inout) :: u, v, w, p
137 type(coef_t), intent(in) :: coef
138 character(len=LOG_SIZE) :: log_buf
139 character(len=NEKO_FNAME_LEN) :: fname
140 character(len=5) :: prefix
141
142 call neko_log%section('Fluid stats')
143 write(log_buf, '(A,E15.7)') 'Start time: ', start_time
144 call neko_log%message(log_buf)
145 write(log_buf, '(A,A)') 'Set of statistics: ', trim(stat_set)
146 call neko_log%message(log_buf)
147 write(log_buf, '(A,A)') 'Averaging in direction: ', trim(hom_dir)
148 call neko_log%message(log_buf)
149
150
151 call this%stats%init(coef, u, v, w, p, stat_set)
152
153 this%start_time = start_time
154 this%time = start_time
155 fname = "fluid_stats0"
156 call this%stats_output%init(this%stats, this%start_time, &
157 hom_dir = hom_dir,name = fname,path = this%case%output_directory)
158
159 call this%case%output_controller%add(this%stats_output, &
160 this%output_controller%control_value, &
161 this%output_controller%control_mode)
162
163 call neko_log%end_section()
164
166
169 class(fluid_stats_simcomp_t), intent(inout) :: this
170 call this%free_base()
171 call this%stats%free()
172 end subroutine fluid_stats_simcomp_free
173
174 subroutine fluid_stats_simcomp_restart(this, t)
175 class(fluid_stats_simcomp_t), intent(inout) :: this
176 real(kind=rp), intent(in) :: t
177 character(len=NEKO_FNAME_LEN) :: fname
178 character(len=5) :: prefix,suffix
179 integer :: last_slash_pos
180 if (t .gt. this%time) this%time = t
181
182 write (prefix, '(I5)') this%stats_output%file_%get_counter()
183 call filename_suffix(this%stats_output%file_%file_type%fname,suffix)
184 last_slash_pos = filename_tslash_pos(this%stats_output%file_%file_type%fname)
185 if (last_slash_pos .ne. 0) then
186 fname = trim(this%stats_output%file_%file_type%fname(1:last_slash_pos))// &
187 "fluid_stats"//trim(adjustl(prefix))//"."//suffix
188 else
189 fname = "fluid_stats"// &
190 trim(adjustl(prefix))//"."//suffix
191 end if
192 call this%stats_output%init_base(fname)
193 end subroutine fluid_stats_simcomp_restart
194
198 subroutine fluid_stats_simcomp_compute(this, t, tstep)
199 class(fluid_stats_simcomp_t), intent(inout) :: this
200 real(kind=rp), intent(in) :: t
201 integer, intent(in) :: tstep
202 real(kind=rp) :: delta_t
203 real(kind=rp) :: sample_start_time, sample_time
204 character(len=LOG_SIZE) :: log_buf
205 integer :: ierr
206
207 if (t .ge. this%start_time) then
208 delta_t = t - this%time
209
210 call mpi_barrier(neko_comm, ierr)
211
212 sample_start_time = mpi_wtime()
213
214 call this%stats%update(delta_t)
215 call mpi_barrier(neko_comm, ierr)
216 this%time = t
217
218 sample_time = mpi_wtime() - sample_start_time
219
220 call neko_log%section('Fluid stats')
221 write(log_buf, '(A,E15.7)') 'Sampling at time:', t
222 call neko_log%message(log_buf)
223 write(log_buf, '(A33,E15.7)') 'Simulationtime since last sample:', &
224 delta_t
225 call neko_log%message(log_buf)
226 write(log_buf, '(A,E15.7)') 'Sampling time (s):', sample_time
227 call neko_log%message(log_buf)
228 call neko_log%end_section()
229 end if
230
231 end subroutine fluid_stats_simcomp_compute
232
233end module fluid_stats_simcomp
Retrieves a parameter by name or assigns a provided default value. In the latter case also adds the m...
Retrieves a parameter by name or throws an error.
Defines a simulation case.
Definition case.f90:34
Coefficients.
Definition coef.f90:34
Definition comm.F90:1
type(mpi_comm) neko_comm
MPI communicator.
Definition comm.F90:38
Defines a registry for storing solution fields.
type(field_registry_t), target, public neko_field_registry
Global field registry.
Defines a field.
Definition field.f90:34
Implements fluid_stats_ouput_t.
Implements the fluid_stats_simcomp_t type.
subroutine fluid_stats_simcomp_compute(this, t, tstep)
fluid_stats, called depending on compute_control and compute_value
subroutine fluid_stats_simcomp_free(this)
Destructor.
subroutine fluid_stats_simcomp_init_from_json(this, json, case)
Constructor from json.
subroutine fluid_stats_simcomp_init_from_attributes(this, u, v, w, p, coef, start_time, hom_dir, stat_set)
Actual constructor.
subroutine fluid_stats_simcomp_restart(this, t)
Computes various statistics for the fluid fields. We use the Reynolds decomposition for a field u = ...
Utilities for retrieving parameters from the case files.
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 sp
Definition num_types.f90:8
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Simulation components are objects that encapsulate functionality that can be fit to a particular comp...
subroutine compute_(this, t, tstep)
Dummy compute function.
subroutine restart_(this, t)
Dummy restart function.
Defines a container for all statistics.
Utilities.
Definition utils.f90:35
integer, parameter, public neko_fname_len
Definition utils.f90:40
subroutine, public filename_suffix(fname, suffix)
Extract a filename's suffix.
Definition utils.f90:70
pure integer function, public filename_tslash_pos(fname)
Find position (in the string) of a filename's trailing slash.
Definition utils.f90:63
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition coef.f90:55
Defines an output for the fluid statistics computed using the fluid_stats_t object.
A simulation component that computes the velocity and pressure statistics up to 4th order....
Base abstract class for simulation components.