46 use json_module,
only : json_file
84 type(
field_t),
intent(inout) :: s
85 type(
coef_t),
intent(in) :: coef
86 type(
gs_t),
intent(inout) :: gs
87 character(len=*) :: type
88 type(json_file),
intent(inout) :: params
89 integer,
intent(in) :: i
92 real(kind=
rp) :: ic_value
93 character(len=:),
allocatable :: read_str
94 character(len=NEKO_FNAME_LEN) :: fname, mesh_fname
95 real(kind=
rp) :: zone_value, tol
96 logical :: interpolate
98 if (trim(type) .eq.
'uniform')
then
100 call json_get(params,
'value', ic_value)
103 else if (trim(type) .eq.
'point_zone')
then
105 call json_get(params,
'base_value', ic_value)
106 call json_get(params,
'zone_name', read_str)
107 call json_get(params,
'zone_value', zone_value)
111 else if (trim(type) .eq.
'field')
then
113 call json_get(params,
'file_name', read_str)
114 fname = trim(read_str)
120 mesh_fname = trim(read_str)
140 character(len=*),
intent(in) :: scheme_name
141 type(
field_t),
target,
intent(inout) :: s
142 type(
coef_t),
intent(in) :: coef
143 type(
gs_t),
intent(inout) :: gs
150 call fields%assign_to_field(1, s)
152 call user_proc(scheme_name, fields)
164 type(
field_t),
intent(inout) :: s
165 type(
coef_t),
intent(in) :: coef
166 type(
gs_t),
intent(inout) :: gs
175 call gs%op(s%x, n, gs_op_add)
180 call col2(s%x, coef%mult, n)
190 type(
field_t),
intent(inout) :: s
191 real(kind=
rp),
intent(in) :: ic_value
193 character(len=LOG_SIZE) :: log_buf
195 call neko_log%message(
"Type : uniform")
196 write (log_buf,
'(A,ES12.6)')
"Value: ", ic_value
202 call cfill(s%x, ic_value, n)
215 type(
field_t),
intent(inout) :: s
216 real(kind=
rp),
intent(in) :: base_value
217 character(len=*),
intent(in) :: zone_name
218 real(kind=
rp),
intent(in) :: zone_value
221 character(len=LOG_SIZE) :: log_buf
225 call neko_log%message(
"Type : point_zone")
226 write (log_buf,
'(A,ES12.6)')
"Base value: ", base_value
228 call neko_log%message(
"Zone name : " // trim(zone_name))
229 write (log_buf,
'(A,ES12.6)')
"Zone value: ", zone_value
236 call cfill_mask(s%x, zone_value,
size, zone%mask%get(), zone%size)
256 interpolate, tolerance, mesh_file_name, i)
257 type(
field_t),
intent(inout) :: s
258 character(len=*),
intent(in) :: file_name
259 logical,
intent(in) :: interpolate
260 real(kind=
rp),
intent(in) :: tolerance
261 character(len=*),
intent(inout) :: mesh_file_name
262 integer,
intent(in) :: i
264 character(len=LOG_SIZE) :: log_buf
265 integer :: sample_idx, sample_mesh_idx
266 integer :: last_index
269 logical :: mesh_mismatch
280 call neko_log%message(
"Type : field")
281 call neko_log%message(
"File name : " // trim(file_name))
282 write (log_buf,
'(A,L1)')
"Interpolation : ", interpolate
288 if (sample_idx .eq. -1)
then
289 call neko_error(
"Invalid file name for the initial condition. The " // &
290 "file format must be e.g. 'mean0.f00001'")
297 call f%init(trim(file_name))
299 if (interpolate)
then
302 if (mesh_file_name .eq.
"none")
then
303 mesh_file_name = trim(file_name)
304 sample_mesh_idx = sample_idx
310 if (sample_mesh_idx .eq. -1)
then
311 call neko_error(
"Invalid file name for the initial condition." // &
312 " The file format must be e.g. 'mean0.f00001'")
315 write (log_buf,
'(A,ES12.6)')
"Tolerance : ", tolerance
317 write (log_buf,
'(A,A)')
"Mesh file : ", &
324 if (sample_mesh_idx .ne. sample_idx)
then
325 call f%set_counter(sample_mesh_idx)
326 call f%read(fld_data)
332 call f%set_counter(sample_idx)
333 call f%read(fld_data)
341 mesh_mismatch = (fld_data%glb_nelv .ne. s%msh%glb_nelv .or. &
342 fld_data%gdim .ne. s%msh%gdim)
344 if (mesh_mismatch .and. .not. interpolate)
then
345 call neko_error(
"The fld file must match the current mesh! " // &
346 "Use 'interpolate': 'true' to enable interpolation.")
347 else if (.not. mesh_mismatch .and. interpolate)
then
348 call neko_log%warning(
"You have activated interpolation but you " // &
349 "might still be using the same mesh.")
354 if (interpolate)
then
356 select type (ft => f%file_type)
358 if (.not. ft%dp_precision)
then
359 call neko_warning(
"The coordinates read from the field file " // &
360 "are in single precision.")
361 call neko_log%message(
"It is recommended to use a mesh in " // &
362 "double precision for better interpolation results.")
363 call neko_log%message(
"If the interpolation does not work, " // &
364 "you can try to increase the tolerance.")
376 call fld_data%generate_interpolator(global_interp, s%dof, s%msh, &
383 call global_interp%evaluate(s%x, fld_data%s(i)%x, .false.)
385 call global_interp%evaluate(s%x, fld_data%t%x, .false.)
388 call global_interp%free
396 call prev_xh%init(
gll, fld_data%lx, fld_data%ly, fld_data%lz)
397 call space_interp%init(s%Xh, prev_xh)
402 call space_interp%map_host(s%x, fld_data%s(i)%x, fld_data%nelv, s%Xh)
404 call space_interp%map_host(s%x, fld_data%t%x, fld_data%nelv, s%Xh)
407 call space_interp%free
Copy data between host and device (or device and device)
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.
Abstract interface for user defined initial conditions.
subroutine, public device_col2(a_d, b_d, n, strm)
Vector multiplication .
Device abstraction, common interface for various accelerators.
integer, parameter, public host_to_device
integer, parameter, public device_to_host
Defines a registry for storing solution fields.
type(field_registry_t), target, public neko_field_registry
Global field registry.
Module for file I/O operations.
Simple module to handle fld file series. Provides an interface to the different fields sotred in a fl...
Implements global_interpolation given a dofmap.
Routines to interpolate between different spaces.
Utilities for retrieving parameters from the case files.
type(log_t), public neko_log
Global log stream.
integer, parameter, public log_size
subroutine, public cfill(a, c, n)
Set all elements to a constant c .
subroutine, public col2(a, b, n)
Vector multiplication .
subroutine, public cfill_mask(a, c, n, mask, n_mask)
Fill a constant to a masked vector. .
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
type(point_zone_registry_t), target, public neko_point_zone_registry
Global point_zone registry.
Scalar initial condition.
subroutine set_scalar_ic_uniform(s, ic_value)
Uniform initial condition.
subroutine set_scalar_ic_point_zone(s, base_value, zone_name, zone_value)
Point zone initial condition.
subroutine set_scalar_ic_common(s, coef, gs)
Set scalar initial condition (common)
subroutine set_scalar_ic_int(s, coef, gs, type, params, i)
Set scalar initial condition (builtin)
subroutine set_scalar_ic_fld(s, file_name, interpolate, tolerance, mesh_file_name, i)
Set the initial condition of the scalar based on a field. @detail The field is read from an fld file....
subroutine set_scalar_ic_usr(scheme_name, s, coef, gs, user_proc)
Set scalar intial condition (user defined)
Defines a function space.
integer, parameter, public gll
Interfaces for user interaction with NEKO.
integer function, public extract_fld_file_index(fld_filename, default_index)
Extracts the index of a field file. For example, "myfield.f00045" will return 45. If the suffix of th...
integer, parameter, public neko_fname_len
subroutine, public neko_warning(warning_msg)
Reports a warning to standard output.
subroutine, public filename_chsuffix(fname, new_fname, new_suffix)
Change a filename's suffix.
subroutine, public filename_suffix(fname, suffix)
Extract a filename's suffix.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
field_list_t, To be able to group fields together
A wrapper around a polymorphic generic_file_t that handles its init. This is essentially a factory fo...
Interface for NEKTON fld files.
Implements global interpolation for arbitrary points in the domain.
Interpolation between two space::space_t.
Base abstract type for point zones.
The function space for the SEM solution fields.