Skip to content

Commit

Permalink
Merge pull request NOAA-GFDL#850 from thomas-robinson/dm-registerObj
Browse files Browse the repository at this point in the history 
Dm register obj
  • Loading branch information
@thomas-robinson
thomas-robinson authored Nov 2, 2021
2 parents 7b7541c + 70b7829 commit 7c9881b
Show file tree
Hide file tree
Showing 2 changed files with 112 additions and 65 deletions.
9 changes: 9 additions & 0 deletions diag_manager/diag_manager.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -226,6 +226,7 @@ MODULE diag_manager_mod
USE diag_table_mod, ONLY: parse_diag_table
USE diag_output_mod, ONLY: get_diag_global_att, set_diag_global_att
USE diag_grid_mod, ONLY: diag_grid_init, diag_grid_end
USE fms_diag_object_mod, ONLY: fms_diag_object, diag_object_placeholder
USE constants_mod, ONLY: SECONDS_PER_DAY

#ifdef use_netCDF
Expand Down Expand Up @@ -582,6 +583,14 @@ INTEGER FUNCTION register_diag_field_array(module_name, field_name, axes, init_t

END DO
END IF

if (use_modern_diag) then
call diag_object_placeholder(1)%register &
(module_name, field_name, axes, init_time, &
long_name, units, missing_value, Range, mask_variant, standard_name, &
do_not_log, err_msg, interp_method, tile_count, area, volume, realm) !(no metadata here)
endif

END FUNCTION register_diag_field_array

!> @brief Return field index for subsequent call to send_data.
Expand Down
168 changes: 103 additions & 65 deletions diag_manager/fms_diag_object.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,14 +14,22 @@ module fms_diag_object_mod
use fms_diag_yaml_mod, only: diag_fields_type, diag_files_type, get_diag_table_field
use diag_axis_mod, only: diag_axis_type
use mpp_mod, only: fatal, note, warning, mpp_error
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, &
!!! & get_ticks_per_second

!use diag_util_mod, only: int_to_cs, logical_to_cs
!USE diag_data_mod, ONLY: fileobjU, fileobj, fnum_for_domain, fileobjND

use fms2_io_mod
use platform_mod
use iso_c_binding

implicit none

integer, parameter :: range_dims = 2 !< The range of the variables will be set to 2 when allocated

interface operator (<)
procedure obj_lt_int
procedure int_lt_obj
Expand All @@ -38,10 +46,10 @@ module fms_diag_object_mod
procedure obj_ge_int
procedure int_ge_obj
end interface
interface operator (==)
procedure obj_eq_int
procedure int_eq_obj
end interface
!interface operator (==)
! procedure obj_eq_int
! procedure int_eq_obj
!end interface
interface operator (.ne.)
procedure obj_ne_int
procedure int_ne_obj
Expand All @@ -50,40 +58,62 @@ module fms_diag_object_mod

!> \brief Object that holds all variable information
type fms_diag_object
type (diag_fields_type) :: diag_field !< info from diag_table
type (diag_files_type),allocatable, dimension(:) :: diag_file !< info from diag_table
type (diag_fields_type) :: diag_field !< info from diag_table
type (diag_files_type),allocatable, dimension(:) :: diag_file !< info from diag_table
integer, allocatable, private :: diag_id !< unique id for varable
class(FmsNetcdfFile_t), dimension (:), pointer :: fileob => NULL() !< A pointer to all of the
!! file objects for this variable
character(len=:), allocatable, dimension(:) :: metadata !< metedata for the variable
logical, private :: static !< true is this is a static var
logical, allocatable, private :: registered !< true when registered
integer, allocatable, dimension(:), private :: frequency !< specifies the frequency

logical, private :: static !< true is this is a static var
logical, allocatable, private :: registered !< true when registered
logical, allocatable, private :: mask_variant !< If there is a mask variant
logical, allocatable, private :: local !< If the output is local
TYPE(time_type), private :: init_time !< The initial time
integer, allocatable, private :: vartype !< the type of varaible
character(len=:), allocatable, private :: varname !< the name of the variable
character(len=:), allocatable, private :: longname !< longname of the variable
character(len=:), allocatable, private :: standname !< standard name of the variable
character(len=:), allocatable, private :: units !< the units
character(len=:), allocatable, private :: modname !< the module
integer, private :: missing_value !< The missing fill value
character(len=:), allocatable, private :: realm !< String to set as the value
!! to the modeling_realm attribute
character(len=:), allocatable, private :: err_msg !< An error message
character(len=:), allocatable, private :: interp_method !< The interp method to be used
!! when regridding the field in post-processing.
!! Valid options are "conserve_order1",
!! "conserve_order2", and "none".
integer, allocatable, dimension(:), private :: frequency !< specifies the frequency
integer, allocatable, dimension(:), private :: output_units
integer, allocatable, private :: t
integer, allocatable, private :: tile_count !< The number of tiles
integer, allocatable, dimension(:), private :: axis_ids !< variable axis IDs
type (diag_axis_type), allocatable, dimension(:) :: axis !< The axis object
integer, allocatable, private :: area, volume !< The Area and Volume
real, private :: missing_value !< Holds a missing value if none given
integer(kind=I4_KIND), allocatable, private :: i4missing_value !< The missing i4 fill value
integer(kind=I8_KIND), allocatable, private :: i8missing_value !< The missing i8 fill value
real(kind=R4_KIND), allocatable, private :: r4missing_value !< The missing r4 fill value
real(kind=R8_KIND), allocatable, private :: r8missing_value !< The missing r8 fill value
integer(kind=I4_KIND), allocatable,dimension(:) :: i4data_RANGE !< The range of i4 data
integer(kind=I8_KIND), allocatable,dimension(:) :: i8data_RANGE !< The range of i8 data
real(kind=R4_KIND), allocatable,dimension(:) :: r4data_RANGE !< The range of r4 data
real(kind=R8_KIND), allocatable,dimension(:) :: r8data_RANGE !< The range of r8 data
type (diag_axis_type), allocatable, dimension(:) :: axis !< The axis object

contains
! procedure :: send_data => fms_send_data !!TODO
procedure :: init_ob => diag_obj_init
procedure :: diag_id_inq => fms_diag_id_inq
procedure :: copy => copy_diag_obj
procedure :: register_meta => fms_register_diag_field_obj
procedure :: setID => set_diag_id
procedure :: is_registered => diag_ob_registered
procedure :: set_type => set_vartype
procedure :: vartype_inq => what_is_vartype

procedure :: is_static => diag_obj_is_static
procedure :: is_registeredB => diag_obj_is_registered
procedure :: get_vartype => diag_obj_get_vartype
procedure :: get_varname => diag_obj_get_varname
procedure,public :: init_ob => diag_obj_init
procedure,public :: diag_id_inq => fms_diag_id_inq
procedure,public :: copy => copy_diag_obj
procedure,public :: register => fms_register_diag_field_obj
procedure,public :: setID => set_diag_id
procedure,public :: is_registered => diag_ob_registered
procedure,public :: set_type => set_vartype
procedure,public :: vartype_inq => what_is_vartype

procedure,public :: is_static => diag_obj_is_static
procedure,public :: is_registeredB => diag_obj_is_registered
procedure,public :: get_vartype => diag_obj_get_vartype
procedure,public :: get_varname => diag_obj_get_varname

end type fms_diag_object
!> \brief Extends the variable object to work with multiple types of data
Expand Down Expand Up @@ -116,11 +146,13 @@ module fms_diag_object_mod

integer,private :: MAX_LEN_VARNAME
integer,private :: MAX_LEN_META

type(fms_diag_object_3d) :: diag_object_placeholder (10)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
public :: fms_diag_object, fms_diag_object_scalar, fms_diag_object_1d
public :: fms_diag_object_2d, fms_diag_object_3d, fms_diag_object_4d, fms_diag_object_5d
public :: copy_diag_obj, fms_diag_id_inq
public :: operator (>),operator (<),operator (>=),operator (<=),operator (==),operator (.ne.)
public :: operator (>),operator (<),operator (>=),operator (<=),operator (.ne.)!operator (==),operator (.ne.)
public :: null_sc, null_1d, null_2d, null_3d, null_4d, null_5d
public :: fms_diag_object_init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Expand Down Expand Up @@ -154,18 +186,33 @@ subroutine diag_obj_init(ob)
end subroutine diag_obj_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)
subroutine fms_register_diag_field_obj &
!(dobj, modname, varname, axes, time, longname, units, missing_value, metadata)
(dobj, modname, varname, axes, init_time, &
longname, units, missing_value, varRange, mask_variant, standname, &
do_not_log, err_msg, interp_method, tile_count, area, volume, realm, metadata)
class(fms_diag_object) , intent(inout) :: dobj
character(*) , intent(in) :: modname!< The module name
character(*) , intent(in) :: varname!< The variable name
integer , dimension(:) , intent(in), optional :: axes !< Th character(:),allocatable :: rese axes
integer , intent(in), optional :: time !< Time placeholder
character(*) , intent(in), optional :: longname!< The variable long name
character(*) , intent(in), optional :: units !< Units of the variable
integer , intent(in), optional :: missing_value !< A missing value to be used
character(*), dimension(:) , intent(in), optional :: metadata
! class(*), pointer :: vptr

CHARACTER(len=*), INTENT(in) :: modname !< The module name
CHARACTER(len=*), INTENT(in) :: varname !< The variable name
INTEGER, INTENT(in) :: axes(:) !< The axes indicies
TYPE(time_type), INTENT(in) :: init_time !< Initial time
CHARACTER(len=*), OPTIONAL, INTENT(in) :: longname !< THe variables long name
CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< The units of the variables
CHARACTER(len=*), OPTIONAL, INTENT(in) :: standname !< The variables stanard name
class(*), OPTIONAL, INTENT(in) :: missing_value
class(*), OPTIONAL, INTENT(in) :: varRANGE(2)
LOGICAL, OPTIONAL, INTENT(in) :: mask_variant
LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field info is not logged
CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error message to be passed back up
CHARACTER(len=*), OPTIONAL, INTENT(in) :: interp_method !< The interp method to be used when
!! regridding the field in post-processing.
!! Valid options are "conserve_order1",
!! "conserve_order2", and "none".
INTEGER, OPTIONAL, INTENT(in) :: tile_count !< the number of tiles
INTEGER, OPTIONAL, INTENT(in) :: area !< diag_field_id containing the cell area field
INTEGER, OPTIONAL, INTENT(in) :: volume !< diag_field_id containing the cell volume field
CHARACTER(len=*), OPTIONAL, INTENT(in):: realm !< String to set as the value to the modeling_realm attribute
character(len=*), optional, intent(in), dimension(:) :: metadata !< metedata for the variable

