user_intf.f90

Go to the documentation of this file.

! Copyright (c) 2020-2025, The Neko Authors
! All rights reserved.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
!
!   * Redistributions of source code must retain the above copyright
!     notice, this list of conditions and the following disclaimer.
!
!   * Redistributions in binary form must reproduce the above
!     copyright notice, this list of conditions and the following
!     disclaimer in the documentation and/or other materials provided
!     with the distribution.
!
!   * Neither the name of the authors nor the names of its
!     contributors may be used to endorse or promote products derived
!     from this software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
module user_intf
  use field, only : field_t
  use field_list, only : field_list_t
  use vector_list, only : vector_list_t
  use mask, only : mask_t
  use coefs, only : coef_t
  use bc_list, only : bc_list_t
  use mesh, only : mesh_t
  use overset_interface, only : morph_overset_interface
  use field_dirichlet, only : field_dirichlet_update
  use field_neumann, only : field_neumann_update
  use num_types, only : rp
  use json_module, only : json_file
  use json_utils, only : json_extract_item, json_get, json_get_or_default
  use utils, only : neko_error, neko_warning
  use logger, only : neko_log
  use bc, only : bc_t
  use field_dirichlet, only : field_dirichlet_t
  use field_neumann, only : field_neumann_t
  use time_state, only : time_state_t
  implicit none
  private
 
  abstract interface
     subroutine user_startup_intf(params)
       import json_file
       type(json_file), intent(inout) :: params
     end subroutine user_startup_intf
  end interface
 
  abstract interface
     subroutine user_initial_conditions_intf(scheme_name, fields)
       import field_list_t
       character(len=*), intent(in) :: scheme_name
       type(field_list_t), intent(inout) :: fields
     end subroutine user_initial_conditions_intf
  end interface
 
  abstract interface
     subroutine user_initialize_intf(time)
       import time_state_t
       type(time_state_t), intent(in) :: time
     end subroutine user_initialize_intf
  end interface
 
  abstract interface
     subroutine user_mesh_setup_intf(msh, time)
       import mesh_t, time_state_t
       type(mesh_t), intent(inout) :: msh
       type(time_state_t), intent(in) :: time
     end subroutine user_mesh_setup_intf
  end interface
 
  abstract interface
     subroutine user_wall_sampling_gll_intf(bc_name, msk, indices)
       character(len=*), intent(in) :: bc_name
       integer, intent(in) :: msk(:)
       integer, intent(out) :: indices(:,:)
     end subroutine user_wall_sampling_gll_intf
  end interface
 
  abstract interface
     subroutine user_wall_sampling_distance_intf(bc_name, msk, distances)
       import rp
       character(len=*), intent(in) :: bc_name
       integer, intent(in) :: msk(:)
       real(kind=rp), intent(out) :: distances(:,:)
     end subroutine user_wall_sampling_distance_intf
  end interface
 
  abstract interface
     subroutine user_compute_intf(time)
       import time_state_t
       type(time_state_t), intent(in) :: time
     end subroutine user_compute_intf
  end interface
 
  abstract interface
     subroutine user_finalize_intf(time)
       import json_file
       import time_state_t
       type(time_state_t), intent(in) :: time
     end subroutine user_finalize_intf
  end interface
 
  abstract interface
     subroutine user_source_term_intf(scheme_name, rhs, time)
       import rp, time_state_t, field_list_t
       character(len=*), intent(in) :: scheme_name
       type(field_list_t), intent(inout) :: rhs
       type(time_state_t), intent(in) :: time
     end subroutine user_source_term_intf
  end interface
 
  abstract interface
     subroutine user_material_properties_intf(scheme_name, properties, time)
       import rp, field_list_t, time_state_t
       character(len=*), intent(in) :: scheme_name
       type(field_list_t), intent(inout) :: properties
       type(time_state_t), intent(in) :: time
     end subroutine user_material_properties_intf
  end interface
 
  abstract interface
     subroutine user_ale_mesh_velocity_intf(wm_x, wm_y, wm_z, coef, &
          x_ref, y_ref, z_ref, base_shapes, time)
       import field_t, time_state_t, coef_t
       type(coef_t), intent(in) :: coef
       type(field_t), intent(in) :: x_ref, y_ref, z_ref
       type(field_t), intent(inout) :: wm_x, wm_y, wm_z
       type(field_t), intent(in) :: base_shapes(:)
       type(time_state_t), intent(in) :: time
     end subroutine user_ale_mesh_velocity_intf
  end interface
 
  abstract interface
     subroutine user_ale_base_shapes_intf(base_shapes)
       import field_t
       type(field_t), intent(inout) :: base_shapes(:)
     end subroutine user_ale_base_shapes_intf
  end interface
 
  abstract interface
     subroutine user_ale_rigid_kinematics_intf(body_id, time, &
          vel_trans, vel_ang)
       import rp, time_state_t
       integer, intent(in) :: body_id
       type(time_state_t), intent(in) :: time
       real(kind=rp), intent(inout) :: vel_trans(3)
       real(kind=rp), intent(inout) :: vel_ang(3)
     end subroutine user_ale_rigid_kinematics_intf
  end interface
 
 
  type, public :: user_t
     logical :: suppress_type_injection = .false.
     procedure(user_startup_intf), nopass, pointer :: startup => null()
     procedure(user_initialize_intf), nopass, pointer :: initialize => null()
     procedure(user_initial_conditions_intf), nopass, pointer :: &
          initial_conditions => null()
     procedure(user_mesh_setup_intf), nopass, pointer :: mesh_setup => null()
     procedure(user_wall_sampling_gll_intf), nopass, pointer :: &
          wall_sampling_gll => null()
     procedure(user_wall_sampling_distance_intf), nopass, pointer :: &
          wall_sampling_distance => null()
     procedure(user_compute_intf), nopass, pointer :: preprocess => null()
     procedure(user_compute_intf), nopass, pointer :: compute => null()
     procedure(user_finalize_intf), nopass, pointer :: &
          finalize => null()
     procedure(user_source_term_intf), nopass, pointer :: &
          source_term => null()
     procedure(field_dirichlet_update), nopass, pointer :: &
          dirichlet_conditions => null()
     procedure(field_neumann_update), nopass, pointer :: &
          neumann_conditions => null()
     procedure(user_material_properties_intf), nopass, pointer :: &
          material_properties => null()
     procedure(user_ale_mesh_velocity_intf), nopass, pointer :: &
          ale_mesh_velocity => null()
     procedure(user_ale_rigid_kinematics_intf), nopass, pointer :: &
          ale_rigid_kinematics => null()
     procedure(user_ale_base_shapes_intf), nopass, pointer :: &
          ale_base_shapes => null()
     procedure(morph_overset_interface), nopass, pointer :: &
          morph_interface => null()
   contains
     procedure, pass(this) :: init => user_intf_init
  end type user_t
 
  public :: user_initial_conditions_intf, user_initialize_intf, &
       user_mesh_setup_intf, dummy_user_material_properties, &
       user_material_properties_intf, user_finalize_intf, &
       user_startup_intf, user_source_term_intf, &
       user_ale_mesh_velocity_intf, user_ale_base_shapes_intf, &
       user_ale_rigid_kinematics_intf, &
       dummy_user_ale_mesh_velocity, dummy_user_ale_base_shapes, &
       dummy_user_ale_rigid_kinematics, morph_overset_interface, &
       user_wall_sampling_gll_intf, user_wall_sampling_distance_intf
