diff --git a/components/iobridge/src/iobridge.F90 b/components/iobridge/src/iobridge.F90 index fa748330..89be1279 100644 --- a/components/iobridge/src/iobridge.F90 +++ b/components/iobridge/src/iobridge.F90 @@ -6,15 +6,17 @@ module iobridge_mod use collections_mod, only : hashmap_type, map_type, list_type, c_contains, c_get_generic, c_get_string, c_put_generic, & c_put_integer, c_size, c_key_at, c_free use conversions_mod, only : conv_to_string - use state_mod, only : model_state_type + use state_mod, only : model_state_type, get_prognostic_field_units, get_prognostic_field_long_name, & + get_prognostic_field_standard_name use grids_mod, only : X_INDEX, Y_INDEX, Z_INDEX, local_grid_type use optionsdatabase_mod, only : options_size, options_get_logical use prognostics_mod, only : prognostic_field_type use datadefn_mod, only : DEFAULT_PRECISION, SINGLE_PRECISION, DOUBLE_PRECISION, STRING_LENGTH - use logging_mod, only : LOG_ERROR, LOG_WARN, log_log, log_master_log + use logging_mod, only : LOG_ERROR, LOG_WARN, log_log, log_master_log, LOG_INFO use optionsdatabase_mod, only : options_get_integer use q_indices_mod, only : q_metadata_type, get_indices_descriptor - use registry_mod, only : get_all_component_published_fields, get_component_field_value, get_component_field_information + use registry_mod, only : get_all_component_published_fields, get_component_field_value, get_component_field_information, & + is_component_field_available use io_server_client_mod, only : COMMAND_TAG, DATA_TAG, REGISTER_COMMAND, DEREGISTER_COMMAND, DATA_COMMAND_START, & ARRAY_FIELD_TYPE, SCALAR_FIELD_TYPE, MAP_FIELD_TYPE, INTEGER_DATA_TYPE, BOOLEAN_DATA_TYPE, STRING_DATA_TYPE, & FLOAT_DATA_TYPE, DOUBLE_DATA_TYPE, LOCAL_SIZES_KEY, LOCAL_START_POINTS_KEY, LOCAL_END_POINTS_KEY, NUMBER_Q_INDICIES_KEY, & @@ -458,6 +460,7 @@ integer function send_data_field_sizes_to_server(current_state, mpi_type_data_si type(model_state_type), target, intent(inout) :: current_state integer, intent(in) :: mpi_type_data_sizing_description, number_unique_fields type(data_sizing_description_type), dimension(:), intent(inout) :: data_description + type(component_field_information_type) :: field_information integer :: ierr, i, next_index, request_handle character(len=STRING_LENGTH) :: field_name @@ -467,7 +470,14 @@ integer function send_data_field_sizes_to_server(current_state, mpi_type_data_si do i=1, number_unique_fields field_name=c_key_at(unique_field_names, i) if (c_contains(sendable_fields, field_name)) then - call assemble_individual_description(data_description, next_index, field_name, get_sendable_field_sizing(field_name)) + if (is_component_field_available(field_name)) then + field_information = get_component_field_information(current_state, field_name) + call assemble_individual_description(data_description, next_index, field_name, get_sendable_field_sizing(field_name), & + field_units=field_information%units, field_long_name=field_information%long_name, & + field_standard_name=field_information%standard_name) + else + call assemble_individual_description(data_description, next_index, field_name, get_sendable_field_sizing(field_name)) + endif next_index=next_index+1 end if end do @@ -574,17 +584,33 @@ end function get_component_field_descriptor !! @param index The index of this current field !! @param field_name The corresponding field name that we are describing !! @param dimensions The number of dimensions (zero means the field is inactive) - !! @param dim1 Optional size of dimension 1 - !! @param dim2 Optional size of dimension 2 - !! @param dim3 Optional size of dimension 3 - !! @param dim4 Optional size of dimension 4 - subroutine assemble_individual_description(data_description, index, field_name, field_sizing_description) + !! @param field_units + !! @param field_long_name + !! @param field_standard_name + subroutine assemble_individual_description(data_description, index, field_name, field_sizing_description, & + field_units, field_long_name, field_standard_name) integer, intent(in) :: index character(len=*), intent(in) :: field_name type(io_server_sendable_field_sizing), intent(in) :: field_sizing_description type(data_sizing_description_type), dimension(:), intent(inout) :: data_description + character(len=*), intent(in), optional :: field_units, field_long_name, field_standard_name data_description(index)%field_name=field_name + if (present(field_units)) then + data_description(index)%field_units=field_units + else + data_description(index)%field_units=get_prognostic_field_units(field_name) + endif + if (present(field_long_name)) then + data_description(index)%field_long_name=field_long_name + else + data_description(index)%field_long_name=get_prognostic_field_long_name(field_name) + endif + if (present(field_standard_name)) then + data_description(index)%field_standard_name=field_standard_name + else + data_description(index)%field_standard_name=get_prognostic_field_standard_name(field_name) + endif data_description(index)%dimensions=field_sizing_description%number_dimensions data_description(index)%dim_sizes=field_sizing_description%dimensions end subroutine assemble_individual_description diff --git a/components/profile_diagnostics/src/profile_diagnostics.F90 b/components/profile_diagnostics/src/profile_diagnostics.F90 index 0c05c37c..5877c310 100644 --- a/components/profile_diagnostics/src/profile_diagnostics.F90 +++ b/components/profile_diagnostics/src/profile_diagnostics.F90 @@ -337,6 +337,26 @@ subroutine field_information_retrieval_callback(current_state, name, field_infor else field_information%enabled=.true. end if + + if (name .eq. "prefn_local") then + field_information%units = "Pa" + field_information%long_name = "reference pressure at cell-faces" + else if (name .eq. "u_wind_total_local") then + field_information%units = "m/s" + field_information%long_name = "per-MONC horizontal sum of u-wind" + else if (name .eq. "v_wind_total_local") then + field_information%units = "m/s" + field_information%long_name = "per-MONC horizontal sum of v-wind" + else if (name .eq. "w_wind_total_local") then + field_information%units = "m/s" + field_information%long_name = "per-MONC horizontal sum of w-wind" + else if (name .eq. "theta_total_local") then + field_information%units = "K" + field_information%long_name = "per-MONC horizontal sum of potential temperature" + else if (name .eq. "thinit_local") then + field_information%units = "K" + field_information%long_name = "initial vertical profile of potential temperature" + endif end subroutine field_information_retrieval_callback !> Field value retrieval callback, this returns the value of a specific published field diff --git a/components/scalar_diagnostics/src/scalar_diagnostics.F90 b/components/scalar_diagnostics/src/scalar_diagnostics.F90 index 666fc18a..a9001faf 100644 --- a/components/scalar_diagnostics/src/scalar_diagnostics.F90 +++ b/components/scalar_diagnostics/src/scalar_diagnostics.F90 @@ -219,7 +219,35 @@ subroutine field_information_retrieval_callback(current_state, name, field_infor else field_information%enabled=.true. end if - + + if (name .eq. "qlmax_local") then + field_information%units = 'kg/kg' + field_information%long_name = "per-column maximum liquid water specific mass" + else if (name .eq. "wmax_local") then + field_information%units = 'm/s' + field_information%long_name = "per-column maximum vertical velocity" + else if (name .eq. "wmin_local") then + field_information%units = 'm/s' + field_information%long_name = "per-column minimum vertical velocity" + else if (name .eq. "cltop_local") then + field_information%units = 'm' + field_information%long_name = "per-column maximum condensate height" + else if (name .eq. "clbas_local") then + field_information%units = 'm' + field_information%long_name = "per-column minimum condensate height" + else if (name .eq. "lwp_local") then + field_information%units = 'kg/m^2' + field_information%long_name = "per-column liquid-water path" + else if (name .eq. "vwp_local") then + field_information%units = 'kg/m^2' + field_information%long_name = "per-column water-vapour path" + else if (name .eq. "lathf_local") then + field_information%units = 'W/m^2' + field_information%long_name = "per-column surface latent-heat flux" + else if (name .eq. "senhf_local") then + field_information%units = 'W/m^2' + field_information%long_name = "per-column surface sensible-heat flux" + endif end subroutine field_information_retrieval_callback !> Field value retrieval callback, this returns the value of a specific published field diff --git a/io/io_cfg_files/profile_fields.xml b/io/io_cfg_files/profile_fields.xml index 5344d412..88dff7be 100644 --- a/io/io_cfg_files/profile_fields.xml +++ b/io/io_cfg_files/profile_fields.xml @@ -31,31 +31,31 @@ - + - + - + - + - + - - + + - - + + - - + + @@ -70,8 +70,8 @@ - - + + diff --git a/io/io_cfg_files/scalar_fields.xml b/io/io_cfg_files/scalar_fields.xml index 7df51c0e..ec12a672 100644 --- a/io/io_cfg_files/scalar_fields.xml +++ b/io/io_cfg_files/scalar_fields.xml @@ -12,91 +12,91 @@ - - + + - - + + - - + + - + - + - + - - + + - - + + - + - + - + - + - + - + - + - + - + - + - - + + - - + + diff --git a/io/src/configurationparser.F90 b/io/src/configurationparser.F90 index 277f8c9b..16f86e97 100644 --- a/io/src/configurationparser.F90 +++ b/io/src/configurationparser.F90 @@ -48,7 +48,10 @@ module configuration_parser_mod !> Configuration associated with the representation of a specific data field type io_configuration_field_type - character(len=STRING_LENGTH) :: name, namespace, dim_size_defns(4), units + character(len=STRING_LENGTH) :: name, namespace, dim_size_defns(4) + character(len=STRING_LENGTH) :: units = "" !< Units of field data + character(len=STRING_LENGTH) :: long_name = "" !< Long descriptive name for CF-compliance + character(len=STRING_LENGTH) :: standard_name = "" !< CF-compliant standard name, see http://cfconventions.org/standard-names.html for reference integer :: field_type, data_type, dimensions logical :: optional, collective end type io_configuration_field_type @@ -74,7 +77,10 @@ module configuration_parser_mod end type io_configuration_misc_item_type type io_configuration_diagnostic_field_type - character(len=STRING_LENGTH) :: name, dim_size_defns(4), units, namespace + character(len=STRING_LENGTH) :: name, dim_size_defns(4), namespace + character(len=STRING_LENGTH) :: units = "" !< Units of field data + character(len=STRING_LENGTH) :: long_name = "" !< Long descriptive name for CF-compliance + character(len=STRING_LENGTH) :: standard_name = "" !< CF-compliant standard name, see http://cfconventions.org/standard-names.html for reference integer :: field_type, data_type, dimensions logical :: collective type(list_type) :: members diff --git a/io/src/diagnostics/diagnostic_federator.F90 b/io/src/diagnostics/diagnostic_federator.F90 index 4f918efb..02c35982 100644 --- a/io/src/diagnostics/diagnostic_federator.F90 +++ b/io/src/diagnostics/diagnostic_federator.F90 @@ -24,20 +24,21 @@ module diagnostic_federator_mod use data_utils_mod, only : get_scalar_integer_from_monc, get_scalar_real_from_monc, is_field_present, & get_action_attribute_logical, get_action_attribute_integer, get_action_attribute_string, & get_array_double_from_monc, get_array_integer_from_monc, get_scalar_logical_from_monc - use logging_mod, only : LOG_WARN, LOG_ERROR, log_log + use logging_mod, only : LOG_WARN, LOG_ERROR, LOG_INFO, log_log use operator_mod, only : perform_activity, initialise_operators, finalise_operators, get_operator_required_fields, & get_operator_perform_procedure, get_operator_auto_size use io_server_client_mod, only : DOUBLE_DATA_TYPE, INTEGER_DATA_TYPE use writer_field_manager_mod, only : provide_field_to_writer_federator + + use diagnostic_types_mod, only: diagnostics_activity_type, get_misc_action_at_index, get_diagnostic_activity_by_result_name, & + retrieve_next_activity, diagnostics_type, OPERATOR_TYPE, REDUCTION_TYPE, BROADCAST_TYPE, ALLREDUCTION_TYPE, PERFORM_CLEAN_EVERY + implicit none #ifndef TEST_MODE private #endif - !< The type of activity - integer, parameter :: OPERATOR_TYPE=1, REDUCTION_TYPE=2, BROADCAST_TYPE=3, ALLREDUCTION_TYPE=4, PERFORM_CLEAN_EVERY=100 - !< A wrapper type containing all the diagnostics for MONC source processes at a specific timestep type all_diagnostics_at_timestep_type integer :: communication_corresponding_activities_rwlock, completed_diagnostics_rwlock, completed_num, completed_num_mutex @@ -56,22 +57,22 @@ module diagnostic_federator_mod end type diagnostics_at_timestep_type !< A diagnostic which is a name and then the list of activities require to be executed - type diagnostics_type - character(len=STRING_LENGTH) :: diagnostic_name, diagnostic_namespace, uuid - type(list_type) :: activities - integer :: generation_timestep_frequency - logical :: collective - end type diagnostics_type + !type diagnostics_type + !character(len=STRING_LENGTH) :: diagnostic_name, diagnostic_namespace, uuid + !type(list_type) :: activities + !integer :: generation_timestep_frequency + !logical :: collective + !end type diagnostics_type !< A diagnostic activity which is executed at some point with an input and returns an output - type diagnostics_activity_type - integer :: activity_type, communication_operator, root - real(kind=DEFAULT_PRECISION) :: result - type(list_type) :: required_fields - type(map_type) :: activity_attributes - character(len=STRING_LENGTH) :: result_name, activity_name, uuid - procedure(perform_activity), pointer, nopass :: operator_procedure - end type diagnostics_activity_type + !type diagnostics_activity_type + !integer :: activity_type, communication_operator, root + !real(kind=DEFAULT_PRECISION) :: result + !type(list_type) :: required_fields + !type(map_type) :: activity_attributes + !character(len=STRING_LENGTH) :: result_name, activity_name, uuid + !procedure(perform_activity), pointer, nopass :: operator_procedure + !end type diagnostics_activity_type type(hashmap_type), volatile :: diagnostics_per_monc_at_timestep, all_diagnostics_at_timestep type(hashset_type), volatile :: all_outstanding_fields, available_fields @@ -79,8 +80,11 @@ module diagnostic_federator_mod integer, volatile :: timestep_entries_rwlock, all_diagnostics_per_timestep_rwlock, clean_progress_mutex, & previous_clean_point, previous_viewed_timestep, current_point - public initialise_diagnostic_federator, finalise_diagnostic_federator, check_diagnostic_federator_for_completion, & + public initialise_diagnostic_federator, finalise_diagnostic_federator, check_diagnostic_federator_for_completion, & pass_fields_to_diagnostics_federator, determine_diagnostics_fields_available + + !! XXX: temp + public diagnostic_definitions contains !> Initialises the diagnostics action and sets up the diagnostics master definitions @@ -889,27 +893,6 @@ subroutine add_required_fields_if_needed(required_fields) end if end subroutine add_required_fields_if_needed - !> Retrieves the next activity in a collection being iterated over by an iterator - !! @param iterator The iterator we are using to iterate over the collection - !! @returns The next activity or null if none is found - function retrieve_next_activity(iterator) - type(iterator_type), intent(inout) :: iterator - type(diagnostics_activity_type), pointer :: retrieve_next_activity - - class(*), pointer :: generic - - generic=>c_next_generic(iterator) - - if (associated(generic)) then - select type(generic) - type is(diagnostics_activity_type) - retrieve_next_activity=>generic - end select - else - retrieve_next_activity=>null() - end if - end function retrieve_next_activity - !> Retrieves the timestep at a specific timestep and source MONC !! @param timestep The timestep to look up !! @param source The source MONC process id @@ -1074,28 +1057,6 @@ function get_comm_activity_from_fieldname(diagnostics_by_timestep, field_name) end if end function get_comm_activity_from_fieldname - !> Retrieves a misc action from the parsed user XML configuration at a specific index - !! @param action_members The members to extract from - !! @param index The index to look up - !! @returns The misc item at this index or null if none is found - function get_misc_action_at_index(action_members, index) - type(list_type), intent(inout) :: action_members - integer, intent(in) :: index - type(io_configuration_misc_item_type), pointer :: get_misc_action_at_index - - class(*), pointer :: generic - - generic=>c_get_generic(action_members, index) - if (associated(generic)) then - select type(generic) - type is(io_configuration_misc_item_type) - get_misc_action_at_index=>generic - end select - else - get_misc_action_at_index=>null() - end if - end function get_misc_action_at_index - !> Based upon the IO configuration this will define the diagnostics structure. It is done once at initialisation and then this !! same information is used for execution at each data arrival point. !! @param io_configuration The IO server configuration @@ -1122,6 +1083,7 @@ subroutine define_diagnostics(io_configuration, diagnostic_generation_frequency) diagnostic_definitions(i)%diagnostic_namespace=io_configuration%diagnostics(i)%namespace diagnostic_definitions(i)%collective=io_configuration%diagnostics(i)%collective action_entities=c_size(io_configuration%diagnostics(i)%members) + if (action_entities .gt. 0) then do j=1, action_entities misc_action=>get_misc_action_at_index(io_configuration%diagnostics(i)%members, j) @@ -1172,27 +1134,6 @@ subroutine define_diagnostics(io_configuration, diagnostic_generation_frequency) end if end subroutine define_diagnostics - !> Retrives a diagnostic activity based upon its result name or null if none is found - !! @param result_name The name of the result we are looking up - !! @param diagnostic_entry_index The diagnostic index that we are concerned with - !! @returns The corresponding activity or null if none is found - function get_diagnostic_activity_by_result_name(result_name, diagnostic_entry_index) - character(len=STRING_LENGTH), intent(inout) :: result_name - integer, intent(in) :: diagnostic_entry_index - type(diagnostics_activity_type), pointer :: get_diagnostic_activity_by_result_name - - type(iterator_type) :: iterator - - iterator=c_get_iterator(diagnostic_definitions(diagnostic_entry_index)%activities) - do while (c_has_next(iterator)) - get_diagnostic_activity_by_result_name=>retrieve_next_activity(iterator) - if (get_diagnostic_activity_by_result_name%result_name == result_name) then - return - end if - end do - get_diagnostic_activity_by_result_name=>null() - end function get_diagnostic_activity_by_result_name - !> Processes all auto dimensions by looking them up and resolving them based upon the operators !! @param io_configuration Configuration of the IO server !! @param diagnostic_configuration Configuration of the diagnostic field @@ -1206,7 +1147,8 @@ subroutine process_auto_dimensions(io_configuration, diagnostic_configuration, e character(len=STRING_LENGTH) :: specific_dimension type(diagnostics_activity_type), pointer :: diagnostic_activity - diagnostic_activity=>get_diagnostic_activity_by_result_name(diagnostic_definitions(entry_index)%diagnostic_name, entry_index) + diagnostic_activity=>get_diagnostic_activity_by_result_name(diagnostic_definitions(entry_index)%activities, & + diagnostic_definitions(entry_index)%diagnostic_name) if (associated(diagnostic_activity)) then if (diagnostic_activity%activity_type==OPERATOR_TYPE) then do i=1, diagnostic_configuration%dimensions diff --git a/io/src/diagnostics/diagnostic_types.F90 b/io/src/diagnostics/diagnostic_types.F90 new file mode 100644 index 00000000..26da4af7 --- /dev/null +++ b/io/src/diagnostics/diagnostic_types.F90 @@ -0,0 +1,98 @@ +module diagnostic_types_mod + use datadefn_mod, only : DEFAULT_PRECISION, STRING_LENGTH + use collections_mod, only : map_type, list_type, c_get_generic, iterator_type, c_has_next, & + c_next_generic, c_get_iterator + use operator_mod, only : perform_activity + use configuration_parser_mod, only : io_configuration_misc_item_type + + !< A diagnostic which is a name and then the list of activities require to be executed + type diagnostics_type + character(len=STRING_LENGTH) :: diagnostic_name, diagnostic_namespace, uuid + type(list_type) :: activities + integer :: generation_timestep_frequency + logical :: collective + end type diagnostics_type + + !< A diagnostic activity which is executed at some point with an input and returns an output + type diagnostics_activity_type + integer :: activity_type, communication_operator, root + real(kind=DEFAULT_PRECISION) :: result + type(list_type) :: required_fields + type(map_type) :: activity_attributes + character(len=STRING_LENGTH) :: result_name, activity_name, uuid + procedure(perform_activity), pointer, nopass :: operator_procedure + end type diagnostics_activity_type + + !< The type of activity + integer, parameter :: OPERATOR_TYPE=1, REDUCTION_TYPE=2, BROADCAST_TYPE=3, ALLREDUCTION_TYPE=4, PERFORM_CLEAN_EVERY=100 + + public diagnostics_activitity_type, diagnostics_type, get_diagnostic_activity_by_result_name, & + retrieve_next_activity, OPERATOR_TYPE, REDUCTION_TYPE, BROADCAST_TYPE, ALLREDUCTION_TYPE, PERFORM_CLEAN_EVERY + +contains + + !> Retrieves a misc action from the parsed user XML configuration at a specific index + !! @param action_members The members to extract from + !! @param index The index to look up + !! @returns The misc item at this index or null if none is found + function get_misc_action_at_index(action_members, index) + type(list_type), intent(inout) :: action_members + integer, intent(in) :: index + type(io_configuration_misc_item_type), pointer :: get_misc_action_at_index + + class(*), pointer :: generic + + generic=>c_get_generic(action_members, index) + if (associated(generic)) then + select type(generic) + type is(io_configuration_misc_item_type) + get_misc_action_at_index=>generic + end select + else + get_misc_action_at_index=>null() + end if + end function get_misc_action_at_index + + !> Retrives a diagnostic activity based upon its result name or null if none is found + !! @param result_name The name of the result we are looking up + !! @param diagnostic_entry_index The diagnostic index that we are concerned with + !! @returns The corresponding activity or null if none is found + function get_diagnostic_activity_by_result_name(diagnostic_activities, result_name) + type(list_type) :: diagnostic_activities + character(len=STRING_LENGTH), intent(in) :: result_name + type(diagnostics_activity_type), pointer :: get_diagnostic_activity_by_result_name + + type(iterator_type) :: iterator + + iterator=c_get_iterator(diagnostic_activities) + do while (c_has_next(iterator)) + get_diagnostic_activity_by_result_name=>retrieve_next_activity(iterator) + if (get_diagnostic_activity_by_result_name%result_name == result_name) then + return + end if + end do + get_diagnostic_activity_by_result_name=>null() + end function get_diagnostic_activity_by_result_name + + !> Retrieves the next activity in a collection being iterated over by an iterator + !! @param iterator The iterator we are using to iterate over the collection + !! @returns The next activity or null if none is found + function retrieve_next_activity(iterator) + type(iterator_type), intent(inout) :: iterator + type(diagnostics_activity_type), pointer :: retrieve_next_activity + + class(*), pointer :: generic + + generic=>c_next_generic(iterator) + + if (associated(generic)) then + select type(generic) + type is(diagnostics_activity_type) + retrieve_next_activity=>generic + end select + else + retrieve_next_activity=>null() + end if + end function retrieve_next_activity + +end module diff --git a/io/src/diagnostics/inter-io/reduction-inter-io.F90 b/io/src/diagnostics/inter-io/reduction-inter-io.F90 index 9deff4ce..895107de 100644 --- a/io/src/diagnostics/inter-io/reduction-inter-io.F90 +++ b/io/src/diagnostics/inter-io/reduction-inter-io.F90 @@ -42,7 +42,7 @@ module reduction_inter_io_mod logical, volatile :: initialised=.false. public init_reduction_inter_io, check_reduction_inter_io_for_completion, finalise_reduction_inter_io, & - perform_inter_io_reduction, get_reduction_operator + perform_inter_io_reduction, get_reduction_operator, get_reduction_operator_string contains !> Initialises the reduction action @@ -498,4 +498,21 @@ integer function get_reduction_operator(op_string) call log_log(LOG_ERROR, "Reduction operator '"//trim(op_string)//"' not recognised") end if end function get_reduction_operator + + !> Given the integer representation return the name of a reduciton operator + character(len=4) function get_reduction_operator_string(op_int) + integer, intent(in) :: op_int + + if (op_int .eq. MEAN) then + get_reduction_operator_string="mean" + else if (op_int .eq. MIN) then + get_reduction_operator_string="min" + else if (op_int .eq. MAX) then + get_reduction_operator_string="max" + else if (op_int .eq. SUM) then + get_reduction_operator_string="sum" + else + call log_log(LOG_ERROR, "Reduction operator for '"//conv_to_string(op_int)//"' not recognised") + end if + end function get_reduction_operator_string end module reduction_inter_io_mod diff --git a/io/src/ioclient.F90 b/io/src/ioclient.F90 index e00c55ba..383c6e32 100644 --- a/io/src/ioclient.F90 +++ b/io/src/ioclient.F90 @@ -16,6 +16,9 @@ module io_server_client_mod type data_sizing_description_type character(len=STRING_LENGTH) :: field_name !< Name of the field that this describes integer :: dimensions, dim_sizes(4) !< The number of dimensions and size in each dimension + character(len=STRING_LENGTH) :: field_units !< Units of field data + character(len=STRING_LENGTH) :: field_long_name !< Long descriptive name for CF-compliance + character(len=STRING_LENGTH) :: field_standard_name !< CF-compliant standard name, see http://cfconventions.org/standard-names.html for reference end type data_sizing_description_type type field_description_type @@ -144,14 +147,16 @@ end function build_mpi_type_field_description !! of the arrays on this process !! @return The handle of the MPI type integer function build_mpi_type_data_sizing_description() - integer :: new_type, ierr, block_counts(3), old_types(3), offsets(3) + integer, parameter :: N_BLOCKS = 6 + integer :: new_type, ierr, block_counts(N_BLOCKS), old_types(N_BLOCKS), offsets(N_BLOCKS) integer(kind=MPI_ADDRESS_KIND) :: num_addr, base_addr type(data_sizing_description_type) :: basic_type + ! `field_name` call mpi_get_address(basic_type, base_addr, ierr) old_types(1) = MPI_CHARACTER - block_counts(1) = STRING_LENGTH + block_counts(1) = STRING_LENGTH offsets(1)=0 call mpi_get_address(basic_type%dimensions, num_addr, ierr) @@ -159,12 +164,27 @@ integer function build_mpi_type_data_sizing_description() block_counts(2) = 1 offsets(2)=int(num_addr-base_addr) - call mpi_get_address(basic_type%dim_sizes, num_addr, ierr) + call mpi_get_address(basic_type%dim_sizes, num_addr, ierr) old_types(3) = MPI_INT block_counts(3) = 4 offsets(3)=int(num_addr-base_addr) - call mpi_type_struct(3, block_counts, offsets, old_types, new_type, ierr) + call mpi_get_address(basic_type%field_units, num_addr, ierr) + old_types(4) = MPI_CHARACTER + block_counts(4) = STRING_LENGTH + offsets(4)=int(num_addr-base_addr) + + call mpi_get_address(basic_type%field_long_name, num_addr, ierr) + old_types(5) = MPI_CHARACTER + block_counts(5) = STRING_LENGTH + offsets(5)=int(num_addr-base_addr) + + call mpi_get_address(basic_type%field_standard_name, num_addr, ierr) + old_types(6) = MPI_CHARACTER + block_counts(6) = STRING_LENGTH + offsets(6)=int(num_addr-base_addr) + + call mpi_type_struct(N_BLOCKS, block_counts, offsets, old_types, new_type, ierr) call mpi_type_commit(new_type, ierr) build_mpi_type_data_sizing_description=new_type end function build_mpi_type_data_sizing_description diff --git a/io/src/ioserver.F90 b/io/src/ioserver.F90 index fe86704f..60517471 100644 --- a/io/src/ioserver.F90 +++ b/io/src/ioserver.F90 @@ -12,11 +12,14 @@ module io_server_mod cancel_requests, free_mpi_type, get_number_io_servers, get_my_io_rank, test_for_inter_io, lock_mpi, unlock_mpi, & waitall_for_mpi_requests, initialise_mpi_communication, pause_for_mpi_interleaving use diagnostic_federator_mod, only : initialise_diagnostic_federator, finalise_diagnostic_federator, & - check_diagnostic_federator_for_completion, pass_fields_to_diagnostics_federator, determine_diagnostics_fields_available + check_diagnostic_federator_for_completion, pass_fields_to_diagnostics_federator, determine_diagnostics_fields_available, & + diagnostic_definitions use writer_federator_mod, only : initialise_writer_federator, finalise_writer_federator, check_writer_for_trigger, & - inform_writer_federator_fields_present, inform_writer_federator_time_point, provide_q_field_names_to_writer_federator + inform_writer_federator_fields_present, inform_writer_federator_time_point, provide_q_field_names_to_writer_federator, & + set_meta_information_for_active_diagnostic_fields use writer_field_manager_mod, only : initialise_writer_field_manager, finalise_writer_field_manager, & provide_monc_data_to_writer_federator + use writer_types_mod, only: field_meta_information_type use collections_mod, only : hashset_type, hashmap_type, map_type, iterator_type, c_get_integer, c_put_integer, c_is_empty, & c_remove, c_add_string, c_integer_at, c_free, c_get_iterator, c_has_next, c_next_mapentry use conversions_mod, only : conv_to_string @@ -32,7 +35,7 @@ module io_server_mod use threadpool_mod, only : threadpool_init, threadpool_finalise, threadpool_start_thread, check_thread_status, & threadpool_deactivate, threadpool_is_idle use global_callback_inter_io_mod, only : perform_global_callback - use logging_mod, only : LOG_ERROR, LOG_WARN, log_log, initialise_logging + use logging_mod, only : LOG_ERROR, LOG_WARN, LOG_INFO, log_log, initialise_logging use mpi, only : MPI_COMM_WORLD, MPI_STATUSES_IGNORE, MPI_BYTE use io_server_state_reader_mod, only : read_io_server_configuration implicit none @@ -410,13 +413,12 @@ subroutine init_data_definition(source, monc_defn) type(data_sizing_description_type) :: data_description(io_configuration%number_of_distinct_data_fields+4) integer :: created_mpi_type, data_size, recv_count, i type(data_sizing_description_type) :: field_description - logical :: field_found + logical :: q_indecies_field_found, field_found recv_count=data_receive(mpi_type_data_sizing_description, io_configuration%number_of_distinct_data_fields+4, & source, description_data=data_description) call handle_monc_dimension_information(data_description, monc_defn) - do i=1, io_configuration%number_of_data_definitions created_mpi_type=build_mpi_datatype(io_configuration%data_definitions(i), data_description, data_size, & monc_defn%field_start_locations(i), monc_defn%field_end_locations(i), monc_defn%dimensions(i)) @@ -428,15 +430,40 @@ subroutine init_data_definition(source, monc_defn) end do if (.not. initialised_present_data) then initialised_present_data=.true. - field_found=get_data_description_from_name(data_description, NUMBER_Q_INDICIES_KEY, field_description) - call c_put_integer(io_configuration%dimension_sizing, "active_q_indicies", field_description%dim_sizes(1)) + + q_indecies_field_found=get_data_description_from_name(data_description, NUMBER_Q_INDICIES_KEY, field_description) + if (q_indecies_field_found) then + call c_put_integer(io_configuration%dimension_sizing, "active_q_indicies", field_description%dim_sizes(1)) + endif call register_present_field_names_to_federators(data_description, recv_count) end if call get_monc_information_data(source) end subroutine init_data_definition + subroutine update_writer_entries_with_metadata_from_data_description(data_description) + type(data_sizing_description_type), dimension(:), intent(in) :: data_description + + type(field_meta_information_type), dimension(size(data_description)):: field_meta_information + integer :: i + + do i=1,size(data_description) + field_meta_information(i)%field_name = data_description(i)%field_name + field_meta_information(i)%field_standard_name = data_description(i)%field_standard_name + field_meta_information(i)%field_long_name = data_description(i)%field_long_name + field_meta_information(i)%field_units = data_description(i)%field_units + end do + + call set_meta_information_for_active_diagnostic_fields(diagnostic_definitions, field_meta_information) + end subroutine update_writer_entries_with_metadata_from_data_description + + !> Retrieves MONC information data, this is sent by MONC (and received) regardless, but only actioned if the data has not !! already been set + !! + !! The following three things are sent in the byte-array: 1) values of the `zn` array, 2) names of the `q` fields and 3) + !! `units`, `long_name` and `standard_name` for all component fields. Corresponding data is packed together in + !! `iobridge_mod::send_general_monc_information_to_server` + !! !! @param source MONC source process subroutine get_monc_information_data(source) integer, intent(in) :: source @@ -508,6 +535,8 @@ subroutine register_present_field_names_to_federators(data_description, recv_cou call inform_writer_federator_fields_present(io_configuration, diag_field_names_and_roots=diagnostics_field_names_and_roots) call c_free(present_field_names) call c_free(diagnostics_field_names_and_roots) + + call update_writer_entries_with_metadata_from_data_description(data_description) end subroutine register_present_field_names_to_federators !> Handles the provided local MONC dimension and data layout information diff --git a/io/src/mpicommunication.F90 b/io/src/mpicommunication.F90 index c468c764..8899d36e 100644 --- a/io/src/mpicommunication.F90 +++ b/io/src/mpicommunication.F90 @@ -10,7 +10,8 @@ module mpi_communication_mod use forthread_mod, only : forthread_mutex_lock, forthread_mutex_unlock, forthread_mutex_init, forthread_mutex_destroy use threadpool_mod, only : check_thread_status use mpi, only : MPI_COMM_WORLD, MPI_SOURCE, MPI_INT, MPI_BYTE, MPI_STATUS_SIZE, MPI_REQUEST_NULL, & - MPI_STATUS_IGNORE, MPI_STATUSES_IGNORE, MPI_ANY_SOURCE, MPI_THREAD_MULTIPLE, MPI_THREAD_SERIALIZED + MPI_STATUS_IGNORE, MPI_STATUSES_IGNORE, MPI_ANY_SOURCE, MPI_THREAD_MULTIPLE, MPI_THREAD_SERIALIZED, MPI_SUCCESS, & + MPI_ERRORS_RETURN, MPI_MAX_ERROR_STRING use iso_c_binding implicit none @@ -44,6 +45,7 @@ end subroutine usleep !! @param provided_threading The provided threading mode subroutine initialise_mpi_communication(provided_threading) integer, intent(in) :: provided_threading + integer :: i_error mpi_threading_mode=provided_threading if (mpi_threading_mode .ne. MPI_THREAD_MULTIPLE .and. mpi_threading_mode .ne. MPI_THREAD_SERIALIZED) then @@ -51,8 +53,29 @@ subroutine initialise_mpi_communication(provided_threading) end if manage_mpi_thread_safety=provided_threading == MPI_THREAD_SERIALIZED call check_thread_status(forthread_mutex_init(mpi_mutex, -1)) + + call MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN, i_error) end subroutine initialise_mpi_communication + subroutine check_for_mpi_error(ierr, error_message_details) + integer, intent(in) :: ierr + character(len=STRING_LENGTH), intent(in), optional :: error_message_details + + integer :: length, error_status + character(len=MPI_MAX_ERROR_STRING) :: mpi_error_message + + call MPI_Error_string(ierr, mpi_error_message, length, error_status) + + if (ierr /= MPI_SUCCESS) then + if (present(error_message_details)) then + call log_log(LOG_ERROR, "MPI-related error occured: "//trim(mpi_error_message)& + //" ("//trim(error_message_details)//")") + else + call log_log(LOG_ERROR, "MPI-related error occured "//trim(mpi_error_message)) + endif + endif + end subroutine check_for_mpi_error + !> If we are explicitly managing MPI thread safety (SERIALIZED mode) then locks MPI subroutine lock_mpi() if (manage_mpi_thread_safety) call check_thread_status(forthread_mutex_lock(mpi_mutex)) @@ -96,6 +119,8 @@ subroutine wait_for_mpi_request(request, status) call mpi_wait(request, MPI_STATUS_IGNORE, ierr) end if end if + + call check_for_mpi_error(ierr, "error in `wait_for_mpi_request`") end subroutine wait_for_mpi_request !> Waits for all MPI requests to complete, either by managing thread safety and interleaving or just a call to MPI @@ -119,6 +144,8 @@ subroutine waitall_for_mpi_requests(requests, count) else call mpi_waitall(count, requests, MPI_STATUSES_IGNORE, ierr) end if + + call check_for_mpi_error(ierr, "error in `waitall_for_mpi_request`") end subroutine waitall_for_mpi_requests !> Retrieves the number of IO servers that are running in total @@ -131,6 +158,8 @@ integer function get_number_io_servers(io_comm) call mpi_comm_size(io_comm, number, ierr) get_number_io_servers=number + + call check_for_mpi_error(ierr, "error in `get_number_io_servers`") end function get_number_io_servers !> Retrieves my IO server rank out of the number of IO servers that are running @@ -143,6 +172,8 @@ integer function get_my_io_rank(io_comm) call mpi_comm_rank(io_comm, number, ierr) get_my_io_rank=number + + call check_for_mpi_error(ierr, "error in `get_my_io_rank`") end function get_my_io_rank !> Registers a request for receiving a command from any MONC process on the command channel @@ -153,6 +184,8 @@ subroutine register_command_receive() call mpi_irecv(command_buffer, 1, MPI_INT, MPI_ANY_SOURCE, COMMAND_TAG, & MPI_COMM_WORLD, command_request_handle, ierr) call unlock_mpi() + + call check_for_mpi_error(ierr, "error in `register_command_receive`") end subroutine register_command_receive !> Awaits some data on the data channel. This is of the type, size from the source provided and can either be written into @@ -190,6 +223,8 @@ integer function data_receive(mpi_datatype, num_elements, source, dump_data, dat call unlock_mpi() data_receive=recv_count end if + + call check_for_mpi_error(ierr, "error in `data_receive`") end function data_receive !> Cancels all outstanding communication requests @@ -209,6 +244,8 @@ subroutine cancel_request(req) call mpi_cancel(req, ierr) call unlock_mpi() end if + + call check_for_mpi_error(ierr, "error in `cancel_request`") end subroutine cancel_request !> Tests for a command message based upon the request already registered @@ -232,6 +269,8 @@ logical function test_for_command(command, source) else test_for_command=.false. end if + + call check_for_mpi_error(ierr, "error in `test_for_command`") end function test_for_command !> Tests for inter IO server communication @@ -266,6 +305,8 @@ logical function test_for_inter_io(inter_io_communications, number_of_inter_io, end do call unlock_mpi() test_for_inter_io=.false. + + call check_for_mpi_error(ierr, "error in `test_for_inter_io`") end function test_for_inter_io !> Frees an MPI type, used in clean up @@ -276,6 +317,8 @@ subroutine free_mpi_type(the_type) integer :: ierr call mpi_type_free(the_type, ierr) + + call check_for_mpi_error(ierr, "error in `free_mpi_type`") end subroutine free_mpi_type !> Builds the MPI type that corresponds to the data which will be received from a specific MONC process. Two factors @@ -390,5 +433,7 @@ integer function build_mpi_datatype(data_definition, data_size_info, data_size, call unlock_mpi() call mpi_type_size(new_type, data_size, ierr) build_mpi_datatype=new_type + + call check_for_mpi_error(ierr, "error in `build_mpi_datatype`") end function build_mpi_datatype end module mpi_communication_mod diff --git a/io/src/writers/file_types/netcdf_filetype.F90 b/io/src/writers/file_types/netcdf_filetype.F90 index 314eaf19..1ddf1494 100644 --- a/io/src/writers/file_types/netcdf_filetype.F90 +++ b/io/src/writers/file_types/netcdf_filetype.F90 @@ -9,7 +9,7 @@ module netcdf_filetype_writer_mod c_put_integer, c_remove, c_free, c_has_next, c_get_iterator, c_next_mapentry, c_next_generic, c_get_real, c_size, & c_next_string, c_is_empty, c_add_string use conversions_mod, only : conv_to_integer, conv_to_string, conv_to_real - use logging_mod, only : LOG_ERROR, LOG_WARN, LOG_DEBUG, log_log, log_master_log, log_get_logging_level, log_is_master + use logging_mod, only : LOG_ERROR, LOG_WARN, LOG_DEBUG, LOG_INFO, log_log, log_master_log, log_get_logging_level, log_is_master use writer_types_mod, only : writer_type, writer_field_type, write_field_collective_values_type, & netcdf_diagnostics_timeseries_type, netcdf_diagnostics_type, write_field_collective_descriptor_type, & write_field_collective_monc_info_type @@ -95,8 +95,10 @@ subroutine define_netcdf_file(io_configuration, file_writer_information, timeste end if call check_thread_status(forthread_mutex_lock(netcdf_mutex)) call lock_mpi() - call check_netcdf_status(nf90_create(unique_filename, ior(NF90_NETCDF4, NF90_MPIIO), ncdf_writer_state%ncid, & - comm = io_configuration%io_communicator, info = MPI_INFO_NULL)) + call check_netcdf_status(nf90_create(unique_filename, & + ior(NF90_NETCDF4, NF90_MPIIO), ncdf_writer_state%ncid, comm = io_configuration%io_communicator, & + info = MPI_INFO_NULL), & + error_message_details="Error creating file '"//trim(unique_filename)//"'") call unlock_mpi() call write_out_global_attributes(io_configuration, ncdf_writer_state%ncid, file_writer_information, timestep, time) call define_dimensions(ncdf_writer_state, io_configuration%dimension_sizing) @@ -919,12 +921,30 @@ subroutine define_variables(io_configuration, file_state, file_writer_informatio call unlock_mpi() deallocate(dimension_ids) end if + + call log_log(LOG_INFO, "netcdf: "//trim(file_writer_information%contents(i)%field_name)//" -- "//& + trim(file_writer_information%contents(i)%units)//" :: "//& + trim(file_writer_information%contents(i)%field_long_name)//" :: "//& + trim(file_writer_information%contents(i)%field_standard_name)//" :: ") + call c_put_integer(file_state%variable_to_id, variable_key, field_id) if (len_trim(file_writer_information%contents(i)%units) .gt. 0) then call lock_mpi() call check_netcdf_status(nf90_put_att(file_state%ncid, field_id, "units", file_writer_information%contents(i)%units)) call unlock_mpi() end if + if (len_trim(file_writer_information%contents(i)%field_long_name) .gt. 0) then + call lock_mpi() + call check_netcdf_status(nf90_put_att(file_state%ncid, field_id, "long_name",& + file_writer_information%contents(i)%field_long_name)) + call unlock_mpi() + end if + if (len_trim(file_writer_information%contents(i)%field_standard_name) .gt. 0) then + call lock_mpi() + call check_netcdf_status(nf90_put_att(file_state%ncid, field_id, "standard_name",& + file_writer_information%contents(i)%field_standard_name)) + call unlock_mpi() + end if end do end subroutine define_variables diff --git a/io/src/writers/writer_federator.F90 b/io/src/writers/writer_federator.F90 index 283fd6d7..6f91c7dd 100644 --- a/io/src/writers/writer_federator.F90 +++ b/io/src/writers/writer_federator.F90 @@ -5,7 +5,7 @@ module writer_federator_mod use configuration_parser_mod, only : TIME_AVERAGED_TYPE, INSTANTANEOUS_TYPE, NONE_TYPE, GROUP_TYPE, FIELD_TYPE, IO_STATE_TYPE, & io_configuration_type, io_configuration_field_type, io_configuration_diagnostic_field_type, & io_configuration_data_definition_type, data_values_type, get_data_value_by_field_name, get_diagnostic_field_configuration,& - get_prognostic_field_configuration, get_monc_location + get_prognostic_field_configuration, get_monc_location, io_configuration_misc_item_type use none_time_manipulation_mod, only : perform_none_time_manipulation, is_none_time_manipulation_ready_to_write use instantaneous_time_manipulation_mod, only : init_instantaneous_manipulation, finalise_instantaneous_manipulation, & perform_instantaneous_time_manipulation, is_instantaneous_time_manipulation_ready_to_write @@ -20,9 +20,10 @@ module writer_federator_mod use forthread_mod, only : forthread_mutex_init, forthread_mutex_lock, forthread_mutex_unlock, forthread_mutex_destroy, & forthread_rwlock_rdlock, forthread_rwlock_wrlock, forthread_rwlock_unlock, forthread_rwlock_init, forthread_rwlock_destroy use threadpool_mod, only : check_thread_status - use logging_mod, only : LOG_DEBUG, LOG_ERROR, LOG_WARN, log_log, log_master_log, log_get_logging_level, log_is_master + use logging_mod, only : LOG_DEBUG, LOG_INFO, LOG_ERROR, LOG_WARN, log_log, log_master_log, log_get_logging_level, log_is_master use writer_types_mod, only : writer_type, writer_field_type, write_field_collective_values_type, pending_write_type, & - collective_q_field_representation_type, write_field_collective_descriptor_type, write_field_collective_monc_info_type + collective_q_field_representation_type, write_field_collective_descriptor_type, write_field_collective_monc_info_type, & + field_meta_information_type use netcdf_filetype_writer_mod, only : initialise_netcdf_filetype, finalise_netcdf_filetype, define_netcdf_file, & write_variable, close_netcdf_file, store_io_server_state, get_writer_entry_from_netcdf use global_callback_inter_io_mod, only : perform_global_callback @@ -34,6 +35,11 @@ module writer_federator_mod use grids_mod, only : Z_INDEX, Y_INDEX, X_INDEX use mpi, only : MPI_INT, MPI_MAX use mpi_communication_mod, only : lock_mpi, unlock_mpi + + use diagnostic_types_mod, only : diagnostics_activity_type, get_misc_action_at_index, & + get_diagnostic_activity_by_result_name, diagnostics_type, OPERATOR_TYPE, REDUCTION_TYPE + use reduction_inter_io_mod, only : get_reduction_operator_string + implicit none #ifndef TEST_MODE @@ -49,7 +55,8 @@ module writer_federator_mod public initialise_writer_federator, finalise_writer_federator, provide_ordered_field_to_writer_federator, & check_writer_for_trigger, issue_actual_write, is_field_used_by_writer_federator, inform_writer_federator_fields_present, & - inform_writer_federator_time_point, provide_q_field_names_to_writer_federator, is_field_split_on_q + inform_writer_federator_time_point, provide_q_field_names_to_writer_federator, is_field_split_on_q, & + set_meta_information_for_active_diagnostic_fields contains !> Initialises the write federator and configures it based on the user configuration. Also initialises the time manipulations @@ -156,6 +163,377 @@ subroutine inform_writer_federator_time_point(io_configuration, source, data_id, end if end subroutine inform_writer_federator_time_point + !> Attempt to find meta information for a given field published by the MONCs + !! @param field_name Field to search for + !! @param all_field_meta_information All field meta information received from MONCs + !! @return specific_field_meta_information Returns meta information if found + logical function find_specific_field_meta_information(field_name, all_field_meta_information, & + specific_field_meta_information) result(field_found) + character(len=STRING_LENGTH), intent(in) :: field_name + type(field_meta_information_type), dimension(:), intent(in) :: all_field_meta_information + type(field_meta_information_type), intent(out) :: specific_field_meta_information + + integer :: k + + field_found=.false. + k=1 + do while (.not. field_found .and. k < size(all_field_meta_information)) + if (field_name == all_field_meta_information(k)%field_name) then + specific_field_meta_information = all_field_meta_information(k) + field_found=.true. + end if + k=k+1 + end do + end function find_specific_field_meta_information + + !> Update a specific writer using the meta information for the field that is written + !! @param writer_field Writer field to update + !! @param field_meta_information Meta information to use + subroutine update_writer_field_with_field_meta_information(writer_field, field_meta_information) + type(writer_field_type), intent(inout) :: writer_field + type(field_meta_information_type), intent(in) :: field_meta_information + + call log_log(LOG_DEBUG, "Setting meta info for field `"//trim(writer_field%field_name)) + call log_log(LOG_DEBUG, trim(writer_field%field_name)//" :: "//& + trim(field_meta_information%field_long_name)//","//& + trim(field_meta_information%field_standard_name)//","//& + trim(field_meta_information%field_units)//","//& + "") + + if (len_trim(field_meta_information%field_units) > 0) then + if (writer_field%units /= "") then + call log_log(LOG_WARN, "Meta information for `units` provided by MONC for field `"//& + trim(writer_field%field_name)//"` ignored because it is "//& + "also defined in IO server configuration file") + else + writer_field%units = field_meta_information%field_units + endif + endif + + if (len_trim(field_meta_information%field_long_name) > 0) then + if (writer_field%field_long_name /= "") then + call log_log(LOG_WARN, "Meta information for `field_long_name` provided by MONC for field `"//& + trim(writer_field%field_name)//"` ignored because it is "//& + "also defined in IO server configuration file") + else + writer_field%field_long_name = field_meta_information%field_long_name + endif + endif + + if (len_trim(field_meta_information%field_standard_name) > 0) then + if (writer_field%field_standard_name /= "") then + call log_log(LOG_WARN, "Meta information for `field_standard_name` provided by MONC for field `"//& + trim(writer_field%field_name)//"` ignored because it is "//& + "also defined in IO server configuration file") + else + writer_field%field_standard_name = field_meta_information%field_standard_name + endif + endif + end subroutine update_writer_field_with_field_meta_information + + + !> Iterate over diagnostic activities defined for a diagnostic field to produce meta information based on the + !! activities performed and the MONC component fields operated on. This function is called recursively (iterating over + !! all required fields) until MONC component fields are found. This function should initially be called with the name + !! of the diagnostic field that will be output, e.g. `wmax` + !! @param field_meta_information All meta information received from MONCs + !! @param result_name Name of field (within activities) for which meta information will be returned + !! @param field_activities All activities defined for a given diagnostic field + recursive type(field_meta_information_type) & + function get_meta_information_from_diagnostics_activity(field_meta_information, result_name, field_activities) & + result(specific_field_meta_information) + + type(field_meta_information_type), dimension(:), intent(in) :: field_meta_information + character(len=STRING_LENGTH), intent(in) :: result_name + type(list_type), intent(inout) :: field_activities + + type(diagnostics_activity_type), pointer :: activity + type(field_meta_information_type) :: child_field_meta_information + character(len=STRING_LENGTH) :: child_field_name, operator_name + logical :: meta_info_found + type(iterator_type) :: iterator + integer :: k + + activity=>get_diagnostic_activity_by_result_name(field_activities, result_name) + + if (.not. associated(activity)) then + ! since there isn't an activity defined to produce this field it much be a component field available from MONC, so we simply + ! return the field's meta information (if MONC is provided it) + meta_info_found = find_specific_field_meta_information(result_name,& + field_meta_information, child_field_meta_information) + + if (.not. meta_info_found) then + call log_log(LOG_ERROR, "End of IO 'activities' for field '"//& + trim(result_name)//"' reached but no meta information found from MONC-provided meta information") + endif + + if (len_trim(child_field_meta_information%field_units) == 0) then + call log_log(LOG_WARN, "No 'units' meta information provided by MONC for field '"//trim(result_name)//"'") + endif + if (len_trim(child_field_meta_information%field_long_name) == 0) then + call log_log(LOG_WARN, "No 'long_name' meta information provided by MONC for field '"//trim(result_name)//"'") + endif + + specific_field_meta_information = child_field_meta_information + else + ! depending on the type of activity the meta information from the used field(s) is combined with meta information specific to + ! the activity + + !call log_log(LOG_INFO, trim(result_name)//" -> "//conv_to_string(activity%activity_type)//" . "//& + !trim(activity%activity_name)) + + iterator=c_get_iterator(activity%required_fields) + if (activity%activity_type == REDUCTION_TYPE) then + if (.not. c_size(activity%required_fields) == 1) then + call log_log(LOG_ERROR, "Not implemented: can only handle meta information for reductions with one fields") + else + child_field_name = c_next_string(iterator) + child_field_meta_information = get_meta_information_from_diagnostics_activity(field_meta_information, & + child_field_name, field_activities) + + operator_name = get_reduction_operator_string(activity%communication_operator) + + specific_field_meta_information%field_units = trim(child_field_meta_information%field_units) + + if (len_trim(child_field_meta_information%field_long_name) > 0) then + specific_field_meta_information%field_long_name = trim(operator_name)//" of "//& + trim(child_field_meta_information%field_long_name) + endif + + if (len_trim(child_field_meta_information%field_standard_name) > 0) then + call log_log(LOG_WARN, "The 'standard_name' meta info provided by MONC for the field '"//& + trim(child_field_name)//"' will be ignored because this field was further manipulated on the IO server") + endif + endif + else if (activity%activity_type == OPERATOR_TYPE) then + if (activity%activity_name == "localreduce") then + if (.not. c_size(activity%required_fields) == 1) then + call log_log(LOG_ERROR, "Not implemented: can only handle meta information for reductions with one fields") + else + child_field_name = c_next_string(iterator) + child_field_meta_information = get_meta_information_from_diagnostics_activity(field_meta_information, & + child_field_name, field_activities) + + operator_name = c_get_string(activity%activity_attributes, "operator") + + specific_field_meta_information%field_units = trim(child_field_meta_information%field_units) + if (len_trim(child_field_meta_information%field_long_name) > 0) then + specific_field_meta_information%field_long_name = "per-MONC "//trim(operator_name)//" of "//& + trim(child_field_meta_information%field_long_name) + endif + + if (len_trim(child_field_meta_information%field_standard_name) > 0) then + call log_log(LOG_WARN, "The 'standard_name' meta info provided by MONC for the field '"//& + trim(child_field_name)//"' will be ignored because this field was further manipulated on the IO server") + endif + endif + else if (activity%activity_name == "arithmetic") then + specific_field_meta_information%field_units = "" + specific_field_meta_information%field_long_name = "" + + ! collect meta information from all fields that are used in arithmetic operation + do while (c_has_next(iterator)) + child_field_name = c_next_string(iterator) + child_field_meta_information = get_meta_information_from_diagnostics_activity(field_meta_information, & + child_field_name, field_activities) + + if (len_trim(child_field_meta_information%field_units) > 0) then + specific_field_meta_information%field_units = trim(trim(child_field_meta_information%field_units)//" "//& + trim(specific_field_meta_information%field_units)) + endif + + if (len_trim(child_field_meta_information%field_long_name) > 0) then + specific_field_meta_information%field_long_name = trim(trim(child_field_meta_information%field_long_name)//" "//& + trim(specific_field_meta_information%field_long_name)) + endif + + if (len_trim(child_field_meta_information%field_standard_name) > 0) then + call log_log(LOG_WARN, "The 'standard_name' meta info provided by MONC for the field '"//& + trim(child_field_name)//"' will be ignored because this field was further manipulated on the IO server") + endif + end do + + call log_log(LOG_WARN, "Meta information for arithmetic operations is simply concatenated for now "//& + "so the meta information may actually be incorrect") + + ! if these fields contributed any meta information append the arithmetic operation's meta information + if (len_trim(specific_field_meta_information%field_units) > 0) then + if (.not. c_contains(activity%activity_attributes, "units")) then + call log_log(LOG_WARN, "The arithmetic operation to produce '"//trim(result_name)//"' does not "//& + "have any units defined, assuming unity.") + specific_field_meta_information%field_units = trim(specific_field_meta_information%field_units) + else + if (trim(c_get_string(activity%activity_attributes, "units")) /= "1") then + specific_field_meta_information%field_units = trim(trim(specific_field_meta_information%field_units)//" "//& + trim(c_get_string(activity%activity_attributes, "units"))) + endif + endif + endif + + if (len_trim(specific_field_meta_information%field_long_name) > 0) then + if (.not. c_contains(activity%activity_attributes, "description")) then + call log_log(LOG_WARN, "The arithmetic operation to produce '"//trim(result_name)//"' does not "//& + "have any description defined, to produce a descriptive `long name` a description must be present.") + specific_field_meta_information%field_long_name = trim(specific_field_meta_information%field_long_name) + else + specific_field_meta_information%field_long_name = trim(trim(specific_field_meta_information%field_long_name)//" "//& + trim(c_get_string(activity%activity_attributes, "description"))) + endif + endif + else + call log_log(LOG_ERROR, "Setting of field meta data not implemented for IO operation '"//& + trim(activity%activity_name)//"'") + endif + else + call log_log(LOG_ERROR, "Setting of field meta data not implemented for IO activity with ID '"//& + conv_to_string(activity%activity_type)//"'") + endif + endif + + !call log_log(LOG_INFO, trim(result_name)//" :: "//& + !trim(specific_field_meta_information%field_long_name)//","//& + !trim(specific_field_meta_information%field_standard_name)//","//& + !trim(specific_field_meta_information%field_units)//","//& + !"") + + end function get_meta_information_from_diagnostics_activity + + + !> Apply one particular substitution for the long name description by looking for prefix and suffix, and if found use + !! the new suffix + character(len=STRING_LENGTH) function do_long_name_substitution(long_name, new_prefix, prefix, suffix) result(new_long_name) + character(len=*), intent(in) :: long_name, new_prefix, prefix + character(len=*), intent(in), optional :: suffix + + integer :: i_prefix, i_suffix + + i_prefix = index(long_name, trim(prefix)) + if (present(suffix)) then + i_suffix = index(long_name, trim(suffix)) + endif + + if (present(suffix) .and. i_prefix /= 0 .and. i_suffix /= 0) then + new_long_name = trim(new_prefix)//" "//trim(long_name(i_prefix+len(prefix)+1:i_suffix-1)) + elseif (.not. present(suffix) .and. i_prefix /= 0) then + new_long_name = trim(new_prefix)//" "//long_name(i_prefix+len(prefix)+1:len(long_name)) + else + new_long_name = long_name + endif + end function do_long_name_substitution + + !> This function is basically a hack for making a long name produced from a chain activities easier to read + character(len=STRING_LENGTH) function cleanup_field_long_name(long_name) result(new_long_name) + character(len=STRING_LENGTH), intent(in) :: long_name + + new_long_name = long_name + if (len_trim(new_long_name) > 0) then + ! to be applied against datasets which have one entry for each vertical column level + new_long_name = do_long_name_substitution(new_long_name, "vertical profile of horizontal mean", & + "sum of per-MONC horizontal sum of", "divided by domain xy-cell-count") + + ! to be applied against datasets which have one value for each vertical column + ! matches e.g. `sum of per-MONC sum of per-column liquid-water path devided by domain xy-cell-count` + new_long_name = do_long_name_substitution(new_long_name, "domain-wide mean", & + "sum of per-MONC sum", "divided by domain xy-cell-count") + ! matches: e.g. `max of per-MONC max of per-column liquid-water path` + new_long_name = do_long_name_substitution(new_long_name, "domain-wide max", & + "max of per-MONC max") + new_long_name = do_long_name_substitution(new_long_name, "domain-wide min", & + "min of per-MONC min") + endif + + end function cleanup_field_long_name + + + + !> Return the diagnostic definition for the requested field name + !! @param diagnostic_definitions All diagnostic definitions currently defined + !! @param field_name Name of field to find diagnostic definition for + type(diagnostics_type) function find_diagnostic_field(diagnostic_definitions, field_name) + type(diagnostics_type), dimension(:), intent(inout) :: diagnostic_definitions + character(len=STRING_LENGTH) :: field_name + + integer :: i + logical :: found_field + + found_field = .false. + + do i=1, size(diagnostic_definitions) + if (diagnostic_definitions(i)%diagnostic_name == field_name) then + find_diagnostic_field=diagnostic_definitions(i) + found_field = .true. + endif + end do + + if (.not. found_field) then + call log_log(LOG_ERROR, "Couldn't find diagnostics definition for field '"//trim(field_name)//"'") + endif + + end function find_diagnostic_field + + !> Set meta information on writers for active diagnostic fields based on information received from MONC + !! @param diagnostic_definitions All diagnostics currently defined + !! @param field_meta_information All meta information received from MONCs + subroutine set_meta_information_for_active_diagnostic_fields(diagnostic_definitions, field_meta_information) + type(diagnostics_type), dimension(:), intent(inout) :: diagnostic_definitions + type(field_meta_information_type), dimension(:), intent(in) :: field_meta_information + + type(field_meta_information_type) :: specific_field_meta_information + type(writer_field_type) :: current_writer_field + character(len=STRING_LENGTH) :: field_name, field_namespace + logical :: meta_info_found + integer :: i,j + + type(diagnostics_type) :: diagnostic_field + + call log_log(LOG_INFO, "Setting meta information for active fields ") + do i=1, size(writer_entries) + do j=1, size(writer_entries(i)%contents) + current_writer_field = writer_entries(i)%contents(j) + if (current_writer_field%enabled) then + field_name = current_writer_field%field_name + field_namespace = current_writer_field%field_namespace + + ! attempt to find meta information for a field which has the same name in the output file + ! as the field published by MONC + meta_info_found = find_specific_field_meta_information(field_name,& + field_meta_information,& + specific_field_meta_information) + + if (meta_info_found) then + ! NB: have to call with `writer_entries(i)%contents(j)` otherwise we'll be updating a copy + call update_writer_field_with_field_meta_information(writer_entries(i)%contents(j),& + specific_field_meta_information) + else if (field_name == "time" .or. field_name == 'ugal' .or. field_name == 'vgal' & + .or. field_name == 'nqfields' .or. field_name == 'timestep' .or. field_name == "dtm" & + .or. field_name == 'dtm_new' .or. field_name == 'absolute_new_dtm' & + .or. field_name == 'x_resolution' .or. field_name == 'y_resolution' & + .or. field_name == 'x_top' .or. field_name == 'y_top' & + .or. field_name == 'x_bottom' .or. field_name == 'y_bottom' & + .or. field_name == 'q_udef1' .or. field_name == 'q_udef2' & ! <- from here and below appeared with bomex.mcf test case + .or. field_name == 'zq_udef1' .or. field_name == 'zq_udef2' & + .or. field_name == 'olqbar_udef1' .or. field_name == 'olqbar_udef2' & + .or. field_name == 'olzqbar_udef1' .or. field_name == 'olzqbar_udef2' & + ) then + ! TODO: no idea what to do with time and these other fields yet... + call log_log(LOG_WARN, "Skipping finding meta data for field `"& + //trim(field_name)//"`") + else + diagnostic_field = find_diagnostic_field(diagnostic_definitions, field_name) + specific_field_meta_information = get_meta_information_from_diagnostics_activity(& + field_meta_information, field_name, diagnostic_field%activities) + + specific_field_meta_information%field_long_name = cleanup_field_long_name(& + specific_field_meta_information%field_long_name) + + call update_writer_field_with_field_meta_information(writer_entries(i)%contents(j),& + specific_field_meta_information) + endif + end if + end do + end do + end subroutine set_meta_information_for_active_diagnostic_fields + !> Informs the writer federator that specific fields are present and should be reflected in the diagnostics output !! @param field_names The set of field names that are present subroutine inform_writer_federator_fields_present(io_configuration, field_names, diag_field_names_and_roots) @@ -1291,6 +1669,8 @@ subroutine add_specific_field_to_writer_entry(io_configuration, writer_entry_ind writer_entries(writer_entry_index)%contents(my_facet_index)%field_type=diagnostic_field_configuration%field_type writer_entries(writer_entry_index)%contents(my_facet_index)%dim_size_defns=diagnostic_field_configuration%dim_size_defns writer_entries(writer_entry_index)%contents(my_facet_index)%units=diagnostic_field_configuration%units + writer_entries(writer_entry_index)%contents(my_facet_index)%field_long_name=diagnostic_field_configuration%long_name + writer_entries(writer_entry_index)%contents(my_facet_index)%field_standard_name=diagnostic_field_configuration%standard_name writer_entries(writer_entry_index)%contents(my_facet_index)%collective_write=diagnostic_field_configuration%collective writer_entries(writer_entry_index)%contents(my_facet_index)%collective_initialised=.false. writer_entries(writer_entry_index)%contents(my_facet_index)%issue_write=.true. @@ -1300,6 +1680,8 @@ subroutine add_specific_field_to_writer_entry(io_configuration, writer_entry_ind writer_entries(writer_entry_index)%contents(my_facet_index)%data_type=prognostic_field_configuration%data_type writer_entries(writer_entry_index)%contents(my_facet_index)%field_type=prognostic_field_configuration%field_type writer_entries(writer_entry_index)%contents(my_facet_index)%units=prognostic_field_configuration%units + writer_entries(writer_entry_index)%contents(my_facet_index)%field_long_name=prognostic_field_configuration%long_name + writer_entries(writer_entry_index)%contents(my_facet_index)%field_standard_name=prognostic_field_configuration%standard_name writer_entries(writer_entry_index)%contents(my_facet_index)%dimensions=prognostic_field_configuration%dimensions writer_entries(writer_entry_index)%contents(my_facet_index)%collective_write=prognostic_field_configuration%collective writer_entries(writer_entry_index)%contents(my_facet_index)%collective_initialised=.false. @@ -1322,6 +1704,7 @@ subroutine add_specific_field_to_writer_entry(io_configuration, writer_entry_ind else call log_log(LOG_ERROR, "A diagnostic or prognostic configuration for the field '"//trim(field_name)//"' was not found") end if + if (writer_entries(writer_entry_index)%contents(my_facet_index)%dimensions .gt. 0) then if (writer_entries(writer_entry_index)%contents(my_facet_index)%dim_size_defns(& writer_entries(writer_entry_index)%contents(my_facet_index)%dimensions) .eq. "qfields") then diff --git a/io/src/writers/writer_types.F90 b/io/src/writers/writer_types.F90 index 60b8aa0e..ca862a07 100644 --- a/io/src/writers/writer_types.F90 +++ b/io/src/writers/writer_types.F90 @@ -59,7 +59,11 @@ end function is_field_ready_to_write !< The field type, many of these make up a specific writer type writer_field_type - character(len=STRING_LENGTH) :: field_name, field_namespace, dim_size_defns(4), units + character(len=STRING_LENGTH) :: field_namespace, dim_size_defns(4) + character(len=STRING_LENGTH) :: field_name = "" + character(len=STRING_LENGTH) :: units = "" !< Units of field + character(len=STRING_LENGTH) :: field_long_name = "" !< Long descriptive name, required for CF-compliance + character(len=STRING_LENGTH) :: field_standard_name = "" !< CF-compliant "standard name" procedure(perform_time_manipulation), pointer, nopass :: time_manipulation procedure(is_field_ready_to_write), pointer, nopass :: ready_to_write integer :: time_manipulation_type, values_mutex, dimensions, field_type, data_type, timestep_frequency, & @@ -103,11 +107,19 @@ end function is_field_ready_to_write logical :: termination_write end type netcdf_diagnostics_type + !< For storing meta information for a field with a given name + type field_meta_information_type + character(len=STRING_LENGTH) :: field_name = "" !< Name of the field that this describes + character(len=STRING_LENGTH) :: field_units = "" !< Units of field data + character(len=STRING_LENGTH) :: field_long_name = ""!< Long descriptive name for CF-compliance + character(len=STRING_LENGTH) :: field_standard_name = ""!< CF-compliant standard name, see http://cfconventions.org/standard-names.html for reference + end type field_meta_information_type + public writer_type, writer_field_type, write_field_collective_values_type, pending_write_type, & perform_time_manipulation, collective_q_field_representation_type, netcdf_diagnostics_timeseries_type, & netcdf_diagnostics_type, serialise_writer_type, unserialise_writer_type, serialise_data_values_type, & unserialise_data_values_type, write_field_collective_descriptor_type, write_field_collective_monc_info_type, & - prepare_to_serialise_data_values_type, prepare_to_serialise_writer_type + prepare_to_serialise_data_values_type, prepare_to_serialise_writer_type, field_meta_information_type contains !> Prepares to serialise the writer type by issuing locks and determining the size of serialised bytes needed diff --git a/model_core/src/components/monc_component.F90 b/model_core/src/components/monc_component.F90 index e426d04b..04027035 100644 --- a/model_core/src/components/monc_component.F90 +++ b/model_core/src/components/monc_component.F90 @@ -28,9 +28,13 @@ module monc_component_mod integer :: scalar_int end type component_field_value_type + !> Data-structure for components to provide details about a specific published field type, public :: component_field_information_type integer :: field_type, data_type, number_dimensions, dimension_sizes(4) logical :: enabled + character(len=STRING_LENGTH) :: units = "" !< Units of field + character(len=STRING_LENGTH) :: long_name = "" !< Long descriptive name for field (for CF-compliance) + character(len=STRING_LENGTH) :: standard_name = "" !< Standard CF-compliant name, see http://cfconventions.org/standard-names.html for reference end type component_field_information_type !> Description of a component diff --git a/model_core/src/state.F90 b/model_core/src/state.F90 index e6aafaf3..08ed7f32 100644 --- a/model_core/src/state.F90 +++ b/model_core/src/state.F90 @@ -4,7 +4,8 @@ module state_mod use grids_mod, only : global_grid_type, local_grid_type use prognostics_mod, only : prognostic_field_type use communication_types_mod, only : halo_communication_type - use datadefn_mod, only : DEFAULT_PRECISION + use datadefn_mod, only : DEFAULT_PRECISION, STRING_LENGTH + use logging_mod, only : LOG_WARN, LOG_ERROR, log_log implicit none #ifndef TEST_MODE @@ -82,4 +83,119 @@ module state_mod logical :: galilean_transformation=.true., fix_ugal=.false., fix_vgal=.false. real(kind=DEFAULT_PRECISION) :: ugal=0.,vgal=0. end type model_state_type + + public get_prognostic_field_units, get_prognostic_field_standard_name, & + get_prognostic_field_long_name + +contains + + !> Provide CF-compliant units for prognostic variables + !! + !! @param field_name name of field to look up + !! @returns units of field + function get_prognostic_field_units(field_name) result(field_units) + character(len=*), intent(in) :: field_name + character(len=STRING_LENGTH) :: field_units + + field_units = "" + if (trim(field_name) == "p") then + field_units = "Pa" + else if (trim(field_name) == "th") then + field_units = "K" + else if (trim(field_name) == "q") then + field_units = "kg/kg" + else if (trim(field_name) == "thref") then + field_units = "K" + else if (trim(field_name) == "u") then + field_units = "m/s" + else if (trim(field_name) == "v") then + field_units = "m/s" + else if (trim(field_name) == "w") then + field_units = "m/s" + else if (trim(field_name) == "x") then + field_units = "m" + else if (trim(field_name) == "y") then + field_units = "m" + else if (trim(field_name) == "z") then + field_units = "m" + else + call log_log(LOG_WARN, "Units not defined for globally sendable field "//trim(field_name)) + endif + + end function get_prognostic_field_units + + + !> Get "long name" (description of a field in terminology of CF conventions) + !! for prognostic fields globally available for IO + !! @param field_name name of field to look up + !! @returns long name of field + function get_prognostic_field_long_name(field_name) result(field_long_name) + character(len=*), intent(in) :: field_name + character(len=STRING_LENGTH) :: field_long_name + + field_long_name = "" + if (trim(field_name) == "p") then + field_long_name = "Pressure perturbation" + else if (trim(field_name) == "th") then + field_long_name = "Potential temperature perturbation" + else if (trim(field_name) == "q") then + field_long_name = "Tracer concentration" + else if (trim(field_name) == "thref") then + field_long_name = "Potential temperature vertical profile" + else if (trim(field_name) == "u") then + field_long_name = "Zonal wind" + else if (trim(field_name) == "v") then + field_long_name = "Meridional wind" + else if (trim(field_name) == "w") then + field_long_name = "Vertical velocity" + else if (trim(field_name) == "x") then + field_long_name = "East-west displacement of cell centers" + else if (trim(field_name) == "y") then + field_long_name = "North-wouth displacement of cell centers" + else if (trim(field_name) == "z") then + field_long_name = "Vertical displacement of cell centers" + else + call log_log(LOG_WARN, "Description not defined for globally sendable field "//trim(field_name)) + endif + + end function get_prognostic_field_long_name + + !> Provide CF-compliant standard names for prognostic variables + !! Variables are taken from table at + !! http://cfconventions.org/Data/cf-standard-names/43/build/cf-standard-name-table.html + !! + !! @param field_name name of field to look up + !! @returns standard name of field + function get_prognostic_field_standard_name(field_name) result(field_standard_name) + character(len=*), intent(in) :: field_name + character(len=STRING_LENGTH) :: field_standard_name + + field_standard_name = "" + if (trim(field_name) == "p") then + field_standard_name = "" ! NB: not "air_pressure", since `p` is actually the perturbation in pressure + else if (trim(field_name) == "th") then + field_standard_name = "" ! NB: similarly to `p` this variable is the perturbation in potential temperature + else if (trim(field_name) == "q") then + field_standard_name = "" ! no standard name + else if (trim(field_name) == "thref") then + field_standard_name = "" + else if (trim(field_name) == "u") then + field_standard_name = "eastward_wind" + else if (trim(field_name) == "v") then + field_standard_name = "northward_wind" + else if (trim(field_name) == "w") then + field_standard_name = "upward_air_velocity" + else if (trim(field_name) == "x") then + field_standard_name = "x-coordinate in Cartesian system (cell-centers)" + else if (trim(field_name) == "y") then + field_standard_name = "y-coordinate in Cartesian system (cell-centers)" + else if (trim(field_name) == "z") then + field_standard_name = "height-coordinate in Cartesian system (cell-edges)" + else if (trim(field_name) == "zn") then + field_standard_name = "height-coordinate in Cartesian system (cell-centers)" + else + call log_log(LOG_WARN, "Standard name not defined for globally sendable field "//trim(field_name)) + endif + + end function get_prognostic_field_standard_name end module state_mod diff --git a/model_core/src/utils/netcdf_misc.F90 b/model_core/src/utils/netcdf_misc.F90 index 9b2867a7..b380dae5 100644 --- a/model_core/src/utils/netcdf_misc.F90 +++ b/model_core/src/utils/netcdf_misc.F90 @@ -1,5 +1,6 @@ !> NetCDF misc functionality which can be shared between modules that work with NetCDF files module netcdf_misc_mod + use datadefn_mod, only : STRING_LENGTH use netcdf, only : nf90_ebaddim, nf90_enotatt, nf90_enotvar, nf90_noerr, nf90_strerror use logging_mod, only : LOG_ERROR, log_log implicit none @@ -15,8 +16,9 @@ module netcdf_misc_mod !! whether a dimension or variable exists within the NetCDF data file !! @param status The NetCDF status flag !! @param foundFlag Whether the field has been found or not - subroutine check_netcdf_status(status, found_flag) + subroutine check_netcdf_status(status, found_flag, error_message_details) integer, intent(in) :: status + character(len=STRING_LENGTH), intent(in), optional :: error_message_details logical, intent(out), optional :: found_flag if (present(found_flag)) then @@ -25,7 +27,12 @@ subroutine check_netcdf_status(status, found_flag) end if if (status /= nf90_noerr) then - call log_log(LOG_ERROR, "NetCDF returned error code of "//trim(nf90_strerror(status))) + if (present(error_message_details)) then + call log_log(LOG_ERROR, "NetCDF returned error code of "//trim(nf90_strerror(status))& + //" ("//trim(error_message_details)//")") + else + call log_log(LOG_ERROR, "NetCDF returned error code of "//trim(nf90_strerror(status))) + endif end if end subroutine check_netcdf_status end module netcdf_misc_mod