!> Fill in information from the register call
allocate(character(len=MAX_LEN_VARNAME) :: dobj%varname)
Expand All @@ -184,6 +231,10 @@ subroutine fms_register_diag_field_obj (dobj, modname, varname, axes, time, long
allocate(character(len=len(longname)) :: dobj%longname)
dobj%longname = trim(longname)
endif
if (present(standname)) then
allocate(character(len=len(standname)) :: dobj%standname)
dobj%standname = trim(standname)
endif
if (present(units)) then
allocate(character(len=len(units)) :: dobj%units)
dobj%units = trim(units)
Expand All @@ -193,7 +244,20 @@ subroutine fms_register_diag_field_obj (dobj, modname, varname, axes, time, long
dobj%metadata = metadata
endif
if (present(missing_value)) then
dobj%missing_value = missing_value
select type (missing_value)
type is (integer(kind=i4_kind))
dobj%i4missing_value = missing_value
type is (integer(kind=i8_kind))
dobj%i8missing_value = missing_value
type is (real(kind=r4_kind))
dobj%r4missing_value = missing_value
type is (real(kind=r8_kind))
dobj%r8missing_value = missing_value
class default
call mpp_error("fms_register_diag_field_obj", &
"The missing value passed to register a diagnostic is not a r8, r4, i8, or i4",&
FATAL)
end select
else
dobj%missing_value = DIAG_NULL
endif
Expand Down Expand Up @@ -485,36 +549,10 @@ pure logical function int_le_obj (i,obj) result(ll)
ll = .true.
elseif (.not.allocated(obj) ) then
ll = .false.
else
else
ll = (i <= obj%diag_id)
endif
end function int_le_obj
!> \brief override for checking if object ID is equal to an integer (IDs)
!> @note unalloacted obj is assumed to equal diag_not_registered
pure logical function obj_eq_int (obj,i) result(ll)
class (fms_diag_object), intent(in), allocatable :: obj
integer, intent(in) :: i
if (.not.allocated(obj) .and. i == diag_not_registered) then
ll = .true.
elseif (.not.allocated(obj) ) then
ll = .false.
else
ll = (obj%diag_id == i)
endif
end function obj_eq_int
!> \brief override for checking if integer (ID) is equal to an object ID
!> @note unalloacted obj is assumed to equal diag_not_registered
pure logical function int_eq_obj (i,obj) result(ll)
class (fms_diag_object), intent(in), allocatable :: obj
integer, intent(in) :: i
if (.not.allocated(obj) .and. i == diag_not_registered) then
ll = .true.
elseif (.not.allocated(obj) ) then
ll = .false.
else
ll = (i == obj%diag_id)
endif
end function int_eq_obj

!> \brief override for checking if object ID is not equal to an integer (IDs)
!> @note unalloacted obj is assumed to equal diag_not_registered
Expand Down

0 comments on commit 7c9881b

Please sign in to comment.