Skip to content

Commit

Permalink
Modern diag manager: Refactor buffers (#1332)
Browse files Browse the repository at this point in the history
* refactor the buffer to always save the data as 5d

* rename the output buffer type
  • Loading branch information
uramirez8707 authored Aug 15, 2023
1 parent f28b99b commit 28124ae
Show file tree
Hide file tree
Showing 4 changed files with 351 additions and 1,628 deletions.
6 changes: 3 additions & 3 deletions diag_manager/fms_diag_file_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ module fms_diag_file_object_mod
fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, &
fmsDiagDiurnalAxis_type, create_new_z_subaxis
use fms_diag_field_object_mod, only: fmsDiagField_type
use fms_diag_output_buffer_mod, only: fmsDiagOutputBufferContainer_type, fmsDiagOutputBuffer_class
use fms_diag_output_buffer_mod, only: fmsDiagOutputBuffer_type
use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, &
uppercase, lowercase

Expand Down Expand Up @@ -714,7 +714,7 @@ subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id, buffer_id, output
integer, intent(in) :: yaml_id !< Yaml id of the field section for
!! this var
integer, intent(in) :: buffer_id !< ID of the buffer
type(fmsDiagOutputBufferContainer_type), intent(inout) :: output_buffers(:) !< Array of output buffers
type(fmsDiagOutputBuffer_type), intent(inout) :: output_buffers(:) !< Array of output buffers

type(diagYamlFilesVar_type), pointer :: field_yaml !< pointer to the yaml entry

Expand Down Expand Up @@ -1124,7 +1124,7 @@ end subroutine write_time_metadata
subroutine write_field_data(this, field_obj, buffer_obj)
class(fmsDiagFileContainer_type), intent(in), target :: this !< The diag file object to write to
type(fmsDiagField_type), intent(in), target :: field_obj(:) !< The field object to write from
type(fmsDiagOutputBufferContainer_type), intent(in), target :: buffer_obj(:) !< The buffer object with the data
type(fmsDiagOutputBuffer_type), intent(in), target :: buffer_obj(:) !< The buffer object with the data

class(fmsDiagFile_type), pointer :: diag_file !< Diag_file object to open
class(FmsNetcdfFile_t), pointer :: fileobj !< Fileobj to write to
Expand Down
68 changes: 10 additions & 58 deletions diag_manager/fms_diag_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ module fms_diag_object_mod
!TODO: Remove FMS prefix from variables in this type
class(fmsDiagFileContainer_type), allocatable :: FMS_diag_files (:) !< array of diag files
class(fmsDiagField_type), allocatable :: FMS_diag_fields(:) !< Array of diag fields
type(fmsDiagOutputBufferContainer_type), allocatable :: FMS_diag_output_buffers(:) !< array of output buffer objects
type(fmsDiagOutputBuffer_type), allocatable :: FMS_diag_output_buffers(:) !< array of output buffer objects
!! one for each variable in the diag_table.yaml
integer, private :: registered_buffers = 0 !< number of registered buffers, per dimension
class(fmsDiagAxisContainer_type), allocatable :: diag_axis(:) !< Array of diag_axis
Expand Down Expand Up @@ -150,9 +150,7 @@ subroutine fms_diag_object_end (this, time)
call this%fms_diag_do_io(is_end_of_run=.true.)
!TODO: Deallocate diag object arrays and clean up all memory
do i=1, size(this%FMS_diag_output_buffers)
if(allocated(this%FMS_diag_output_buffers(i)%diag_buffer_obj)) then
call this%FMS_diag_output_buffers(i)%diag_buffer_obj%flush_buffer()
endif
call this%FMS_diag_output_buffers(i)%flush_buffer()
enddo
deallocate(this%FMS_diag_output_buffers)
this%axes_initialized = fms_diag_axis_object_end(this%diag_axis)
Expand Down Expand Up @@ -851,11 +849,11 @@ function get_diag_buffer(this, bufferid) &
result(rslt)
class(fmsDiagObject_type), intent(in) :: this
integer, intent(in) :: bufferid
class(fmsDiagOutputBuffer_class),allocatable:: rslt
class(fmsDiagOutputBuffer_type),allocatable:: rslt
if( (bufferid .gt. UBOUND(this%FMS_diag_output_buffers, 1)) .or. &
(bufferid .lt. LBOUND(this%FMS_diag_output_buffers, 1))) &
call mpp_error(FATAL, 'get_diag_bufer: invalid bufferid given')
rslt = this%FMS_diag_output_buffers(bufferid)%diag_buffer_obj
rslt = this%FMS_diag_output_buffers(bufferid)
end function
#endif

Expand Down Expand Up @@ -999,9 +997,9 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
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 :: axes_length(5) !< Length of each axis
integer :: i, j !< For looping
class(fmsDiagOutputBuffer_class), pointer :: ptr_diag_buffer_obj !< Pointer to the buffer class
class(fmsDiagOutputBuffer_type), 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, allocatable :: 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.
Expand Down Expand Up @@ -1059,13 +1057,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
ptr_diag_field_yaml => diag_yaml%diag_fields(yaml_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
else
allocate(axes_length(ndims))
endif

axes_length = 1
do j = 1, ndims
axes_length(j) = this%fms_get_axis_length(axis_ids(j))
enddo
Expand All @@ -1075,52 +1067,12 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
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
call fms_diag_output_buffer_create_container(ndims, this%FMS_diag_output_buffers(buffer_id))
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), &
ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)
call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, 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)
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
call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name)

if (allocated(axis_ids)) deallocate(axis_ids)
deallocate(axes_length)
enddo

this%FMS_diag_fields(field_id)%buffer_allocated = .true.
Expand Down
Loading

0 comments on commit 28124ae

Please sign in to comment.