contains
 
  subroutine user_intf_init(this)
    class(user_t), intent(inout) :: this
    logical :: user_extended = .false.
    character(len=256), dimension(20) :: extensions
    integer :: i, n
 
    n = 0
    if (.not. associated(this%startup)) then
       this%startup => dummy_startup
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Startup'
    end if
 
    if (.not. associated(this%initial_conditions)) then
       this%initial_conditions => dummy_user_initial_conditions
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Initial condition'
    end if
 
    if (.not. associated(this%source_term)) then
       this%source_term => dummy_user_source_term
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Source term'
    end if
 
    if (.not. associated(this%dirichlet_conditions)) then
       this%dirichlet_conditions => dirichlet_do_nothing
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Dirichlet boundary condition'
    end if
 
    if (.not. associated(this%neumann_conditions)) then
       this%neumann_conditions => neumann_do_nothing
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Neumann boundary condition'
    end if
 
    if (.not. associated(this%mesh_setup)) then
       this%mesh_setup => dummy_user_mesh_setup
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Mesh setup'
    end if
 
    if (.not. associated(this%wall_sampling_gll)) then
       this%wall_sampling_gll => dummy_user_wall_sampling_gll
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- GLL wall sampling'
    end if
 
    if (.not. associated(this%wall_sampling_distance)) then
       this%wall_sampling_distance => dummy_user_wall_sampling_distance
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Distance wall sampling'
    end if
 
    if (.not. associated(this%compute)) then
       this%compute => dummy_user_compute
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- User compute'
    end if
 
    if (.not. associated(this%preprocess)) then
       this%preprocess => dummy_user_compute
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- User preprocess'
    end if
 
    if (.not. associated(this%initialize)) then
       this%initialize => dummy_initialize
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Initialize modules'
    end if
 
    if (.not. associated(this%finalize)) then
       this%finalize => dummy_user_finalize
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Finalize modules'
    end if
 
    if (.not. associated(this%material_properties)) then
       this%material_properties => dummy_user_material_properties
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Material properties'
    end if
 
    if (.not. associated(this%ale_mesh_velocity)) then
       this%ale_mesh_velocity => dummy_user_ale_mesh_velocity
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- ALE mesh velocity'
    end if
 
    if (.not. associated(this%ale_rigid_kinematics)) then
       this%ale_rigid_kinematics => dummy_user_ale_rigid_kinematics
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- ALE kinematics'
    end if
 
    if (.not. associated(this%ale_base_shapes)) then
       this%ale_base_shapes => dummy_user_ale_base_shapes
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- ALE base shapes'
    end if
 
    if (.not. associated(this%morph_interface)) then
       this%morph_interface => dummy_morph_overset_interface
    else
       user_extended = .true.
       n = n + 1
       write(extensions(n), '(A)') '- Morph overset interface'
    end if
 
    if (user_extended) then
       call neko_log%section('User defined extensions')
 
       do i = 1, n
          call neko_log%message(extensions(i))
       end do
 
       call neko_log%end_section()
    end if
 
  end subroutine user_intf_init
 
 
  !
  ! Below is the dummy user interface
  ! when running in pure turboNEKO mode
  !
 
  subroutine dummy_startup(params)
    type(json_file), intent(inout) :: params
  end subroutine dummy_startup
 
  subroutine dummy_user_initial_conditions(scheme_name, fields)
    character(len=*), intent(in) :: scheme_name
    type(field_list_t), intent(inout) :: fields
 
    call neko_error('Dummy user defined initial condition set')
  end subroutine dummy_user_initial_conditions
 
  subroutine dummy_user_source_term(scheme_name, rhs, time)
    character(len=*), intent(in) :: scheme_name
    type(field_list_t), intent(inout) :: rhs
    type(time_state_t), intent(in) :: time
    call neko_error('Dummy user defined source term set')
  end subroutine dummy_user_source_term
 
  subroutine dummy_user_mesh_setup(msh, time)
    type(mesh_t), intent(inout) :: msh
    type(time_state_t), intent(in) :: time
  end subroutine dummy_user_mesh_setup
 
  subroutine dummy_user_wall_sampling_gll(bc_name, msk, indices)
    character(len=*), intent(in) :: bc_name
    integer, intent(in) :: msk(:)
    integer, intent(out) :: indices(:,:)
 
    call neko_error('Wall sampling for '//trim(bc_name)// &
         ' is configured as user, but wall_sampling_gll is not set')
  end subroutine dummy_user_wall_sampling_gll
 
  subroutine dummy_user_wall_sampling_distance(bc_name, msk, distances)
    character(len=*), intent(in) :: bc_name
    integer, intent(in) :: msk(:)
    real(kind=rp), intent(out) :: distances(:,:)
 
    call neko_error('Wall sampling for '//trim(bc_name)// &
         ' is configured as user, but wall_sampling_distance is not set')
  end subroutine dummy_user_wall_sampling_distance
 
  subroutine dummy_user_compute(time)
    type(time_state_t), intent(in) :: time
  end subroutine dummy_user_compute
 
  subroutine dummy_initialize(time)
    type(time_state_t), intent(in) :: time
  end subroutine dummy_initialize
 
  subroutine dummy_user_finalize(time)
    type(time_state_t), intent(in) :: time
  end subroutine dummy_user_finalize
 
  subroutine dirichlet_do_nothing(fields, bc, time)
    type(field_list_t), intent(inout) :: fields
    type(field_dirichlet_t), intent(in) :: bc
    type(time_state_t), intent(in) :: time
  end subroutine dirichlet_do_nothing
 
  subroutine neumann_do_nothing(fields, bc, time)
    type(field_list_t), intent(inout) :: fields
    type(field_neumann_t), intent(in) :: bc
    type(time_state_t), intent(in) :: time
  end subroutine neumann_do_nothing
 
  subroutine dummy_user_material_properties(scheme_name, properties, time)
    character(len=*), intent(in) :: scheme_name
    type(field_list_t), intent(inout) :: properties
    type(time_state_t), intent(in) :: time
  end subroutine dummy_user_material_properties
 
  subroutine dummy_morph_overset_interface(interface_dof, interface_field, &
       interface_mask, time, bc_name, &
       find_interface)
    type(vector_list_t), intent(inout) :: interface_dof
    type(vector_list_t), intent(inout) :: interface_field
    type(mask_t), intent(in) :: interface_mask
    type(time_state_t), intent(in) :: time
    character(len=*), intent(in) :: bc_name
    logical, intent(inout) :: find_interface
  end subroutine dummy_morph_overset_interface
 
  subroutine dummy_user_ale_mesh_velocity(wm_x, wm_y, wm_z, coef, &
       x_ref, y_ref, z_ref, base_shapes, time)
    type(field_t), intent(inout) :: wm_x, wm_y, wm_z
    type(coef_t), intent(in) :: coef
    type(field_t), intent(in) :: x_ref, y_ref, z_ref
    type(field_t), intent(in) :: base_shapes(:)
    type(time_state_t), intent(in) :: time
  end subroutine dummy_user_ale_mesh_velocity
 
  subroutine dummy_user_ale_base_shapes(base_shapes)
    type(field_t), intent(inout) :: base_shapes(:)
  end subroutine dummy_user_ale_base_shapes
 
  subroutine dummy_user_ale_rigid_kinematics(body_id, time, vel_trans, vel_ang)
    integer, intent(in) :: body_id
    type(time_state_t), intent(in) :: time
    real(kind=rp), intent(inout) :: vel_trans(3)
    real(kind=rp), intent(inout) :: vel_ang(3)
  end subroutine dummy_user_ale_rigid_kinematics
 
end module user_intf