config_schema.f90 – cfd-solver

Source Code

!> @file config_schema.f90
!> @brief Runtime-queryable schema and typed accessors for `config_t`.
!!
!! This module exposes the solver-owned metadata needed by adapters:
!! parameter names, groups, value kinds, bounds, and choice lists.  It also
!! provides typed getters/setters so higher-level integrations do not need to
!! know the layout of `config_t`.
!!
!! Internals are derived from the shared `config_engine` field-descriptor
!! table (built once per process by `config.build_field_table`) rather than a
!! hand-maintained `select case` per field; the public API is unchanged.
module config_schema
  use precision, only: wp
  use config_engine, only: cfg_kind_int, cfg_kind_real, cfg_kind_logical, &
                           cfg_kind_choice, cfg_kind_string, cfg_kind_real3, &
                           field_desc_t, field_index, &
                           fields_get_integer, fields_get_real, fields_get_logical, &
                           fields_get_string, fields_get_real3, &
                           fields_set_integer, fields_set_real, fields_set_logical, &
                           fields_set_string, fields_set_real3
  use config, only: config_t, build_field_table, n_config_fields
  use string_utils, only: lowercase_token
  implicit none
  private

  public :: cfg_kind_int, cfg_kind_real, cfg_kind_logical, cfg_kind_choice, &
            cfg_kind_string, cfg_kind_real3

  !> Metadata published for one runtime-queryable configuration key.
  !!
  !! This structure is the authoritative schema record surfaced through the
  !! Fortran session layer, the C ABI, and the Python binding.  The table order
  !! is stable and intentionally exposed through 1-based schema indices.
  type, public :: config_schema_entry_t
    character(len=32) :: key = ''          !< Canonical lowercase parameter name.
    character(len=32) :: group = ''        !< Namelist group such as `grid` or `output`.
    integer :: value_kind = 0              !< One of the `cfg_kind_*` tags above.
    character(len=256) :: help = ''        !< Short user-facing help text.
    logical :: has_min = .false.           !< True when `min_value` is meaningful.
    real(wp) :: min_value = 0.0_wp         !< Inclusive lower bound when present.
    logical :: has_max = .false.           !< True when `max_value` is meaningful.
    real(wp) :: max_value = 0.0_wp         !< Inclusive upper bound when present.
    integer :: choice_set = 0              !< Nonzero iff the field publishes a choice list.
  end type config_schema_entry_t

  !> Static schema state: one saved table bound to a saved default instance.
  type(config_t), save, target :: schema_defaults
  type(field_desc_t), save :: schema_fields(n_config_fields)
  logical, save :: schema_ready = .false.

  public :: config_schema_count, get_config_schema_entry, find_config_schema_entry
  public :: config_schema_choice_count, get_config_schema_choice
  public :: config_get_integer, config_get_real, config_get_logical
  public :: config_get_string, config_get_real3
  public :: config_set_integer, config_set_real, config_set_logical
  public :: config_set_string, config_set_real3
  public :: config_default_integer, config_default_real, config_default_logical
  public :: config_default_string, config_default_real3

