feat: add a modern version of add_diag_axis_attribute (NOAA-GFDL#990)

diag_manager/diag_axis.F90

@@ -40,8 +40,10 @@ MODULE diag_axis_mod
   USE diag_data_mod, ONLY: diag_axis_type, max_subaxes, max_axes,&
        & max_num_axis_sets, max_axis_attributes, debug_diag_manager,&
        & first_send_data_call, diag_atttype, use_modern_diag
-  USE fms_diag_axis_object_mod, ONLY: fms_diag_axis_init
+  USE fms_diag_axis_object_mod, ONLY: fms_diag_axis_init, fms_diag_axis_add_attribute
+#ifdef use_netCDF
   USE netcdf, ONLY: NF90_INT, NF90_FLOAT, NF90_CHAR
+#endif
 
   IMPLICIT NONE
 
@@ -1047,39 +1049,58 @@ SUBROUTINE diag_axis_add_attribute_scalar_r(diag_axis_id, att_name, att_value)
     CHARACTER(len=*), INTENT(in) :: att_name
     REAL, INTENT(in) :: att_value
 
-    CALL diag_axis_add_attribute_r1d(diag_axis_id, att_name, (/ att_value /))
+    if (use_modern_diag) then
+      call fms_diag_axis_add_attribute(diag_axis_id, att_name, (/ att_value /))
+    else
+      CALL diag_axis_add_attribute_r1d(diag_axis_id, att_name, (/ att_value /))
+    endif
   END SUBROUTINE diag_axis_add_attribute_scalar_r
 
   SUBROUTINE diag_axis_add_attribute_scalar_i(diag_axis_id, att_name, att_value)
     INTEGER, INTENT(in) :: diag_axis_id
     CHARACTER(len=*), INTENT(in) :: att_name
     INTEGER, INTENT(in) :: att_value
 
-    CALL diag_axis_add_attribute_i1d(diag_axis_id, att_name, (/ att_value /))
+    if (use_modern_diag) then
+      call fms_diag_axis_add_attribute(diag_axis_id, att_name, (/ att_value /))
+    else
+      CALL diag_axis_add_attribute_i1d(diag_axis_id, att_name, (/ att_value /))
+    endif
   END SUBROUTINE diag_axis_add_attribute_scalar_i
 
   SUBROUTINE diag_axis_add_attribute_scalar_c(diag_axis_id, att_name, att_value)
     INTEGER, INTENT(in) :: diag_axis_id
     CHARACTER(len=*), INTENT(in) :: att_name
     CHARACTER(len=*), INTENT(in) :: att_value
 
-    CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_CHAR, cval=att_value)
+    if (use_modern_diag) then
+      call fms_diag_axis_add_attribute(diag_axis_id, att_name, (/ att_value /))
+    else
+      CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_CHAR, cval=att_value)
+    endif
   END SUBROUTINE diag_axis_add_attribute_scalar_c
 
   SUBROUTINE diag_axis_add_attribute_r1d(diag_axis_id, att_name, att_value)
     INTEGER, INTENT(in) :: diag_axis_id
     CHARACTER(len=*), INTENT(in) :: att_name
     REAL, DIMENSION(:), INTENT(in) :: att_value
 
-    CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_FLOAT, rval=att_value)
+    if (use_modern_diag) then
+      call fms_diag_axis_add_attribute(diag_axis_id, att_name, att_value)
+    else
+      CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_FLOAT, rval=att_value)
+    endif
   END SUBROUTINE diag_axis_add_attribute_r1d
 
   SUBROUTINE diag_axis_add_attribute_i1d(diag_axis_id, att_name, att_value)
     INTEGER, INTENT(in) :: diag_axis_id
     CHARACTER(len=*), INTENT(in) :: att_name
     INTEGER, DIMENSION(:), INTENT(in) :: att_value
-
-    CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_INT, ival=att_value)
+    if (use_modern_diag) then
+      call fms_diag_axis_add_attribute(diag_axis_id, att_name, att_value)
+    else
+      CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_INT, ival=att_value)
+    endif
   END SUBROUTINE diag_axis_add_attribute_i1d
 
   !> @brief Allocates memory in out_file for the attributes.  Will <TT>FATAL</TT> if err_msg is not included

diag_manager/diag_data.F90

@@ -314,6 +314,15 @@ MODULE diag_data_mod
      CHARACTER(len=128)   :: tile_name='N/A'
   END TYPE diag_global_att_type
 
+  !> @brief Type to hold the attributes of the field/axis/file
+  !> @ingroup diag_data_mod
+  type fmsDiagAttribute_type
+    class(*), allocatable         :: att_value(:) !< Value of the attribute
+    character(len=:), allocatable :: att_name     !< Name of the attribute
+
+    contains
+      procedure :: add => fms_add_attribute
+  end type fmsDiagAttribute_type
 ! Include variable "version" to be written to log file.
 #include<file_version.h>
 
