d6/d42/euler__res__sx_8f90_source.html

module euler_res_sx

  use euler_residual, only : euler_rhs_t

  use field, only : field_t

  use ax_product, only : ax_t

  use coefs, only : coef_t

  use gather_scatter, only : gs_t

  use num_types, only : rp

  use operators, only: div

  use math, only: subcol3, copy, sub2, add2, add3, &

       col2, col3, addcol3, cmult, cfill, invcol3

  use gs_ops, only : gs_op_add

  use scratch_registry, only: neko_scratch_registry

  use runge_kutta_time_scheme, only : runge_kutta_time_scheme_t

  use field_list, only : field_list_t

  implicit none

  private


  type, public, extends(euler_rhs_t) :: euler_res_sx_t

   contains

     procedure, nopass :: step => advance_primitive_variables_sx

     procedure, nopass :: evaluate_rhs_sx

  end type euler_res_sx_t

  type, public, extends(euler_rhs_t) :: euler_res_sx_t …


contains


  subroutine advance_primitive_variables_sx(rho_field, m_x, m_y, m_z, E, p, u, v, w, Ax, &

       coef, gs, h, c_avisc_low, rk_scheme, dt)

    type(field_t), intent(inout) :: rho_field, m_x, m_y, m_z, E

    type(field_t), intent(in) :: p, u, v, w, h

    class(ax_t), intent(inout) :: Ax

    type(coef_t), intent(inout) :: coef

    type(gs_t), intent(inout) :: gs

    real(kind=rp) :: c_avisc_low

    class(runge_kutta_time_scheme_t), intent(in) :: rk_scheme

    real(kind=rp), intent(in) :: dt

    integer :: n, s, i, j, k

    real(kind=rp) :: t, c

    type(field_t), pointer :: k_rho_1, k_rho_2, k_rho_3, k_rho_4, &

         k_m_x_1, k_m_x_2, k_m_x_3, k_m_x_4, &

         k_m_y_1, k_m_y_2, k_m_y_3, k_m_y_4, &

         k_m_z_1, k_m_z_2, k_m_z_3, k_m_z_4, &

         k_e_1, k_e_2, k_e_3, k_e_4, &

         temp_rho, temp_m_x, temp_m_y, temp_m_z, temp_e

    integer :: temp_indices(25)

    type(field_list_t) :: k_rho, k_m_x, k_m_y, k_m_z, k_E


    n = p%dof%size()

    s = rk_scheme%order

    call neko_scratch_registry%request_field(k_rho_1, temp_indices(1))

    call neko_scratch_registry%request_field(k_rho_2, temp_indices(2))

    call neko_scratch_registry%request_field(k_rho_3, temp_indices(3))

    call neko_scratch_registry%request_field(k_rho_4, temp_indices(4))

    call neko_scratch_registry%request_field(k_m_x_1, temp_indices(5))

    call neko_scratch_registry%request_field(k_m_x_2, temp_indices(6))

    call neko_scratch_registry%request_field(k_m_x_3, temp_indices(7))

    call neko_scratch_registry%request_field(k_m_x_4, temp_indices(8))

    call neko_scratch_registry%request_field(k_m_y_1, temp_indices(9))

    call neko_scratch_registry%request_field(k_m_y_2, temp_indices(10))

    call neko_scratch_registry%request_field(k_m_y_3, temp_indices(11))

    call neko_scratch_registry%request_field(k_m_y_4, temp_indices(12))

    call neko_scratch_registry%request_field(k_m_z_1, temp_indices(13))

    call neko_scratch_registry%request_field(k_m_z_2, temp_indices(14))

    call neko_scratch_registry%request_field(k_m_z_3, temp_indices(15))

    call neko_scratch_registry%request_field(k_m_z_4, temp_indices(16))

    call neko_scratch_registry%request_field(k_e_1, temp_indices(17))

    call neko_scratch_registry%request_field(k_e_2, temp_indices(18))

    call neko_scratch_registry%request_field(k_e_3, temp_indices(19))

    call neko_scratch_registry%request_field(k_e_4, temp_indices(20))

    call neko_scratch_registry%request_field(temp_rho, temp_indices(21))

    call neko_scratch_registry%request_field(temp_m_x, temp_indices(22))

    call neko_scratch_registry%request_field(temp_m_y, temp_indices(23))

    call neko_scratch_registry%request_field(temp_m_z, temp_indices(24))

    call neko_scratch_registry%request_field(temp_e, temp_indices(25))


    call k_rho%init(4)

    call k_rho%assign(1, k_rho_1)

    call k_rho%assign(2, k_rho_2)

    call k_rho%assign(3, k_rho_3)

    call k_rho%assign(4, k_rho_4)

    call k_m_x%init(4)

    call k_m_x%assign(1, k_m_x_1)

    call k_m_x%assign(2, k_m_x_2)

    call k_m_x%assign(3, k_m_x_3)

    call k_m_x%assign(4, k_m_x_4)

    call k_m_y%init(4)

    call k_m_y%assign(1, k_m_y_1)

    call k_m_y%assign(2, k_m_y_2)

    call k_m_y%assign(3, k_m_y_3)

    call k_m_y%assign(4, k_m_y_4)

    call k_m_z%init(4)

    call k_m_z%assign(1, k_m_z_1)

    call k_m_z%assign(2, k_m_z_2)

    call k_m_z%assign(3, k_m_z_3)

    call k_m_z%assign(4, k_m_z_4)

    call k_e%init(4)

    call k_e%assign(1, k_e_1)

    call k_e%assign(2, k_e_2)

    call k_e%assign(3, k_e_3)

    call k_e%assign(4, k_e_4)


    ! Runge-Kutta stages

    do i = 1, s

       call copy(temp_rho%x, rho_field%x, n)

       call copy(temp_m_x%x, m_x%x, n)

       call copy(temp_m_y%x, m_y%x, n)

       call copy(temp_m_z%x, m_z%x, n)

       call copy(temp_e%x, e%x, n)


       do j = 1, i-1

          do concurrent(k = 1:n)

             temp_rho%x(k,1,1,1) = temp_rho%x(k,1,1,1) &

                  + dt * rk_scheme%coeffs_A(i, j) * k_rho%items(j)%ptr%x(k,1,1,1)

             temp_m_x%x(k,1,1,1) = temp_m_x%x(k,1,1,1) &

                  + dt * rk_scheme%coeffs_A(i, j) * k_m_x%items(j)%ptr%x(k,1,1,1)

             temp_m_y%x(k,1,1,1) = temp_m_y%x(k,1,1,1) &

                  + dt * rk_scheme%coeffs_A(i, j) * k_m_y%items(j)%ptr%x(k,1,1,1)

             temp_m_z%x(k,1,1,1) = temp_m_z%x(k,1,1,1) &

                  + dt * rk_scheme%coeffs_A(i, j) * k_m_z%items(j)%ptr%x(k,1,1,1)

             temp_e%x(k,1,1,1) = temp_e%x(k,1,1,1) &

                  + dt * rk_scheme%coeffs_A(i, j) * k_e%items(j)%ptr%x(k,1,1,1)

          end do

       end do


       ! Compute f(U) = rhs(U) for the intermediate values

       call evaluate_rhs_sx(k_rho%items(i)%ptr, k_m_x%items(i)%ptr, &

            k_m_y%items(i)%ptr, k_m_z%items(i)%ptr, &

            k_e%items(i)%ptr, &

            temp_rho, temp_m_x, temp_m_y, temp_m_z, temp_e, &

            p, u, v, w, ax, &

            coef, gs, h, c_avisc_low)

    end do


    ! Update the solution

    do i = 1, s

       do concurrent(k = 1:n)

          rho_field%x(k,1,1,1) = rho_field%x(k,1,1,1) &

               + dt * rk_scheme%coeffs_b(i) * k_rho%items(i)%ptr%x(k,1,1,1)

          m_x%x(k,1,1,1) = m_x%x(k,1,1,1) &

               + dt * rk_scheme%coeffs_b(i) * k_m_x%items(i)%ptr%x(k,1,1,1)

          m_y%x(k,1,1,1) = m_y%x(k,1,1,1) &

               + dt * rk_scheme%coeffs_b(i) * k_m_y%items(i)%ptr%x(k,1,1,1)

          m_z%x(k,1,1,1) = m_z%x(k,1,1,1) &

               + dt * rk_scheme%coeffs_b(i) * k_m_z%items(i)%ptr%x(k,1,1,1)

          e%x(k,1,1,1) = e%x(k,1,1,1) &

               + dt * rk_scheme%coeffs_b(i) * k_e%items(i)%ptr%x(k,1,1,1)

       end do

    end do


    call neko_scratch_registry%relinquish_field(temp_indices)

  subroutine advance_primitive_variables_sx(rho_field, m_x, m_y, m_z, E, p, u, v, w, Ax, & …

  end subroutine advance_primitive_variables_sx


  subroutine evaluate_rhs_sx(rhs_rho_field, rhs_m_x, rhs_m_y, rhs_m_z, rhs_E, &

       rho_field, m_x, m_y, m_z, E, p, u, v, w, Ax, &

       coef, gs, h, c_avisc_low)

    type(field_t), intent(inout) :: rhs_rho_field, rhs_m_x, &

         rhs_m_y, rhs_m_z, rhs_E

    type(field_t), intent(inout) :: rho_field, m_x, m_y, m_z, E

    type(field_t), intent(in) :: p, u, v, w, h

    class(ax_t), intent(inout) :: Ax

    type(coef_t), intent(inout) :: coef

    type(gs_t), intent(inout) :: gs

    real(kind=rp) :: c_avisc_low

    integer :: i, n

    type(field_t), pointer :: temp, f_x, f_y, f_z, &

         visc_rho, visc_m_x, visc_m_y, visc_m_z, visc_E

    integer :: temp_indices(9)


    n = coef%dof%size()

    call neko_scratch_registry%request_field(temp, temp_indices(1))

    call neko_scratch_registry%request_field(f_x, temp_indices(2))

    call neko_scratch_registry%request_field(f_y, temp_indices(3))

    call neko_scratch_registry%request_field(f_z, temp_indices(4))


    call div(rhs_rho_field%x, m_x%x, m_y%x, m_z%x, coef)


    ! m_x

    do concurrent(i = 1:n)

       f_x%x(i,1,1,1) = m_x%x(i,1,1,1) * m_x%x(i,1,1,1) / rho_field%x(i, 1, 1, 1) &

            + p%x(i,1,1,1)

       f_y%x(i,1,1,1) = m_x%x(i,1,1,1) * m_y%x(i,1,1,1) / rho_field%x(i, 1, 1, 1)

       f_z%x(i,1,1,1) = m_x%x(i,1,1,1) * m_z%x(i,1,1,1) / rho_field%x(i, 1, 1, 1)

    end do

    call div(rhs_m_x%x, f_x%x, f_y%x, f_z%x, coef)

    ! m_y

    do concurrent(i = 1:n)

       f_x%x(i,1,1,1) = m_y%x(i,1,1,1) * m_x%x(i,1,1,1) / rho_field%x(i, 1, 1, 1)

       f_y%x(i,1,1,1) = m_y%x(i,1,1,1) * m_y%x(i,1,1,1) / rho_field%x(i, 1, 1, 1) &

            + p%x(i,1,1,1)

       f_z%x(i,1,1,1) = m_y%x(i,1,1,1) * m_z%x(i,1,1,1) / rho_field%x(i, 1, 1, 1)

    end do

    call div(rhs_m_y%x, f_x%x, f_y%x, f_z%x, coef)

    ! m_z

    do concurrent(i = 1:n)

       f_x%x(i,1,1,1) = m_z%x(i,1,1,1) * m_x%x(i,1,1,1) / rho_field%x(i, 1, 1, 1)

       f_y%x(i,1,1,1) = m_z%x(i,1,1,1) * m_y%x(i,1,1,1) / rho_field%x(i, 1, 1, 1)

       f_z%x(i,1,1,1) = m_z%x(i,1,1,1) * m_z%x(i,1,1,1) / rho_field%x(i, 1, 1, 1) &

            + p%x(i,1,1,1)

    end do

    call div(rhs_m_z%x, f_x%x, f_y%x, f_z%x, coef)


    do concurrent(i = 1:n)

       f_x%x(i,1,1,1) = (e%x(i,1,1,1) + p%x(i,1,1,1)) &

            * u%x(i,1,1,1)

       f_y%x(i,1,1,1) = (e%x(i,1,1,1) + p%x(i,1,1,1)) &

            * v%x(i,1,1,1)

       f_z%x(i,1,1,1) = (e%x(i,1,1,1) + p%x(i,1,1,1)) &

            * w%x(i,1,1,1)

    end do

    call div(rhs_e%x, f_x%x, f_y%x, f_z%x, coef)


    call gs%op(rhs_rho_field, gs_op_add)

    call gs%op(rhs_m_x, gs_op_add)

    call gs%op(rhs_m_y, gs_op_add)

    call gs%op(rhs_m_z, gs_op_add)

    call gs%op(rhs_e, gs_op_add)


    do concurrent(i = 1:rhs_e%dof%size())

       rhs_rho_field%x(i,1,1,1) = rhs_rho_field%x(i,1,1,1) * coef%mult(i,1,1,1)

       rhs_m_x%x(i,1,1,1) = rhs_m_x%x(i,1,1,1) * coef%mult(i,1,1,1)

       rhs_m_y%x(i,1,1,1) = rhs_m_y%x(i,1,1,1) * coef%mult(i,1,1,1)

       rhs_m_z%x(i,1,1,1) = rhs_m_z%x(i,1,1,1) * coef%mult(i,1,1,1)

       rhs_e%x(i,1,1,1) = rhs_e%x(i,1,1,1) * coef%mult(i,1,1,1)

    end do


    call neko_scratch_registry%request_field(visc_rho, temp_indices(5))

    call neko_scratch_registry%request_field(visc_m_x, temp_indices(6))

    call neko_scratch_registry%request_field(visc_m_y, temp_indices(7))

    call neko_scratch_registry%request_field(visc_m_z, temp_indices(8))

    call neko_scratch_registry%request_field(visc_e, temp_indices(9))


    ! Calculate artificial diffusion

    call ax%compute(visc_rho%x, rho_field%x, coef, p%msh, p%Xh)

    call ax%compute(visc_m_x%x, m_x%x, coef, p%msh, p%Xh)

    call ax%compute(visc_m_y%x, m_y%x, coef, p%msh, p%Xh)

    call ax%compute(visc_m_z%x, m_z%x, coef, p%msh, p%Xh)

    call ax%compute(visc_e%x, e%x, coef, p%msh, p%Xh)


    call gs%op(visc_rho, gs_op_add)

    call gs%op(visc_m_x, gs_op_add)

    call gs%op(visc_m_y, gs_op_add)

    call gs%op(visc_m_z, gs_op_add)

    call gs%op(visc_e, gs_op_add)


    ! Move div to the rhs and apply the artificial viscosity

    do concurrent(i = 1:n)

       rhs_rho_field%x(i,1,1,1) = -rhs_rho_field%x(i,1,1,1) &

            - c_avisc_low * h%x(i,1,1,1) * coef%Binv(i,1,1,1) * visc_rho%x(i,1,1,1)

       rhs_m_x%x(i,1,1,1) = -rhs_m_x%x(i,1,1,1) &

            - c_avisc_low * h%x(i,1,1,1) * coef%Binv(i,1,1,1) * visc_m_x%x(i,1,1,1)

       rhs_m_y%x(i,1,1,1) = -rhs_m_y%x(i,1,1,1) &

            - c_avisc_low * h%x(i,1,1,1) * coef%Binv(i,1,1,1) * visc_m_y%x(i,1,1,1)

       rhs_m_z%x(i,1,1,1) = -rhs_m_z%x(i,1,1,1) &

            - c_avisc_low * h%x(i,1,1,1) * coef%Binv(i,1,1,1) * visc_m_z%x(i,1,1,1)

       rhs_e%x(i,1,1,1) = -rhs_e%x(i,1,1,1) &

            - c_avisc_low * h%x(i,1,1,1) * coef%Binv(i,1,1,1) * visc_e%x(i,1,1,1)

    end do


    call neko_scratch_registry%relinquish_field(temp_indices)

  subroutine evaluate_rhs_sx(rhs_rho_field, rhs_m_x, rhs_m_y, rhs_m_z, rhs_E, & …

  end subroutine evaluate_rhs_sx


end module euler_res_sx

ax_product
Defines a Matrix-vector product.
Definition ax.f90:34

coefs
Coefficients.
Definition coef.f90:34

euler_res_sx
Definition euler_res_sx.f90:1

euler_res_sx::advance_primitive_variables_sx
subroutine advance_primitive_variables_sx(rho_field, m_x, m_y, m_z, e, p, u, v, w, ax, coef, gs, h, c_avisc_low, rk_scheme, dt)
Definition euler_res_sx.f90:27

euler_res_sx::evaluate_rhs_sx
subroutine evaluate_rhs_sx(rhs_rho_field, rhs_m_x, rhs_m_y, rhs_m_z, rhs_e, rho_field, m_x, m_y, m_z, e, p, u, v, w, ax, coef, gs, h, c_avisc_low)
Definition euler_res_sx.f90:154

euler_residual
Definition euler_res.f90:33

field_list
Definition field_list.f90:1

field
Defines a field.
Definition field.f90:34

gather_scatter
Gather-scatter.
Definition gather_scatter.f90:34

gs_ops
Defines Gather-scatter operations.
Definition gs_ops.f90:34

gs_ops::gs_op_add
integer, parameter, public gs_op_add
Definition gs_ops.f90:36

math
Definition math.f90:60

math::cmult
subroutine, public cmult(a, c, n)
Multiplication by constant c .
Definition math.f90:310

math::subcol3
subroutine, public subcol3(a, b, c, n)
Returns .
Definition math.f90:755

math::add3
subroutine, public add3(a, b, c, n)
Vector addition .
Definition math.f90:599

math::add2
subroutine, public add2(a, b, n)
Vector addition .
Definition math.f90:586

math::cfill
subroutine, public cfill(a, c, n)
Set all elements to a constant c .
Definition math.f90:347

math::invcol3
subroutine, public invcol3(a, b, c, n)
Invert a vector .
Definition math.f90:486

math::addcol3
subroutine, public addcol3(a, b, c, n)
Returns .
Definition math.f90:800

math::col2
subroutine, public col2(a, b, n)
Vector multiplication .
Definition math.f90:728

math::copy
subroutine, public copy(a, b, n)
Copy a vector .
Definition math.f90:238

math::col3
subroutine, public col3(a, b, c, n)
Vector multiplication with 3 vectors .
Definition math.f90:741

math::sub2
subroutine, public sub2(a, b, n)
Vector substraction .
Definition math.f90:628

num_types
Definition num_types.f90:1

num_types::rp
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12

operators
Operators.
Definition operators.f90:34

operators::div
subroutine, public div(res, ux, uy, uz, coef)
Compute the divergence of a vector field.
Definition operators.f90:103

runge_kutta_time_scheme
Definition runge_kutta_scheme.f90:33

scratch_registry
Defines a registry for storing and requesting temporary fields This can be used when you have a funct...
Definition scratch_registry.f90:37

scratch_registry::neko_scratch_registry
type(scratch_registry_t), target, public neko_scratch_registry
Global scratch registry.
Definition scratch_registry.f90:85

ax_product::ax_t
Base type for a matrix-vector product providing .
Definition ax.f90:43

coefs::coef_t
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition coef.f90:55

euler_res_sx::euler_res_sx_t
Definition euler_res_sx.f90:18

euler_residual::euler_rhs_t
Abstract type to compute rhs.
Definition euler_res.f90:47

field::field_t
Definition field.f90:47

field_list::field_list_t
field_list_t, To be able to group fields together
Definition field_list.f90:13

gather_scatter::gs_t
Definition gather_scatter.f90:62

runge_kutta_time_scheme::runge_kutta_time_scheme_t
Definition runge_kutta_scheme.f90:44