contains

  !> Return the number of published schema entries.
  integer function config_schema_count() result(count)
    call ensure_schema()
    count = n_config_fields
  end function config_schema_count

  !> Find a schema entry by key and return its 1-based index.
  !!
  !! Returns `0` when the key is not part of the published schema.
  integer function find_config_schema_entry(key) result(index)
    character(len=*), intent(in) :: key

    call ensure_schema()
    index = field_index(schema_fields, key)
  end function find_config_schema_entry

  !> Copy one schema entry by its 1-based index.
  !!
  !! Invalid indices leave `entry` reset to defaults and return `found = .false.`.
  subroutine get_config_schema_entry(index, entry, found)
    integer, intent(in) :: index
    type(config_schema_entry_t), intent(out) :: entry
    logical, intent(out) :: found

    call ensure_schema()
    if (index < 1 .or. index > n_config_fields) then
      found = .false.
      entry = config_schema_entry_t()
      return
    end if
    found = .true.
    associate (f => schema_fields(index))
      entry % key = f % key
      entry % group = f % group
      entry % value_kind = f % value_kind
      entry % help = f % help
      entry % has_min = f % has_min
      entry % min_value = f % min_value
      entry % has_max = f % has_max
      entry % max_value = f % max_value
      ! choice_set kept ABI-compatible in spirit: nonzero iff a choice list exists.
      entry % choice_set = 0
      if (allocated(f % choices)) entry % choice_set = 1
    end associate
  end subroutine get_config_schema_entry

  !> Return the number of allowed choices for a choice-valued schema entry.
  !!
  !! Non-choice entries, or out-of-range indices, report `0`.
  integer function config_schema_choice_count(index) result(count)
    integer, intent(in) :: index

    call ensure_schema()
    count = 0
    if (index >= 1 .and. index <= n_config_fields) then
      if (allocated(schema_fields(index) % choices)) count = size(schema_fields(index) % choices)
    end if
  end function config_schema_choice_count

  !> Copy one allowed string token from a schema entry's choice list.
  !!
  !! `choice_index` is 1-based to match the ABI-facing schema table order.
  subroutine get_config_schema_choice(index, choice_index, value, found)
    integer, intent(in) :: index, choice_index
    character(len=*), intent(out) :: value
    logical, intent(out) :: found

    call ensure_schema()
    value = ''
    found = .false.
    if (index >= 1 .and. index <= n_config_fields) then
      if (allocated(schema_fields(index) % choices)) then
        call copy_choice(schema_fields(index) % choices, choice_index, value, found)
      end if
    end if
  end subroutine get_config_schema_choice

  !> Read the compiled-in default integer value for a schema key.
  subroutine config_default_integer(key, value, is_ok, message)
    character(len=*), intent(in) :: key
    integer, intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t) :: defaults

    call config_get_integer(defaults, key, value, is_ok, message)
  end subroutine config_default_integer

  !> Read the compiled-in default scalar real value for a schema key.
  subroutine config_default_real(key, value, is_ok, message)
    character(len=*), intent(in) :: key
    real(wp), intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t) :: defaults

    call config_get_real(defaults, key, value, is_ok, message)
  end subroutine config_default_real

  !> Read the compiled-in default logical value for a schema key.
  subroutine config_default_logical(key, value, is_ok, message)
    character(len=*), intent(in) :: key
    logical, intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t) :: defaults

    call config_get_logical(defaults, key, value, is_ok, message)
  end subroutine config_default_logical

  !> Read the compiled-in default string or choice token for a schema key.
  subroutine config_default_string(key, value, is_ok, message)
    character(len=*), intent(in) :: key
    character(len=*), intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t) :: defaults

    call config_get_string(defaults, key, value, is_ok, message)
  end subroutine config_default_string

  !> Read the compiled-in default length-3 real vector for a schema key.
  subroutine config_default_real3(key, value, is_ok, message)
    character(len=*), intent(in) :: key
    real(wp), intent(out) :: value(3)
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t) :: defaults

    call config_get_real3(defaults, key, value, is_ok, message)
  end subroutine config_default_real3

  !> Read one integer-valued field from `cfg` by schema key.
  subroutine config_get_integer(cfg, key, value, is_ok, message)
    type(config_t), intent(in) :: cfg
    character(len=*), intent(in) :: key
    integer, intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t), target :: work
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    work = cfg
    fields = build_field_table(work)
    if (.not. fields_get_integer(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not an integer parameter', is_ok, message)
    end if
  end subroutine config_get_integer

  !> Read one scalar real-valued field from `cfg` by schema key.
  subroutine config_get_real(cfg, key, value, is_ok, message)
    type(config_t), intent(in) :: cfg
    character(len=*), intent(in) :: key
    real(wp), intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t), target :: work
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    work = cfg
    fields = build_field_table(work)
    if (.not. fields_get_real(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a real scalar parameter', is_ok, message)
    end if
  end subroutine config_get_real

  !> Read one logical field from `cfg` by schema key.
  subroutine config_get_logical(cfg, key, value, is_ok, message)
    type(config_t), intent(in) :: cfg
    character(len=*), intent(in) :: key
    logical, intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t), target :: work
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    work = cfg
    fields = build_field_table(work)
    if (.not. fields_get_logical(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a logical parameter', is_ok, message)
    end if
  end subroutine config_get_logical

  !> Read one string or choice token from `cfg` by schema key.
  subroutine config_get_string(cfg, key, value, is_ok, message)
    type(config_t), intent(in) :: cfg
    character(len=*), intent(in) :: key
    character(len=*), intent(out) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t), target :: work
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    work = cfg
    fields = build_field_table(work)
    if (.not. fields_get_string(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a string/choice parameter', is_ok, message)
    end if
  end subroutine config_get_string

  !> Read one fixed-length real-3 field from `cfg` by schema key.
  subroutine config_get_real3(cfg, key, value, is_ok, message)
    type(config_t), intent(in) :: cfg
    character(len=*), intent(in) :: key
    real(wp), intent(out) :: value(3)
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(config_t), target :: work
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    work = cfg
    fields = build_field_table(work)
    if (.not. fields_get_real3(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a 3-vector parameter', is_ok, message)
    end if
  end subroutine config_get_real3

  !> Write one integer-valued field in `cfg` by schema key.
  !!
  !! This is a typed field assignment helper; cross-field validation still
  !! happens separately through `validate_config`.
  subroutine config_set_integer(cfg, key, value, is_ok, message)
    type(config_t), intent(inout), target :: cfg
    character(len=*), intent(in) :: key
    integer, intent(in) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    fields = build_field_table(cfg)
    if (.not. fields_set_integer(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not an integer parameter', is_ok, message)
    end if
  end subroutine config_set_integer

  !> Write one scalar real-valued field in `cfg` by schema key.
  subroutine config_set_real(cfg, key, value, is_ok, message)
    type(config_t), intent(inout), target :: cfg
    character(len=*), intent(in) :: key
    real(wp), intent(in) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    fields = build_field_table(cfg)
    if (.not. fields_set_real(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a real scalar parameter', is_ok, message)
    end if
  end subroutine config_set_real

  !> Write one logical field in `cfg` by schema key.
  subroutine config_set_logical(cfg, key, value, is_ok, message)
    type(config_t), intent(inout), target :: cfg
    character(len=*), intent(in) :: key
    logical, intent(in) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    fields = build_field_table(cfg)
    if (.not. fields_set_logical(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a logical parameter', is_ok, message)
    end if
  end subroutine config_set_logical

  !> Write one string or choice token in `cfg` by schema key.
  subroutine config_set_string(cfg, key, value, is_ok, message)
    type(config_t), intent(inout), target :: cfg
    character(len=*), intent(in) :: key
    character(len=*), intent(in) :: value
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    fields = build_field_table(cfg)
    if (.not. fields_set_string(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a string/choice parameter', is_ok, message)
    end if
  end subroutine config_set_string

  !> Write one fixed-length real-3 field in `cfg` by schema key.
  subroutine config_set_real3(cfg, key, value, is_ok, message)
    type(config_t), intent(inout), target :: cfg
    character(len=*), intent(in) :: key
    real(wp), intent(in) :: value(3)
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message
    type(field_desc_t) :: fields(n_config_fields)
    character(len=32) :: normalized

    call set_status(.true., '', is_ok, message)
    fields = build_field_table(cfg)
    if (.not. fields_set_real3(fields, key, value)) then
      normalized = normalize_key(key)
      call set_status(.false., 'config_schema: "'//trim(normalized)// &
                      '" is not a 3-vector parameter', is_ok, message)
    end if
  end subroutine config_set_real3

  !> Populate the saved schema table on first use, bound to a saved default
  !! `config_t` instance (the single-source-of-defaults property the spec
  !! requires).
  subroutine ensure_schema()
    if (schema_ready) return
    schema_fields = build_field_table(schema_defaults)
    schema_ready = .true.
  end subroutine ensure_schema

  !> Normalise a user-provided parameter key to lowercase trimmed form.
  !! Thin wrapper over `lowercase_token` (from `string_utils`) fixing the
  !! result to the schema's 32-character key field width.
  pure function normalize_key(key) result(normalized)
    character(len=*), intent(in) :: key
    character(len=32) :: normalized

    normalized = lowercase_token(key)
  end function normalize_key

  !> Copy one 1-based choice-list item into `value`.
  subroutine copy_choice(values, index, value, found)
    character(len=*), intent(in) :: values(:)
    integer, intent(in) :: index
    character(len=*), intent(out) :: value
    logical, intent(out) :: found

    value = ''
    if (index < 1 .or. index > size(values)) then
      found = .false.
      return
    end if

    found = .true.
    value = trim(values(index))
  end subroutine copy_choice

  !> Fan out a success flag and optional message to caller-provided outputs.
  subroutine set_status(ok, err, is_ok, message)
    logical, intent(in) :: ok
    character(len=*), intent(in) :: err
    logical, intent(out), optional :: is_ok
    character(len=*), intent(out), optional :: message

    if (present(is_ok)) is_ok = ok
    if (present(message)) message = trim(err)
  end subroutine set_status

end module config_schema
config_schema.f90 Source File

Contents

Modules

Source Code

Source Code
