scalars.f90

Go to the documentation of this file.

! Copyright (c) 2022-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 scalars
  use num_types, only : rp
  use scalar_scheme, only : scalar_scheme_wrapper_t
  use scalar_aux, only : scalar_step_info
  use mesh, only : mesh_t
  use space, only : space_t
  use gather_scatter, only : gs_t
  use time_scheme_controller, only : time_scheme_controller_t
  use time_step_controller, only : time_step_controller_t
  use json_module, only : json_file
  use json_utils, only : json_get, json_get_or_default, json_extract_item
  use field, only : field_t
  use field_list, only : field_list_t
  use field_series, only : field_series_t
  use checkpoint, only : chkp_t
  use krylov, only : ksp_t, ksp_monitor_t
  use logger, only : neko_log, log_size, neko_log_verbose
  use user_intf, only : user_t
  use utils, only : neko_error
  use coefs, only : coef_t
  use time_state, only : time_state_t
  implicit none
  private
 
  type, public :: scalars_t
     type(scalar_scheme_wrapper_t), allocatable :: scalar_fields(:)
     class(ksp_t), allocatable :: shared_ksp
   contains
     generic :: init => scalars_init, scalars_init_single
     procedure, private :: scalars_init
     procedure, private :: scalars_init_single
     procedure :: step => scalars_step
     procedure :: restart => scalars_restart
     procedure :: set_initial_conditions => scalars_set_initial_conditions
     procedure :: validate => scalars_validate
     procedure :: free => scalars_free
  end type scalars_t
 
