From 190499958c4711fa8d63ce352a9d33c9a1e5e6d3 Mon Sep 17 00:00:00 2001 From: Ganga P Purja Pun Date: Mon, 24 Apr 2023 09:07:17 -0400 Subject: [PATCH 1/9] Adds allocate_diag_field_output_buffers() to fms_diag_object_mod --- diag_manager/Makefile.am | 1 + diag_manager/fms_diag_field_object.F90 | 1 + diag_manager/fms_diag_object.F90 | 127 +++++++++++++++++++++++- diag_manager/fms_diag_output_buffer.F90 | 1 + 4 files changed, 127 insertions(+), 3 deletions(-) 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 bd3165f6f1..e3a6d25538 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -163,6 +163,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 0827d2d5fc..9d04141bb2 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -20,15 +20,15 @@ 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 + &get_base_time, NULL_AXIS_ID, get_var_type 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, & @@ -80,6 +80,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 @@ -872,4 +873,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:), 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 = 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 + 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 From 94db7ed8b276f568b3da9a7757065a932c0b4b77 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 09:24:59 -0400 Subject: [PATCH 2/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 9d04141bb2..aaf699afca 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -891,7 +891,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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:), allocatable :: var_name !< Field name 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)) From 9c3d8f89716f34fdf376d0c5024564067e7ed064 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 09:39:38 -0400 Subject: [PATCH 3/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index aaf699afca..f4b99b9224 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -903,9 +903,9 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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 = real(my_type, kind=r4_kind) + missing_value = my_type type is (real(kind=r8_kind)) - missing_value = real(my_type, 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 From 13293c05c4b437508ab91e2777d197e200fb2337 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 09:57:45 -0400 Subject: [PATCH 4/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index f4b99b9224..fde377a655 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -903,7 +903,10 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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 + select type (missing_value) + type is (real(kind=r4_kind)) + missing_value = real(my_type, kind=r4_kind) + end select type is (real(kind=r8_kind)) missing_value = real(my_type) class default From 17e0c56500f2bbf870917f98cb17a6f18fe8cfb6 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 12:53:36 -0400 Subject: [PATCH 5/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index fde377a655..f4b99b9224 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -903,10 +903,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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)) - select type (missing_value) - type is (real(kind=r4_kind)) - missing_value = real(my_type, kind=r4_kind) - end select + missing_value = my_type type is (real(kind=r8_kind)) missing_value = real(my_type) class default From 4ff58b69d6b0c0312703aa9bd2dc4f1dc7438575 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 13:04:21 -0400 Subject: [PATCH 6/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index f4b99b9224..779f191c16 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -890,7 +890,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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 + class(*) :: 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 From 9520224332e628069eb66551d42400cad8fc35c3 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 13:08:24 -0400 Subject: [PATCH 7/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 779f191c16..46d9e84d59 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -890,7 +890,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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. - class(*) :: missing_value !< Fill value to initialize output buffers + 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 From 4d88c2fea5b15c2a8b65b68135bf347ff35f07a5 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 13:12:53 -0400 Subject: [PATCH 8/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 46d9e84d59..f4b99b9224 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -890,7 +890,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) 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 + 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 From 8233aa777fe6a302d12bd5ec5885e48fc91bfa9d Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Mon, 24 Apr 2023 14:21:01 -0400 Subject: [PATCH 9/9] Update fms_diag_object.F90 --- diag_manager/fms_diag_object.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index f4b99b9224..99b1e3d98e 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -39,6 +39,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