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