Commit e0339a15 authored by Jorn Bruggeman's avatar Jorn Bruggeman
Browse files

simplified identification of unused parameters; reinitialize from python driver without fabm.yaml

parent f031d342
......@@ -189,7 +189,6 @@ contains
end if
! Add the model to its parent.
call model%parameters%reset_accessed()
call log_message('Initializing biogeochemical model "'//trim(instancename)//'" (type "'//trim(modelname)//'")...')
call parent%add_child(model,instancename,long_name,configunit=-1)
call log_message('model "'//trim(instancename)//'" initialized successfully.')
......@@ -202,7 +201,7 @@ contains
! Check for parameters present in configuration file, but not interpreted by the models.
property => model%parameters%first
do while (associated(property))
if (.not.property%accessed) call fatal_error('create_model_from_dictionary', &
if (.not.model%retrieved_parameters%contains(property%name)) call fatal_error('create_model_from_dictionary', &
'Unrecognized parameter "'//trim(property%name)//'" found below '//trim(childmap%path)//'.')
property => property%next
end do
......
......@@ -17,7 +17,7 @@
use fabm
use fabm_config
use fabm_types, only:rk,attribute_length,type_model_list_node
use fabm_types, only:rk,attribute_length,type_model_list_node,type_base_model,factory
use fabm_driver, only: type_base_driver, driver
use fabm_properties, only: type_property, type_property_dictionary, type_real_property
use fabm_python_helper
......@@ -34,10 +34,9 @@
integer,parameter :: HORIZONTAL_DIAGNOSTIC_VARIABLE = 5
integer,parameter :: CONSERVED_QUANTITY = 6
type (type_model),private,target,save :: model
class (type_model),private,pointer,save :: model => null()
real(8),dimension(:),pointer :: state
character(len=1024),dimension(:),allocatable :: environment_names,environment_units
character(len=1024) :: yaml_path
type (type_property_dictionary),save,private :: forced_parameters
......@@ -69,17 +68,26 @@
!EOP
!
character(len=attribute_length),pointer :: ppath
class (type_property), pointer :: property
!-----------------------------------------------------------------------
!BOC
call c_f_pointer(c_loc(path), ppath)
yaml_path = ppath(:index(ppath,C_NULL_CHAR)-1)
if (model%initialized) call finalize()
if (associated(model)) call finalize()
if (.not.associated(driver)) allocate(type_python_driver::driver)
! Build FABM model tree (configuration will be read from fabm.yaml).
call fabm_create_model_from_yaml_file(model,path=yaml_path,parameters=forced_parameters)
allocate(model)
call fabm_create_model_from_yaml_file(model,path=ppath(:index(ppath,C_NULL_CHAR)-1),parameters=forced_parameters)
! Get a list of all parameter that had an explicit value specified.
property => model%root%parameters%first
do while (associated(property))
if (.not.model%root%missing_parameters%contains(property%name)) &
call forced_parameters%set_property(property)
property => property%next
end do
! Send information on spatial domain to FABM (this also allocates memory for diagnostics)
call fabm_set_domain(model)
......@@ -90,6 +98,53 @@
end subroutine initialize
!EOC
subroutine reinitialize()
type (type_model), pointer :: newmodel
type (type_model_list_node), pointer :: node
class (type_base_model), pointer :: childmodel
class (type_property), pointer :: property,next
allocate(newmodel)
! Transfer forced parameters to root of the model.
call newmodel%root%parameters%update(forced_parameters)
! Re-create original models
node => model%root%children%first
do while (associated(node))
if (node%model%type_name/='') then
call factory%create(node%model%type_name,childmodel)
call newmodel%root%add_child(childmodel,node%model%name,node%model%long_name,configunit=-1)
end if
node => node%next
end do
! Clean up old model
call finalize()
model => newmodel
! Initialize new model
call fabm_initialize(model)
! Removed unused forced parameters from root model.
property => model%root%parameters%first
do while (associated(property))
if (.not. model%root%retrieved_parameters%contains(property%name)) then
next => property%next
call model%root%parameters%delete(property%name)
property => next
else
property => property%next
end if
end do
! Send information on spatial domain to FABM (this also allocates memory for diagnostics)
call fabm_set_domain(model)
! Retrieve arrays to hold values for environmental variables and corresponding metadata.
call get_environment_metadata(model,environment_names,environment_units)
end subroutine
subroutine check_ready()
!DIR$ ATTRIBUTES DLLEXPORT :: check_ready
call fabm_check_ready(model)
......@@ -270,7 +325,7 @@
call forced_parameters%delete(pname(:index(pname,C_NULL_CHAR)-1))
! Re-initialize the model using updated parameter values
call initialize(yaml_path)
call reinitialize()
end subroutine
subroutine set_real_parameter(name,value) bind(c)
......@@ -284,7 +339,7 @@
call forced_parameters%set_real(pname(:index(pname,C_NULL_CHAR)-1),value)
! Re-initialize the model using updated parameter values
call initialize(yaml_path)
call reinitialize()
end subroutine
function get_real_parameter(name,default) bind(c) result(value)
......@@ -308,7 +363,7 @@
call forced_parameters%set_integer(pname(:index(pname,C_NULL_CHAR)-1),value)
! Re-initialize the model using updated parameter values
call initialize(yaml_path)
call reinitialize()
end subroutine
function get_integer_parameter(name,default) bind(c) result(value)
......@@ -332,7 +387,7 @@
call forced_parameters%set_logical(pname(:index(pname,C_NULL_CHAR)-1),value/=0)
! Re-initialize the model using updated parameter values
call initialize(yaml_path)
call reinitialize()
end subroutine
function get_logical_parameter(name,default) bind(c) result(value)
......@@ -354,7 +409,7 @@
call forced_parameters%set_string(name,value)
! Re-initialize the model using updated parameter values
call initialize(yaml_path)
call reinitialize()
end subroutine
function get_string_parameter(name,default) result(value)
......
......@@ -23,7 +23,6 @@ module fabm_properties
character(len=metadata_string_length) :: name = ''
character(len=metadata_string_length) :: long_name = ''
character(len=metadata_string_length) :: units = ''
logical :: accessed = .false.
class (type_property), pointer :: next => null()
contains
procedure :: typecode
......@@ -74,8 +73,6 @@ module fabm_properties
procedure :: keys
procedure :: compare_keys
procedure :: reset_accessed
end type
type type_set_element
......@@ -267,7 +264,6 @@ contains
allocate(current%next,source=property)
current => current%next
end if
current%accessed = .true.
nullify(current%next)
end subroutine
......@@ -319,10 +315,7 @@ contains
property => dictionary%first
do while (associated(property))
if (dictionary%compare_keys(property%name,name)) then
property%accessed = .true.
return
end if
if (dictionary%compare_keys(property%name,name)) return
property => property%next
end do
end function
......@@ -397,7 +390,7 @@ contains
! Now look internally for properties with this name.
previous => dictionary%first
property => property%next
property => previous%next
do while (associated(property))
if (dictionary%compare_keys(property%name,name)) then
previous%next => property%next
......@@ -439,18 +432,6 @@ contains
end do
end subroutine
subroutine reset_accessed(dictionary)
class (type_property_dictionary),intent(inout) :: dictionary
class (type_property),pointer :: property
property => dictionary%first
do while (associated(property))
property%accessed = .false.
property => property%next
end do
end subroutine
logical function set_contains(self,string)
class (type_set),intent(in) :: self
character(len=*),intent(in) :: string
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment