Neko  0.9.0
A portable framework for high-order spectral element flow simulations
fld_file_data.f90
Go to the documentation of this file.
1 
9  use num_types, only : rp
10  use math, only: cmult, add2
11  use vector, only : vector_t, vector_ptr_t
12  use field, only: field_t
13  use dofmap, only: dofmap_t
14  use space, only: space_t, gll
16  use utils, only: neko_error
17  use mesh, only: mesh_t
18  implicit none
19  private
20 
21  type, public :: fld_file_data_t
22  type(vector_t) :: x
23  type(vector_t) :: y
24  type(vector_t) :: z
25  type(vector_t) :: u
26  type(vector_t) :: v
27  type(vector_t) :: w
28  type(vector_t) :: p
29  type(vector_t) :: t
30  integer, allocatable :: idx(:)
31  type(vector_t), allocatable :: s(:)
32  integer :: gdim
33  integer :: n_scalars = 0
34  real(kind=rp) :: time = 0.0
35  integer :: glb_nelv = 0
36  integer :: nelv = 0
37  integer :: offset_el = 0
38  integer :: lx = 0
39  integer :: ly = 0
40  integer :: lz = 0
41  integer :: t_counter = 0
42  ! meta file information (if any)
44  integer :: meta_nsamples = 0
45  integer :: meta_start_counter = 0
47  character(len=1024) :: fld_series_fname
48  contains
49  procedure, pass(this) :: init => fld_file_data_init
50  procedure, pass(this) :: free => fld_file_data_free
51  procedure, pass(this) :: scale => fld_file_data_scale
52  procedure, pass(this) :: add => fld_file_data_add
53  procedure, pass(this) :: size => fld_file_data_size
54  procedure, pass(this) :: get_list => fld_file_data_get_list
55  procedure, pass(this) :: init_same => fld_file_data_init_same
56  procedure, pass(this) :: init_n_fields => fld_file_data_init_n_fields
58  procedure, pass(this) :: generate_interpolator => &
60  end type fld_file_data_t
61 
62 contains
63 
65  subroutine fld_file_data_init(this, nelv, offset_el)
66  class(fld_file_data_t), intent(inout) :: this
67  integer, intent(in), optional :: nelv, offset_el
68 
69  call this%free()
70  if (present(nelv)) this%nelv = nelv
71  if (present(offset_el)) this%offset_el = offset_el
72 
73  end subroutine fld_file_data_init
75  function fld_file_data_size(this) result(i)
76  class(fld_file_data_t) :: this
77  integer :: i
78  i = 0
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
85 
86  end function fld_file_data_size
87 
89  subroutine fld_file_data_init_same(this, fld_file, n)
90  class(fld_file_data_t), target, intent(inout) :: this
91  class(fld_file_data_t), target, intent(in) :: fld_file
92  integer, intent(in) :: n
93  integer :: i, j
94 
95  if(fld_file%u%n .gt. 0) then
96  call this%u%init(n)
97  end if
98  if(fld_file%v%n .gt. 0) then
99  call this%v%init(n)
100  end if
101  if(fld_file%w%n .gt. 0) then
102  call this%w%init(n)
103  end if
104  if(fld_file%p%n .gt. 0) then
105  call this%p%init(n)
106  end if
107  if(fld_file%t%n .gt. 0) then
108  call this%t%init(n)
109  end if
110  this%n_scalars = fld_file%n_scalars
111  allocate(this%s(fld_file%n_scalars))
112  do j = 1, fld_file%n_scalars
113  call this%s(j)%init(n)
114  end do
115 
116  end subroutine fld_file_data_init_same
117 
119  subroutine fld_file_data_init_n_fields(this, n_fields, n)
120  class(fld_file_data_t), target, intent(inout) :: this
121  integer, intent(in) :: n, n_fields
122  integer :: i, j
123 
124 
125  if(n_fields .gt. 0) then
126  call this%u%init(n)
127  end if
128  if(n_fields .gt. 1) then
129  call this%v%init(n)
130  end if
131  if(n_fields .gt. 2) then
132  call this%w%init(n)
133  end if
134  if(n_fields .gt. 3) then
135  call this%p%init(n)
136  end if
137  if(n_fields .gt. 4) then
138  call this%t%init(n)
139  end if
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)
145  end do
146  end if
147 
148  end subroutine fld_file_data_init_n_fields
149 
151  subroutine fld_file_data_get_list(this, ptr_list, n)
152  class(fld_file_data_t), target, intent(in) :: this
153  integer, intent(in) :: n
154  integer :: i, j
155  type(vector_ptr_t), intent(inout) :: ptr_list(n)
156  i = 1
157  if (this%u%n .gt. 0) then
158  ptr_list(i)%ptr => this%u
159  i = i + 1
160  end if
161  if (this%v%n .gt. 0) then
162  ptr_list(i)%ptr => this%v
163  i = i + 1
164  end if
165  if (this%w%n .gt. 0) then
166  ptr_list(i)%ptr => this%w
167  i = i + 1
168  end if
169  if (this%p%n .gt. 0) then
170  ptr_list(i)%ptr => this%p
171  i = i + 1
172  end if
173  if (this%t%n .gt. 0) then
174  ptr_list(i)%ptr => this%t
175  i = i + 1
176  end if
177  do j = 1, this%n_scalars
178  ptr_list(i)%ptr => this%s(j)
179  i = i +1
180  end do
181 
182  end subroutine fld_file_data_get_list
183 
184 
185 
187  subroutine fld_file_data_scale(this, c)
188  class(fld_file_data_t), intent(inout) :: this
189  real(kind=rp), intent(in) :: c
190  integer :: i
191 
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)
197 
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)
200  end do
201 
202  end subroutine fld_file_data_scale
203 
205  subroutine fld_file_data_add(this, fld_data_add)
206  class(fld_file_data_t), intent(inout) :: this
207  class(fld_file_data_t), intent(in) :: fld_data_add
208  integer :: i
209 
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)
215 
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, &
218  this%s(i)%n)
219  end do
220  end subroutine fld_file_data_add
221 
223  subroutine fld_file_data_free(this)
224  class(fld_file_data_t), intent(inout) :: this
225  integer :: i
226  call this%x%free()
227  call this%y%free()
228  call this%z%free()
229  call this%u%free()
230  call this%v%free()
231  call this%w%free()
232  call this%p%free()
233  call this%t%free()
234  if (allocated(this%s)) then
235  do i = 1, this%n_scalars
236  call this%s(i)%free()
237  end do
238  deallocate(this%s)
239  end if
240  this%n_scalars = 0
241  this%time = 0.0
242  this%glb_nelv = 0
243  this%nelv = 0
244  this%offset_el = 0
245  this%lx = 0
246  this%ly = 0
247  this%lz = 0
248  this%t_counter = 0
249  this%meta_nsamples = 0
250  this%meta_start_counter = 0
251  if(allocated(this%idx)) deallocate(this%idx)
252  end subroutine fld_file_data_free
253 
258  function fld_file_data_generate_interpolator(this, to_dof, &
259  to_msh, tolerance) result(global_interp)
260  class(fld_file_data_t), intent(in) :: this
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
264 
265  type(global_interpolation_t) :: global_interp
266 
267  ! --- variables for interpolation
268  type(space_t) :: fld_xh
269  real(kind=rp), allocatable :: x_coords(:,:,:,:), y_coords(:,:,:,:), &
270  z_coords(:,:,:,:)
271  real(kind=rp) :: center_x, center_y, center_z
272  integer :: e, i
273  ! ---
274 
275  type(space_t), pointer :: to_xh
276  to_xh => to_dof%Xh
277 
278  ! Safeguard in case we didn't read mesh information
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.")
283 
284  ! Create a space based on the fld data
285  call fld_xh%init(gll, this%lx, this%ly, this%lz)
286 
287  ! These are the coordinates of our current dofmap
288  ! that we use for the interpolation
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))
292 
297  do e = 1, to_msh%nelv
298  center_x = 0d0
299  center_y = 0d0
300  center_z = 0d0
301  do i = 1, to_xh%lxyz
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)
305  end do
306  center_x = center_x / to_xh%lxyz
307  center_y = center_y / to_xh%lxyz
308  center_z = center_z / to_xh%lxyz
309  do i = 1, 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)
316  end do
317  end do
318 
319  ! The initialization is done based on the variables created from
320  ! fld data
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, &
324  to_dof%size())
325 
326  deallocate(x_coords)
327  deallocate(y_coords)
328  deallocate(z_coords)
329 
331 
332 end module fld_file_data
Defines a mapping of the degrees of freedom.
Definition: dofmap.f90:35
Defines a field.
Definition: field.f90:34
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.
NEKTON fld file format.
Definition: fld_file.f90:35
Implements global_interpolation given a dofmap.
Definition: math.f90:60
subroutine, public cmult(a, c, n)
Multiplication by constant c .
Definition: math.f90:311
subroutine, public add2(a, b, n)
Vector addition .
Definition: math.f90:587
Defines a mesh.
Definition: mesh.f90:34
integer, parameter, public rp
Global precision used in computations.
Definition: num_types.f90:12
Defines a function space.
Definition: space.f90:34
integer, parameter, public gll
Definition: space.f90:48
Utilities.
Definition: utils.f90:35
Defines a vector.
Definition: vector.f90:34
Implements global interpolation for arbitrary points in the domain.
The function space for the SEM solution fields.
Definition: space.f90:62