Neko 1.99.5
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
chkp_file.f90
Go to the documentation of this file.
1! Copyright (c) 2021-2022, 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!
35module chkp_file
36 use generic_file, only : generic_file_t
37 use field_series, only : field_series_t
38 use checkpoint, only : chkp_t
39 use num_types, only : rp, dp, i8
40 use field, only : field_t
41 use dofmap, only : dofmap_t
42 use utils, only : neko_error, filename_suffix_pos
43 use space, only : space_t, gll
44 use mesh, only : mesh_t
45 use math, only : rzero
46 use interpolation, only : interpolator_t
47 use neko_mpi_types, only : mpi_real_prec_size, mpi_integer_size, &
48 mpi_double_precision_size, mpi_real_prec_size
49 use global_interpolation, only : global_interpolation_t
50 use logger, only : neko_log, neko_log_verbose
51 use comm, only : neko_comm, pe_rank, mpi_real_precision
52 use mpi_f08, only : mpi_file, mpi_status, mpi_offset_kind, mpi_mode_create, &
53 mpi_mode_rdonly, mpi_mode_wronly, mpi_info_null, mpi_integer, &
54 mpi_double_precision, mpi_logical, mpi_success, &
55 mpi_file_open, mpi_file_close, mpi_file_read_all, mpi_file_write_all, &
56 mpi_file_read_at_all, mpi_file_write_at_all, mpi_bcast
57 implicit none
58 private
59
61 type, public, extends(generic_file_t) :: chkp_file_t
63 type(space_t), pointer :: chkp_xh
65 type(space_t), pointer :: sim_xh
67 type(interpolator_t) :: space_interp
69 type(global_interpolation_t) :: global_interp
71 logical :: mesh2mesh
72 contains
73 procedure :: read => chkp_file_read
74 procedure :: read_field => chkp_read_field
75 procedure :: write => chkp_file_write
76 procedure :: set_overwrite => chkp_file_set_overwrite
77 end type chkp_file_t
78
79contains
80
82 subroutine chkp_file_write(this, data, t)
83 class(chkp_file_t), intent(inout) :: this
84 class(*), target, intent(in) :: data
85 real(kind=rp), intent(in), optional :: t
86 real(kind=dp) :: time
87 character(len=5) :: id_str
88 character(len=1024) :: fname
89 integer :: ierr, suffix_pos, optional_fields
90 type(field_t), pointer :: u, v, w, p, s
91 type(field_t), pointer :: wm_x => null()
92 type(field_t), pointer :: wm_y => null()
93 type(field_t), pointer :: wm_z => null()
94 type(field_t), pointer :: abx1, abx2
95 type(field_t), pointer :: aby1, aby2
96 type(field_t), pointer :: abz1, abz2
97 type(field_t), pointer :: abs1, abs2
98 type(field_series_t), pointer :: ulag => null()
99 type(field_series_t), pointer :: vlag => null()
100 type(field_series_t), pointer :: wlag => null()
101 type(field_series_t), pointer :: wm_x_lag => null()
102 type(field_series_t), pointer :: wm_y_lag => null()
103 type(field_series_t), pointer :: wm_z_lag => null()
104 type(field_series_t), pointer :: slag => null()
105 real(kind=rp), pointer :: msh_x(:,:,:,:) => null()
106 real(kind=rp), pointer :: msh_y(:,:,:,:) => null()
107 real(kind=rp), pointer :: msh_z(:,:,:,:) => null()
108 real(kind=rp), pointer :: blag(:,:,:,:) => null()
109 real(kind=rp), pointer :: blaglag(:,:,:,:) => null()
110 real(kind=rp), pointer :: pivot_pos(:) => null()
111 real(kind=rp), pointer :: pivot_vel_lag(:,:) => null()
112 real(kind=rp), pointer :: basis_pos(:) => null()
113 real(kind=rp), pointer :: basis_vel_lag(:,:) => null()
114 real(kind=rp), pointer :: dtlag(:), tlag(:)
115 type(mesh_t), pointer :: msh
116 type(mpi_status) :: status
117 type(mpi_file) :: fh
118 integer (kind=MPI_OFFSET_KIND) :: mpi_offset, byte_offset
119 integer(kind=i8) :: n_glb_dofs, dof_offset
120 logical :: write_lag, write_scalar, write_dtlag
121 logical :: write_ale
122 logical :: write_scalarlag, write_abvel
123 integer :: i
124
125 if (present(t)) then
126 time = real(t, kind = dp)
127 else
128 time = 0.0_dp
129 end if
130
131 select type (data)
132 type is (chkp_t)
133
134 if ( .not. associated(data%u) .or. &
135 .not. associated(data%v) .or. &
136 .not. associated(data%w) .or. &
137 .not. associated(data%p) ) then
138 call neko_error('Checkpoint not initialized')
139 end if
140
141 u => data%u
142 v => data%v
143 w => data%w
144 p => data%p
145 msh => u%msh
146
147 optional_fields = 0
148
149 if (associated(data%ulag)) then
150 ulag => data%ulag
151 vlag => data%vlag
152 wlag => data%wlag
153 write_lag = .true.
154 optional_fields = optional_fields + 1
155 else
156 write_lag = .false.
157 end if
158
159 if (associated(data%s)) then
160 s => data%s
161 write_scalar = .true.
162 optional_fields = optional_fields + 2
163 else
164 write_scalar = .false.
165 end if
166
167 if (associated(data%tlag)) then
168 tlag => data%tlag
169 dtlag => data%dtlag
170 write_dtlag = .true.
171 optional_fields = optional_fields + 4
172 else
173 write_dtlag = .false.
174 end if
175
176 write_abvel = .false.
177 if (associated(data%abx1)) then
178 abx1 => data%abx1
179 abx2 => data%abx2
180 aby1 => data%aby1
181 aby2 => data%aby2
182 abz1 => data%abz1
183 abz2 => data%abz2
184 optional_fields = optional_fields + 8
185 write_abvel = .true.
186 end if
187
188 write_scalarlag = .false.
189 if (associated(data%abs1)) then
190 slag => data%slag
191 abs1 => data%abs1
192 abs2 => data%abs2
193 optional_fields = optional_fields + 16
194 write_scalarlag = .true.
195 end if
196
197 write_ale = .false.
198 if (associated(data%wm_x)) then
199 msh_x => data%msh_x
200 msh_y => data%msh_y
201 msh_z => data%msh_z
202 wm_x => data%wm_x
203 wm_y => data%wm_y
204 wm_z => data%wm_z
205 wm_x_lag => data%wm_x_lag
206 wm_y_lag => data%wm_y_lag
207 wm_z_lag => data%wm_z_lag
208 blag => data%Blag
209 blaglag => data%Blaglag
210 pivot_pos => data%pivot_pos
211 pivot_vel_lag => data%pivot_vel_lag
212 basis_pos => data%basis_pos
213 basis_vel_lag => data%basis_vel_lag
214 optional_fields = optional_fields + 32
215 write_ale = .true.
216 end if
217
218 class default
219 call neko_error('Invalid data')
220 end select
221
222 dof_offset = int(msh%offset_el, i8) * int(u%Xh%lx * u%Xh%ly * u%Xh%lz, i8)
223 n_glb_dofs = int(u%Xh%lx * u%Xh%ly * u%Xh%lz, i8) * int(msh%glb_nelv, i8)
224
225 ! Retrieve the filename and increment the counter if we are not overwriting
226 if (.not. this%overwrite) call this%increment_counter()
227 fname = trim(this%get_fname())
228
229 call mpi_file_open(neko_comm, trim(fname), &
230 mpi_mode_wronly + mpi_mode_create, mpi_info_null, fh, ierr)
231 call mpi_file_write_all(fh, msh%glb_nelv, 1, mpi_integer, status, ierr)
232 call mpi_file_write_all(fh, msh%gdim, 1, mpi_integer, status, ierr)
233 call mpi_file_write_all(fh, u%Xh%lx, 1, mpi_integer, status, ierr)
234 call mpi_file_write_all(fh, optional_fields, 1, mpi_integer, status, ierr)
235 call mpi_file_write_all(fh, time, 1, mpi_double_precision, status, ierr)
236
237
238 !
239 ! Dump mandatory checkpoint data
240 !
241
242 byte_offset = 4_i8 * int(mpi_integer_size, i8) + &
243 int(mpi_double_precision_size, i8)
244 byte_offset = byte_offset + &
245 dof_offset * int(mpi_real_prec_size, i8)
246 call mpi_file_write_at_all(fh, byte_offset,u%x, u%dof%size(), &
247 mpi_real_precision, status, ierr)
248 mpi_offset = 4_i8 * int(mpi_integer_size, i8) + &
249 int(mpi_double_precision_size, i8)
250 mpi_offset = mpi_offset +&
251 n_glb_dofs * int(mpi_real_prec_size, i8)
252
253 byte_offset = mpi_offset + &
254 dof_offset * int(mpi_real_prec_size, i8)
255 call mpi_file_write_at_all(fh, byte_offset, v%x, v%dof%size(), &
256 mpi_real_precision, status, ierr)
257 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
258
259 byte_offset = mpi_offset + &
260 dof_offset * int(mpi_real_prec_size, i8)
261 call mpi_file_write_at_all(fh, byte_offset, w%x, w%dof%size(), &
262 mpi_real_precision, status, ierr)
263 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
264
265 byte_offset = mpi_offset + &
266 dof_offset * int(mpi_real_prec_size, i8)
267 call mpi_file_write_at_all(fh, byte_offset, p%x, p%dof%size(), &
268 mpi_real_precision, status, ierr)
269 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
270
271 !
272 ! Dump optional payload
273 !
274
275 if (write_lag) then
276
277 do i = 1, ulag%size()
278 byte_offset = mpi_offset + &
279 dof_offset * int(mpi_real_prec_size, i8)
280 ! We should not need this extra associate block, and it works
281 ! great without it for GNU, Intel, NEC and Cray, but throws an
282 ! ICE with NAG.
283 associate(x => ulag%lf(i)%x)
284 call mpi_file_write_at_all(fh, byte_offset, x, &
285 ulag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
286 end associate
287 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
288 end do
289
290 do i = 1, vlag%size()
291 byte_offset = mpi_offset + &
292 dof_offset * int(mpi_real_prec_size, i8)
293 ! We should not need this extra associate block, and it works
294 ! great without it for GNU, Intel, NEC and Cray, but throws an
295 ! ICE with NAG.
296 associate(x => vlag%lf(i)%x)
297 call mpi_file_write_at_all(fh, byte_offset, x, &
298 vlag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
299 end associate
300 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
301 end do
302
303 do i = 1, wlag%size()
304 byte_offset = mpi_offset + &
305 dof_offset * int(mpi_real_prec_size, i8)
306 ! We should not need this extra associate block, and it works
307 ! great without it for GNU, Intel, NEC and Cray, but throws an
308 ! ICE with NAG.
309 associate(x => wlag%lf(i)%x)
310 call mpi_file_write_at_all(fh, byte_offset, x, &
311 wlag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
312 end associate
313 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
314 end do
315
316 end if
317
318 if (write_scalar) then
319 byte_offset = mpi_offset + &
320 dof_offset * int(mpi_real_prec_size, i8)
321 call mpi_file_write_at_all(fh, byte_offset, s%x, p%dof%size(), &
322 mpi_real_precision, status, ierr)
323 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
324 end if
325
326 if (write_dtlag) then
327 call mpi_file_write_at_all(fh, mpi_offset, tlag, 10, &
328 mpi_real_precision, status, ierr)
329 mpi_offset = mpi_offset + 10_i8 * int(mpi_real_prec_size, i8)
330 call mpi_file_write_at_all(fh, mpi_offset, dtlag, 10, &
331 mpi_real_precision, status, ierr)
332 mpi_offset = mpi_offset + 10_i8 * int(mpi_real_prec_size, i8)
333 end if
334
335 if (write_abvel) then
336 byte_offset = mpi_offset + &
337 dof_offset * int(mpi_real_prec_size, i8)
338 call mpi_file_write_at_all(fh, byte_offset, abx1%x, abx1%dof%size(), &
339 mpi_real_precision, status, ierr)
340 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
341 byte_offset = mpi_offset + &
342 dof_offset * int(mpi_real_prec_size, i8)
343 call mpi_file_write_at_all(fh, byte_offset, abx2%x, abx1%dof%size(), &
344 mpi_real_precision, status, ierr)
345 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
346 byte_offset = mpi_offset + &
347 dof_offset * int(mpi_real_prec_size, i8)
348 call mpi_file_write_at_all(fh, byte_offset, aby1%x, abx1%dof%size(), &
349 mpi_real_precision, status, ierr)
350 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
351 byte_offset = mpi_offset + &
352 dof_offset * int(mpi_real_prec_size, i8)
353 call mpi_file_write_at_all(fh, byte_offset, aby2%x, abx1%dof%size(), &
354 mpi_real_precision, status, ierr)
355 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
356 byte_offset = mpi_offset + &
357 dof_offset * int(mpi_real_prec_size, i8)
358 call mpi_file_write_at_all(fh, byte_offset, abz1%x, abx1%dof%size(), &
359 mpi_real_precision, status, ierr)
360 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
361 byte_offset = mpi_offset + &
362 dof_offset * int(mpi_real_prec_size, i8)
363 call mpi_file_write_at_all(fh, byte_offset, abz2%x, abx1%dof%size(), &
364 mpi_real_precision, status, ierr)
365 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
366 end if
367
368 if (write_scalarlag) then
369 do i = 1, slag%size()
370 byte_offset = mpi_offset + &
371 dof_offset * int(mpi_real_prec_size, i8)
372 ! We should not need this extra associate block, and it works
373 ! great without it for GNU, Intel, NEC and Cray, but throws an
374 ! ICE with NAG.
375 associate(x => slag%lf(i)%x)
376 call mpi_file_write_at_all(fh, byte_offset, x, &
377 slag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
378 end associate
379 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
380 end do
381
382 byte_offset = mpi_offset + &
383 dof_offset * int(mpi_real_prec_size, i8)
384 call mpi_file_write_at_all(fh, byte_offset, abs1%x, abx1%dof%size(), &
385 mpi_real_precision, status, ierr)
386 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
387 byte_offset = mpi_offset + &
388 dof_offset * int(mpi_real_prec_size, i8)
389 call mpi_file_write_at_all(fh, byte_offset, abs2%x, abx1%dof%size(), &
390 mpi_real_precision, status, ierr)
391 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
392 end if
393
394 if (write_ale) then
395 byte_offset = mpi_offset + &
396 dof_offset * int(mpi_real_prec_size, i8)
397 call mpi_file_write_at_all(fh, byte_offset, msh_x, size(msh_x), &
398 mpi_real_precision, status, ierr)
399 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
400
401 byte_offset = mpi_offset + &
402 dof_offset * int(mpi_real_prec_size, i8)
403 call mpi_file_write_at_all(fh, byte_offset, msh_y, size(msh_y), &
404 mpi_real_precision, status, ierr)
405 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
406
407 byte_offset = mpi_offset + &
408 dof_offset * int(mpi_real_prec_size, i8)
409 call mpi_file_write_at_all(fh, byte_offset, msh_z, size(msh_z), &
410 mpi_real_precision, status, ierr)
411 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
412
413 byte_offset = mpi_offset + &
414 dof_offset * int(mpi_real_prec_size, i8)
415 call mpi_file_write_at_all(fh, byte_offset, wm_x%x, wm_x%dof%size(), &
416 mpi_real_precision, status, ierr)
417 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
418
419 byte_offset = mpi_offset + &
420 dof_offset * int(mpi_real_prec_size, i8)
421 call mpi_file_write_at_all(fh, byte_offset, wm_y%x, wm_y%dof%size(), &
422 mpi_real_precision, status, ierr)
423 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
424
425 byte_offset = mpi_offset + &
426 dof_offset * int(mpi_real_prec_size, i8)
427 call mpi_file_write_at_all(fh, byte_offset, wm_z%x, wm_z%dof%size(), &
428 mpi_real_precision, status, ierr)
429 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
430
431 do i = 1, wm_x_lag%size()
432 byte_offset = mpi_offset + &
433 dof_offset * int(mpi_real_prec_size, i8)
434 ! We should not need this extra associate block, and it works
435 ! great without it for GNU, Intel, NEC and Cray, but throws an
436 ! ICE with NAG.
437 associate(x => wm_x_lag%lf(i)%x)
438 call mpi_file_write_at_all(fh, byte_offset, x, &
439 wm_x_lag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
440 end associate
441 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
442 end do
443
444 do i = 1, wm_y_lag%size()
445 byte_offset = mpi_offset + &
446 dof_offset * int(mpi_real_prec_size, i8)
447 ! We should not need this extra associate block, and it works
448 ! great without it for GNU, Intel, NEC and Cray, but throws an
449 ! ICE with NAG.
450 associate(x => wm_y_lag%lf(i)%x)
451 call mpi_file_write_at_all(fh, byte_offset, x, &
452 wm_y_lag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
453 end associate
454 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
455 end do
456
457 do i = 1, wm_z_lag%size()
458 byte_offset = mpi_offset + &
459 dof_offset * int(mpi_real_prec_size, i8)
460 ! We should not need this extra associate block, and it works
461 ! great without it for GNU, Intel, NEC and Cray, but throws an
462 ! ICE with NAG.
463 associate(x => wm_z_lag%lf(i)%x)
464 call mpi_file_write_at_all(fh, byte_offset, x, &
465 wm_z_lag%lf(i)%dof%size(), mpi_real_precision, status, ierr)
466 end associate
467 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
468 end do
469
470 byte_offset = mpi_offset + &
471 dof_offset * int(mpi_real_prec_size, i8)
472 call mpi_file_write_at_all(fh, byte_offset, blag, size(blag), &
473 mpi_real_precision, status, ierr)
474 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
475
476 byte_offset = mpi_offset + &
477 dof_offset * int(mpi_real_prec_size, i8)
478 call mpi_file_write_at_all(fh, byte_offset, blaglag, size(blaglag), &
479 mpi_real_precision, status, ierr)
480 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
481
482 call mpi_file_write_at_all(fh, mpi_offset, pivot_pos, size(pivot_pos), &
483 mpi_real_precision, status, ierr)
484 mpi_offset = mpi_offset + &
485 int(size(pivot_pos), i8) * int(mpi_real_prec_size, i8)
486 call mpi_file_write_at_all(fh, mpi_offset, pivot_vel_lag, &
487 size(pivot_vel_lag), mpi_real_precision, status, ierr)
488 mpi_offset = mpi_offset + &
489 int(size(pivot_vel_lag), i8) * int(mpi_real_prec_size, i8)
490 call mpi_file_write_at_all(fh, mpi_offset, basis_pos, &
491 size(basis_pos), mpi_real_precision, status, ierr)
492 mpi_offset = mpi_offset + &
493 int(size(basis_pos), i8) * int(mpi_real_prec_size, i8)
494 call mpi_file_write_at_all(fh, mpi_offset, basis_vel_lag, &
495 size(basis_vel_lag), mpi_real_precision, status, ierr)
496 mpi_offset = mpi_offset + &
497 int(size(basis_vel_lag), i8) * int(mpi_real_prec_size, i8)
498 end if
499
500 call mpi_file_close(fh, ierr)
501
502 if (ierr .ne. mpi_success) then
503 call neko_error('Error writing checkpoint file ' // trim(fname))
504 end if
505
506 end subroutine chkp_file_write
507
509 subroutine chkp_file_read(this, data)
510 class(chkp_file_t) :: this
511 class(*), target, intent(inout) :: data
512 type(chkp_t), pointer :: chkp
513 character(len=5) :: id_str
514 character(len=1024) :: fname
515 integer :: ierr, suffix_pos
516 type(field_t), pointer :: u, v, w, p, s
517 type(field_t), pointer :: wm_x => null()
518 type(field_t), pointer :: wm_y => null()
519 type(field_t), pointer :: wm_z => null()
520 type(field_series_t), pointer :: ulag => null()
521 type(field_series_t), pointer :: vlag => null()
522 type(field_series_t), pointer :: wlag => null()
523 type(field_series_t), pointer :: wm_x_lag => null()
524 type(field_series_t), pointer :: wm_y_lag => null()
525 type(field_series_t), pointer :: wm_z_lag => null()
526 type(field_series_t), pointer :: slag => null()
527 type(mesh_t), pointer :: msh
528 type(mpi_status) :: status
529 type(mpi_file) :: fh
530 type(field_t), pointer :: abx1, abx2
531 type(field_t), pointer :: aby1, aby2
532 type(field_t), pointer :: abz1, abz2
533 type(field_t), pointer :: abs1, abs2
534 real(kind=rp), pointer :: blag(:,:,:,:) => null()
535 real(kind=rp), pointer :: blaglag(:,:,:,:) => null()
536 real(kind=rp), pointer :: msh_x(:,:,:,:) => null()
537 real(kind=rp), pointer :: msh_y(:,:,:,:) => null()
538 real(kind=rp), pointer :: msh_z(:,:,:,:) => null()
539 real(kind=rp), pointer :: pivot_pos(:) => null()
540 real(kind=rp), pointer :: pivot_vel_lag(:,:) => null()
541 real(kind=rp), pointer :: basis_pos(:) => null()
542 real(kind=rp), pointer :: basis_vel_lag(:,:) => null()
543 real(kind=rp), allocatable :: x_coord(:,:,:,:)
544 real(kind=rp), allocatable :: y_coord(:,:,:,:)
545 real(kind=rp), allocatable :: z_coord(:,:,:,:)
546 real(kind=rp), pointer :: dtlag(:), tlag(:)
547 integer (kind=MPI_OFFSET_KIND) :: mpi_offset, byte_offset
548 integer(kind=i8) :: n_glb_dofs, dof_offset
549 integer :: glb_nelv, gdim, lx, have_lag, have_scalar, nel
550 integer :: optional_fields, have_dtlag
551 integer :: have_abvel, have_scalarlag
552 integer :: have_ale
553 logical :: read_lag, read_scalar, read_dtlag, read_abvel, read_scalarlag
554 logical :: read_ale
555 real(kind=dp) :: tol
556 real(kind=rp) :: center_x, center_y, center_z
557 integer :: i, e
558 type(dofmap_t) :: dof
559
560 call this%check_exists()
561
562 select type (data)
563 type is (chkp_t)
564
565 if ( .not. associated(data%u) .or. &
566 .not. associated(data%v) .or. &
567 .not. associated(data%w) .or. &
568 .not. associated(data%p) ) then
569 call neko_error('Checkpoint not initialized')
570 end if
571
572 u => data%u
573 v => data%v
574 w => data%w
575 p => data%p
576 this%chkp_Xh => data%previous_Xh
578 if (allocated(data%previous_mesh%elements)) then
579 msh => data%previous_mesh
580 this%mesh2mesh = .true.
581 tol = data%mesh2mesh_tol
582 else
583 msh => u%msh
584 this%mesh2mesh = .false.
585 end if
586
587 if (associated(data%ulag)) then
588 ulag => data%ulag
589 vlag => data%vlag
590 wlag => data%wlag
591 read_lag = .true.
592 else
593 read_lag = .false.
594 end if
595
596 if (associated(data%s)) then
597 s => data%s
598 read_scalar = .true.
599 else
600 read_scalar = .false.
601 end if
602 if (associated(data%dtlag)) then
603 dtlag => data%dtlag
604 tlag => data%tlag
605 read_dtlag = .true.
606 else
607 read_dtlag = .false.
608 end if
609 read_abvel = .false.
610 if (associated(data%abx1)) then
611 abx1 => data%abx1
612 abx2 => data%abx2
613 aby1 => data%aby1
614 aby2 => data%aby2
615 abz1 => data%abz1
616 abz2 => data%abz2
617 read_abvel = .true.
618 end if
619 read_scalarlag = .false.
620 if (associated(data%abs1)) then
621 slag => data%slag
622 abs1 => data%abs1
623 abs2 => data%abs2
624 read_scalarlag = .true.
625 end if
626
627 read_ale = .false.
628 if (associated(data%wm_x)) then
629 msh_x => data%msh_x
630 msh_y => data%msh_y
631 msh_z => data%msh_z
632 wm_x => data%wm_x
633 wm_y => data%wm_y
634 wm_z => data%wm_z
635 wm_x_lag => data%wm_x_lag
636 wm_y_lag => data%wm_y_lag
637 wm_z_lag => data%wm_z_lag
638 blag => data%Blag
639 blaglag => data%Blaglag
640 pivot_pos => data%pivot_pos
641 pivot_vel_lag => data%pivot_vel_lag
642 basis_pos => data%basis_pos
643 basis_vel_lag => data%basis_vel_lag
644 read_ale = .true.
645 end if
646
647 chkp => data
648
649 class default
650 call neko_error('Invalid data')
651 end select
652
653 fname = trim(this%get_fname())
654 call neko_log%message("Reading checkpoint from file: " // trim(fname), &
655 neko_log_verbose)
656 call mpi_file_open(neko_comm, trim(fname), &
657 mpi_mode_rdonly, mpi_info_null, fh, ierr)
658 call mpi_file_read_all(fh, glb_nelv, 1, mpi_integer, status, ierr)
659 call mpi_file_read_all(fh, gdim, 1, mpi_integer, status, ierr)
660 call mpi_file_read_all(fh, lx, 1, mpi_integer, status, ierr)
661 call mpi_file_read_all(fh, optional_fields, 1, mpi_integer, status, ierr)
662 call mpi_file_read_all(fh, chkp%t, 1, mpi_double_precision, status, ierr)
663
664 have_lag = mod(optional_fields,2)/1
665 have_scalar = mod(optional_fields,4)/2
666 have_dtlag = mod(optional_fields,8)/4
667 have_abvel = mod(optional_fields,16)/8
668 have_scalarlag = mod(optional_fields,32)/16
669 have_ale = mod(optional_fields,64)/32
670
671 if ( ( glb_nelv .ne. msh%glb_nelv ) .or. &
672 ( gdim .ne. msh%gdim) .or. &
673 ( (have_lag .eq. 0) .and. (read_lag) ) .or. &
674 ( (have_scalar .eq. 0) .and. (read_scalar) ) .or. &
675 ( (have_ale .eq. 0) .and. (read_ale) ) ) then
676 call neko_error('Checkpoint does not match case')
677 end if
678 nel = msh%nelv
679 this%sim_Xh => u%Xh
680 if (gdim .eq. 3) then
681 call this%chkp_Xh%init(gll, lx, lx, lx)
682 else
683 call this%chkp_Xh%init(gll, lx, lx)
684 end if
685 if (this%mesh2mesh) then
686 if (read_ale) then
687 call neko_error('ALE does not yet support mesh2mesh ' // &
688 'interpolation for restart!')
689 end if
690 call dof%init(msh, this%chkp_Xh)
691 call this%global_interp%init(dof, neko_comm, tol = tol)
692 call this%global_interp%find_points(u%dof%x, u%dof%y, u%dof%z, &
693 u%dof%size())
694 else
695 call this%space_interp%init(this%sim_Xh, this%chkp_Xh)
696 end if
697 dof_offset = int(msh%offset_el, i8) * int(this%chkp_Xh%lxyz, i8)
698 n_glb_dofs = int(this%chkp_Xh%lxyz, i8) * int(msh%glb_nelv, i8)
699
700 !
701 ! Read mandatory checkpoint data
702 !
703
704 byte_offset = 4_i8 * int(mpi_integer_size, i8) + &
705 int(mpi_double_precision_size, i8)
706 byte_offset = byte_offset + &
707 dof_offset * int(mpi_real_prec_size, i8)
708 call this%read_field(fh, byte_offset, u%x, nel)
709 mpi_offset = 4_i8 * int(mpi_integer_size, i8) + &
710 int(mpi_double_precision_size, i8)
711 mpi_offset = mpi_offset +&
712 n_glb_dofs * int(mpi_real_prec_size, i8)
713
714 byte_offset = mpi_offset + &
715 dof_offset * int(mpi_real_prec_size, i8)
716 call this%read_field(fh, byte_offset, v%x, nel)
717 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
718
719 byte_offset = mpi_offset + &
720 dof_offset * int(mpi_real_prec_size, i8)
721 call this%read_field(fh, byte_offset, w%x, nel)
722 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
723
724 byte_offset = mpi_offset + &
725 dof_offset * int(mpi_real_prec_size, i8)
726 call this%read_field(fh, byte_offset, p%x, nel)
727 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
728
729 !
730 ! Read optional payload
731 !
732
733 if (read_lag) then
734 do i = 1, ulag%size()
735 byte_offset = mpi_offset + &
736 dof_offset * int(mpi_real_prec_size, i8)
737 call this%read_field(fh, byte_offset, ulag%lf(i)%x, nel)
738 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
739 end do
740
741 do i = 1, vlag%size()
742 byte_offset = mpi_offset + &
743 dof_offset * int(mpi_real_prec_size, i8)
744 call this%read_field(fh, byte_offset, vlag%lf(i)%x, nel)
745 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
746 end do
747
748 do i = 1, wlag%size()
749 byte_offset = mpi_offset + &
750 dof_offset * int(mpi_real_prec_size, i8)
751 call this%read_field(fh, byte_offset, wlag%lf(i)%x, nel)
752 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
753 end do
754 end if
755
756 if (read_scalar) then
757 byte_offset = mpi_offset + &
758 dof_offset * int(mpi_real_prec_size, i8)
759 call this%read_field(fh, byte_offset, s%x, nel)
760 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
761 end if
762
763 if (read_dtlag .and. have_dtlag .eq. 1) then
764 call mpi_file_read_at_all(fh, mpi_offset, tlag, 10, &
765 mpi_real_precision, status, ierr)
766 mpi_offset = mpi_offset + 10_i8 * int(mpi_real_prec_size, i8)
767 call mpi_file_read_at_all(fh, mpi_offset, dtlag, 10, &
768 mpi_real_precision, status, ierr)
769 mpi_offset = mpi_offset + 10_i8 * int(mpi_real_prec_size, i8)
770 end if
771
772 if (read_abvel .and. have_abvel .eq. 1) then
773 byte_offset = mpi_offset + &
774 dof_offset * int(mpi_real_prec_size, i8)
775 call this%read_field(fh, byte_offset, abx1%x, nel)
776 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
777 byte_offset = mpi_offset + &
778 dof_offset * int(mpi_real_prec_size, i8)
779 call this%read_field(fh, byte_offset, abx2%x, nel)
780 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
781 byte_offset = mpi_offset + &
782 dof_offset * int(mpi_real_prec_size, i8)
783 call this%read_field(fh, byte_offset, aby1%x, nel)
784 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
785 byte_offset = mpi_offset + &
786 dof_offset * int(mpi_real_prec_size, i8)
787 call this%read_field(fh, byte_offset, aby2%x, nel)
788 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
789 byte_offset = mpi_offset + &
790 dof_offset * int(mpi_real_prec_size, i8)
791 call this%read_field(fh, byte_offset, abz1%x, nel)
792 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
793 byte_offset = mpi_offset + &
794 dof_offset * int(mpi_real_prec_size, i8)
795 call this%read_field(fh, byte_offset, abz2%x, nel)
796 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
797 end if
798 if (read_scalarlag .and. have_scalarlag .eq. 1) then
799 do i = 1, slag%size()
800 byte_offset = mpi_offset + &
801 dof_offset * int(mpi_real_prec_size, i8)
802 call this%read_field(fh, byte_offset, slag%lf(i)%x, nel)
803 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
804 end do
805 byte_offset = mpi_offset + &
806 dof_offset * int(mpi_real_prec_size, i8)
807 call this%read_field(fh, byte_offset, abs1%x, nel)
808 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
809 byte_offset = mpi_offset + &
810 dof_offset * int(mpi_real_prec_size, i8)
811 call this%read_field(fh, byte_offset, abs2%x, nel)
812 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
813 end if
814
815 if (read_ale .and. have_ale .eq. 1) then
816
817 byte_offset = mpi_offset + &
818 dof_offset * int(mpi_real_prec_size, i8)
819 call this%read_field(fh, byte_offset, msh_x, nel)
820 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
821
822 byte_offset = mpi_offset + &
823 dof_offset * int(mpi_real_prec_size, i8)
824 call this%read_field(fh, byte_offset, msh_y, nel)
825 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
826
827 byte_offset = mpi_offset + &
828 dof_offset * int(mpi_real_prec_size, i8)
829 call this%read_field(fh, byte_offset, msh_z, nel)
830 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
831
832 byte_offset = mpi_offset + &
833 dof_offset * int(mpi_real_prec_size, i8)
834 call this%read_field(fh, byte_offset, wm_x%x, nel)
835 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
836
837 byte_offset = mpi_offset + &
838 dof_offset * int(mpi_real_prec_size, i8)
839 call this%read_field(fh, byte_offset, wm_y%x, nel)
840 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
841
842 byte_offset = mpi_offset + &
843 dof_offset * int(mpi_real_prec_size, i8)
844 call this%read_field(fh, byte_offset, wm_z%x, nel)
845 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
846
847 do i = 1, wm_x_lag%size()
848 byte_offset = mpi_offset + &
849 dof_offset * int(mpi_real_prec_size, i8)
850 call this%read_field(fh, byte_offset, wm_x_lag%lf(i)%x, nel)
851 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
852 end do
853 do i = 1, wm_y_lag%size()
854 byte_offset = mpi_offset + &
855 dof_offset * int(mpi_real_prec_size, i8)
856 call this%read_field(fh, byte_offset, wm_y_lag%lf(i)%x, nel)
857 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
858 end do
859 do i = 1, wm_z_lag%size()
860 byte_offset = mpi_offset + &
861 dof_offset * int(mpi_real_prec_size, i8)
862 call this%read_field(fh, byte_offset, wm_z_lag%lf(i)%x, nel)
863 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
864 end do
865 byte_offset = mpi_offset + &
866 dof_offset * int(mpi_real_prec_size, i8)
867 call this%read_field(fh, byte_offset, blag, nel)
868 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
869
870 byte_offset = mpi_offset + &
871 dof_offset * int(mpi_real_prec_size, i8)
872 call this%read_field(fh, byte_offset, blaglag, nel)
873 mpi_offset = mpi_offset + n_glb_dofs * int(mpi_real_prec_size, i8)
874
875 call mpi_file_read_at_all(fh, mpi_offset, pivot_pos, &
876 size(pivot_pos), mpi_real_precision, status, ierr)
877 mpi_offset = mpi_offset + int(size(pivot_pos), i8) &
878 * int(mpi_real_prec_size, i8)
879
880 call mpi_file_read_at_all(fh, mpi_offset, pivot_vel_lag, &
881 size(pivot_vel_lag), mpi_real_precision, status, ierr)
882 mpi_offset = mpi_offset + int(size(pivot_vel_lag), i8) &
883 * int(mpi_real_prec_size, i8)
884
885 call mpi_file_read_at_all(fh, mpi_offset, basis_pos, &
886 size(basis_pos), mpi_real_precision, status, ierr)
887 mpi_offset = mpi_offset + &
888 int(size(basis_pos), i8) * int(mpi_real_prec_size, i8)
889
890 call mpi_file_read_at_all(fh, mpi_offset, basis_vel_lag, &
891 size(basis_vel_lag), mpi_real_precision, status, ierr)
892 mpi_offset = mpi_offset + &
893 int(size(basis_vel_lag), i8) * int(mpi_real_prec_size, i8)
894 end if
895
896
897 call mpi_file_close(fh, ierr)
898
899 if (ierr .ne. mpi_success) then
900 call neko_error('Error reading checkpoint file ' // trim(fname))
901 end if
902
903 call this%global_interp%free()
904 call this%space_interp%free()
905
906 end subroutine chkp_file_read
907
908 subroutine chkp_read_field(this, fh, byte_offset, x, nel)
909 class(chkp_file_t) :: this
910 type(mpi_file) :: fh
911 integer(kind=MPI_OFFSET_KIND) :: byte_offset
912 integer, intent(in) :: nel
913 real(kind=rp) :: x(this%sim_Xh%lxyz, nel)
914 real(kind=rp), allocatable :: read_array(:)
915 integer :: nel_stride, frac_space
916 type(mpi_status) :: status
917 integer :: ierr, i, n
918 logical :: interp_on_host = .true.
919
920 n = this%chkp_xh%lxyz*nel
921 allocate(read_array(n))
922
923 call rzero(read_array,n)
924 call mpi_file_read_at_all(fh, byte_offset, read_array, &
925 n, mpi_real_precision, status, ierr)
926 if (this%mesh2mesh) then
927 x = 0.0_rp
928 call this%global_interp%evaluate(x, read_array, interp_on_host)
929
930 else if (this%sim_Xh%lx .ne. this%chkp_Xh%lx) then
931 call this%space_interp%map_host(x, read_array, nel, this%sim_Xh)
932 else
933 do i = 1,n
934 x(i,1) = read_array(i)
935 end do
936 end if
937 deallocate(read_array)
938 end subroutine chkp_read_field
939
940 subroutine chkp_file_set_overwrite(this, overwrite)
941 class(chkp_file_t), intent(inout) :: this
942 logical, intent(in) :: overwrite
943 this%overwrite = overwrite
944 end subroutine chkp_file_set_overwrite
945end module chkp_file
real
double real
Definition device_config.h:12
utils::neko_error
Definition utils.f90:45
checkpoint
Defines a checkpoint.
Definition checkpoint.f90:34
chkp_file
Neko checkpoint file format.
Definition chkp_file.f90:35
chkp_file::chkp_file_write
subroutine chkp_file_write(this, data, t)
Write a Neko checkpoint.
Definition chkp_file.f90:83
chkp_file::chkp_file_read
subroutine chkp_file_read(this, data)
Load a checkpoint from file.
Definition chkp_file.f90:510
chkp_file::chkp_file_set_overwrite
subroutine chkp_file_set_overwrite(this, overwrite)
Definition chkp_file.f90:941
chkp_file::chkp_read_field
subroutine chkp_read_field(this, fh, byte_offset, x, nel)
Definition chkp_file.f90:909
comm
Definition comm.F90:1
comm::mpi_real_precision
type(mpi_datatype), public mpi_real_precision
MPI type for working precision of REAL types.
Definition comm.F90:53
comm::pe_rank
integer, public pe_rank
MPI rank.
Definition comm.F90:58
comm::neko_comm
type(mpi_comm), public neko_comm
MPI communicator.
Definition comm.F90:45
dofmap
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
field_series
Contains the field_serties_t type.
Definition field_series.f90:34
field
Defines a field.
Definition field.f90:34
generic_file
Definition generic_file.f90:33
global_interpolation
Implements global_interpolation given a dofmap.
Definition global_interpolation.f90:35
interpolation
Routines to interpolate between different spaces.
Definition interpolation.f90:34
logger
Logging routines.
Definition log.f90:34
logger::neko_log_verbose
integer, parameter, public neko_log_verbose
Verbose log level.
Definition log.f90:86
logger::neko_log
type(log_t), public neko_log
Global log stream.
Definition log.f90:80
math
Definition math.f90:60
math::rzero
subroutine, public rzero(a, n)
Zero a real vector.
Definition math.f90:235
mesh
Defines a mesh.
Definition mesh.f90:34
neko_mpi_types
MPI derived types.
Definition mpi_types.f90:34
neko_mpi_types::mpi_double_precision_size
integer, public mpi_double_precision_size
Size of MPI type double precision.
Definition mpi_types.f90:66
neko_mpi_types::mpi_real_prec_size
integer, public mpi_real_prec_size
Size of working precision REAL types.
Definition mpi_types.f90:70
neko_mpi_types::mpi_integer_size
integer, public mpi_integer_size
Size of MPI type integer.
Definition mpi_types.f90:68
num_types
Definition num_types.f90:1
num_types::i8
integer, parameter, public i8
Definition num_types.f90:7
num_types::dp
integer, parameter, public dp
Definition num_types.f90:9
num_types::rp
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
space
Defines a function space.
Definition space.f90:34
space::gll
integer, parameter, public gll
Definition space.f90:49
utils
Utilities.
Definition utils.f90:35
utils::filename_suffix_pos
pure integer function, public filename_suffix_pos(fname)
Find position (in the string) of a filename's suffix.
Definition utils.f90:74
checkpoint::chkp_t
Definition checkpoint.f90:52
chkp_file::chkp_file_t
Interface for Neko checkpoint files.
Definition chkp_file.f90:61
dofmap::dofmap_t
Definition dofmap.f90:56
field::field_t
Definition field.f90:48
field_series::field_series_t
Stores a series (sequence) of fields, logically connected to a base field, and arranged according to ...
Definition field_series.f90:42
generic_file::generic_file_t
A generic file handler.
Definition generic_file.f90:42
global_interpolation::global_interpolation_t
Implements global interpolation for arbitrary points in the domain.
Definition global_interpolation.f90:87
interpolation::interpolator_t
Interpolation between two space::space_t.
Definition interpolation.f90:53
mesh::mesh_t
Definition mesh.f90:73
space::space_t
The function space for the SEM solution fields.
Definition space.f90:63