@@ -521,6 +530,34 @@ function get_base_second() &
     integer :: res
     res = base_second
   end function get_base_second
+
+  subroutine fms_add_attribute(obj, att_name, att_value)
+    class(fmsDiagAttribute_type), intent(inout) :: obj          !< Diag attribute type
+    character(len=*),             intent(in)    :: att_name     !< Name of the attribute
+    class(*),                     intent(in)    :: att_value(:) !< The attribute value to add
+
+    integer :: natt !< the size of att_value
+
+    natt = size(att_value)
+    obj%att_name = att_name
+    select type (att_value)
+    type is (integer(kind=i4_kind))
+      allocate(integer(kind=i4_kind) :: obj%att_value(natt))
+      obj%att_value = att_value
+    type is (integer(kind=i8_kind))
+      allocate(integer(kind=i8_kind) :: obj%att_value(natt))
+      obj%att_value = att_value
+    type is (real(kind=r4_kind))
+      allocate(real(kind=r4_kind) :: obj%att_value(natt))
+      obj%att_value = att_value
+    type is (real(kind=r8_kind))
+      allocate(real(kind=r8_kind) :: obj%att_value(natt))
+      obj%att_value = att_value
+    type is (character(len=*))
+      allocate(character(len=len(att_value)) :: obj%att_value(natt))
+      obj%att_value = att_value
+    end select
+  end subroutine fms_add_attribute
 END MODULE diag_data_mod
 !> @}
 ! close documentation grouping

diag_manager/fms_diag_axis_object.F90

@@ -30,9 +30,9 @@
 module fms_diag_axis_object_mod
   use mpp_domains_mod, only:  domain1d, domain2d, domainUG, mpp_get_compute_domain, CENTER, &
                             & mpp_get_compute_domain, NORTH, EAST
-  use platform_mod,    only:  r8_kind, r4_kind
+  use platform_mod,    only:  r8_kind, r4_kind, i4_kind, i8_kind
   use diag_data_mod,   only:  diag_atttype, max_axes, NO_DOMAIN, TWO_D_DOMAIN, UG_DOMAIN, &
-                              direction_down, direction_up
+                              direction_down, direction_up, fmsDiagAttribute_type, max_axis_attributes
   use mpp_mod,         only:  FATAL, mpp_error, uppercase
   use fms2_io_mod,     only:  FmsNetcdfFile_t, FmsNetcdfDomainFile_t, FmsNetcdfUnstructuredDomainFile_t, &
                             & register_axis, register_field, register_variable_attribute, write_data
@@ -41,7 +41,7 @@ module fms_diag_axis_object_mod
   PRIVATE
 
   public :: diagAxis_t, set_subaxis, fms_diag_axis_init, fms_diag_axis_object_init, fms_diag_axis_object_end, &
-          & get_domain_and_domain_type, axis_obj, diagDomain_t, sub_axis_objs
+          & get_domain_and_domain_type, axis_obj, diagDomain_t, sub_axis_objs, fms_diag_axis_add_attribute
   !> @}
 
   !> @brief Type to hold the domain info for an axis
@@ -103,12 +103,13 @@ module fms_diag_axis_object_mod
                                                                  !! or <TT>geolat_t</TT>
      CHARACTER(len=128)             , private :: req             !< Required field names.
      INTEGER                        , private :: tile_count      !< The number of tiles
-     TYPE(diag_atttype),allocatable , private :: attributes(:)   !< Array to hold user definable attributes
+     TYPE(fmsDiagAttribute_type),allocatable , private :: attributes(:) !< Array to hold user definable attributes
      INTEGER                        , private :: num_attributes  !< Number of defined attibutes
      INTEGER                        , private :: domain_position !< The position in the doman (NORTH, EAST or CENTER)
 
      contains
 
+     PROCEDURE :: add_axis_attribute
      PROCEDURE :: register => register_diag_axis_obj
      PROCEDURE :: axis_length => get_axis_length
      PROCEDURE :: set_subaxis
