Skip to content

Commit

Permalink
write the coordinate and standard name attribute to the field
Browse files Browse the repository at this point in the history
  • Loading branch information
uramirez8707 committed Mar 31, 2023
1 parent f59663b commit d82d3f5
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 1 deletion.
26 changes: 25 additions & 1 deletion diag_manager/fms_diag_axis_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -154,7 +154,7 @@ module fms_diag_axis_object_mod
INTEGER , private :: direction !< Direction of the axis 0, 1, -1
CHARACTER(len=:), ALLOCATABLE, private :: edges_name !< Name for the previously defined "edges axis"
!! This will be written as an attribute
CHARACTER(len=128) , private :: aux !< Auxiliary name, can only be <TT>geolon_t</TT>
CHARACTER(len=:), ALLOCATABLE, private :: aux !< Auxiliary name, can only be <TT>geolon_t</TT>
!! or <TT>geolat_t</TT>
CHARACTER(len=128) , private :: req !< Required field names.
INTEGER , private :: tile_count !< The number of tiles
Expand All @@ -174,6 +174,8 @@ module fms_diag_axis_object_mod
PROCEDURE :: get_compute_domain
PROCEDURE :: get_indices
PROCEDURE :: get_global_io_domain
PROCEDURE :: get_aux
PROCEDURE :: has_aux
! TO DO:
! Get/has/is subroutines as needed
END TYPE fmsDiagFullAxis_type
Expand Down Expand Up @@ -560,6 +562,28 @@ function get_axis_length(this) &

end function


!> @brief Determine if an axis object has an auxiliary name
!! @return .true. if an axis object has an auxiliary name
pure function has_aux(this) &
result(rslt)
class(fmsDiagFullAxis_type), intent(in) :: this !< diag_axis obj
logical :: rslt

rslt = .false.
if (allocated(this%aux)) rslt = trim(this%aux) .ne. ""
end function has_aux

!> @brief Get the auxiliary name of an axis object
!! @return the auxiliary name of an axis object
pure function get_aux(this) &
result(rslt)
class(fmsDiagFullAxis_type), intent(in) :: this !< diag_axis obj
character(len=:), allocatable :: rslt

rslt = this%aux
end function get_aux

!> @brief Set the axis_id
subroutine set_axis_id(this, axis_id)
class(fmsDiagFullAxis_type), intent(inout) :: this !< diag_axis obj
Expand Down
41 changes: 41 additions & 0 deletions diag_manager/fms_diag_field_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,7 @@ module fms_diag_field_object_mod
procedure :: get_var_skind
procedure :: get_longname_to_write
procedure :: write_field_metadata
procedure :: write_coordinate_attribute
procedure :: get_math_needs_to_be_done
end type fmsDiagField_type
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Expand Down Expand Up @@ -1141,7 +1142,47 @@ subroutine write_field_metadata(this, fileobj, file_id, yaml_id, diag_axis, unli
call register_variable_attribute(fileobj, var_name, "cell_methods", &
trim(adjustl(cell_measures)), str_len=len_trim(adjustl(cell_measures)))

!< Write out the standard_name (this was defined in the register call)
if (this%has_standname()) &
call register_variable_attribute(fileobj, var_name, "standard_name", &
trim(this%get_standname()), str_len=len_trim(this%get_standname()))

call this%write_coordinate_attribute(fileobj, var_name, diag_axis)
end subroutine write_field_metadata

!> @brief Writes the coordinate attribute of a field if any of the field's axis has an
!! auxiliary axis
subroutine write_coordinate_attribute (this, fileobj, var_name, diag_axis)
CLASS(fmsDiagField_type), intent(in) :: this !< The field object
class(FmsNetcdfFile_t), INTENT(INOUT) :: fileobj !< Fms2_io fileobj to write to
character(len=*), intent(in) :: var_name !< Variable name
class(fmsDiagAxisContainer_type), intent(in) :: diag_axis(:) !< Diag_axis object

integer :: i !< For do loops
character(len = 252) :: aux_coord !< Auxuliary axis name

!> If the variable is a scalar, go away
if (.not. allocated(this%axis_ids)) return

!> Determine if any of the field's axis has an auxiliary axis and the
!! axis_names as a variable attribute
aux_coord = ""
do i = 1, size(this%axis_ids)
select type (obj => diag_axis(this%axis_ids(i))%axis)
type is (fmsDiagFullAxis_type)
if (obj%has_aux()) then
aux_coord = trim(aux_coord)//" "//obj%get_aux()
endif
end select
enddo

if (trim(aux_coord) .eq. "") return

call register_variable_attribute(fileobj, var_name, "coordinates", &
trim(adjustl(aux_coord)), str_len=len_trim(adjustl(aux_coord)))

end subroutine write_coordinate_attribute

!> @brief Gets a fields data buffer
!! @return a pointer to the data buffer
function get_data_buffer (this) &
Expand Down

0 comments on commit d82d3f5

Please sign in to comment.