From fd3c088faf3d62af80b9d33f2bfea7c34289946e Mon Sep 17 00:00:00 2001
From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com>
Date: Tue, 13 Sep 2022 07:23:39 -0400
Subject: [PATCH] feat: update axis/subaxis types and add controller object
(#1024)
---
diag_manager/Makefile.am | 12 +-
diag_manager/diag_axis.F90 | 46 +++---
diag_manager/diag_manager.F90 | 3 -
diag_manager/fms_diag_axis_object.F90 | 250 ++++++++++++++-------------------
diag_manager/fms_diag_field_object.F90 | 14 +-
diag_manager/fms_diag_file_object.F90 | 23 +--
diag_manager/fms_diag_object.F90 | 167 +++++++++++++++++++++-
7 files changed, 311 insertions(+), 204 deletions(-)
diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am
index caf2dc77..73efc0c3 100644
--- a/diag_manager/Makefile.am
+++ b/diag_manager/Makefile.am
@@ -55,17 +55,15 @@ libdiag_manager_la_SOURCES = \
# Some mods are dependant on other mods in this dir.
diag_data_mod.$(FC_MODEXT): fms_diag_bbox_mod.$(FC_MODEXT)
-diag_axis_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT)
+diag_axis_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT) fms_diag_object_mod.$(FC_MODEXT)
diag_output_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MODEXT)
diag_util_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT) diag_output_mod.$(FC_MODEXT) \
diag_grid_mod.$(FC_MODEXT)
diag_table_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT)
-fms_diag_yaml_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT)
-fms_diag_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT) fms_diag_file_object_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \
- diag_util_mod.$(FC_MODEXT)
-fms_diag_field_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \
- diag_util_mod.$(FC_MODEXT)
-fms_diag_file_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT)
+fms_diag_yaml_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
+fms_diag_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_file_object_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT)
+fms_diag_field_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT)
+fms_diag_file_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT)
fms_diag_object_container_mod.$(FC_MODEXT): fms_diag_object_mod.$(FC_MODEXT) fms_diag_dlinked_list_mod.$(FC_MODEXT)
fms_diag_axis_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT) \
diff --git a/diag_manager/diag_axis.F90 b/diag_manager/diag_axis.F90
index e574b8ee..341f7fbf 100644
--- a/diag_manager/diag_axis.F90
+++ b/diag_manager/diag_axis.F90
@@ -40,8 +40,7 @@ use platform_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, TWO_D_DOMAIN
- USE fms_diag_axis_object_mod, ONLY: fms_diag_axis_init, fms_diag_axis_add_attribute, &
- & diagDomain_t, DIAGDOMAIN2D_T, get_domain_and_domain_type, fms_get_axis_length
+ use fms_diag_object_mod, only:fms_diag_object
#ifdef use_netCDF
USE netcdf, ONLY: NF90_INT, NF90_FLOAT, NF90_CHAR
#endif
@@ -139,9 +138,9 @@ CONTAINS
ENDIF
if (use_modern_diag) then
- diag_axis_init = fms_diag_axis_init(name, DATA, units, cart_name, long_name=long_name, direction=direction,&
- & set_name=set_name, edges=edges, Domain=Domain, Domain2=Domain2, DomainU=DomainU, aux=aux, req=req, &
- & tile_count=tile_count, domain_position=domain_position )
+ diag_axis_init = fms_diag_object%fms_diag_axis_init(name, DATA, units, cart_name, long_name=long_name,&
+ & direction=direction, set_name=set_name, edges=edges, Domain=Domain, Domain2=Domain2, DomainU=DomainU, &
+ & aux=aux, req=req, tile_count=tile_count, domain_position=domain_position )
return
endif
IF ( PRESENT(tile_count)) THEN
@@ -586,12 +585,16 @@ CONTAINS
END SUBROUTINE get_diag_axis_data
!> @brief Return the short name of the axis.
- SUBROUTINE get_diag_axis_name(id, name)
+ SUBROUTINE get_diag_axis_name(id, axis_name)
INTEGER , INTENT(in) :: id !< Axis ID
- CHARACTER(len=*), INTENT(out) :: name !< Axis short name
+ CHARACTER(len=*), INTENT(out) :: axis_name !< Axis short name
- CALL valid_id_check(id, 'get_diag_axis_name')
- name = Axes(id)%name
+ if (use_modern_diag) then
+ axis_name = fms_diag_object%fms_get_axis_name_from_id(id)
+ else
+ CALL valid_id_check(id, 'get_diag_axis_name')
+ axis_name = Axes(id)%name
+ endif
END SUBROUTINE get_diag_axis_name
!> @brief Return the name of the axis' domain
@@ -610,7 +613,7 @@ CONTAINS
INTEGER :: length
if (use_modern_diag) then
- get_axis_length = fms_get_axis_length(id)
+ get_axis_length = fms_diag_object%fms_get_axis_length(id)
else
CALL valid_id_check(id, 'get_axis_length')
IF ( Axes(id)%Domain .NE. null_domain1d ) THEN
@@ -698,26 +701,17 @@ CONTAINS
INTEGER :: i, id, flag
- INTEGER :: type_of_domain !< The type of domain
- CLASS(diagDomain_t), POINTER :: domain !< Diag Domain pointer
-
IF ( SIZE(ids(:)) < 1 ) THEN
! input argument has incorrect size.
CALL error_mesg('diag_axis_mod::get_domain2d', 'input argument has incorrect size', FATAL)
END IF
- get_domain2d = null_domain2d
if (use_modern_diag) then
- call get_domain_and_domain_type(ids, type_of_domain, domain, "get_domain2d")
- if (type_of_domain .ne. TWO_D_DOMAIN) &
- call error_mesg('diag_axis_mod::get_domain2d', 'The axis do not correspond to a 2d Domain', FATAL)
- select type(domain)
- type is (diagDomain2d_t)
- get_domain2d = domain%domain2
- end select
+ get_domain2d = fms_diag_object%fms_get_domain2d(ids)
return
endif
+ get_domain2d = null_domain2d
flag = 0
DO i = 1, SIZE(ids(:))
id = ids(i)
@@ -1070,7 +1064,7 @@ CONTAINS
REAL, INTENT(in) :: att_value
if (use_modern_diag) then
- call fms_diag_axis_add_attribute(diag_axis_id, att_name, (/ att_value /))
+ call fms_diag_object%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
@@ -1082,7 +1076,7 @@ CONTAINS
INTEGER, INTENT(in) :: att_value
if (use_modern_diag) then
- call fms_diag_axis_add_attribute(diag_axis_id, att_name, (/ att_value /))
+ call fms_diag_object%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
@@ -1094,7 +1088,7 @@ CONTAINS
CHARACTER(len=*), INTENT(in) :: att_value
if (use_modern_diag) then
- call fms_diag_axis_add_attribute(diag_axis_id, att_name, (/ att_value /))
+ call fms_diag_object%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
@@ -1106,7 +1100,7 @@ CONTAINS
REAL, DIMENSION(:), INTENT(in) :: att_value
if (use_modern_diag) then
- call fms_diag_axis_add_attribute(diag_axis_id, att_name, att_value)
+ call fms_diag_object%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
@@ -1117,7 +1111,7 @@ CONTAINS
CHARACTER(len=*), INTENT(in) :: att_name
INTEGER, DIMENSION(:), INTENT(in) :: att_value
if (use_modern_diag) then
- call fms_diag_axis_add_attribute(diag_axis_id, att_name, att_value)
+ call fms_diag_object%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
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
index 7c8f79dc..db8497c3 100644
--- a/diag_manager/diag_manager.F90
+++ b/diag_manager/diag_manager.F90
@@ -239,7 +239,6 @@ use platform_mod
USE diag_grid_mod, ONLY: diag_grid_init, diag_grid_end
#ifdef use_yaml
use fms_diag_yaml_mod, only: diag_yaml_object_init, diag_yaml_object_end, get_num_unique_fields, find_diag_field
- use fms_diag_axis_object_mod, only: fms_diag_axis_object_end, fms_diag_axis_object_init
#endif
use fms_diag_object_mod, only:fms_diag_object
@@ -3825,7 +3824,6 @@ INTEGER FUNCTION register_diag_field_array_old(module_name, field_name, axes, in
#ifdef use_yaml
if (use_modern_diag) then
call diag_yaml_object_end
- call fms_diag_axis_object_end()
call fms_diag_object%diag_end()
endif
#endif
@@ -4042,7 +4040,6 @@ INTEGER FUNCTION register_diag_field_array_old(module_name, field_name, axes, in
#ifdef use_yaml
if (use_modern_diag) then
CALL diag_yaml_object_init(diag_subset_output)
- CALL fms_diag_axis_object_init()
CALL fms_diag_object%init(diag_subset_output)
endif
#else
diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90
index 085d0100..eeeab90f 100644
--- a/diag_manager/fms_diag_axis_object.F90
+++ b/diag_manager/fms_diag_axis_object.F90
@@ -32,7 +32,8 @@ module fms_diag_axis_object_mod
& mpp_get_compute_domain, NORTH, EAST
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, fmsDiagAttribute_type, max_axis_attributes
+ direction_down, direction_up, fmsDiagAttribute_type, max_axis_attributes, &
+ MAX_SUBAXES, DIAG_NULL
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
@@ -40,9 +41,9 @@ module fms_diag_axis_object_mod
PRIVATE
- public :: diagAxis_t, 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, fms_diag_axis_add_attribute, &
- & DIAGDOMAIN2D_T, fms_get_axis_length
+ public :: fmsDiagAxis_type, fms_diag_axis_object_init, fms_diag_axis_object_end, &
+ & get_domain_and_domain_type, diagDomain_t, &
+ & DIAGDOMAIN2D_T, fmsDiagSubAxis_type, fmsDiagAxisContainer_type, fmsDiagFullAxis_type
!> @}
!> @brief Type to hold the domain info for an axis
@@ -70,21 +71,36 @@ module fms_diag_axis_object_mod
type(domainUG) :: DomainUG !< Domain of "U" axis
end type
+ !> @brief Type to hold the diag_axis (either subaxis or a full axis)
+ !> @ingroup diag_axis_object_mod
+ type :: fmsDiagAxisContainer_type
+ class(fmsDiagAxis_type), allocatable :: axis
+ end type
+
+ !> @brief Type to hold the diagnostic axis description.
+ !> @ingroup diag_axis_object_mod
+ TYPE fmsDiagAxis_type
+ INTEGER , private :: axis_id !< ID of the axis
+ END TYPE fmsDiagAxis_type
+
!> @brief Type to hold the subaxis
!> @ingroup diag_axis_object_mod
- TYPE subaxis_t
- CHARACTER(len=:), ALLOCATABLE :: subaxis_name !< Name of the subaxis
- INTEGER :: starting_index !< Starting index of the subaxis relative to the parent axis
- INTEGER :: ending_index !< Ending index of the subaxis relative to the parent axis
- class(*) , ALLOCATABLE :: bounds !< Bounds of the subaxis (lat/lon or indices)
- INTEGER :: parent_axis_id !< Id of the parent_axis
+ TYPE, extends(fmsDiagAxis_type) :: fmsDiagSubAxis_type
+ INTEGER , private :: subaxis_id !< ID of the subaxis
+ CHARACTER(len=:), ALLOCATABLE, private :: subaxis_name !< Name of the subaxis
+ INTEGER , private :: starting_index !< Starting index of the subaxis relative to the
+ !! parent axis
+ INTEGER , private :: ending_index !< Ending index of the subaxis relative to the
+ !! parent axis
+ class(*) , ALLOCATABLE, private :: bounds !< Bounds of the subaxis (lat/lon or indices)
+ INTEGER , private :: parent_axis_id !< Id of the parent_axis
contains
procedure :: exists => check_if_subaxis_exists
- END TYPE subaxis_t
+ END TYPE fmsDiagSubAxis_type
!> @brief Type to hold the diagnostic axis description.
!> @ingroup diag_axis_object_mod
- TYPE diagAxis_t
+ TYPE, extends(fmsDiagAxis_type) :: fmsDiagFullAxis_type
CHARACTER(len=:), ALLOCATABLE, private :: axis_name !< Name of the axis
CHARACTER(len=:), ALLOCATABLE, private :: units !< Units of the axis
CHARACTER(len=:), ALLOCATABLE, private :: long_name !< Long_name attribute of the axis
@@ -92,14 +108,15 @@ module fms_diag_axis_object_mod
CLASS(*), ALLOCATABLE, private :: axis_data(:) !< Data of the axis
CHARACTER(len=:), ALLOCATABLE, private :: type_of_data !< The type of the axis_data ("float" or "double")
!< TO DO this can be a dlinked to avoid having limits
- type(subaxis_t) , private :: subaxis(3) !< Array of subaxis
+ type(fmsDiagSubAxis_type) , private :: subaxis(3) !< Array of subaxis
integer , private :: nsubaxis !< Number of subaxis
class(diagDomain_t),ALLOCATABLE, private :: axis_domain !< Domain
INTEGER , private :: type_of_domain !< The type of domain ("NO_DOMAIN", "TWO_D_DOMAIN",
!! or "UG_DOMAIN")
INTEGER , private :: length !< Global axis length
INTEGER , private :: direction !< Direction of the axis 0, 1, -1
- INTEGER , private :: edges !< Axis ID for the previously defined "edges axis"
+ 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
!! or geolat_t
CHARACTER(len=128) , private :: req !< Required field names.
@@ -113,19 +130,15 @@ module fms_diag_axis_object_mod
PROCEDURE :: add_axis_attribute
PROCEDURE :: register => register_diag_axis_obj
PROCEDURE :: axis_length => get_axis_length
+ PROCEDURE :: get_axis_name
+ PROCEDURE :: set_edges_name
PROCEDURE :: set_subaxis
PROCEDURE :: write_axis_metadata
PROCEDURE :: write_axis_data
! TO DO:
! Get/has/is subroutines as needed
- END TYPE diagAxis_t
-
- integer :: number_of_axis !< Number of axis that has been registered
- type(diagAxis_t), ALLOCATABLE, TARGET :: axis_obj(:) !< Diag_axis objects
- logical :: module_is_initialized !< Flag indicating if the module is initialized
- integer :: nsubaxis_objs !< Number of sub_axis that has been registered
- type(subaxis_t), ALLOCATABLE, Target :: sub_axis_objs(:) !< Registered sub_axis objects
+ END TYPE fmsDiagFullAxis_type
!> @addtogroup fms_diag_yaml_mod
!> @{
@@ -134,8 +147,8 @@ module fms_diag_axis_object_mod
!!!!!!!!!!!!!!!!! DIAG AXIS PROCEDURES !!!!!!!!!!!!!!!!!
!> @brief Initialize the axis
subroutine register_diag_axis_obj(this, axis_name, axis_data, units, cart_name, long_name, direction,&
- & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position )
- class(diagAxis_t), INTENT(out) :: this !< Diag_axis obj
+ & set_name, Domain, Domain2, DomainU, aux, req, tile_count, domain_position )
+ class(fmsDiagFullAxis_type),INTENT(out) :: this !< Diag_axis obj
CHARACTER(len=*), INTENT(in) :: axis_name !< Name of the axis
class(*), INTENT(in) :: axis_data(:) !< Array of coordinate values
CHARACTER(len=*), INTENT(in) :: units !< Units for the axis
@@ -143,7 +156,6 @@ module fms_diag_axis_object_mod
CHARACTER(len=*), INTENT(in), OPTIONAL :: long_name !< Long name for the axis.
CHARACTER(len=*), INTENT(in), OPTIONAL :: set_name !< Name of the parent axis, if it is a subaxis
INTEGER, INTENT(in), OPTIONAL :: direction !< Indicates the direction of the axis
- INTEGER, INTENT(in), OPTIONAL :: edges !< Axis ID for the previously defined "edges axis"
TYPE(domain1d), INTENT(in), OPTIONAL :: Domain !< 1D domain
TYPE(domain2d), INTENT(in), OPTIONAL :: Domain2 !< 2D domain
TYPE(domainUG), INTENT(in), OPTIONAL :: DomainU !< Unstructured domain
@@ -207,10 +219,6 @@ module fms_diag_axis_object_mod
if (present(direction)) this%direction = direction
call check_if_valid_direction(this%direction)
- this%edges = 0
- if (present(edges)) this%edges = edges
- call check_if_valid_edges(this%edges)
-
if (present(aux)) this%aux = trim(aux)
if (present(req)) this%req = trim(req)
@@ -220,7 +228,7 @@ module fms_diag_axis_object_mod
!> @brief Add an attribute to an axis
subroutine add_axis_attribute(this, att_name, att_value)
- class(diagAxis_t),INTENT(INOUT) :: this !< diag_axis obj
+ class(fmsDiagFullAxis_type),INTENT(INOUT) :: this !< diag_axis obj
character(len=*), intent(in) :: att_name !< Name of the attribute
class(*), intent(in) :: att_value(:) !< The attribute value to add
@@ -237,7 +245,7 @@ module fms_diag_axis_object_mod
!> @brief Write the axis meta data to an open fileobj
subroutine write_axis_metadata(this, fileobj, sub_axis_id)
- class(diagAxis_t), target, INTENT(IN) :: this !< diag_axis obj
+ class(fmsDiagFullAxis_type), target, INTENT(IN) :: this !< diag_axis obj
class(FmsNetcdfFile_t), INTENT(INOUT) :: fileobj !< Fms2_io fileobj to write the data to
integer, OPTIONAL, INTENT(IN) :: sub_axis_id !< ID of the sub_axis, if it exists
@@ -299,10 +307,9 @@ module fms_diag_axis_object_mod
call register_variable_attribute(fileobj, axis_name, "positive", "down", str_len=4)
end select
- if (this%edges > 0) then
- axis_edges_name = axis_obj(this%edges)%axis_name
- call register_variable_attribute(fileobj, axis_name, "edges", axis_edges_name, &
- str_len=len_trim(axis_edges_name))
+ if (allocated(this%edges_name)) then
+ call register_variable_attribute(fileobj, axis_name, "edges", this%edges_name, &
+ str_len=len_trim(this%edges_name))
endif
if(allocated(this%attributes)) then
@@ -316,7 +323,7 @@ module fms_diag_axis_object_mod
!> @brief Write the axis data to an open fileobj
subroutine write_axis_data(this, fileobj, sub_axis_id)
- class(diagAxis_t), INTENT(IN) :: this !< diag_axis obj
+ class(fmsDiagFullAxis_type),INTENT(IN):: this !< diag_axis obj
class(FmsNetcdfFile_t), INTENT(INOUT) :: fileobj !< Fms2_io fileobj to write the data to
integer, OPTIONAL, INTENT(IN) :: sub_axis_id !< ID of the sub_axis, if it exists
@@ -337,8 +344,8 @@ module fms_diag_axis_object_mod
!> @return axis length
function get_axis_length(this) &
result (axis_length)
- class(diagAxis_t), intent(inout) :: this !< diag_axis obj
- integer :: axis_length
+ class(fmsDiagFullAxis_type), intent(in) :: this !< diag_axis obj
+ integer :: axis_length
!< If the axis is domain decomposed axis_length will be set to the length for the current PE:
if (allocated(this%axis_domain)) then
@@ -349,12 +356,30 @@ module fms_diag_axis_object_mod
end function
+ !> @brief Get the name of the axis
+ !> @return axis name
+ pure function get_axis_name(this) &
+ result (axis_name)
+ class(fmsDiagFullAxis_type), intent(in) :: this !< diag_axis obj
+ CHARACTER(len=:), ALLOCATABLE :: axis_name
+
+ axis_name = this%axis_name
+ end function
+
+ !> @brief Set the name of the edges
+ subroutine set_edges_name(this, edges_name)
+ class(fmsDiagFullAxis_type), intent(inout) :: this !< diag_axis obj
+ CHARACTER(len=*), intent(in) :: edges_name !< Name of the edges
+
+ this%edges_name = edges_name
+ end subroutine
+
!> @brief Set the subaxis of the axis obj
!> @return A sub_axis id corresponding to the indices of the sub_axes in the sub_axes_objs array
function set_subaxis(this, bounds) &
result(sub_axes_id)
- class(diagAxis_t), INTENT(INOUT) :: this !< diag_axis obj
- class(*), INTENT(INOUT) :: bounds(:) !< bound of the subaxis
+ class(fmsDiagFullAxis_type), INTENT(INOUT) :: this !< diag_axis obj
+ class(*), INTENT(INOUT) :: bounds(:) !< bound of the subaxis
integer :: sub_axes_id
@@ -367,30 +392,27 @@ module fms_diag_axis_object_mod
!< TO DO: everything
this%nsubaxis = this%nsubaxis + 1
-
- nsubaxis_objs = nsubaxis_objs + 1
- sub_axes_id = nsubaxis_objs
- !< TO DO: set the parent_axis_id
+ sub_axes_id = -999
end function
!!!!!!!!!!!!!!!!!! SUB AXIS PROCEDURES !!!!!!!!!!!!!!!!!
!> @brief Check if a subaxis was already defined
!> @return Flag indicating if a subaxis is already defined
- function check_if_subaxis_exists(this, bounds) &
+ pure function check_if_subaxis_exists(this, bounds) &
result(exists)
- class(subaxis_t), INTENT(INOUT) :: this !< diag_axis obj
- class(*), INTENT(IN) :: bounds(:) !< bounds of the subaxis
- logical :: exists
+ class(fmsDiagSubAxis_type), INTENT(IN) :: this !< diag_axis obj
+ class(*), INTENT(IN) :: bounds(:) !< bounds of the subaxis
+ logical :: exists
!< TO DO: compare bounds
exists = .false.
- end function
+ end function check_if_subaxis_exists
!> @brief Get the length of a 2D domain
!> @return Length of the 2D domain
function get_length(this, cart_axis, domain_position, global_length) &
result (length)
- class(diagDomain_t), INTENT(INOUT) :: this !< diag_axis obj
+ class(diagDomain_t), INTENT(IN) :: this !< diag_axis obj
character(len=*), INTENT(IN) :: cart_axis !< cart_axis of the axis
integer, INTENT(IN) :: domain_position !< Domain position (CENTER, NORTH, EAST)
integer, INTENT(IN) :: global_length !< global_length of the axis
@@ -405,7 +427,7 @@ module fms_diag_axis_object_mod
!< If domain is 1D or UG, just set it to the global length
length = global_length
end select
- end function
+ end function get_length
!!!!!!!!!!!!!!!!! FMS_DOMAIN PROCEDURES !!!!!!!!!!!!!!!!!
@@ -426,70 +448,27 @@ module fms_diag_axis_object_mod
end select
end subroutine set_axis_domain
- subroutine fms_diag_axis_object_init()
-
- if (module_is_initialized) return
+ !< @brief Allocates the array of axis/subaxis objects
+ !! @return true if there the aray of axis/subaxis objects is allocated
+ logical function fms_diag_axis_object_init(axis_array)
+ class(fmsDiagAxisContainer_type) , allocatable, intent(inout) :: axis_array(:) !< Array of diag_axis
- number_of_axis = 0
- allocate(axis_obj(max_axes))
+ if (allocated(axis_array)) call mpp_error(FATAL, "The diag_axis containers is already allocated")
+ allocate(axis_array(max_axes))
+ !axis_array%axis_id = DIAG_NULL
- module_is_initialized = .true.
- end subroutine fms_diag_axis_object_init
+ fms_diag_axis_object_init = .true.
+ end function fms_diag_axis_object_init
- subroutine fms_diag_axis_object_end()
- deallocate(axis_obj)
+ !< @brief Deallocates the array of axis/subaxis objects
+ !! @return false if the aray of axis/subaxis objects was allocated
+ logical function fms_diag_axis_object_end(axis_array)
+ class(fmsDiagAxisContainer_type) , allocatable, intent(inout) :: axis_array(:) !< Array of diag_axis
- module_is_initialized = .false.
- end subroutine fms_diag_axis_object_end
+ if (allocated(axis_array)) deallocate(axis_array)
+ fms_diag_axis_object_end = .false.
- !> @brief Wrapper for the register_diag_axis subroutine. This is needed to keep the diag_axis_init
- !! interface the same
- !> @return Axis id
- FUNCTION fms_diag_axis_init(axis_name, axis_data, units, cart_name, long_name, direction,&
- & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position ) &
- & result(id)
-
- CHARACTER(len=*), INTENT(in) :: axis_name !< Name of the axis
- CLASS(*), INTENT(in) :: axis_data(:) !< Array of coordinate values
- CHARACTER(len=*), INTENT(in) :: units !< Units for the axis
- CHARACTER(len=1), INTENT(in) :: cart_name !< Cartesian axis ("X", "Y", "Z", "T", "U", "N")
- CHARACTER(len=*), INTENT(in), OPTIONAL :: long_name !< Long name for the axis.
- CHARACTER(len=*), INTENT(in), OPTIONAL :: set_name !< Name of the parent axis, if it is a subaxis
- INTEGER, INTENT(in), OPTIONAL :: direction !< Indicates the direction of the axis
- INTEGER, INTENT(in), OPTIONAL :: edges !< Axis ID for the previously defined "edges axis"
- TYPE(domain1d), INTENT(in), OPTIONAL :: Domain !< 1D domain
- TYPE(domain2d), INTENT(in), OPTIONAL :: Domain2 !< 2D domain
- TYPE(domainUG), INTENT(in), OPTIONAL :: DomainU !< Unstructured domain
- CHARACTER(len=*), INTENT(in), OPTIONAL :: aux !< Auxiliary name, can only be geolon_t
- !! or geolat_t
- CHARACTER(len=*), INTENT(in), OPTIONAL :: req !< Required field names.
- INTEGER, INTENT(in), OPTIONAL :: tile_count !< Number of tiles
- INTEGER, INTENT(in), OPTIONAL :: domain_position !< Domain position, "NORTH" or "EAST"
- integer :: id
-
- number_of_axis = number_of_axis + 1
-
- if (number_of_axis > max_axes) call mpp_error(FATAL, &
- &"diag_axis_init: max_axes exceeded, increase via diag_manager_nml")
-
- call axis_obj(number_of_axis)%register(axis_name, axis_data, units, cart_name, long_name=long_name, &
- & direction=direction, set_name=set_name, edges=edges, Domain=Domain, Domain2=Domain2, DomainU=DomainU, aux=aux, &
- & req=req, tile_count=tile_count, domain_position=domain_position)
-
- 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
+ end function fms_diag_axis_object_end
!> @brief Check if a cart_name is valid and crashes if it isn't
subroutine check_if_valid_cart_name(cart_name)
@@ -527,17 +506,9 @@ module fms_diag_axis_object_mod
end select
end subroutine check_if_valid_direction
- !> @brief Check if the edges id is valid and crashes if it isn't
- subroutine check_if_valid_edges(edges)
- integer, INTENT(IN) :: edges
-
- if (edges < 0 .or. edges > number_of_axis) &
- call mpp_error(FATAL, "diag_axit_init: The edge axis has not been defined. "&
- "Call diag_axis_init for the edge axis first")
- end subroutine check_if_valid_edges
-
!> @brief Loop through a variable's axis_id to determine and return the domain type and domain to use
- subroutine get_domain_and_domain_type(axis_id, domain_type, domain, var_name)
+ subroutine get_domain_and_domain_type(diag_axis, axis_id, domain_type, domain, var_name)
+ class(fmsDiagAxisContainer_type), target, intent(in) :: diag_axis(:) !< Array of diag_axis
integer, INTENT(IN) :: axis_id(:) !< Array of axis ids
integer, INTENT(OUT) :: domain_type !< fileobj_type to use
CLASS(diagDomain_t), POINTER, INTENT(OUT) :: domain !< Domain
@@ -551,36 +522,27 @@ module fms_diag_axis_object_mod
do i = 1, size(axis_id)
j = axis_id(i)
- !< Check that all the axis are in the same domain
- if (domain_type .ne. axis_obj(j)%type_of_domain) then
- !< If they are different domains, one of them can be NO_DOMAIN
- !! i.e a variable can have axis that are domain decomposed (x,y) and an axis that isn't (z)
- if (domain_type .eq. NO_DOMAIN .or. axis_obj(j)%type_of_domain .eq. NO_DOMAIN ) then
- !< Update the domain_type and domain, if needed
- if ((axis_obj(j)%type_of_domain .eq. TWO_D_DOMAIN .and. size(axis_id) > 2) &
- & .or. axis_obj(j)%type_of_domain .eq. UG_DOMAIN) then
- domain_type = axis_obj(j)%type_of_domain
- domain => axis_obj(j)%axis_domain
+ select type (axis => diag_axis(j)%axis)
+ type is (fmsDiagFullAxis_type)
+ !< Check that all the axis are in the same domain
+ if (domain_type .ne. axis%type_of_domain) then
+ !< If they are different domains, one of them can be NO_DOMAIN
+ !! i.e a variable can have axis that are domain decomposed (x,y) and an axis that isn't (z)
+ if (domain_type .eq. NO_DOMAIN .or. axis%type_of_domain .eq. NO_DOMAIN ) then
+ !< Update the domain_type and domain, if needed
+ if ((axis%type_of_domain .eq. TWO_D_DOMAIN .and. size(axis_id) > 2) &
+ & .or. axis%type_of_domain .eq. UG_DOMAIN) then
+ domain_type = axis%type_of_domain
+ domain => axis%axis_domain
+ endif
+ else
+ call mpp_error(FATAL, "The variable:"//trim(var_name)//" has axis that are not in the same domain")
endif
- else
- call mpp_error(FATAL, "The variable:"//trim(var_name)//" has axis that are not in the same domain")
endif
- endif
+ end select
enddo
end subroutine get_domain_and_domain_type
- !> @brief Gets the length of the axis based on the axis_id
- !> @return Axis_length
- function fms_get_axis_length(axis_id)&
- result(axis_length)
- INTEGER, INTENT(in) :: axis_id !< Axis ID of the axis to the length of
- integer :: axis_length
-
- if (axis_id < 0 .and. axis_id > number_of_axis) &
- call mpp_error(FATAL, "fms_get_axis_length: The axis_id is not valid")
-
- axis_length = axis_obj(axis_id)%axis_length()
- end function fms_get_axis_length
end module fms_diag_axis_object_mod
!> @}
! close documentation grouping
diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90
index c69b9caa..2504617f 100644
--- a/diag_manager/fms_diag_field_object.F90
+++ b/diag_manager/fms_diag_field_object.F90
@@ -13,12 +13,11 @@ use diag_data_mod, only: r8, r4, i8, i4, string, null_type_int, NO_DOMAIN
use diag_data_mod, only: max_field_attributes, fmsDiagAttribute_type
use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, &
&DIAG_FIELD_NOT_FOUND
-
-use diag_axis_mod, only: diag_axis_type
use mpp_mod, only: fatal, note, warning, mpp_error
use fms_diag_yaml_mod, only: diagYamlFilesVar_type, get_diag_fields_entries, get_diag_files_id, &
& find_diag_field, get_num_unique_fields
-use fms_diag_axis_object_mod, only: diagDomain_t, get_domain_and_domain_type
+use fms_diag_axis_object_mod, only: diagDomain_t, get_domain_and_domain_type, fmsDiagAxis_type, &
+ & fmsDiagAxisContainer_type
use time_manager_mod, ONLY: time_type
!!!set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),&
!!! & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, &
@@ -167,8 +166,7 @@ end function fms_diag_fields_object_init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> \Description Fills in and allocates (when necessary) the values in the diagnostic object
subroutine fms_register_diag_field_obj &
- !(dobj, modname, varname, axes, time, longname, units, missing_value, metadata)
- (this, modname, varname, diag_field_indices, axes, &
+ (this, modname, varname, diag_field_indices, diag_axis, axes, &
longname, units, missing_value, varRange, mask_variant, standname, &
do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static)
@@ -177,6 +175,7 @@ subroutine fms_register_diag_field_obj &
CHARACTER(len=*), INTENT(in) :: varname !< The variable name
integer, INTENT(in) :: diag_field_indices(:) !< Array of indices to the field
!! in the yaml object
+ class(fmsDiagAxisContainer_type),intent(in) :: diag_axis(:) !< Array of diag_axis
INTEGER, TARGET, OPTIONAL, INTENT(in) :: axes(:) !< The axes indicies
CHARACTER(len=*), OPTIONAL, INTENT(in) :: longname !< THe variables long name
CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< The units of the variables
@@ -197,9 +196,6 @@ subroutine fms_register_diag_field_obj &
!! modeling_realm attribute
LOGICAL, OPTIONAL, INTENT(in) :: static !< Set to true if it is a static field
- integer :: i !< For do loops
- integer :: j !< this%file_ids(i) (for less typing :)
-
!> Fill in information from the register call
this%varname = trim(varname)
this%modname = trim(modname)
@@ -210,7 +206,7 @@ subroutine fms_register_diag_field_obj &
!> Add axis and domain information
if (present(axes)) then
this%axis_ids = axes
- call get_domain_and_domain_type(this%axis_ids, this%type_of_domain, this%domain, this%varname)
+ call get_domain_and_domain_type(diag_axis, this%axis_ids, this%type_of_domain, this%domain, this%varname)
else
!> The variable is a scalar
this%type_of_domain = NO_DOMAIN
diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90
index e3b33c2e..4c1aeb9e 100644
--- a/diag_manager/fms_diag_file_object.F90
+++ b/diag_manager/fms_diag_file_object.F90
@@ -27,10 +27,11 @@ module fms_diag_file_object_mod
#ifdef use_yaml
use fms2_io_mod, only: FmsNetcdfFile_t, FmsNetcdfUnstructuredDomainFile_t, FmsNetcdfDomainFile_t
use diag_data_mod, only: DIAG_NULL, NO_DOMAIN, max_axes, SUB_REGIONAL, get_base_time, DIAG_NOT_REGISTERED
-use diag_util_mod, only: diag_time_inc
+!TODO cross dependency use diag_util_mod, only: diag_time_inc
use time_manager_mod, only: time_type, operator(/=), operator(==)
use fms_diag_yaml_mod, only: diag_yaml, diagYamlObject_type, diagYamlFiles_type
-use fms_diag_axis_object_mod, only: diagDomain_t, get_domain_and_domain_type
+use fms_diag_axis_object_mod, only: diagDomain_t, get_domain_and_domain_type, fmsDiagAxis_type, &
+ fmsDiagAxisContainer_type
use mpp_mod, only: mpp_error, FATAL
implicit none
private
@@ -176,8 +177,9 @@ logical function fms_diag_files_object_init (files_array)
!> Set the start_time of the file to the base_time and set up the *_output variables
obj%start_time = get_base_time()
obj%last_output = get_base_time()
- obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit())
- obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit())
+ !TODO cross dependency
+ !obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit())
+ !obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit())
obj%next_open = get_base_time()
nullify(obj)
@@ -487,10 +489,12 @@ pure function has_file_global_meta (this) result(res)
end function has_file_global_meta
!> @brief Sets the domain and type of domain from the axis IDs
-subroutine set_domain_from_axis(this, axes)
- class(fmsDiagFile_type), intent(inout) :: this !< The file object
+subroutine set_domain_from_axis(this, diag_axis, axes)
+ class(fmsDiagFile_type), intent(inout) :: this !< The file object
+ class(fmsDiagAxisContainer_type), intent(in) :: diag_axis(:) !< Array of diag_axis
integer, intent(in) :: axes (:)
- call get_domain_and_domain_type(axes, this%type_of_domain, this%domain, this%get_file_fname())
+
+ call get_domain_and_domain_type(diag_axis, axes, this%type_of_domain, this%domain, this%get_file_fname())
end subroutine set_domain_from_axis
!> @brief Set the domain and the type_of_domain for a file
@@ -574,8 +578,9 @@ subroutine add_start_time(this, start_time)
!! simply update it with the start_time and set up the *_output variables
this%start_time = start_time
this%last_output = start_time
- this%next_output = diag_time_inc(start_time, this%get_file_freq(), this%get_file_frequnit())
- this%next_next_output = diag_time_inc(this%next_output, this%get_file_freq(), this%get_file_frequnit())
+ !TODO circular dependency
+ !obj%next_output = diag_time_inc(start_time, obj%get_file_freq(), obj%get_file_frequnit())
+ !obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit())
endif
end subroutine
diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90
index fb05cbcc..0b5768b0 100644
--- a/diag_manager/fms_diag_object.F90
+++ b/diag_manager/fms_diag_object.F90
@@ -19,7 +19,7 @@
module fms_diag_object_mod
use mpp_mod, only: fatal, note, warning, mpp_error
use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, &
- &DIAG_FIELD_NOT_FOUND, diag_not_registered
+ &DIAG_FIELD_NOT_FOUND, diag_not_registered, max_axes, TWO_D_DOMAIN
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
@@ -27,8 +27,11 @@ use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_r
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_yaml_mod, only: diag_yaml_object_init, find_diag_field, get_diag_files_id
-use fms_diag_axis_object_mod, only: fms_diag_axis_object_init
+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
#endif
+use mpp_domains_mod, only: domain1d, domain2d, domainUG, null_domain2d
implicit none
private
@@ -39,7 +42,9 @@ private
!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
+ class(fmsDiagAxisContainer_type), allocatable :: diag_axis(:) !< Array of diag_axis
integer, private :: registered_variables !< Number of registered variables
+ integer, private :: registered_axis !< Number of registered axis
logical, private :: initialized=.false. !< True if the fmsDiagObject is initialized
logical, private :: files_initialized=.false. !< True if the fmsDiagObject is initialized
logical, private :: fields_initialized=.false. !< True if the fmsDiagObject is initialized
@@ -51,9 +56,14 @@ private
procedure :: fms_register_diag_field_scalar
procedure :: fms_register_diag_field_array
procedure :: fms_register_static_field
+ procedure :: fms_diag_axis_init
procedure :: register => fms_register_diag_field_obj !! Merely initialize fields.
procedure :: fms_diag_field_add_attribute
+ procedure :: fms_diag_axis_add_attribute
+ procedure :: fms_get_domain2d
+ procedure :: fms_get_axis_length
procedure :: fms_get_diag_field_id_from_name
+ procedure :: fms_get_axis_name_from_id
procedure :: diag_end => fms_diag_object_end
end type fmsDiagObject_type
@@ -76,10 +86,11 @@ subroutine fms_diag_object_init (this,diag_subset_output)
!TODO: allocate the file, field, and buffer containers
! allocate(diag_objs(get_num_unique_fields()))
CALL diag_yaml_object_init(diag_subset_output)
- CALL fms_diag_axis_object_init()
+ this%axes_initialized = fms_diag_axis_object_init(this%diag_axis)
this%files_initialized = fms_diag_files_object_init(this%FMS_diag_files)
this%fields_initialized = fms_diag_fields_object_init (this%FMS_diag_fields)
this%registered_variables = 0
+ this%registered_axis = 0
this%initialized = .true.
#else
call mpp_error("fms_diag_object_init",&
@@ -97,6 +108,7 @@ subroutine fms_diag_object_end (this)
!TODO: loop through files and force write
!TODO: Close all files
!TODO: Deallocate diag object arrays and clean up all memory
+ this%axes_initialized = fms_diag_axis_object_end(this%diag_axis)
this%initialized = .false.
#endif
end subroutine fms_diag_object_end
@@ -157,7 +169,7 @@ integer function fms_register_diag_field_obj &
!> Use pointers for convenience
fieldptr => this%FMS_diag_fields(this%registered_variables)
!> Register the data for the field
- call fieldptr%register(modname, varname, diag_field_indices, &
+ call fieldptr%register(modname, varname, diag_field_indices, fms_diag_object%diag_axis, &
axes, longname, units, missing_value, varRange, mask_variant, standname, &
do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static)
!> Get the file IDs from the field indicies from the yaml
@@ -167,7 +179,7 @@ integer function fms_register_diag_field_obj &
do i = 1, size(file_ids)
fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
call fileptr%add_field_id(fieldptr%get_id())
- call fileptr%set_domain_from_axis(axes)
+ call fileptr%set_domain_from_axis(fms_diag_object%diag_axis, axes)
call fileptr%add_axes(axes)
call fileptr%add_start_time(init_time)
enddo
@@ -175,7 +187,7 @@ integer function fms_register_diag_field_obj &
do i = 1, size(file_ids)
fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
call fileptr%add_field_id(fieldptr%get_id())
- call fileptr%set_domain_from_axis(axes)
+ call fileptr%set_domain_from_axis(fms_diag_object%diag_axis, axes)
call fileptr%add_axes(axes)
enddo
elseif (present(init_time)) then !only inti time present
@@ -193,6 +205,8 @@ integer function fms_register_diag_field_obj &
nullify (fileptr)
nullify (fieldptr)
deallocate(diag_field_indices)
+#else
+ fms_register_diag_field_obj = diag_null
#endif
end function fms_register_diag_field_obj
@@ -308,6 +322,65 @@ fms_register_static_field = diag_not_registered
#endif
end function fms_register_static_field
+!> @brief Wrapper for the register_diag_axis subroutine. This is needed to keep the diag_axis_init
+!! interface the same
+!> @return Axis id
+FUNCTION fms_diag_axis_init(this, axis_name, axis_data, units, cart_name, long_name, direction,&
+ & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position ) &
+ & result(id)
+
+ class(fmsDiagObject_type),TARGET,INTENT(inout):: this !< Diaj_obj to fill
+ CHARACTER(len=*), INTENT(in) :: axis_name !< Name of the axis
+ CLASS(*), INTENT(in) :: axis_data(:) !< Array of coordinate values
+ CHARACTER(len=*), INTENT(in) :: units !< Units for the axis
+ CHARACTER(len=1), INTENT(in) :: cart_name !< Cartesian axis ("X", "Y", "Z", "T", "U", "N")
+ CHARACTER(len=*), INTENT(in), OPTIONAL :: long_name !< Long name for the axis.
+ CHARACTER(len=*), INTENT(in), OPTIONAL :: set_name !< Name of the parent axis, if it is a subaxis
+ INTEGER, INTENT(in), OPTIONAL :: direction !< Indicates the direction of the axis
+ INTEGER, INTENT(in), OPTIONAL :: edges !< Axis ID for the previously defined "edges axis"
+ TYPE(domain1d), INTENT(in), OPTIONAL :: Domain !< 1D domain
+ TYPE(domain2d), INTENT(in), OPTIONAL :: Domain2 !< 2D domain
+ TYPE(domainUG), INTENT(in), OPTIONAL :: DomainU !< Unstructured domain
+ CHARACTER(len=*), INTENT(in), OPTIONAL :: aux !< Auxiliary name, can only be geolon_t
+ !! or geolat_t
+ CHARACTER(len=*), INTENT(in), OPTIONAL :: req !< Required field names.
+ INTEGER, INTENT(in), OPTIONAL :: tile_count !< Number of tiles
+ INTEGER, INTENT(in), OPTIONAL :: domain_position !< Domain position, "NORTH" or "EAST"
+ integer :: id
+
+#ifdef use_yaml
+ CHARACTER(len=:), ALLOCATABLE :: edges_name !< Name of the edges
+
+ this%registered_axis = this%registered_axis + 1
+
+ if (this%registered_axis > max_axes) call mpp_error(FATAL, &
+ &"diag_axis_init: max_axes exceeded, increase via diag_manager_nml")
+
+ allocate(fmsDiagFullAxis_type :: this%diag_axis(this%registered_axis)%axis)
+
+ select type (axis => this%diag_axis(this%registered_axis)%axis )
+ type is (fmsDiagFullAxis_type)
+ if(present(edges)) then
+ if (edges < 0 .or. edges > this%registered_axis) &
+ call mpp_error(FATAL, "diag_axit_init: The edge axis has not been defined. "&
+ "Call diag_axis_init for the edge axis first")
+ select type (edges_axis => this%diag_axis(edges)%axis)
+ type is (fmsDiagFullAxis_type)
+ edges_name = edges_axis%get_axis_name()
+ call axis%set_edges_name(edges_name)
+ end select
+ endif
+ call axis%register(axis_name, axis_data, units, cart_name, long_name=long_name, &
+ & direction=direction, set_name=set_name, Domain=Domain, Domain2=Domain2, DomainU=DomainU, aux=aux, &
+ & req=req, tile_count=tile_count, domain_position=domain_position)
+
+ id = this%registered_axis
+ end select
+#else
+ id = diag_null
+#endif
+end function fms_diag_axis_init
+
!> @brief Add a attribute to the diag_obj using the diag_field_id
subroutine fms_diag_field_add_attribute(this, diag_field_id, att_name, att_value)
class(fmsDiagObject_type), intent (inout) :: this !< The diag object
@@ -325,6 +398,24 @@ subroutine fms_diag_field_add_attribute(this, diag_field_id, att_name, att_value
#endif
end subroutine fms_diag_field_add_attribute
+!> @brief Add an attribute to an axis
+subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
+ class(fmsDiagObject_type), intent (inout) :: this !< The diag object
+ 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
+
+#ifdef use_yaml
+ if (axis_id < 0 .and. axis_id > this%registered_axis) &
+ call mpp_error(FATAL, "diag_axis_add_attribute: The axis_id is not valid")
+
+ select type (axis => this%diag_axis(axis_id)%axis)
+ type is (fmsDiagFullAxis_type)
+ call axis%add_axis_attribute(att_name, att_value)
+ end select
+#endif
+end subroutine fms_diag_axis_add_attribute
+
!> \brief Gets the diag field ID from the module name and field name.
!> \returns a copy of the ID of the diag field or DIAG_FIELD_NOT_FOUND if the field is not registered
PURE FUNCTION fms_get_diag_field_id_from_name(fms_diag_object, module_name, field_name) &
@@ -345,4 +436,68 @@ PURE FUNCTION fms_get_diag_field_id_from_name(fms_diag_object, module_name, fiel
enddo
#endif
END FUNCTION fms_get_diag_field_id_from_name
+
+!> @brief Return the 2D domain for the axis IDs given.
+!! @return 2D domain for the axis IDs given
+type(domain2d) FUNCTION fms_get_domain2d(this, ids)
+ class(fmsDiagObject_type), intent (in) :: this !< The diag object
+ INTEGER, DIMENSION(:), INTENT(in) :: ids !< Axis IDs.
+
+#ifdef use_yaml
+ INTEGER :: type_of_domain !< The type of domain
+ CLASS(diagDomain_t), POINTER :: domain !< Diag Domain pointer
+
+ call get_domain_and_domain_type(fms_diag_object%diag_axis, ids, type_of_domain, domain, "get_domain2d")
+ if (type_of_domain .ne. TWO_D_DOMAIN) &
+ call mpp_error(FATAL, 'diag_axis_mod::get_domain2d- The axis do not correspond to a 2d Domain')
+ select type(domain)
+ type is (diagDomain2d_t)
+ fms_get_domain2d = domain%domain2
+ end select
+#else
+ fms_get_domain2d = null_domain2d
+#endif
+END FUNCTION fms_get_domain2d
+
+ !> @brief Gets the length of the axis based on the axis_id
+ !> @return Axis_length
+ integer function fms_get_axis_length(this, axis_id)
+ class(fmsDiagObject_type), intent (in) :: this !< The diag object
+ INTEGER, INTENT(in) :: axis_id !< Axis ID of the axis to the length of
+
+fms_get_axis_length = 0
+
+#ifdef use_yaml
+ if (axis_id < 0 .and. axis_id > this%registered_axis) &
+ call mpp_error(FATAL, "fms_get_axis_length: The axis_id is not valid")
+
+ select type (axis => this%diag_axis(axis_id)%axis)
+ type is (fmsDiagFullAxis_type)
+ fms_get_axis_length = axis%axis_length()
+ end select
+#endif
+end function fms_get_axis_length
+
+!> @brief Gets the name of the axis based on the axis_id
+ !> @return The axis_name
+function fms_get_axis_name_from_id (this, axis_id) &
+result(axis_name)
+ class(fmsDiagObject_type), intent (in) :: this !< The diag object
+ INTEGER, INTENT(in) :: axis_id !< Axis ID of the axis to the length of
+
+ character (len=:), allocatable :: axis_name
+
+#ifdef use_yaml
+ if (axis_id < 0 .and. axis_id > this%registered_axis) &
+ call mpp_error(FATAL, "fms_get_axis_length: The axis_id is not valid")
+
+ select type (axis => this%diag_axis(axis_id)%axis)
+ type is (fmsDiagFullAxis_type)
+ axis_name = axis%get_axis_name()
+ end select
+#else
+ axis_name = ""
+#endif
+end function fms_get_axis_name_from_id
+
end module fms_diag_object_mod
--
2.11.4.GIT