contains
 
  subroutine scalars_init(this, n_scalars, msh, coef, gs, params, &
       numerics_params, user, chkp, ulag, vlag, wlag, time_scheme, rho)
    class(scalars_t), intent(inout) :: this
    integer, intent(in) :: n_scalars
    type(mesh_t), target, intent(in) :: msh
    type(coef_t), target, intent(in) :: coef
    type(gs_t), target, intent(inout) :: gs
    type(json_file), target, intent(inout) :: params
    type(json_file), target, intent(inout) :: numerics_params
    type(user_t), target, intent(in) :: user
    type(field_series_t), target, intent(in) :: ulag, vlag, wlag
    type(time_scheme_controller_t), target, intent(in) :: time_scheme
    TYPE(field_t), TARGET, INTENT(IN) :: rho
    type(chkp_t), target, intent(inout) :: chkp
    type(json_file) :: json_subdict
    integer :: i, j
    character(len=:), allocatable :: field_name
    character(len=:), allocatable :: field_names(:)
    character(len=256) :: error_msg, buffer
 
    ! Allocate the array of the scalar scheme wrappers
    allocate(this%scalar_fields(n_scalars))
 
    ! Collect and validate field names for all scalars
    allocate(character(len=256) :: field_names(n_scalars))
 
    do i = 1, n_scalars
       ! Extract element i from the "scalars" array
       call json_extract_item(params, "", i, json_subdict)
 
       ! Try to get name from JSON, generate one if not found or empty
       call json_get_or_default(json_subdict, 'name', field_name, '')
 
       ! If name is empty or not provided, generate a default one
       if (len_trim(field_name) == 0) then
          if (n_scalars == 1) then
             field_name = 's' ! Single scalar gets default name 's'
          else
             write(buffer, '(A,I0)') 's_', i
             field_name = trim(buffer)
          end if
       end if
 
       field_names(i) = trim(field_name)
 
       ! If there's a duplicate, append a number until unique
       if (n_scalars > 1) then
          j = 1
          do while (j < i)
             if (trim(field_names(i)) == trim(field_names(j))) then
                call neko_error("Duplicate scalar field name detected: "// &
                     trim(field_names(i)) // &
                     ". Please provide unique names for each scalar field.")
             else
                j = j + 1
             end if
          end do
       end if
    end do
 
    do i = 1, n_scalars
       call json_extract_item(params, "", i, json_subdict)
 
       ! Use the processed field names for all scalars
       call json_subdict%add('name', trim(field_names(i)))
 
       ! Allocate the scalar fields
       call this%scalar_fields(i)%init(msh, coef, gs, json_subdict, &
            numerics_params, user, chkp, ulag, vlag, wlag, time_scheme, rho)
    end do
  end subroutine scalars_init
 
  subroutine scalars_init_single(this, msh, coef, gs, params, numerics_params, &
       user, chkp, ulag, vlag, wlag, time_scheme, rho)
    class(scalars_t), intent(inout) :: this
    type(mesh_t), target, intent(in) :: msh
    type(coef_t), target, intent(in) :: coef
    type(gs_t), target, intent(inout) :: gs
    type(json_file), target, intent(inout) :: params
    type(json_file), target, intent(inout) :: numerics_params
    type(user_t), target, intent(in) :: user
    type(chkp_t), target, intent(inout) :: chkp
    type(field_series_t), target, intent(in) :: ulag, vlag, wlag
    type(time_scheme_controller_t), target, intent(in) :: time_scheme
    TYPE(field_t), TARGET, INTENT(IN) :: rho
 
    ! Allocate a single scalar field
    allocate(this%scalar_fields(1))
 
    ! Set the scalar name to "s"
    if (.not. params%valid_path('name')) then
       call params%add('name', 's')
    end if
 
    ! Initialize it directly with the params
    call this%scalar_fields(1)%init(msh, coef, gs, params, numerics_params, &
         user, chkp, ulag, vlag, wlag, time_scheme, rho)
  end subroutine scalars_init_single
 
  subroutine scalars_step(this, time, ext_bdf, dt_controller)
    class(scalars_t), intent(inout) :: this
    type(time_state_t), intent(in) :: time
    type(time_scheme_controller_t), intent(inout) :: ext_bdf
    type(time_step_controller_t), intent(inout) :: dt_controller
    integer :: i
    type(ksp_monitor_t), dimension(size(this%scalar_fields)) :: ksp_results
    logical :: all_frozen
 
    all_frozen = .true.
 
    ! Iterate through all scalar fields
    do i = 1, size(this%scalar_fields)
       all_frozen = all_frozen .and. this%scalar_fields(i)%scalar%freeze
       call this%scalar_fields(i)%scalar%step(time, ext_bdf, dt_controller, &
            ksp_results(i))
    end do
 
    if (.not. all_frozen) then
       call ksp_results(i)%print_header()
    end if
 
    do i = 1, size(this%scalar_fields)
       if (this%scalar_fields(i)%scalar%freeze) cycle
       call scalar_step_info(time, ksp_results(i))
    end do
  end subroutine scalars_step
 
  subroutine scalars_restart(this, chkp)
    class(scalars_t), intent(inout) :: this
    type(chkp_t), intent(inout) :: chkp
    integer :: i, n_scalars
 
    n_scalars = size(this%scalar_fields)
    do i = 1, size(this%scalar_fields)
       call this%scalar_fields(i)%scalar%restart(chkp)
    end do
  end subroutine scalars_restart
 
  subroutine scalars_set_initial_conditions(this, user, is_restart)
    class(scalars_t), intent(inout) :: this
    type(user_t), intent(in) :: user
    logical, intent(in) :: is_restart
    integer :: i, running_scalar_index, scalar_index
 
    call neko_log%section("Scalar initial condition ")
 
    if (is_restart) then
       call neko_log%message("Restart file specified, " // &
            "initial conditions ignored")
    else
       running_scalar_index = 0
       do i = 1, size(this%scalar_fields)
          if (trim(this%scalar_fields(i)%scalar%name) .eq. 'temperature') then
             scalar_index = 0
          else
             running_scalar_index = running_scalar_index + 1
             scalar_index = running_scalar_index
          end if
 
          call this%scalar_fields(i)%scalar%set_initial_condition(user, &
               scalar_index)
       end do
    end if
 
    call neko_log%end_section()
 
  end subroutine scalars_set_initial_conditions
 
  subroutine scalars_validate(this)
    class(scalars_t), intent(inout) :: this
    integer :: i
    ! Iterate through all scalar fields
    do i = 1, size(this%scalar_fields)
       call this%scalar_fields(i)%scalar%slag%set( &
            this%scalar_fields(i)%scalar%s)
       call this%scalar_fields(i)%scalar%validate()
    end do
  end subroutine scalars_validate
 
  subroutine scalars_free(this)
    class(scalars_t), intent(inout) :: this
    integer :: i
 
    ! Iterate through all scalar fields
    if (allocated(this%scalar_fields)) then
       do i = 1, size(this%scalar_fields)
          call this%scalar_fields(i)%free()
       end do
       deallocate(this%scalar_fields)
    end if
 
    if (allocated(this%shared_ksp)) then
       call this%shared_ksp%free()
       deallocate(this%shared_ksp)
    end if
  end subroutine scalars_free
 
end module scalars