diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am index 9aec89194c..3b2d1e1fd9 100644 --- a/diag_manager/Makefile.am +++ b/diag_manager/Makefile.am @@ -86,6 +86,7 @@ diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MOD fms_diag_object_container_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT) \ fms_diag_time_reduction_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT) \ fms_diag_fieldbuff_update_mod.$(FC_MODEXT) +fms_diag_output_buffer_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) # Mod files are built and then installed as headers. MODFILES = \ diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90 index 128d62fe1d..b41d18fca1 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -164,6 +164,7 @@ module fms_diag_field_object_mod public :: fms_diag_fields_object_init public :: null_ob public :: fms_diag_field_object_end +public :: get_default_missing_value !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CONTAINS diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index c4c1f1bcbf..a4bc1a2174 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -20,15 +20,16 @@ module fms_diag_object_mod use mpp_mod, only: fatal, note, warning, mpp_error, mpp_pe, mpp_root_pe, stdout use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, & &DIAG_FIELD_NOT_FOUND, diag_not_registered, max_axes, TWO_D_DOMAIN, & - &get_base_time, null_axis_id, diag_not_registered + &get_base_time, NULL_AXIS_ID, get_var_type, diag_not_registered + USE time_manager_mod, ONLY: set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),& & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, & & get_ticks_per_second #ifdef use_yaml use fms_diag_file_object_mod, only: fmsDiagFileContainer_type, fmsDiagFile_type, fms_diag_files_object_init -use fms_diag_field_object_mod, only: fmsDiagField_type, fms_diag_fields_object_init +use fms_diag_field_object_mod, only: fmsDiagField_type, fms_diag_fields_object_init, get_default_missing_value use fms_diag_yaml_mod, only: diag_yaml_object_init, diag_yaml_object_end, find_diag_field, & - & get_diag_files_id, diag_yaml + & get_diag_files_id, diag_yaml, DiagYamlFilesVar_type use fms_diag_axis_object_mod, only: fms_diag_axis_object_init, fmsDiagAxis_type, fmsDiagSubAxis_type, & &diagDomain_t, get_domain_and_domain_type, diagDomain2d_t, & &fmsDiagAxisContainer_type, fms_diag_axis_object_end, fmsDiagFullAxis_type, & @@ -39,6 +40,7 @@ module fms_diag_object_mod use omp_lib #endif use mpp_domains_mod, only: domain1d, domain2d, domainUG, null_domain2d +use platform_mod implicit none private @@ -80,6 +82,7 @@ module fms_diag_object_mod procedure :: fms_diag_send_complete procedure :: fms_diag_do_io procedure :: fms_diag_field_add_cell_measures + procedure :: allocate_diag_field_output_buffers #ifdef use_yaml procedure :: get_diag_buffer #endif @@ -884,4 +887,124 @@ subroutine dump_diag_obj( filename ) call mpp_error( FATAL, "You can not use the modern diag manager without compiling with -Duse_yaml") #endif end subroutine + +!> @brief Allocates the output buffers of the fields corresponding to the registered variable +!! Input arguments are the field and its ID passed to routine fms_diag_accept_data() +subroutine allocate_diag_field_output_buffers(this, field_data, field_id) + class(fmsDiagObject_type), target, intent(inout) :: this !< diag object + class(*), dimension(:,:,:,:), intent(in) :: field_data !< field data + integer, intent(in) :: field_id !< Id of the field data +#ifdef use_yaml + integer :: ndims !< Number of dimensions in the input field data + integer :: buffer_id !< Buffer index of FMS_diag_buffers + integer :: num_diurnal_samples !< Number of diurnal samples from diag_yaml + integer, allocatable :: axes_length(:) !< Length of each axis + integer :: i, j !< For looping + class(fmsDiagOutputBuffer_class), pointer :: ptr_diag_buffer_obj !< Pointer to the buffer class + class(DiagYamlFilesVar_type), pointer :: ptr_diag_field_yaml !< Pointer to a field from yaml fields + integer, pointer :: axis_ids(:) !< Pointer to indices of axes of the field variable + integer :: var_type !< Stores type of the field data (r4, r8, i4, i8, and string) represented as an integer. + real :: missing_value !< Fill value to initialize output buffers + character(len=128), allocatable :: var_name !< Field name to initialize output buffers + + ! Determine the type of the field data + var_type = get_var_type(field_data(1, 1, 1, 1)) + + ! Get variable/field name + var_name = this%Fms_diag_fields(field_id)%get_varname() + + ! Get missing value for the field + if (this%FMS_diag_fields(field_id)%has_missing_value()) then + select type (my_type => this%FMS_diag_fields(field_id)%get_missing_value(var_type)) + type is (real(kind=r4_kind)) + missing_value = my_type + type is (real(kind=r8_kind)) + missing_value = real(my_type) + class default + call mpp_error( FATAL, 'fms_diag_object_mod:allocate_diag_field_output_buffers Invalid type') + end select + else + select type (my_type => get_default_missing_value(var_type)) + type is (real(kind=r4_kind)) + missing_value = real(my_type, kind=r4_kind) + type is (real(kind=r8_kind)) + missing_value = real(my_type, kind=r8_kind) + class default + call mpp_error( FATAL, 'fms_diag_object_mod:allocate_diag_field_output_buffers Invalid type') + end select + endif + + ! Determine dimensions of the field + ndims = 0 + if (this%FMS_diag_fields(field_id)%has_axis_ids()) then + axis_ids => this%FMS_diag_fields(field_id)%get_axis_id() !< Get ids of axes of the variable + ndims = size(axis_ids) !< Dimensions of the field + endif + + ! Loop over a number of fields/buffers where this variable occurs + do i = 1, size(this%FMS_diag_fields(field_id)%buffer_ids) + buffer_id = this%FMS_diag_fields(field_id)%buffer_ids(i) + ptr_diag_field_yaml => diag_yaml%get_diag_field_from_id(buffer_id) + num_diurnal_samples = ptr_diag_field_yaml%get_n_diurnal() !< Get number of diurnal samples + + ! If diurnal axis exists, fill lengths of axes. + if (num_diurnal_samples .ne. 0) then + allocate(axes_length(ndims + 1)) !< Include extra length for the diurnal axis + do j = 1, ndims + axes_length(j) = this%fms_get_axis_length(axis_ids(j)) + enddo + !TODO This is going to require more work for when we have subRegion variables + axes_length(ndims + 1) = num_diurnal_samples + ndims = ndims + 1 !< Add one more dimension for the diurnal axis + endif + + ! Allocates diag_buffer_obj to the correct outputBuffer type based on the dimension: + ! outputBuffer0d_type, outputBuffer1d_type, outputBuffer2d_type, outputBuffer3d_type, + ! outputBuffer4d_type or outputBuffer5d_type. + if (.not. allocated(this%FMS_diag_output_buffers(buffer_id)%diag_buffer_obj)) then + this%FMS_diag_output_buffers(buffer_id) = fms_diag_output_buffer_create_container(ndims) + end if + + ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)%diag_buffer_obj + + select type (ptr_diag_buffer_obj) + type is (outputBuffer0d_type) !< Scalar buffer + if (allocated(ptr_diag_buffer_obj%buffer)) cycle !< If allocated, loop back + call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), & !< If scalar field variable + this%FMS_diag_fields(field_id)%get_varname()) + call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + type is (outputBuffer1d_type) !< 1D buffer + if (allocated(ptr_diag_buffer_obj%buffer)) cycle !< If allocated, loop back + call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), axes_length(1), & + this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples) + call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + type is (outputBuffer2d_type) !< 2D buffer + if (allocated(ptr_diag_buffer_obj%buffer)) cycle !< If allocated, loop back + call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), axes_length(1:2), & + this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples) + call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + type is (outputBuffer3d_type) !< 3D buffer + if (allocated(ptr_diag_buffer_obj%buffer)) cycle !< If allocated, loop back + call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), axes_length(1:3), & + this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples) + call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + type is (outputBuffer4d_type) !< 4D buffer + if (allocated(ptr_diag_buffer_obj%buffer)) cycle !< If allocated, loop back + call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), axes_length(1:4), & + this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples) + call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + type is (outputBuffer5d_type) !< 5D buffer + if (allocated(ptr_diag_buffer_obj%buffer)) cycle !< If allocated, loop back + call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), axes_length(1:5), & + this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples) + call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + class default + call mpp_error( FATAL, 'allocate_diag_field_output_buffers: invalid buffer type') + end select + enddo +#else + call mpp_error( FATAL, "allocate_diag_field_output_buffers: "//& + "you can not use the modern diag manager without compiling with -Duse_yaml") +#endif +end subroutine allocate_diag_field_output_buffers end module fms_diag_object_mod diff --git a/diag_manager/fms_diag_output_buffer.F90 b/diag_manager/fms_diag_output_buffer.F90 index 3036777526..d6ade5621d 100644 --- a/diag_manager/fms_diag_output_buffer.F90 +++ b/diag_manager/fms_diag_output_buffer.F90 @@ -143,6 +143,7 @@ module fms_diag_output_buffer_mod ! public routines public :: fms_diag_output_buffer_init +public :: fms_diag_output_buffer_create_container contains