39 opr_cpu_conv1, opr_cpu_convect_scalar, opr_cpu_cdtp, &
42 opr_sx_conv1, opr_sx_convect_scalar, opr_sx_cdtp, &
43 opr_sx_dudxyz, opr_sx_lambda2, opr_sx_set_convect_rst
62 use mpi_f08,
only : mpi_allreduce, mpi_in_place, mpi_max, mpi_sum
63 use,
intrinsic :: iso_c_binding, only : c_ptr
79 subroutine dudxyz (du, u, dr, ds, dt, coef)
80 type(
coef_t),
intent(in),
target :: coef
81 real(kind=
rp),
dimension(coef%Xh%lx, coef%Xh%ly, coef%Xh%lz, &
coef%msh%nelv),
intent(inout) :: du
82 real(kind=
rp),
dimension(coef%Xh%lx, coef%Xh%ly, coef%Xh%lz, &
coef%msh%nelv),
intent(in) :: u, dr, ds, dt
85 call opr_sx_dudxyz(du, u, dr, ds, dt, coef)
91 call opr_cpu_dudxyz(du, u, dr, ds, dt, coef)
102 subroutine div(res, ux, uy, uz, coef)
103 type(
coef_t),
intent(in),
target :: coef
104 real(kind=
rp),
dimension(coef%Xh%lx, coef%Xh%ly, coef%Xh%lz, &
coef%msh%nelv),
intent(inout) :: res
105 real(kind=
rp),
dimension(coef%Xh%lx, coef%Xh%ly, coef%Xh%lz, &
coef%msh%nelv),
intent(in) :: ux, uy, uz
117 call dudxyz(res, ux, coef%drdx, coef%dsdx, coef%dtdx, coef)
120 call dudxyz(work%x, uy, coef%drdy, coef%dsdy, coef%dtdy, coef)
124 call add2(res, work%x, work%size())
128 call dudxyz(work%x, uz, coef%drdz, coef%dsdz, coef%dtdz, coef)
132 call add2(res, work%x, work%size())
145 subroutine grad(ux, uy, uz, u, coef)
146 type(
coef_t),
intent(in) :: coef
147 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: ux
148 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: uy
149 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: uz
150 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(in) :: u
152 call dudxyz(ux, u, coef%drdx, coef%dsdx, coef%dtdx, coef)
153 call dudxyz(uy, u, coef%drdy, coef%dsdy, coef%dtdy, coef)
154 call dudxyz(uz, u, coef%drdz, coef%dsdz, coef%dtdz, coef)
170 subroutine opgrad(ux, uy, uz, u, coef, es, ee)
171 type(
coef_t),
intent(in) :: coef
172 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: ux
173 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: uy
174 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: uz
175 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(in) :: u
176 integer,
optional :: es, ee
177 integer :: eblk_start, eblk_end
179 if (
present(es))
then
185 if (
present(ee))
then
188 eblk_end = coef%msh%nelv
192 call opr_sx_opgrad(ux, uy, uz, u, coef)
198 call opr_cpu_opgrad(ux, uy, uz, u, coef, eblk_start, eblk_end)
207 subroutine ortho(x, glb_n_points, n)
208 integer,
intent(in) :: n
209 integer(kind=i8),
intent(in) :: glb_n_points
210 real(kind=
rp),
dimension(n),
intent(inout) :: x
218 c =
glsum(x, n)/glb_n_points
235 subroutine cdtp (dtx, x, dr, ds, dt, coef, es, ee)
236 type(
coef_t),
intent(in) :: coef
237 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: dtx
238 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(inout) :: x
239 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(in) :: dr
240 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(in) :: ds
241 real(kind=
rp),
dimension(coef%Xh%lxyz, coef%msh%nelv),
intent(in) :: dt
242 integer,
optional :: es, ee
243 integer :: eblk_start, eblk_end
245 if (
present(es))
then
251 if (
present(ee))
then
254 eblk_end = coef%msh%nelv
258 call opr_sx_cdtp(dtx, x, dr, ds, dt, coef)
264 call opr_cpu_cdtp(dtx, x, dr, ds, dt, coef, eblk_start, eblk_end)
279 subroutine conv1(du, u, vx, vy, vz, Xh, coef, es, ee)
280 type(
space_t),
intent(in) :: xh
281 type(
coef_t),
intent(in) :: coef
282 real(kind=
rp),
intent(inout) :: du(xh%lxyz, coef%msh%nelv)
283 real(kind=
rp),
intent(inout) :: u(xh%lx, xh%ly, xh%lz, coef%msh%nelv)
284 real(kind=
rp),
intent(inout) :: vx(xh%lx, xh%ly, xh%lz, coef%msh%nelv)
285 real(kind=
rp),
intent(inout) :: vy(xh%lx, xh%ly, xh%lz, coef%msh%nelv)
286 real(kind=
rp),
intent(inout) :: vz(xh%lx, xh%ly, xh%lz, coef%msh%nelv)
287 integer,
optional :: es, ee
288 integer :: eblk_end, eblk_start
290 associate(nelv => coef%msh%nelv, gdim => coef%msh%gdim)
291 if (
present(es))
then
297 if (
present(ee))
then
300 eblk_end = coef%msh%nelv
304 call opr_sx_conv1(du, u, vx, vy, vz, xh, coef, nelv)
310 call opr_cpu_conv1(du, u, vx, vy, vz, xh, coef, eblk_start, eblk_end)
333 type(space_t),
intent(in) :: xh_gl
334 type(space_t),
intent(in) :: xh_gll
335 type(coef_t),
intent(in) :: coef_GLL
336 type(coef_t),
intent(in) :: coef_GL
337 type(interpolator_t),
intent(inout) :: GLL_to_GL
338 real(kind=rp),
intent(inout) :: &
339 du(xh_gll%lx, xh_gll%ly, xh_gll%lz, coef_gl%msh%nelv)
340 real(kind=rp),
intent(inout) :: &
341 u(xh_gl%lx, xh_gl%lx, xh_gl%lx, coef_gl%msh%nelv)
342 real(kind=rp),
intent(inout) :: c(xh_gl%lxyz, coef_gl%msh%nelv, 3)
344 if (neko_bcknd_sx .eq. 1)
then
345 call opr_sx_convect_scalar(du, u, c, xh_gll, xh_gl, &
346 coef_gll, coef_gl, gll_to_gl)
347 else if (neko_bcknd_xsmm .eq. 1)
then
348 call opr_xsmm_convect_scalar(du, u, c, xh_gll, xh_gl, &
349 coef_gll, coef_gl, gll_to_gl)
351 call opr_cpu_convect_scalar(du, u, c, xh_gll, xh_gl, &
352 coef_gll, coef_gl, gll_to_gl)
367 subroutine curl(w1, w2, w3, u1, u2, u3, work1, work2, coef, event)
368 type(field_t),
intent(inout) :: w1
369 type(field_t),
intent(inout) :: w2
370 type(field_t),
intent(inout) :: w3
371 type(field_t),
intent(in) :: u1
372 type(field_t),
intent(in) :: u2
373 type(field_t),
intent(in) :: u3
374 type(field_t),
intent(inout) :: work1
375 type(field_t),
intent(inout) :: work2
376 type(coef_t),
intent(in) :: coef
377 type(c_ptr),
optional,
intent(inout) :: event
379 if (neko_bcknd_sx .eq. 1)
then
380 call opr_sx_curl(w1, w2, w3, u1, u2, u3, work1, work2, coef)
381 else if (neko_bcknd_xsmm .eq. 1)
then
382 call opr_xsmm_curl(w1, w2, w3, u1, u2, u3, work1, work2, coef)
383 else if (neko_bcknd_device .eq. 1)
then
384 if (
present(event))
then
385 call opr_device_curl(w1, w2, w3, u1, u2, u3, &
386 work1, work2, coef, event)
388 call opr_device_curl(w1, w2, w3, u1, u2, u3, work1, work2, coef)
391 call opr_cpu_curl(w1, w2, w3, u1, u2, u3, work1, work2, coef)
405 function cfl(dt, u, v, w, Xh, coef, nelv, gdim)
406 type(space_t),
intent(in) :: xh
407 type(coef_t),
intent(in) :: coef
408 integer,
intent(in) :: nelv, gdim
409 real(kind=rp),
intent(in) :: dt
410 real(kind=rp),
dimension(Xh%lx, Xh%ly, Xh%lz, nelv),
intent(in) :: u, v, w
414 if (neko_bcknd_sx .eq. 1)
then
415 cfl = opr_sx_cfl(dt, u, v, w, xh, coef, nelv)
416 else if (neko_bcknd_device .eq. 1)
then
417 cfl = opr_device_cfl(dt, u, v, w, xh, coef, nelv, gdim)
419 cfl = opr_cpu_cfl(dt, u, v, w, xh, coef, nelv, gdim)
422 if (.not. neko_device_mpi)
then
423 call mpi_allreduce(mpi_in_place,
cfl, 1, &
424 mpi_real_precision, mpi_max, neko_comm, ierr)
437 type(space_t),
intent(in) :: xh
438 type(coef_t),
intent(in) :: coef
439 integer,
intent(in) :: nelv, gdim
440 real(kind=rp),
intent(in) :: dt
441 real(kind=rp),
dimension(Xh%lx, Xh%ly, Xh%lz, nelv),
intent(in) :: max_wave_speed
444 type(field_t),
pointer :: zero_vector
447 n = xh%lx * xh%ly * xh%lz * nelv
450 call neko_scratch_registry%request_field(zero_vector, ind)
453 call field_rzero(zero_vector)
456 cfl_compressible =
cfl(dt, max_wave_speed, zero_vector%x, zero_vector%x, xh, coef, nelv, gdim)
459 call neko_scratch_registry%relinquish_field(ind)
475 subroutine strain_rate(s11, s22, s33, s12, s13, s23, u, v, w, coef)
476 type(field_t),
intent(in) :: u, v, w
477 type(coef_t),
intent(in) :: coef
478 real(kind=rp),
intent(inout) :: s11(u%Xh%lx, u%Xh%ly, u%Xh%lz, u%msh%nelv)
479 real(kind=rp),
intent(inout) :: s22(u%Xh%lx, u%Xh%ly, u%Xh%lz, u%msh%nelv)
480 real(kind=rp),
intent(inout) :: s33(u%Xh%lx, u%Xh%ly, u%Xh%lz, u%msh%nelv)
481 real(kind=rp),
intent(inout) :: s12(u%Xh%lx, u%Xh%ly, u%Xh%lz, u%msh%nelv)
482 real(kind=rp),
intent(inout) :: s13(u%Xh%lx, u%Xh%ly, u%Xh%lz, u%msh%nelv)
483 real(kind=rp),
intent(inout) :: s23(u%Xh%lx, u%Xh%ly, u%Xh%lz, u%msh%nelv)
485 type(c_ptr) :: s11_d, s22_d, s33_d, s12_d, s23_d, s13_d
487 integer :: nelv, lxyz
489 if (neko_bcknd_device .eq. 1)
then
490 s11_d = device_get_ptr(s11)
491 s22_d = device_get_ptr(s22)
492 s33_d = device_get_ptr(s33)
493 s12_d = device_get_ptr(s12)
494 s23_d = device_get_ptr(s23)
495 s13_d = device_get_ptr(s13)
502 call dudxyz (s12, u%x, coef%drdy, coef%dsdy, coef%dtdy, coef)
503 call dudxyz (s11, v%x, coef%drdx, coef%dsdx, coef%dtdx, coef)
504 if (neko_bcknd_device .eq. 1)
then
505 call device_add2(s12_d, s11_d, nelv*lxyz)
507 call add2(s12, s11, nelv*lxyz)
510 call dudxyz (s13, u%x, coef%drdz, coef%dsdz, coef%dtdz, coef)
511 call dudxyz (s11, w%x, coef%drdx, coef%dsdx, coef%dtdx, coef)
512 if (neko_bcknd_device .eq. 1)
then
513 call device_add2(s13_d, s11_d, nelv*lxyz)
515 call add2(s13, s11, nelv*lxyz)
518 call dudxyz (s23, v%x, coef%drdz, coef%dsdz, coef%dtdz, coef)
519 call dudxyz (s11, w%x, coef%drdy, coef%dsdy, coef%dtdy, coef)
520 if (neko_bcknd_device .eq. 1)
then
521 call device_add2(s23_d, s11_d, nelv*lxyz)
523 call add2(s23, s11, nelv*lxyz)
526 call dudxyz (s11, u%x, coef%drdx, coef%dsdx, coef%dtdx, coef)
527 call dudxyz (s22, v%x, coef%drdy, coef%dsdy, coef%dtdy, coef)
528 call dudxyz (s33, w%x, coef%drdz, coef%dsdz, coef%dtdz, coef)
530 if (neko_bcknd_device .eq. 1)
then
531 call device_cmult(s12_d, 0.5_rp, nelv*lxyz)
532 call device_cmult(s13_d, 0.5_rp, nelv*lxyz)
533 call device_cmult(s23_d, 0.5_rp, nelv*lxyz)
535 call cmult(s12, 0.5_rp, nelv*lxyz)
536 call cmult(s13, 0.5_rp, nelv*lxyz)
537 call cmult(s23, 0.5_rp, nelv*lxyz)
548 subroutine lambda2op(lambda2, u, v, w, coef)
549 type(coef_t),
intent(in) :: coef
550 type(field_t),
intent(inout) ::
lambda2
551 type(field_t),
intent(in) :: u, v, w
553 if (neko_bcknd_sx .eq. 1)
then
554 call opr_sx_lambda2(
lambda2, u, v, w, coef)
555 else if (neko_bcknd_device .eq. 1)
then
556 call opr_device_lambda2(
lambda2, u, v, w, coef)
558 call opr_cpu_lambda2(
lambda2, u, v, w, coef)
574 type(space_t),
intent(inout) :: xh
575 type(coef_t),
intent(inout) :: coef
576 real(kind=rp),
dimension(Xh%lxyz, coef%msh%nelv), &
577 intent(inout) :: cr, cs, ct
578 real(kind=rp),
dimension(Xh%lxyz, coef%msh%nelv), &
579 intent(in) :: cx, cy, cz
581 if (neko_bcknd_sx .eq. 1)
then
582 call opr_sx_set_convect_rst(cr, cs, ct, cx, cy, cz, xh, coef)
583 else if (neko_bcknd_xsmm .eq. 1)
then
584 call opr_xsmm_set_convect_rst(cr, cs, ct, cx, cy, cz, xh, coef)
586 call opr_cpu_set_convect_rst(cr, cs, ct, cx, cy, cz, xh, coef)
606 subroutine runge_kutta(phi, c_r1, c_r23, c_r4, Xh_GLL, Xh_GL, coef, &
607 coef_GL, GLL_to_GL, tau, dtau, n, nel, n_GL)
608 type(space_t),
intent(in) :: xh_gll
609 type(space_t),
intent(inout) :: xh_gl
610 type(coef_t),
intent(in) :: coef
611 type(coef_t),
intent(inout) :: coef_gl
612 type(interpolator_t) :: gll_to_gl
613 real(kind=rp),
intent(inout) :: tau, dtau
614 integer,
intent(in) :: n, nel, n_gl
615 real(kind=rp),
dimension(n),
intent(inout) :: phi
616 real(kind=rp),
dimension(3 * n_GL),
intent(inout) :: c_r1, c_r23, c_r4
617 real(kind=rp) :: c1, c2, c3
619 real(kind=rp),
dimension(n) :: u1, r1, r2, r3, r4
620 real(kind=rp),
dimension(n_GL) :: u1_gl
628 call invcol3 (u1, phi, coef%B, n)
629 call gll_to_gl%map(u1_gl, u1, nel, xh_gl)
632 call col2(r1, coef%B, n)
635 call add3s2 (u1, phi, r1, c1, c2, n)
636 call invcol2 (u1, coef%B, n)
637 call gll_to_gl%map(u1_gl, u1, nel, xh_gl)
640 call col2(r2, coef%B, n)
643 call add3s2 (u1, phi, r2, c1, c2, n)
644 call invcol2 (u1, coef%B, n)
645 call gll_to_gl%map(u1_gl, u1, nel, xh_gl)
648 call col2(r3, coef%B, n)
651 call add3s2 (u1, phi, r3, c1, c3, n)
652 call invcol2 (u1, coef%B, n)
653 call gll_to_gl%map(u1_gl, u1, nel, xh_gl)
656 call col2(r4, coef%B, n)
661 phi(i) = phi(i) + c1 * (r1(i) + r4(i)) + c2 * (r2(i) + r3(i))
Return the device pointer for an associated Fortran array.
type(mpi_datatype), public mpi_real_precision
MPI type for working precision of REAL types.
type(mpi_comm), public neko_comm
MPI communicator.
subroutine, public device_add2(a_d, b_d, n, strm)
Vector addition .
real(kind=rp) function, public device_glsum(a_d, n, strm)
Sum a vector of length n.
subroutine, public device_cmult(a_d, c, n, strm)
Multiplication by constant c .
subroutine, public device_copy(a_d, b_d, n, strm)
Copy a vector .
Device abstraction, common interface for various accelerators.
subroutine, public field_rzero(a, n)
Zero a real vector.
Routines to interpolate between different spaces.
A simulation component that computes lambda2 The values are stored in the field registry under the na...
subroutine, public cmult(a, c, n)
Multiplication by constant c .
subroutine, public invcol2(a, b, n)
Vector division .
subroutine, public cadd(a, s, n)
Add a scalar to vector .
real(kind=rp) function, public glsum(a, n)
Sum a vector of length n.
subroutine, public add2(a, b, n)
Vector addition .
subroutine, public invcol3(a, b, c, n)
Invert a vector .
subroutine, public add3s2(a, b, c, c1, c2, n)
Returns .
subroutine, public col2(a, b, n)
Vector multiplication .
subroutine, public copy(a, b, n)
Copy a vector .
subroutine, public rzero(a, n)
Zero a real vector.
integer, parameter neko_bcknd_sx
integer, parameter neko_bcknd_device
logical, parameter neko_device_mpi
integer, parameter neko_bcknd_xsmm
integer, parameter, public i8
integer, parameter, public rp
Global precision used in computations.
subroutine, public runge_kutta(phi, c_r1, c_r23, c_r4, xh_gll, xh_gl, coef, coef_gl, gll_to_gl, tau, dtau, n, nel, n_gl)
Compute one step of Runge Kutta time interpolation for OIFS scheme.
subroutine, public set_convect_rst(cr, cs, ct, cx, cy, cz, xh, coef)
Transforms the convecting velocity field to the rst form of the GL space.
subroutine, public ortho(x, glb_n_points, n)
Othogonalize with regard to vector (1,1,1,1,1,1...,1)^T.
subroutine convect_scalar(du, u, c, xh_gll, xh_gl, coef_gll, coef_gl, gll_to_gl)
Apply the convecting velocity c to the to the scalar field u, used in the OIFS scheme.
real(kind=rp) function, public cfl(dt, u, v, w, xh, coef, nelv, gdim)
subroutine, public opgrad(ux, uy, uz, u, coef, es, ee)
Compute the weak gradient of a scalar field, i.e. the gradient multiplied by the mass matrix.
subroutine, public div(res, ux, uy, uz, coef)
Compute the divergence of a vector field.
real(kind=rp) function, public cfl_compressible(dt, max_wave_speed, xh, coef, nelv, gdim)
subroutine, public conv1(du, u, vx, vy, vz, xh, coef, es, ee)
Compute the advection term.
subroutine, public grad(ux, uy, uz, u, coef)
Compute the gradient of a scalar field.
subroutine, public curl(w1, w2, w3, u1, u2, u3, work1, work2, coef, event)
subroutine, public strain_rate(s11, s22, s33, s12, s13, s23, u, v, w, coef)
Compute the strain rate tensor, i.e 0.5 * du_i/dx_j + du_j/dx_i.
subroutine, public lambda2op(lambda2, u, v, w, coef)
Compute the Lambda2 field for a given velocity field.
subroutine, public cdtp(dtx, x, dr, ds, dt, coef, es, ee)
Apply D^T to a scalar field, where D is the derivative matrix.
subroutine, public dudxyz(du, u, dr, ds, dt, coef)
Compute derivative of a scalar field along a single direction.
subroutine, public opr_cpu_curl(w1, w2, w3, u1, u2, u3, work1, work2, c_xh)
real(kind=rp) function, public opr_cpu_cfl(dt, u, v, w, xh, coef, nelv, gdim)
subroutine, public opr_cpu_lambda2(lambda2, u, v, w, coef)
Operators accelerator backends.
subroutine, public opr_device_cdtp(dtx, x, dr, ds, dt, coef)
real(kind=rp) function, public opr_device_cfl(dt, u, v, w, xh, coef, nelv, gdim)
subroutine, public opr_device_curl(w1, w2, w3, u1, u2, u3, work1, work2, c_xh, event)
subroutine, public opr_device_dudxyz(du, u, dr, ds, dt, coef)
subroutine, public opr_device_opgrad(ux, uy, uz, u, coef)
subroutine, public opr_device_conv1(du, u, vx, vy, vz, xh, coef, nelv, gdim)
subroutine, public opr_device_lambda2(lambda2, u, v, w, coef)
Operators SX-Aurora backend.
subroutine, public opr_sx_curl(w1, w2, w3, u1, u2, u3, work1, work2, c_xh)
Operators libxsmm backend.
subroutine, public opr_xsmm_conv1(du, u, vx, vy, vz, xh, coef, nelv, gdim)
subroutine, public opr_xsmm_cdtp(dtx, x, dr, ds, dt, coef)
subroutine, public opr_xsmm_curl(w1, w2, w3, u1, u2, u3, work1, work2, c_xh)
subroutine, public opr_xsmm_dudxyz(du, u, dr, ds, dt, coef)
subroutine, public opr_xsmm_opgrad(ux, uy, uz, u, coef)
subroutine, public opr_xsmm_set_convect_rst(cr, cs, ct, cx, cy, cz, xh, coef)
subroutine, public opr_xsmm_convect_scalar(du, u, c, xh_gll, xh_gl, coef_gll, coef_gl, gll_to_gl)
Defines a registry for storing and requesting temporary fields This can be used when you have a funct...
type(scratch_registry_t), target, public neko_scratch_registry
Global scratch registry.
Defines a function space.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Interpolation between two space::space_t.
The function space for the SEM solution fields.