@@ -213,8 +214,26 @@ subroutine register_diag_axis_obj(obj, axis_name, axis_data, units, cart_name, l
     if (present(req)) obj%req = trim(req)
 
     obj%nsubaxis = 0
+    obj%num_attributes = 0
   end subroutine register_diag_axis_obj
 
+  !> @brief Add an attribute to an axis
+  subroutine add_axis_attribute(obj, att_name, att_value)
+    class(diagAxis_t),INTENT(INOUT) :: obj          !< diag_axis obj
+    character(len=*), intent(in)    :: att_name     !< Name of the attribute
+    class(*),         intent(in)    :: att_value(:) !< The attribute value to add
+
+    integer :: j    !< obj%num_attributes (for less typing)
+
+    if (.not. allocated(obj%attributes)) &
+      allocate(obj%attributes(max_axis_attributes))
+
+    obj%num_attributes = obj%num_attributes + 1
+
+    j = obj%num_attributes
+    call obj%attributes(j)%add(att_name, att_value)
+  end subroutine add_axis_attribute
+
   !> @brief Write the axis meta data to an open fileobj
   subroutine write_axis_metadata(obj, fileobj, sub_axis_id)
     class(diagAxis_t), target, INTENT(IN)    :: obj         !< diag_axis obj
@@ -223,7 +242,8 @@ subroutine write_axis_metadata(obj, fileobj, sub_axis_id)
 
     character(len=:), ALLOCATABLE :: axis_edges_name !< Name of the edges, if it exist
     character(len=:), pointer     :: axis_name       !< Name of the axis
-    integer                       :: axis_length      !< Size of the axis
+    integer                       :: axis_length     !< Size of the axis
+    integer                       :: i               !< For do loops
 
     if (present(sub_axis_id)) then
       axis_name  => obj%subaxis(sub_axis_id)%subaxis_name
@@ -284,6 +304,13 @@ subroutine write_axis_metadata(obj, fileobj, sub_axis_id)
         str_len=len_trim(axis_edges_name))
     endif
 
+    if(allocated(obj%attributes)) then
+      do i = 1, size(obj%attributes)
+        call register_variable_attribute(fileobj, axis_name, obj%attributes(i)%att_name, &
+          & obj%attributes(i)%att_value)
+      enddo
+    endif
+
   end subroutine write_axis_metadata
 
   !> @brief Write the axis data to an open fileobj
@@ -451,6 +478,18 @@ FUNCTION fms_diag_axis_init(axis_name, axis_data, units, cart_name, long_name, d
     id = number_of_axis
   end function
 
+  !> @brief Add an attribute to an axis
+  subroutine fms_diag_axis_add_attribute(axis_id, att_name, att_value)
+    integer,          intent(in) :: axis_id      !< Id of the axis to add the attribute to
+    character(len=*), intent(in) :: att_name     !< Name of the attribute
+    class(*),         intent(in) :: att_value(:) !< The attribute value to add
+
+    if (axis_id < 0 .and. axis_id > number_of_axis) &
+      call mpp_error(FATAL, "diag_axis_add_attribute: The axis_id is not valid")
+
+    call axis_obj(axis_id)%add_axis_attribute(att_name, att_value)
+  end subroutine fms_diag_axis_add_attribute
+
   !> @brief Check if a cart_name is valid and crashes if it isn't
   subroutine check_if_valid_cart_name(cart_name)
     character(len=*), intent(in) :: cart_name

diag_manager/fms_diag_object.F90

@@ -544,7 +544,7 @@ pure function get_metadata (obj) &
      class (fmsDiagObject_type), intent(in) :: obj !< diag object
      character(len=:), allocatable, dimension(:) :: rslt
      if (allocated(obj%metadata)) then
-       allocate(character(len=(len(obj%metadata(1)))) :: rslt (size(obj%metadata)) )
+       allocate(character(len=(len(obj%metadata))) :: rslt (size(obj%metadata)) )
        rslt = obj%metadata
      else
        allocate(character(len=1) :: rslt(1:1))

test_fms/diag_manager/test_modern_diag.F90

@@ -25,7 +25,8 @@ program test_modern_diag
                               mpp_define_mosaic, domainug, mpp_get_compute_domains, mpp_define_unstruct_domain, &
                               mpp_get_compute_domain, mpp_get_data_domain, mpp_get_UG_domain_grid_index, &
                               mpp_get_UG_compute_domain
-use   diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_axis_init, register_diag_field
+use   diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_axis_init, register_diag_field, &
+                              diag_axis_add_attribute
 use   fms_mod,          only: fms_init, fms_end
 use   mpp_mod,          only: FATAL, mpp_error, mpp_npes, mpp_pe, mpp_root_pe, mpp_broadcast
 use   time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time
@@ -107,6 +108,11 @@ program test_modern_diag
                          set_name="land", DomainU=land_domain, aux="geolon_t geolat_t")
 
 id_z  = diag_axis_init('z',  z,  'point_Z', 'z', long_name='point_Z')
+call diag_axis_add_attribute (id_z, 'formula', 'p(n,k,j,i) = ap(k) + b(k)*ps(n,j,i)')
+call diag_axis_add_attribute (id_z, 'integer', 10)
+call diag_axis_add_attribute (id_z, '1d integer', (/10, 10/))
+call diag_axis_add_attribute (id_z, 'real', 10.)
+call diag_axis_add_attribute (id_x, '1d real', (/10./))
 
 if (id_x  .ne. 1) call mpp_error(FATAL, "The x axis does not have the expected id")
 if (id_y  .ne. 2) call mpp_error(FATAL, "The y axis does not have the expected id")