Commit 88fdd9c5 authored by Jorn Bruggeman's avatar Jorn Bruggeman
Browse files

complete_outputs -> finalize_outputs; control logging through fabm.yaml; cosmetic tweaks

parent 8fc3fa26
......@@ -404,7 +404,7 @@ contains
dy_(1:size(model%state_variables)) = dy_(1:size(model%state_variables)) / column_depth
end if
call model%get_interior_sources(dy_(1:size(model%state_variables)))
call model%complete_outputs()
call model%finalize_outputs()
! Compute rate of change in conserved quantities
!call fabm_state_to_conserved_quantities(model,pelagic_rates,conserved_rates)
......
......@@ -73,6 +73,8 @@ module fabm
public fabm_set_mask
#endif
logical, save, public :: fabm_log = .false.
integer, parameter :: status_none = 0
integer, parameter :: status_initialize_done = 1
integer, parameter :: status_set_domain_done = 2
......@@ -312,7 +314,7 @@ module fabm
procedure :: prepare_inputs1
procedure :: prepare_inputs2
generic :: prepare_inputs => prepare_inputs1, prepare_inputs2
procedure :: complete_outputs
procedure :: finalize_outputs
procedure :: get_interior_sources_rhs
procedure :: get_interior_sources_ppdd
......@@ -977,16 +979,15 @@ contains
! Merge write indices when operations can be done in place
! This must be done after all variables are requested from the different jobs, so we know which variables
! will be retrieved (such variables cannot be merged)
#ifndef NDEBUG
log_unit = get_free_unit()
open(unit=log_unit, file=log_prefix // 'merges.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'merges.log')
call merge_indices(self%root, log_unit)
close(log_unit)
#else
call merge_indices(self%root)
#endif
if (fabm_log) then
log_unit = get_free_unit()
open(unit=log_unit, file=log_prefix // 'merges.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'merges.log')
call merge_indices(self%root, log_unit)
close(log_unit)
else
call merge_indices(self%root)
end if
! Initialize all jobs. This also creates registers for the read and write caches, as well as the persistent store.
call self%job_manager%initialize(self%variable_register, self%schedules, unfulfilled_dependencies)
......@@ -1014,27 +1015,27 @@ contains
link => link%next
end do
#ifndef NDEBUG
open(unit=log_unit, file=log_prefix // 'register.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'register.log')
call self%variable_register%print(log_unit)
close(log_unit)
open(unit=log_unit, file=log_prefix // 'jobs.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'jobs.log')
call self%job_manager%print(log_unit)
close(log_unit)
open(unit=log_unit, file=log_prefix // 'discards.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'discards.log')
write (log_unit,'(a)') 'Writes for the following variables are discarded:'
link => self%links_postcoupling%first
do while (associated(link))
if (link%target%write_indices%value == 0) write (log_unit,'("- ",a)') trim(link%target%name)
link => link%next
end do
close(log_unit)
#endif
if (fabm_log) then
open(unit=log_unit, file=log_prefix // 'register.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'register.log')
call self%variable_register%print(log_unit)
close(log_unit)
open(unit=log_unit, file=log_prefix // 'jobs.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'jobs.log')
call self%job_manager%print(log_unit)
close(log_unit)
open(unit=log_unit, file=log_prefix // 'discards.log', action='write', status='replace', iostat=ios)
if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'discards.log')
write (log_unit,'(a)') 'Writes for the following variables are discarded:'
link => self%links_postcoupling%first
do while (associated(link))
if (link%target%write_indices%value == 0) write (log_unit,'("- ",a)') trim(link%target%name)
link => link%next
end do
close(log_unit)
end if
_ASSERT_(all(self%state_variables(:)%sms_index > 0), 'start', 'BUG: sms_index invalid for one or more interior state variables.')
_ASSERT_(all(self%state_variables(:)%surface_flux_index > 0), 'start', 'BUG: surface_flux_index invalid for one or more interior state variables.')
......@@ -3331,11 +3332,11 @@ end subroutine end_vertical_task
call prepare_inputs1(self, t)
end subroutine prepare_inputs2
subroutine complete_outputs(self)
subroutine finalize_outputs(self)
class (type_model), intent(inout) :: self
call self%process(self%get_diagnostics_job)
end subroutine complete_outputs
end subroutine finalize_outputs
subroutine classify_variables(self)
class (type_model), intent(inout), target :: self
......
......@@ -6,7 +6,7 @@ module fabm_config
use fabm_properties, only: type_property_dictionary, type_property, type_set
use fabm_driver
use fabm_schedule
use fabm, only: type_fabm_model, fabm_initialize_library, type_model
use fabm, only: type_fabm_model, fabm_initialize_library, fabm_log, type_model
use yaml_types
use yaml, yaml_parse=>parse, yaml_error_length=>error_length
......@@ -112,18 +112,20 @@ contains
! If custom parameter values were provided, transfer these to the root model.
if (present(parameters)) call model%root%parameters%update(parameters)
nullify(config_error)
check_conservation = mapping%get_logical('check_conservation',default=.false.,error=config_error)
config_error => null()
check_conservation = mapping%get_logical('check_conservation', default=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_tree_from_dictionary', config_error%message)
require_initialization = mapping%get_logical('require_initialization',default=.false.,error=config_error)
require_initialization = mapping%get_logical('require_initialization', default=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_tree_from_dictionary', config_error%message)
require_all_parameters = mapping%get_logical('require_all_parameters',default=.false.,error=config_error)
require_all_parameters = mapping%get_logical('require_all_parameters', default=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_tree_from_dictionary', config_error%message)
fabm_log = mapping%get_logical('log', default=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_tree_from_dictionary', config_error%message)
node => mapping%get('instances')
if (.not.associated(node)) &
call fatal_error('create_model_tree_from_dictionary', 'No "instances" dictionary found at root level.')
nullify(pair)
pair => null()
select type (node)
class is (type_dictionary)
pair => node%first
......@@ -191,42 +193,42 @@ contains
integer :: schedule_pattern, source
character(len=64) :: pattern
nullify(config_error)
config_error => null()
use_model = node%get_logical('use',default=.true.,error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
if (.not.use_model) then
use_model = node%get_logical('use', default=.true., error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
if (.not. use_model) then
call log_message('SKIPPING model instance '//trim(instancename)//' because it has use=false set.')
return
end if
! Retrieve model name (default to instance name if not provided).
modelname = trim(node%get_string('model',default=instancename,error=config_error))
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
modelname = trim(node%get_string('model', default=instancename, error=config_error))
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
! Retrieve descriptive name for the model instance (default to instance name if not provided).
long_name = trim(node%get_string('long_name',default=instancename,error=config_error))
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
long_name = trim(node%get_string('long_name', default=instancename, error=config_error))
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
! Try to create the model based on name.
call factory%create(trim(modelname),model)
if (.not.associated(model)) call fatal_error('create_model_from_dictionary', &
trim(instancename)//': "'//trim(modelname)//'" is not a valid model name.')
call factory%create(trim(modelname), model)
if (.not. associated(model)) call fatal_error('create_model_from_dictionary', &
trim(instancename) // ': "' // trim(modelname) // '" is not a valid model name.')
model%user_created = .true.
! Transfer user-specified parameter values to the model.
childmap => node%get_dictionary('parameters',required=.false.,error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
childmap => node%get_dictionary('parameters', required=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
if (associated(childmap)) then
call childmap%flatten(parametermap,'')
call childmap%flatten(parametermap, '')
pair => parametermap%first
do while (associated(pair))
select type (value=>pair%value)
class is (type_scalar)
call model%parameters%set_string(trim(pair%key),trim(value%string))
class is (type_node)
call fatal_error('create_model_from_dictionary','BUG: "flatten" should &
&have ensured that the value of '//trim(value%path)//' is scalar, not a nested dictionary.')
select type (value => pair%value)
class is (type_scalar)
call model%parameters%set_string(trim(pair%key), trim(value%string))
class is (type_node)
call fatal_error('create_model_from_dictionary', 'BUG: "flatten" should &
&have ensured that the value of ' // trim(value%path) // ' is scalar, not a nested dictionary.')
end select
pair => pair%next
end do
......@@ -234,86 +236,86 @@ contains
end if
! Add the model to its parent.
call log_message('Initializing '//trim(instancename)//'...')
call log_message(' model type: '//trim(modelname))
call parent%add_child(model,instancename,long_name,configunit=-1)
call log_message('Initializing ' // trim(instancename) // '...')
call log_message(' model type: ' // trim(modelname))
call parent%add_child(model, instancename, long_name, configunit=-1)
call log_message(' initialization succeeded.')
! Check for parameters requested by the model, but not present in the configuration file.
if (require_all_parameters.and.associated(model%parameters%missing%first)) &
call fatal_error('create_model_from_dictionary','Value for parameter "'// &
trim(model%parameters%missing%first%string)//'" of model "'//trim(instancename)//'" is not provided.')
if (require_all_parameters .and. associated(model%parameters%missing%first)) &
call fatal_error('create_model_from_dictionary', 'Value for parameter "'// &
trim(model%parameters%missing%first%string)//'" of model "' // trim(instancename) // '" is not provided.')
! Check for parameters present in configuration file, but not interpreted by the models.
property => model%parameters%first
do while (associated(property))
if (.not.model%parameters%retrieved%contains(property%name)) call fatal_error('create_model_from_dictionary', &
'Unrecognized parameter "'//trim(property%name)//'" found below '//trim(childmap%path)//'.')
'Unrecognized parameter "' // trim(property%name) // '" found below ' // trim(childmap%path) // '.')
property => property%next
end do
! Interpret coupling links specified in configuration file.
! These override any couplings requested by the models during initialization.
! This step must therefore occur after model initialization [from parent%add_child] has completed.
childmap => node%get_dictionary('coupling',required=.false.,error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
childmap => node%get_dictionary('coupling', required=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
if (associated(childmap)) then
pair => childmap%first
do while (associated(pair))
select type (value=>pair%value)
class is (type_scalar)
! Register couplings at the root level, so they override whatever the models themselves request.
call parent%couplings%set_string(trim(instancename)//'/'//trim(pair%key),trim(value%string))
class is (type_node)
call fatal_error('create_model_from_dictionary','The value of '//trim(value%path)// &
' must be a string, not a nested dictionary.')
select type (value => pair%value)
class is (type_scalar)
! Register couplings at the root level, so they override whatever the models themselves request.
call parent%couplings%set_string(trim(instancename) // '/' // trim(pair%key), trim(value%string))
class is (type_node)
call fatal_error('create_model_from_dictionary', 'The value of ' // trim(value%path) // &
' must be a string, not a nested dictionary.')
end select
pair => pair%next
end do
end if
! Parse scheduling instructions
childmap => node%get_dictionary('schedule',required=.false.,error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
childmap => node%get_dictionary('schedule', required=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
if (associated(childmap)) then
pair => childmap%first
do while (associated(pair))
select type (value=>pair%value)
class is (type_dictionary)
select case (pair%key)
case ('interior')
source = source_do
case default
call fatal_error('create_model_from_dictionary', 'Scheduler currently only supports "interior" &
&(not "' // trim(pair%key) // '").')
end select
pattern = trim(value%get_string('pattern', error=config_error))
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
select case (pattern)
case ('monthly')
schedule_pattern = schedule_pattern_monthly
case default
call fatal_error('create_model_from_dictionary', 'Scheduler currently only supports "monthly" &
&as a pattern (not "' // trim(pattern) // '").')
end select
call schedules%add(model, source, schedule_pattern)
class is (type_node)
call fatal_error('create_model_from_dictionary','The value of '//trim(value%path)// &
' must be a dictionary.')
select type (value => pair%value)
class is (type_dictionary)
select case (pair%key)
case ('interior')
source = source_do
case default
call fatal_error('create_model_from_dictionary', 'Scheduler currently only supports "interior" &
&(not "' // trim(pair%key) // '").')
end select
pattern = trim(value%get_string('pattern', error=config_error))
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
select case (pattern)
case ('monthly')
schedule_pattern = schedule_pattern_monthly
case default
call fatal_error('create_model_from_dictionary', 'Scheduler currently only supports "monthly" &
&as a pattern (not "' // trim(pattern) // '").')
end select
call schedules%add(model, source, schedule_pattern)
class is (type_node)
call fatal_error('create_model_from_dictionary','The value of '//trim(value%path)// &
' must be a dictionary.')
end select
pair => pair%next
end do
end if
! Transfer user-specified initial state to the model.
childmap => node%get_dictionary('initialization',required=.false.,error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
if (associated(childmap)) call parse_initialization(model,childmap,initialized_set,get_background=.false.)
childmap => node%get_dictionary('initialization', required=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
if (associated(childmap)) call parse_initialization(model, childmap, initialized_set, get_background=.false.)
! Transfer user-specified background value to the model.
childmap => node%get_dictionary('background',required=.false.,error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary',config_error%message)
if (associated(childmap)) call parse_initialization(model,childmap,background_set,get_background=.true.)
childmap => node%get_dictionary('background', required=.false., error=config_error)
if (associated(config_error)) call fatal_error('create_model_from_dictionary', config_error%message)
if (associated(childmap)) call parse_initialization(model, childmap, background_set, get_background=.true.)
! Verify whether all state variables have been provided with an initial value.
!link => model%first_link
......@@ -347,8 +349,8 @@ contains
! Check whether any keys at the model level remain unused.
pair => node%first
do while (associated(pair))
if (.not.pair%accessed) call fatal_error('create_model_from_dictionary', &
'Unrecognized option "'//trim(pair%key)//'" found below '//trim(node%path)//'.')
if (.not. pair%accessed) call fatal_error('create_model_from_dictionary', &
'Unrecognized option "' // trim(pair%key) // '" found below ' // trim(node%path) // '.')
pair => pair%next
end do
......
......@@ -267,7 +267,7 @@ end subroutine
coupling => self%coupling_task_list%first
do while (associated(coupling))
nullify(master)
master => null()
select case (stage)
case (couple_explicit,couple_final)
if (associated(coupling%master_standard_variable)) then
......@@ -549,7 +549,10 @@ recursive subroutine create_aggregate_models(self)
aggregate_variable_access => self%first_aggregate_variable_access
do while (associated(aggregate_variable_access))
nullify(sum,horizontal_sum,bottom_sum,surface_sum)
sum => null()
horizontal_sum => null()
bottom_sum => null()
surface_sum => null()
if (aggregate_variable_access%interior /=access_none) allocate(sum)
if (aggregate_variable_access%horizontal/=access_none) allocate(horizontal_sum)
if (aggregate_variable_access%bottom /=access_none) allocate(bottom_sum)
......
......@@ -817,7 +817,7 @@ subroutine task_finalize(self)
deallocate(node)
node => next
end do
nullify(self%first_call)
self%first_call => null()
end subroutine task_finalize
subroutine call_initialize(self, variable_register)
......
......@@ -258,7 +258,7 @@ contains
key = string_lower(property%name)
! First determine if a property with this name already exists (if so, delete it)
nullify(previous)
previous => null()
current => dictionary%first
do while (associated(current))
if (current%key==key) then
......@@ -294,7 +294,7 @@ contains
current => current%next
end if
current%key = key
nullify(current%next)
current%next => null()
end subroutine
subroutine update(target,source,overwrite)
......@@ -518,7 +518,7 @@ contains
deallocate(property)
property => next
end do
nullify(dictionary%first)
dictionary%first => null()
end subroutine finalize
logical function set_contains(self,string)
......@@ -566,7 +566,7 @@ contains
type (type_set_element),pointer :: previous,element
nullify(previous)
previous => null()
element => self%first
do while (associated(element))
if (element%string==string) exit
......@@ -625,7 +625,7 @@ contains
deallocate(element)
element => next
end do
nullify(self%first)
self%first => null()
end subroutine
function hierarchical_dictionary_find_in_tree(self,name) result(property)
......@@ -637,7 +637,7 @@ contains
class (type_property), pointer :: current_property
character(len=metadata_string_length) :: localname
nullify(property)
property => null()
current_dictionary => self
localname = name
do while (associated(current_dictionary))
......
......@@ -1269,7 +1269,7 @@ subroutine link_list_finalize(self)
deallocate(link)
link => next
end do
nullify(self%first)
self%first => null()
end subroutine link_list_finalize
function create_coupling_task(self,link) result(task)
......@@ -2864,8 +2864,8 @@ end subroutine get_string_parameter
type (type_link), pointer :: link
nullify(object)
link => self%find_link(name,recursive,exact)
object => null()
link => self%find_link(name, recursive, exact)
if (associated(link)) object => link%target
end function find_object
......@@ -2958,7 +2958,7 @@ end subroutine get_string_parameter
!EOP
!-----------------------------------------------------------------------
!BOC
nullify(found_model)
found_model => null()
! Determine whether to also try among ancestors
recursive_eff = .false.
......@@ -2976,7 +2976,7 @@ end subroutine get_string_parameter
found_model => found_model%parent
elseif (.not.(length==1.and.name(istart:istart)=='.')) then
node => found_model%children%find(name(istart:istart+length-1))
nullify(found_model)
found_model => null()
if (associated(node)) found_model => node%model
end if
istart = istart+length+1
......@@ -3161,10 +3161,10 @@ end subroutine abstract_model_factory_register_version
end do
used = .true.
if (.not.associated(self%first)) then
if (.not. associated(self%first)) then
! Task list is empty - add first.
self%first => task
nullify(task%previous)
task%previous => null()
else
! Task list contains items - append to tail.
......@@ -3177,7 +3177,7 @@ end subroutine abstract_model_factory_register_version
existing_task%next => task
task%previous => existing_task
end if
nullify(task%next)
task%next => null()
end function coupling_task_list_add_object
subroutine coupling_task_list_add(self,link,always_create,task)
......
......@@ -675,7 +675,7 @@ contains
call model%get_interior_sources(_PREARG_INTERIOR_IN_ dy)
_END_OUTER_INTERIOR_LOOP_
call model%complete_outputs()
call model%finalize_outputs()
if (mod(i, 100) == 0) write (*,'(i0,a)') int(100*i/real(n, rke)), ' % complete'
end do
......@@ -910,10 +910,10 @@ contains
! Postprocressing
! ======================================================================
call start_test('complete_outputs')
call model%complete_outputs()
call start_test('finalize_outputs')
call model%finalize_outputs()
call assert(column_loop_count == interior_count, 'complete_outputs', 'call count does not match number of (unmasked) interior points')
call assert(column_loop_count == interior_count, 'finalize_outputs', 'call count does not match number of (unmasked) interior points')
do ivar = 1, size(model%diagnostic_variables)
if (model%diagnostic_variables(ivar)%save .and. model%diagnostic_variables(ivar)%target%source == source_do_column) then
......
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