60 real(kind=
rp),
pointer :: tlag(:) => null()
61 real(kind=
rp),
pointer :: dtlag(:) => null()
81 real(kind=
rp) :: mesh2mesh_tol = 1d-6
97 class(
chkp_t),
intent(inout) :: this
98 type(
field_t),
intent(in),
target :: u
99 type(
field_t),
intent(in),
target :: v
100 type(
field_t),
intent(in),
target :: w
101 type(
field_t),
intent(in),
target :: p
105 if ( u%Xh .ne. v%Xh .or. &
106 u%Xh .ne. w%Xh )
then
107 call neko_error(
'Different function spaces for each velocity component')
111 if ( u%msh%nelv .ne. p%msh%nelv )
then
112 call neko_error(
'Velocity and pressure defined on different meshes')
126 type(
chkp_t),
intent(inout) :: this
141 class(
chkp_t),
intent(inout) :: this
144 associate(u=>this%u, v=>this%v, w=>this%w, &
145 ulag=>this%ulag, vlag=>this%vlag, wlag=>this%wlag, &
148 if (
associated(this%u) .and.
associated(this%v) .and. &
149 associated(this%w) .and.
associated(this%p))
then
156 if (
associated(this%ulag) .and.
associated(this%vlag) .and. &
157 associated(this%wlag))
then
185 if (
associated(this%s))
then
205 class(
chkp_t),
intent(inout) :: this
207 if (neko_bcknd_device .eq. 1)
then
208 associate(u=>this%u, v=>this%v, w=>this%w, &
209 ulag=>this%ulag, vlag=>this%vlag, wlag=>this%wlag,&
212 if (
associated(this%u) .and.
associated(this%v) .and. &
213 associated(this%w))
then
214 call device_memcpy(u%x, u%x_d, u%dof%size(), &
215 host_to_device, sync=.false.)
216 call device_memcpy(v%x, v%x_d, v%dof%size(), &
217 host_to_device, sync=.false.)
218 call device_memcpy(w%x, w%x_d, w%dof%size(), &
219 host_to_device, sync=.false.)
220 call device_memcpy(p%x, p%x_d, p%dof%size(), &
221 host_to_device, sync=.false.)
224 if (
associated(this%ulag) .and.
associated(this%vlag) .and. &
225 associated(this%wlag))
then
226 call device_memcpy(ulag%lf(1)%x, ulag%lf(1)%x_d, u%dof%size(), &
227 host_to_device, sync=.false.)
228 call device_memcpy(ulag%lf(2)%x, ulag%lf(2)%x_d, u%dof%size(), &
229 host_to_device, sync=.false.)
231 call device_memcpy(vlag%lf(1)%x, vlag%lf(1)%x_d, v%dof%size(), &
232 host_to_device, sync=.false.)
233 call device_memcpy(vlag%lf(2)%x, vlag%lf(2)%x_d, v%dof%size(), &
234 host_to_device, sync=.false.)
236 call device_memcpy(wlag%lf(1)%x, wlag%lf(1)%x_d, w%dof%size(), &
237 host_to_device, sync=.false.)
238 call device_memcpy(wlag%lf(2)%x, wlag%lf(2)%x_d, w%dof%size(), &
239 host_to_device, sync=.false.)
241 if (
associated(this%s))
then
242 call device_memcpy(this%s%x, this%s%x_d, this%s%dof%size(), &
243 host_to_device, sync=.false.)
245 call device_memcpy(this%slag%lf(1)%x, this%slag%lf(1)%x_d, &
246 this%s%dof%size(), host_to_device, sync=.false.)
247 call device_memcpy(this%slag%lf(2)%x, this%slag%lf(2)%x_d, &
248 this%s%dof%size(), host_to_device, sync=.false.)
249 call device_memcpy(this%abs1%x, this%abs1%x_d, &
250 w%dof%size(), host_to_device, sync=.false.)
251 call device_memcpy(this%abs2%x, this%abs2%x_d, &
252 w%dof%size(), host_to_device, sync=.false.)
261 class(
chkp_t),
intent(inout) :: this
262 type(field_series_t),
target :: ulag
263 type(field_series_t),
target :: vlag
264 type(field_series_t),
target :: wlag
274 class(
chkp_t),
intent(inout) :: this
275 type(field_t),
target :: s
284 class(
chkp_t),
intent(in) :: this
285 real(kind=dp) :: rtime
Copy data between host and device (or device and device)
Synchronize a device or stream.
subroutine chkp_sync_host(this)
Synchronize checkpoint with device.
subroutine chkp_init(this, u, v, w, p)
Initialize checkpoint structure with mandatory data.
subroutine chkp_sync_device(this)
Synchronize device with checkpoint.
subroutine chkp_add_scalar(this, s)
Add scalars.
pure real(kind=dp) function chkp_restart_time(this)
Return restart time from a loaded checkpoint.
subroutine chkp_free(this)
Reset checkpoint.
subroutine chkp_add_lag(this, ulag, vlag, wlag)
Add lagged velocity terms.
Device abstraction, common interface for various accelerators.
integer, parameter, public device_to_host
integer, parameter neko_bcknd_device
integer, parameter, public dp
integer, parameter, public rp
Global precision used in computations.
Defines a function space.
The function space for the SEM solution fields.