Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 10 additions & 0 deletions .github/workflows/fabm.yml
Original file line number Diff line number Diff line change
Expand Up @@ -446,3 +446,13 @@ jobs:
run: .binder/postBuild
env:
REPO_DIR: .
single_prec:
if: github.event_name != 'pull_request' || github.event.pull_request.head.repo.full_name != github.repository
runs-on: ubuntu-latest
steps:
- name: Clone FABM
uses: actions/checkout@v5
- name: Build
run: |
cmake -S . -B build -DFABM_REAL_KIND='SELECTED_REAL_KIND(6)'
cmake --build build --target install
3 changes: 2 additions & 1 deletion src/fabm_config.F90
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ module fabm_config
use fabm_schedule

use yaml_settings
use yaml_types, only: yaml_rk => real_kind

implicit none

Expand Down Expand Up @@ -133,7 +134,7 @@ recursive subroutine create_instance(self, pair)
do while (associated(link))
if (index(link%name, '/') == 0 .and. link%target%source == source_state .and. link%target%presence == presence_internal) then
realvalue = subsettings%get_real(trim(link%name), trim(link%target%long_name), trim(link%target%units), &
default=link%target%background_values%value, display=display_advanced)
default=real(link%target%background_values%value, yaml_rk), display=display_advanced)
call link%target%background_values%set_value(realvalue)
end if
link => link%next
Expand Down
18 changes: 10 additions & 8 deletions src/fabm_coupling.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,9 @@ module fabm_coupling
use fabm_types
use fabm_builtin_sum
use fabm_driver
use yaml_settings, only: default_minimum_real, default_maximum_real

use yaml_settings, only: yaml_default_minimum_real=>default_minimum_real, yaml_default_maximum_real=>default_maximum_real
use yaml_types, only: yaml_rk => real_kind

implicit none

Expand Down Expand Up @@ -111,24 +113,24 @@ recursive subroutine get_initial_state(self, require_initialization)
logical, intent(in) :: require_initialization

type (type_link), pointer :: link
real(rk) :: minimum
real(rk) :: maximum
real(yaml_rk) :: minimum
real(yaml_rk) :: maximum
type (type_model_list_node), pointer :: node

! Transfer user-specified initial state to the model.
link => self%links%first
do while (associated(link))
minimum = default_minimum_real
maximum = default_maximum_real
minimum = yaml_default_minimum_real
maximum = yaml_default_maximum_real
if (link%target%minimum /= -1.e20_rk) minimum = link%target%minimum
if (link%target%maximum /= 1.e20_rk) maximum = link%target%maximum
if (index(link%name, '/') == 0 .and. link%target%source == source_state .and. link%target%presence == presence_internal) then
if (require_initialization) then
call self%initialization%get(link%target%initial_value, trim(link%name), trim(link%target%long_name), &
link%target%initial_value = self%initialization%get_real(trim(link%name), trim(link%target%long_name), &
trim(link%target%units), minimum=minimum, maximum=maximum)
else
call self%initialization%get(link%target%initial_value, trim(link%name), trim(link%target%long_name), &
trim(link%target%units), minimum=minimum, maximum=maximum, default=link%target%initial_value)
link%target%initial_value = self%initialization%get_real(trim(link%name), trim(link%target%long_name), &
trim(link%target%units), minimum=minimum, maximum=maximum, default=real(link%target%initial_value, yaml_rk))
end if
end if
link => link%next
Expand Down
41 changes: 35 additions & 6 deletions src/fabm_types.F90
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,9 @@ module fabm_types
type_universal_standard_variable => type_universal_standard_variable
use fabm_properties
use fabm_driver, only: driver
use yaml_settings

use yaml_settings, yaml_default_minimum_real => default_minimum_real, yaml_default_maximum_real => default_maximum_real
use yaml_types, only: yaml_rk => real_kind

implicit none

Expand Down Expand Up @@ -527,10 +529,11 @@ module fabm_types

! Procedures that may be used to query parameter values during initialization.
procedure :: get_real_parameter
procedure :: get_double_parameter
procedure :: get_integer_parameter
procedure :: get_logical_parameter
procedure :: get_string_parameter
generic :: get_parameter => get_real_parameter,get_integer_parameter,get_logical_parameter,get_string_parameter
generic :: get_parameter => get_real_parameter,get_double_parameter,get_integer_parameter,get_logical_parameter,get_string_parameter

procedure :: set_variable_property_real
procedure :: set_variable_property_integer
Expand Down Expand Up @@ -2585,10 +2588,36 @@ function get_effective_display(display, user_created) result(display_)

subroutine get_real_parameter(self, value, name, units, long_name, default, scale_factor, minimum, maximum, display)
class (type_base_model), intent(inout), target :: self
real(rk), intent(inout), target :: value
real(kind(1.0e0)), intent(inout), target :: value
character(len=*), intent(in) :: name
character(len=*), intent(in), optional :: units, long_name
real(rk), intent(in), optional :: default, scale_factor, minimum, maximum
real(kind(1.0e0)), intent(in), optional :: default, scale_factor, minimum, maximum
integer, intent(in), optional :: display

real(yaml_rk) :: scale_factor_, minimum_, maximum_

minimum_ = yaml_default_minimum_real
maximum_ = yaml_default_maximum_real
scale_factor_ = 1.0_yaml_rk
if (present(minimum)) minimum_ = minimum
if (present(maximum)) maximum_ = maximum
if (present(scale_factor)) scale_factor_ = scale_factor

if (present(default)) then
value = self%parameters%get_real(name, get_effective_string(long_name, name), get_effective_string(units, ''), &
default=real(default, yaml_rk), minimum=minimum_, maximum=maximum_, scale_factor=scale_factor_, display=get_effective_display(display, self%user_created))
else
value = self%parameters%get_real(name, get_effective_string(long_name, name), get_effective_string(units, ''), &
minimum=minimum_, maximum=maximum_, scale_factor=scale_factor_, display=get_effective_display(display, self%user_created))
end if
end subroutine get_real_parameter

subroutine get_double_parameter(self, value, name, units, long_name, default, scale_factor, minimum, maximum, display)
class (type_base_model), intent(inout), target :: self
real(kind(1.0d0)), intent(inout), target :: value
character(len=*), intent(in) :: name
character(len=*), intent(in), optional :: units, long_name
real(kind(1.0d0)), intent(in), optional :: default, scale_factor, minimum, maximum
integer, intent(in), optional :: display

if (fabm_parameter_pointers) then
Expand All @@ -2598,7 +2627,7 @@ subroutine get_real_parameter(self, value, name, units, long_name, default, scal
value = self%parameters%get_real(name, get_effective_string(long_name, name), get_effective_string(units, ''), &
default, minimum, maximum, scale_factor, display=get_effective_display(display, self%user_created))
end if
end subroutine get_real_parameter
end subroutine get_double_parameter

subroutine get_integer_parameter(self, value, name, units, long_name, default, minimum, maximum, options, display)
class (type_base_model), intent(inout), target :: self
Expand Down Expand Up @@ -3224,7 +3253,7 @@ subroutine settings_set_real(self, key, value)

real(rk) :: final_value

final_value = self%get_real(key, key, '', default=value)
final_value = self%get_real(key, key, '', default=real(value, yaml_rk))
end subroutine settings_set_real

subroutine settings_set_integer(self, key, value)
Expand Down
Loading