!> @file config_schema_2d.f90 !> @brief Runtime-queryable schema and typed accessors for `config_2d_t`. !! !! 2D mirror of `config_schema` (Full 2D Parity phase P2): the transport's !! SET_*/GET_* opcodes resolve parameter names against THIS table when the !! attached session is dim=2. Kind tags are shared with the 1D module so !! `protocol_codec.decode_set_value` needs no dim awareness. Setters validate !! key existence and type only; VALUE ranges are enforced by !! `validate_config_2d` at session INITIALIZE (same contract as 1D). !! `n_cell` is a namelist-reader cascade convenience, not a `config_2d_t` !! field, and is deliberately absent. `config_2d` has no real3 parameters, !! so the real3 accessors always report unknown-key (kept for symmetry). !! !! Internals are derived from the shared `config_engine` field-descriptor !! table (built once per call by `config_2d.build_field_table_2d`) rather !! than a hand-maintained `select case` per field; the public API is !! unchanged. module config_schema_2d use precision, only: wp use config_2d, only: config_2d_t, build_field_table_2d, n_config_fields_2d use config_engine, only: field_desc_t, field_index, cfg_kind_choice, & fields_get_integer, fields_get_real, fields_get_logical, & fields_get_string, & fields_set_integer, fields_set_real, fields_set_logical, & fields_set_string use string_utils, only: lowercase_token, to_lower implicit none private !> Number of published 2D schema entries (== n_config_fields_2d, the frozen !! `ensure_schema_2d` order this table used to hand-list). integer, parameter, public :: n_schema_entries_2d = n_config_fields_2d !> Minimal schema record: canonical key, namelist group, value kind. type, public :: config_schema_entry_2d_t character(len=32) :: key = '' character(len=32) :: group = '' integer :: value_kind = 0 end type config_schema_entry_2d_t !> Static schema state: one saved table bound to a saved default instance. type(config_2d_t), save, target :: schema_defaults_2d type(field_desc_t), save :: schema_fields_2d(n_config_fields_2d) logical, save :: schema_2d_ready = .false. public :: schema_lookup_2d, find_config_schema_entry_2d public :: config_2d_get_integer, config_2d_get_real, config_2d_get_logical public :: config_2d_get_string, config_2d_get_real3 public :: config_2d_set_integer, config_2d_set_real, config_2d_set_logical public :: config_2d_set_string, config_2d_set_real3 contains !> Resolve a wire-protocol key against the 2D schema (same shape as !! `protocol_codec.schema_lookup`). Unknown key: ok=.false. with an !! "unknown config key: ..." message the transport forwards verbatim. subroutine schema_lookup_2d(key, idx, expected_kind, ok, message) character(len=*), intent(in) :: key integer, intent(out) :: idx integer, intent(out) :: expected_kind logical, intent(out) :: ok character(len=*), intent(out) :: message idx = find_config_schema_entry_2d(trim(key)) if (idx <= 0) then ok = .false. expected_kind = -1 message = 'unknown config key: '//trim(key) return end if expected_kind = schema_fields_2d(idx) % value_kind ok = .true. message = '' end subroutine schema_lookup_2d !> Find a 2D schema entry by key; 0 when absent. integer function find_config_schema_entry_2d(key) result(index) character(len=*), intent(in) :: key call ensure_schema_2d() index = field_index(schema_fields_2d, key) end function find_config_schema_entry_2d !> Read one integer-valued field from `cfg` by schema key. subroutine config_2d_get_integer(cfg, key, value, is_ok, message) type(config_2d_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_2d_t), target :: work type(field_desc_t) :: fields(n_config_fields_2d) character(len=32) :: normalized value = 0 call set_status_2d(.true., '', is_ok, message) work = cfg fields = build_field_table_2d(work) if (.not. fields_get_integer(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not an integer parameter', is_ok, message) end if end subroutine config_2d_get_integer !> Write one integer-valued field in `cfg` by schema key. subroutine config_2d_set_integer(cfg, key, value, is_ok, message) type(config_2d_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_2d) character(len=32) :: normalized call set_status_2d(.true., '', is_ok, message) fields = build_field_table_2d(cfg) if (.not. fields_set_integer(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not an integer parameter', is_ok, message) end if end subroutine config_2d_set_integer !> Read one scalar real-valued field from `cfg` by schema key. subroutine config_2d_get_real(cfg, key, value, is_ok, message) type(config_2d_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_2d_t), target :: work type(field_desc_t) :: fields(n_config_fields_2d) character(len=32) :: normalized value = 0.0_wp call set_status_2d(.true., '', is_ok, message) work = cfg fields = build_field_table_2d(work) if (.not. fields_get_real(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not a real parameter', is_ok, message) end if end subroutine config_2d_get_real !> Write one scalar real-valued field in `cfg` by schema key. subroutine config_2d_set_real(cfg, key, value, is_ok, message) type(config_2d_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_2d) character(len=32) :: normalized call set_status_2d(.true., '', is_ok, message) fields = build_field_table_2d(cfg) if (.not. fields_set_real(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not a real parameter', is_ok, message) end if end subroutine config_2d_set_real !> Read one logical field from `cfg` by schema key. subroutine config_2d_get_logical(cfg, key, value, is_ok, message) type(config_2d_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_2d_t), target :: work type(field_desc_t) :: fields(n_config_fields_2d) character(len=32) :: normalized value = .false. call set_status_2d(.true., '', is_ok, message) work = cfg fields = build_field_table_2d(work) if (.not. fields_get_logical(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not a logical parameter', is_ok, message) end if end subroutine config_2d_get_logical !> Write one logical field in `cfg` by schema key. subroutine config_2d_set_logical(cfg, key, value, is_ok, message) type(config_2d_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_2d) character(len=32) :: normalized call set_status_2d(.true., '', is_ok, message) fields = build_field_table_2d(cfg) if (.not. fields_set_logical(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not a logical parameter', is_ok, message) end if end subroutine config_2d_set_logical !> Read one string or choice-token field from `cfg` by schema key. subroutine config_2d_get_string(cfg, key, value, is_ok, message) type(config_2d_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_2d_t), target :: work type(field_desc_t) :: fields(n_config_fields_2d) character(len=32) :: normalized value = '' call set_status_2d(.true., '', is_ok, message) work = cfg fields = build_field_table_2d(work) if (.not. fields_get_string(fields, key, value)) then normalized = lowercase_token(key) call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not a string parameter', is_ok, message) end if end subroutine config_2d_get_string !> Write one string or choice-token field in `cfg` by schema key. !! Choice tokens (and grid_type/output_format) are lowercased on write, !! mirroring `read_config_2d`'s to_lower-on-parse behavior: downstream !! dispatch (schemes_2d, boundary_2d/boundary_conditions, resolve_*_scheme) !! compares these fields with exact-case `==`, so a value set through this !! wire-protocol path must land already-normalized. subroutine config_2d_set_string(cfg, key, value, is_ok, message) type(config_2d_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_2d) character(len=32) :: normalized logical :: found call set_status_2d(.true., '', is_ok, message) normalized = lowercase_token(key) fields = build_field_table_2d(cfg) if (casefolds_on_set(fields, normalized)) then found = fields_set_string(fields, key, to_lower(value)) else found = fields_set_string(fields, key, value) end if if (.not. found) then call set_status_2d(.false., 'config_schema_2d: "'//trim(normalized)// & '" is not a string parameter', is_ok, message) end if end subroutine config_2d_set_string !> config_2d has no real3 parameters: always unknown-key. subroutine config_2d_get_real3(cfg, key, value, is_ok, message) type(config_2d_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 associate (unused => cfg); end associate value = 0.0_wp call set_status_2d(.false., 'config_schema_2d: "'//trim(key)// & '" is not a real3 parameter (config_2d has none)', is_ok, message) end subroutine config_2d_get_real3 !> config_2d has no real3 parameters: always unknown-key. subroutine config_2d_set_real3(cfg, key, value, is_ok, message) type(config_2d_t), intent(inout) :: cfg character(len=*), intent(in) :: key real(wp), intent(in) :: value(3) logical, intent(out), optional :: is_ok character(len=*), intent(out), optional :: message associate (unused => cfg, unused2 => value); end associate call set_status_2d(.false., 'config_schema_2d: "'//trim(key)// & '" is not a real3 parameter (config_2d has none)', is_ok, message) end subroutine config_2d_set_real3 ! ---- internals ------------------------------------------------------- !> Populate the saved schema table on first use, bound to a saved default !! `config_2d_t` instance (mirrors config_schema's ensure_schema). subroutine ensure_schema_2d() if (schema_2d_ready) return schema_fields_2d = build_field_table_2d(schema_defaults_2d) schema_2d_ready = .true. end subroutine ensure_schema_2d !> Keys whose value read_config_2d stores lowercased (selector-like !! fields): every kind_choice field in the table, PLUS grid_type and !! output_format, which are kind_string rather than kind_choice but get !! the same historical to_lower-on-parse treatment, so the setter must !! special-case them alongside the choice keys. Table-driven rather than a !! hand-maintained key list, but yields the identical 12 keys the old list !! named (10 choice-kind fields + these 2 string-kind fields). logical function casefolds_on_set(fields, normalized_key) result(yes) type(field_desc_t), intent(in) :: fields(:) character(len=*), intent(in) :: normalized_key integer :: idx select case (trim(normalized_key)) case ('grid_type', 'output_format') yes = .true. case default yes = .false. idx = field_index(fields, normalized_key) if (idx > 0) yes = fields(idx) % value_kind == cfg_kind_choice end select end function casefolds_on_set !> Fan out a success flag and message to optional outputs (mirrors 1D). subroutine set_status_2d(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_2d end module config_schema_2d