diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90
index 7f69674a35..f441287e66 100644
--- a/diag_manager/fms_diag_axis_object.F90
+++ b/diag_manager/fms_diag_axis_object.F90
@@ -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 geolon_t
+ CHARACTER(len=:), ALLOCATABLE, private :: aux !< Auxiliary name, can only be geolon_t
!! or geolat_t
CHARACTER(len=128) , private :: req !< Required field names.
INTEGER , private :: tile_count !< The number of tiles
@@ -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
@@ -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
diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90
index f82ca0d842..095ca941c3 100644
--- a/diag_manager/fms_diag_field_object.F90
+++ b/diag_manager/fms_diag_field_object.F90
@@ -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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -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) &