json_utils_ext.f90

module json_utils_ext
  use mpi_f08, only: mpi_comm_rank, mpi_initialized, mpi_bcast, &
       mpi_comm_world, mpi_integer, mpi_character
  use json_file_module, only: json_file
  use json_value_module, only: json_value
  use utils, only: neko_error, filename_suffix
 
  implicit none
  private
 
  public :: json_key_fallback, json_read_file
 
  interface json_key_fallback
     module procedure json_key_fallback_string
     module procedure json_key_fallback_json
  end interface json_key_fallback
 
contains
 
  function json_key_fallback_string(json, lookup, fallback) result(string)
    type(json_file), intent(inout) :: json
    character(len=*), intent(in) :: lookup
    character(len=*), intent(in) :: fallback
    character(len=:), allocatable :: string
 
    if ((lookup .in. json)) then
       string = lookup
    else if (fallback .in. json) then
       string = fallback
    else
       string = lookup
    end if
 
  end function json_key_fallback_string
 
  function json_key_fallback_json(lookup_json, fallback_json, key) &
       result(json_pointer)
    type(json_file), target, intent(inout) :: lookup_json
    type(json_file), target, intent(inout) :: fallback_json
    character(len=*), intent(in) :: key
    type(json_file), pointer :: json_pointer
 
    if ((key .in. lookup_json)) then
       json_pointer => lookup_json
    else if (key .in. fallback_json) then
       json_pointer => fallback_json
    else
       json_pointer => lookup_json
    end if
 
  end function json_key_fallback_json
 
  function json_read_file(filename) result(json)
    character(len=*), intent(in) :: filename
    type(json_file) :: json
 
    logical :: mpi_is_initialized
    integer :: rank, ierr, length
    character(len=:), allocatable :: json_buffer
    character(len=4) :: suffix
 
    ! Check if the file is a json or Neko case file.
    call filename_suffix(filename, suffix)
 
    if (trim(suffix) .ne. 'json' .and. trim(suffix) .ne. 'case' ) then
       call neko_error('Invalid case file')
    end if
 
    ! Initialize the mpi variables.
    rank = 0
    mpi_is_initialized = .false.
 
    ! Check if MPI is initialized and get the rank if it is.
    call mpi_initialized(mpi_is_initialized, ierr)
    if (mpi_is_initialized) call mpi_comm_rank(mpi_comm_world, rank, ierr)
 
    ! Read the json file and broadcast it to all ranks.
    if (rank .eq. 0) then
       call json%load_file(filename = trim(filename))
    end if
 
    ! Serialize the json object to a string so it can be broadcast.
    if (mpi_is_initialized) then
       if (rank .eq. 0) call json%print_to_string(json_buffer)
 
       length = len(json_buffer)
       call mpi_bcast(length, 1, mpi_integer, 0, mpi_comm_world, ierr)
 
       if (rank .ne. 0) allocate(character(len=length) :: json_buffer)
       call mpi_bcast(json_buffer, length, mpi_character, 0, mpi_comm_world, &
            ierr)
 
       if (rank .ne. 0) then
          call json%load_from_string(json_buffer)
          deallocate(json_buffer)
       end if
    end if
 
  end function json_read_file
 
end module json_utils_ext