30 integer,
allocatable :: idx(:)
33 integer :: n_scalars = 0
34 real(kind=
rp) :: time = 0.0
35 integer :: glb_nelv = 0
37 integer :: offset_el = 0
41 integer :: t_counter = 0
44 integer :: meta_nsamples = 0
45 integer :: meta_start_counter = 0
47 character(len=1024) :: fld_series_fname
58 procedure, pass(this) :: generate_interpolator => &
67 integer,
intent(in),
optional :: nelv, offset_el
70 if (
present(nelv)) this%nelv = nelv
71 if (
present(offset_el)) this%offset_el = offset_el
79 if (this%u%n .gt. 0) i = i + 1
80 if (this%v%n .gt. 0) i = i + 1
81 if (this%w%n .gt. 0) i = i + 1
82 if (this%p%n .gt. 0) i = i + 1
83 if (this%t%n .gt. 0) i = i + 1
84 i = i + this%n_scalars
92 integer,
intent(in) :: n
111 allocate(this%s(
fld_file%n_scalars))
113 call this%s(j)%init(n)
121 integer,
intent(in) :: n, n_fields
125 if(n_fields .gt. 0)
then
128 if(n_fields .gt. 1)
then
131 if(n_fields .gt. 2)
then
134 if(n_fields .gt. 3)
then
137 if(n_fields .gt. 4)
then
140 if (n_fields .gt. 5)
then
141 this%n_scalars = n_fields-5
142 allocate(this%s(this%n_scalars))
143 do j = 1, this%n_scalars
144 call this%s(j)%init(n)
153 integer,
intent(in) :: n
157 if (this%u%n .gt. 0)
then
158 ptr_list(i)%ptr => this%u
161 if (this%v%n .gt. 0)
then
162 ptr_list(i)%ptr => this%v
165 if (this%w%n .gt. 0)
then
166 ptr_list(i)%ptr => this%w
169 if (this%p%n .gt. 0)
then
170 ptr_list(i)%ptr => this%p
173 if (this%t%n .gt. 0)
then
174 ptr_list(i)%ptr => this%t
177 do j = 1, this%n_scalars
178 ptr_list(i)%ptr => this%s(j)
189 real(kind=
rp),
intent(in) :: c
192 if (this%u%n .gt. 0)
call cmult(this%u%x, c, this%u%n)
193 if (this%v%n .gt. 0)
call cmult(this%v%x, c, this%v%n)
194 if (this%w%n .gt. 0)
call cmult(this%w%x, c, this%w%n)
195 if (this%p%n .gt. 0)
call cmult(this%p%x, c, this%p%n)
196 if (this%t%n .gt. 0)
call cmult(this%t%x, c, this%t%n)
198 do i = 1, this%n_scalars
199 if (this%s(i)%n .gt. 0)
call cmult(this%s(i)%x, c, this%s(i)%n)
210 if (this%u%n .gt. 0)
call add2(this%u%x, fld_data_add%u%x, this%u%n)
211 if (this%v%n .gt. 0)
call add2(this%v%x, fld_data_add%v%x, this%v%n)
212 if (this%w%n .gt. 0)
call add2(this%w%x, fld_data_add%w%x, this%w%n)
213 if (this%p%n .gt. 0)
call add2(this%p%x, fld_data_add%p%x, this%p%n)
214 if (this%t%n .gt. 0)
call add2(this%t%x, fld_data_add%t%x, this%t%n)
216 do i = 1, this%n_scalars
217 if (this%s(i)%n .gt. 0)
call add2(this%s(i)%x, fld_data_add%s(i)%x, &
234 if (
allocated(this%s))
then
235 do i = 1, this%n_scalars
236 call this%s(i)%free()
249 this%meta_nsamples = 0
250 this%meta_start_counter = 0
251 if(
allocated(this%idx))
deallocate(this%idx)
259 to_msh, tolerance)
result(global_interp)
261 type(
dofmap_t),
intent(in),
target :: to_dof
262 type(
mesh_t),
intent(in),
target :: to_msh
263 real(kind=
rp),
intent(in) :: tolerance
269 real(kind=
rp),
allocatable :: x_coords(:,:,:,:), y_coords(:,:,:,:), &
271 real(kind=
rp) :: center_x, center_y, center_z
275 type(
space_t),
pointer :: to_xh
279 if (.not.
allocated(this%x%x) .or. &
280 .not.
allocated(this%y%x) .or. &
281 .not.
allocated(this%z%x))
call neko_error(
"Unable to retrieve &
282 &mesh information from fld data.")
285 call fld_xh%init(
gll, this%lx, this%ly, this%lz)
289 allocate(x_coords(to_xh%lx, to_xh%ly, to_xh%lz, to_msh%nelv))
290 allocate(y_coords(to_xh%lx, to_xh%ly, to_xh%lz, to_msh%nelv))
291 allocate(z_coords(to_xh%lx, to_xh%ly, to_xh%lz, to_msh%nelv))
297 do e = 1, to_msh%nelv
302 center_x = center_x + to_dof%x(i, 1, 1, e)
303 center_y = center_y + to_dof%y(i, 1, 1, e)
304 center_z = center_z + to_dof%z(i, 1, 1, e)
306 center_x = center_x / to_xh%lxyz
307 center_y = center_y / to_xh%lxyz
308 center_z = center_z / to_xh%lxyz
310 x_coords(i, 1, 1, e) = to_dof%x(i, 1, 1, e) - &
311 tolerance * (to_dof%x(i, 1, 1, e) - center_x)
312 y_coords(i, 1, 1, e) = to_dof%y(i, 1, 1, e) - &
313 tolerance * (to_dof%y(i, 1, 1, e) - center_y)
314 z_coords(i, 1, 1, e) = to_dof%z(i, 1, 1, e) - &
315 tolerance * (to_dof%z(i, 1, 1, e) - center_z)
321 call global_interp%init(this%x%x, this%y%x, this%z%x, this%gdim, &
322 this%nelv, fld_xh, tol = tolerance)
323 call global_interp%find_points(x_coords, y_coords, z_coords, &
Defines a mapping of the degrees of freedom.
Simple module to handle fld file series. Provides an interface to the different fields sotred in a fl...
integer function fld_file_data_size(this)
Get number of fields in this fld file.
subroutine fld_file_data_add(this, fld_data_add)
Add the values in another fld file to this.
subroutine fld_file_data_init_same(this, fld_file, n)
Genereate same fields as in another fld_file.
subroutine fld_file_data_get_list(this, ptr_list, n)
Get a list with pointers to the fields in the fld file.
subroutine fld_file_data_free(this)
Deallocate fld file data type.
subroutine fld_file_data_init(this, nelv, offset_el)
Initialise a fld_file_data object with nelv elements with a offset_nel.
subroutine fld_file_data_init_n_fields(this, n_fields, n)
Genereate same fields as in another fld_file.
subroutine fld_file_data_scale(this, c)
Scale the values stored in this fld_file_data.
type(global_interpolation_t) function fld_file_data_generate_interpolator(this, to_dof, to_msh, tolerance)
Generates a global_interpolation object to interpolate the fld data.
Implements global_interpolation given a dofmap.
subroutine, public cmult(a, c, n)
Multiplication by constant c .
subroutine, public add2(a, b, n)
Vector addition .
integer, parameter, public rp
Global precision used in computations.
Defines a function space.
integer, parameter, public gll
Implements global interpolation for arbitrary points in the domain.
The function space for the SEM solution fields.