FMS  2026.01.01-dev
Flexible Modeling System
fms_diag_object.F90
1 !***********************************************************************
2 !* Apache License 2.0
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* Licensed under the Apache License, Version 2.0 (the "License");
7 !* you may not use this file except in compliance with the License.
8 !* You may obtain a copy of the License at
9 !*
10 !* http://www.apache.org/licenses/LICENSE-2.0
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
14 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
15 !* PARTICULAR PURPOSE. See the License for the specific language
16 !* governing permissions and limitations under the License.
17 !***********************************************************************
18 module fms_diag_object_mod
19 use mpp_mod, only: fatal, note, warning, mpp_error, mpp_pe, mpp_root_pe, stdout
20 use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, &
21  &diag_field_not_found, diag_not_registered, max_axes, two_d_domain, &
22  &get_base_time, null_axis_id, get_var_type, diag_not_registered, &
23  &time_none, time_max, time_min, time_sum, time_average, time_diurnal, &
24  &time_power, time_rms, r8, no_domain, diag_init_time
25 
26  USE time_manager_mod, ONLY: set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),&
27  & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, &
28  & get_ticks_per_second, date_to_string
29 #ifdef use_yaml
30 use fms_diag_file_object_mod, only: fmsdiagfilecontainer_type, fmsdiagfile_type, fms_diag_files_object_init
31 use fms_diag_field_object_mod, only: fmsdiagfield_type, fms_diag_fields_object_init, get_default_missing_value, &
32  check_for_slices
33 use fms_diag_yaml_mod, only: diag_yaml_object_init, diag_yaml_object_end, find_diag_field, &
34  & get_diag_files_id, diag_yaml, get_diag_field_ids, diagyamlfilesvar_type, fms_diag_yaml_out
35 use fms_diag_axis_object_mod, only: fms_diag_axis_object_init, fmsdiagaxis_type, fmsdiagsubaxis_type, &
36  &diagdomain_t, get_domain_and_domain_type, diagdomain2d_t, &
37  &fmsdiagaxiscontainer_type, fms_diag_axis_object_end, fmsdiagfullaxis_type, &
38  &parse_compress_att, get_axis_id_from_name
39 use fms_diag_output_buffer_mod
40 use fms_mod, only: fms_error_handler
41 use fms_diag_reduction_methods_mod, only: check_indices_order, init_mask, set_weight
42 use constants_mod, only: seconds_per_day
43 #endif
44 USE fms_diag_bbox_mod, ONLY: fmsdiagibounds_type, determine_if_block_is_in_region
45 #if defined(_OPENMP)
46 use omp_lib
47 #endif
48 use mpp_domains_mod, only: domain1d, domain2d, domainug, null_domain2d
49 use fms_string_utils_mod, only: string
50 use platform_mod
51 implicit none
52 private
53 
54 type fmsdiagobject_type
55 !TODO add container arrays
56 #ifdef use_yaml
57 private
58 !TODO: Remove FMS prefix from variables in this type
59  class(fmsdiagfilecontainer_type), allocatable :: fms_diag_files (:) !< array of diag files
60  type(fmsdiagfield_type), allocatable :: fms_diag_fields(:) !< Array of diag fields
61  type(fmsdiagoutputbuffer_type), allocatable :: fms_diag_output_buffers(:) !< array of output buffer objects
62  !! one for each variable in the diag_table.yaml
63  logical, private :: data_was_send !< True if send_data has been successfully called for at least one variable
64  !< diag_send_complete does nothing if it is .false.
65  integer, private :: registered_buffers = 0 !< number of registered buffers, per dimension
66  class(fmsdiagaxiscontainer_type), allocatable :: diag_axis(:) !< Array of diag_axis
67  integer, private :: registered_variables !< Number of registered variables
68  integer, private :: registered_axis !< Number of registered axis
69  logical, private :: initialized=.false. !< True if the fmsDiagObject is initialized
70  logical, private :: files_initialized=.false. !< True if the fmsDiagObject is initialized
71  logical, private :: fields_initialized=.false. !< True if the fmsDiagObject is initialized
72  logical, private :: buffers_initialized=.false. !< True if the fmsDiagObject is initialized
73  logical, private :: axes_initialized=.false. !< True if the fmsDiagObject is initialized
74  type(time_type) :: model_end_time !< The time that the simulation is going to end
75  !! (set by calling diag_manager_set_time_end)
76 #endif
77  contains
78  procedure :: init => fms_diag_object_init
79  procedure :: diag_end => fms_diag_object_end
80  procedure :: fms_register_diag_field_scalar
81  procedure :: fms_register_diag_field_array
82  procedure :: fms_register_static_field
83  procedure :: fms_diag_axis_init
84  procedure :: register => fms_register_diag_field_obj !! Merely initialize fields.
85  procedure :: fms_diag_field_add_attribute
86  procedure :: fms_diag_axis_add_attribute
87  procedure :: fms_get_domain2d
88  procedure :: fms_get_axis_length
89  procedure :: fms_get_diag_field_id_from_name
90  procedure :: fms_get_field_name_from_id
91  procedure :: fms_get_axis_name_from_id
92  procedure :: fms_diag_accept_data
93  procedure :: fms_diag_send_complete
94  procedure :: do_buffer_math
95  procedure :: fms_diag_do_io
96  procedure :: fms_diag_do_reduction
97  procedure :: fms_diag_field_add_cell_measures
98  procedure :: allocate_diag_field_output_buffers
99  procedure :: fms_diag_compare_window
100  procedure :: set_time_end
101  procedure :: write_diag_manifest
102 #ifdef use_yaml
103  procedure :: get_diag_buffer
104 #endif
105 end type fmsdiagobject_type
106 
107 type (fmsdiagobject_type), target :: fms_diag_object
108 
109 public :: fms_register_diag_field_obj
110 public :: fms_register_diag_field_scalar
111 public :: fms_register_diag_field_array
112 public :: fms_register_static_field
113 public :: fms_diag_field_add_attribute
114 public :: fms_get_diag_field_id_from_name
115 public :: fms_diag_object
116 public :: fmsdiagobject_type
117 integer, private :: registered_variables !< Number of registered variables
118 public :: dump_diag_obj
119 
120 contains
121 
122 !> @brief Initiliazes the fms_diag_object.
123 !! Reads the diag_table.yaml and fills in the yaml object
124 !! Allocates the diag manager object arrays for files, fields, and buffers
125 !! Initializes variables
126 subroutine fms_diag_object_init (this,diag_subset_output, time_init)
127  class(fmsdiagobject_type) :: this !< Diag mediator/controller object
128  integer :: diag_subset_output !< Subset of the diag output?
129  INTEGER, DIMENSION(6), OPTIONAL, INTENT(IN) :: time_init !< Model time diag_manager initialized
130 
131 #ifdef use_yaml
132  if (this%initialized) return
133 
134 ! allocate(diag_objs(get_num_unique_fields()))
135  CALL diag_yaml_object_init(diag_subset_output)
136 
137  !! Doing this here, because the base_time is not set until the yaml is parsed
138  !! if time_init is present, it will be set in diag_manager_init
139  if (.not. present(time_init)) then
140  diag_init_time = get_base_time()
141  endif
142 
143  this%axes_initialized = fms_diag_axis_object_init(this%diag_axis)
144  this%files_initialized = fms_diag_files_object_init(this%FMS_diag_files)
145  this%fields_initialized = fms_diag_fields_object_init(this%FMS_diag_fields)
146  this%buffers_initialized =fms_diag_output_buffer_init(this%FMS_diag_output_buffers,SIZE(diag_yaml%get_diag_fields()))
147  this%registered_variables = 0
148  this%registered_axis = 0
149  this%data_was_send = .false.
150  this%initialized = .true.
151 #else
152  call mpp_error("fms_diag_object_init",&
153  "You must compile with -Duse_yaml to use the option use_modern_diag", fatal)
154 #endif
155 end subroutine fms_diag_object_init
156 
157 !> @brief Writes out the diag manifest file
158 subroutine write_diag_manifest(this)
159  class(fmsdiagobject_type) :: this !< Diag object
160 
161  integer, allocatable :: ntimes(:) !< Number of times written in each file
162  integer, allocatable :: ntiles(:) !< Number of tiles for each file domain
163  integer, allocatable :: ndistributedfiles(:) !< Number of distributed files
164 
165  integer :: i !< For looping through the files
166  integer :: nfiles !< Number of files in the diag object
167 
168 #ifdef use_yaml
169  nfiles = size(this%FMS_diag_files)
170  allocate(ntimes(nfiles))
171  allocate(ntiles(nfiles))
172  allocate(ndistributedfiles(nfiles))
173 
174  do i = 1, size(this%FMS_diag_files)
175  ntimes(i) = this%FMS_diag_files(i)%get_num_time_levels()
176  ntiles(i) = this%FMS_diag_files(i)%get_num_tiles()
177  ndistributedfiles(i) = this%FMS_diag_files(i)%get_ndistributedfiles()
178  enddo
179  call fms_diag_yaml_out(ntimes, ntiles, ndistributedfiles)
180 
181 #else
182  call mpp_error(fatal, "You must compile with -Duse_yaml to call fms_diag_object%write_diag_manifest!")
183 #endif
184 
185 end subroutine write_diag_manifest
186 
187 !> \description Loops through all files and does one final write.
188 !! Closes all files
189 !! Deallocates all buffers, fields, and files
190 !! Uninitializes the fms_diag_object
191 subroutine fms_diag_object_end (this, time)
192  class(fmsdiagobject_type) :: this
193  TYPE(time_type), INTENT(in) :: time
194 
195  integer :: i
196 #ifdef use_yaml
197  !TODO: loop through files and force write
198  if (.not. this%initialized) return
199 
200  call this%do_buffer_math()
201  call this%fms_diag_do_io(end_time=time)
202 
203  call this%write_diag_manifest()
204 
205  !TODO: Deallocate diag object arrays and clean up all memory
206  do i=1, size(this%FMS_diag_output_buffers)
207  call this%FMS_diag_output_buffers(i)%flush_buffer()
208  enddo
209  deallocate(this%FMS_diag_output_buffers)
210  this%axes_initialized = fms_diag_axis_object_end(this%diag_axis)
211  this%initialized = .false.
212  call diag_yaml_object_end
213 #else
214  call mpp_error(fatal, "You can not call fms_diag_object%end without yaml")
215 #endif
216 end subroutine fms_diag_object_end
217 
218 !> @brief Registers a field.
219 !! @description This to avoid having duplicate code in each of the _scalar, _array and _static register calls
220 !! @return field index to be used in subsequent calls to send_data or DIAG_FIELD_NOT_FOUND if the field is not
221 !! in the diag_table.yaml
222 integer function fms_register_diag_field_obj &
223  (this, modname, varname, axes, init_time, &
224  longname, units, missing_value, varrange, mask_variant, standname, &
225  do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static, &
226  multiple_send_data)
227 
228  class(fmsdiagobject_type),TARGET,INTENT(inout):: this !< Diaj_obj to fill
229  CHARACTER(len=*), INTENT(in) :: modname !< The module name
230  CHARACTER(len=*), INTENT(in) :: varname !< The variable name
231  TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Initial time
232  INTEGER, TARGET, OPTIONAL, INTENT(in) :: axes(:) !< The axes indicies
233  CHARACTER(len=*), OPTIONAL, INTENT(in) :: longname !< THe variables long name
234  CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< The units of the variables
235  CHARACTER(len=*), OPTIONAL, INTENT(in) :: standname !< The variables stanard name
236  class(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a attribute
237  class(*), OPTIONAL, INTENT(in) :: varrange(:) !< Range to add as a attribute (#1896)
238  LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< .True. if mask changes over time
239  LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field info is not logged
240  CHARACTER(len=*), OPTIONAL, INTENT(out) :: err_msg !< Error message to be passed back up
241  CHARACTER(len=*), OPTIONAL, INTENT(in) :: interp_method !< The interp method to be used when
242  !! regridding the field in post-processing.
243  !! Valid options are "conserve_order1",
244  !! "conserve_order2", and "none".
245  INTEGER, OPTIONAL, INTENT(in) :: tile_count !< the number of tiles
246  INTEGER, OPTIONAL, INTENT(in) :: area !< diag_field_id of the cell area field
247  INTEGER, OPTIONAL, INTENT(in) :: volume !< diag_field_id of the cell volume field
248  CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the value to the
249  !! modeling_realm attribute
250  LOGICAL, OPTIONAL, INTENT(in) :: static !< True if the variable is static
251  LOGICAL, OPTIONAL, INTENT(in) :: multiple_send_data !< .True. if send data is called, multiple
252  !! times for the same time
253 
254 #ifdef use_yaml
255 
256  class(fmsdiagfile_type), pointer :: fileptr !< Pointer to the diag_file
257  class(fmsdiagfield_type), pointer :: fieldptr !< Pointer to the diag_field
258  class(fmsdiagoutputbuffer_type), pointer :: bufferptr !< Pointer to the output buffer
259  class(diagyamlfilesvar_type), pointer :: yamlfptr !< Pointer to yaml object to get the reduction method
260  integer, allocatable :: file_ids(:) !< The file IDs for this variable
261  integer :: i !< For do loops
262  integer, allocatable :: diag_field_indices(:) !< indices where the field was found in the yaml
263  class(diagdomain_t), pointer :: null_diag_domain => null() !< Workaround for a Cray bug which will be fixed in CCE 19
264 #endif
265 #ifndef use_yaml
266 fms_register_diag_field_obj = diag_field_not_found
267 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
268 #else
269  diag_field_indices = find_diag_field(varname, modname)
270  if (diag_field_indices(1) .eq. diag_null) then
271  !< The field was not found in the table, so return DIAG_FIELD_NOT_FOUND
272  fms_register_diag_field_obj = diag_field_not_found
273  deallocate(diag_field_indices)
274  return
275  endif
276 
277  this%registered_variables = this%registered_variables + 1
278  fms_register_diag_field_obj = this%registered_variables
279 
280  call this%FMS_diag_fields(this%registered_variables)%&
281  &setid(this%registered_variables)
282 
283 !> Use pointers for convenience
284  fieldptr => this%FMS_diag_fields(this%registered_variables)
285 !> Get the file IDs from the field indicies from the yaml
286  file_ids = get_diag_files_id(diag_field_indices)
287  call fieldptr%set_file_ids(file_ids)
288 
289 !> Allocate and initialize member buffer_allocated of this field
290  fieldptr%buffer_allocated = .false.
291  fieldptr%buffer_ids = get_diag_field_ids(diag_field_indices)
292 
293 !> Register the data for the field
294  call fieldptr%register(modname, varname, diag_field_indices, this%diag_axis, &
295  axes=axes, longname=longname, units=units, missing_value=missing_value, varrange= varrange, &
296  mask_variant= mask_variant, standname=standname, do_not_log=do_not_log, err_msg=err_msg, &
297  interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
298  static=static, multiple_send_data=multiple_send_data)
299 
300 !> Add the axis information, initial time, and field IDs to the files
301  if (present(axes) .and. present(init_time)) then
302  do i = 1, size(file_ids)
303  fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
304  call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
305  call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
306  if(fieldptr%get_type_of_domain() .eq. no_domain) then
307  call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
308  else
309  call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
310  endif
311  call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
312  call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
313  fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
314  call fileptr%add_start_time(init_time)
315  call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
316  enddo
317  elseif (present(axes)) then !only axes present
318  do i = 1, size(file_ids)
319  fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
320  call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
321  call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
322  call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
323  if(fieldptr%get_type_of_domain() .eq. no_domain) then
324  call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
325  else
326  call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
327  endif
328  call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
329  fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
330  call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
331  enddo
332  elseif (present(init_time)) then !only inti time present
333  do i = 1, size(file_ids)
334  fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
335  call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
336  call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
337  call fileptr%add_start_time(init_time)
338  call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
339  enddo
340  else !no axis or init time present
341  do i = 1, size(file_ids)
342  fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
343  call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
344  call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
345  call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
346  enddo
347  endif
348 
349  !> Initialize buffer_ids of this field with the diag_field_indices(diag_field_indices)
350 !! of the sorted variable list
351  do i = 1, size(fieldptr%buffer_ids)
352  bufferptr => this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))
353  call bufferptr%set_field_id(this%registered_variables)
354  call bufferptr%set_yaml_id(fieldptr%buffer_ids(i))
355  ! check if diurnal reduction for this buffer and if so set the diurnal sample size
356  yamlfptr => diag_yaml%diag_fields(fieldptr%buffer_ids(i))
357  if( yamlfptr%get_var_reduction() .eq. time_diurnal) then
358  call bufferptr%set_diurnal_sample_size(yamlfptr%get_n_diurnal())
359  endif
360  call bufferptr%init_buffer_time(init_time)
361  call bufferptr%set_next_output(this%FMS_diag_files(file_ids(i))%get_next_output(), &
362  this%FMS_diag_files(file_ids(i))%get_next_next_output(), is_static=fieldptr%is_static())
363  enddo
364 
365  nullify (fileptr)
366  nullify (fieldptr)
367  deallocate(diag_field_indices)
368 #endif
369 end function fms_register_diag_field_obj
370 
371 !> @brief Registers a scalar field
372 !! @return field index to be used in subsequent calls to send_data or DIAG_FIELD_NOT_FOUND if the field is not
373 !! in the diag_table.yaml
374 INTEGER FUNCTION fms_register_diag_field_scalar(this,module_name, field_name, init_time, &
375  & long_name, units, missing_value, var_range, standard_name, do_not_log, err_msg,&
376  & area, volume, realm, multiple_send_data)
377  class(fmsdiagobject_type),TARGET,INTENT(inout):: this !< Diaj_obj to fill
378  CHARACTER(len=*), INTENT(in) :: module_name !< Module where the field comes from
379  CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field
380  TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Time to start writing data from
381  CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Long_name to add as a variable attribute
382  CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to add as a variable_attribute
383  CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard_name to name the variable in the file
384  CLASS(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a variable attribute
385  CLASS(*), OPTIONAL, INTENT(in) :: var_range(:) !< Range to add a variable attribute
386  LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< If TRUE, field information is not logged
387  CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error_msg from call
388  INTEGER, OPTIONAL, INTENT(in) :: area !< Id of the area field
389  INTEGER, OPTIONAL, INTENT(in) :: volume !< Id of the volume field
390  CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute
391  LOGICAL, OPTIONAL, INTENT(in) :: multiple_send_data !< .True. if send data is called, multiple times
392  !! for the same time
393 
394 #ifndef use_yaml
395 fms_register_diag_field_scalar=diag_field_not_found
396 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
397 #else
398  fms_register_diag_field_scalar = this%register(&
399  & module_name, field_name, init_time=init_time, &
400  & longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
401  & standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
402  & area=area, volume=volume, realm=realm, multiple_send_data=multiple_send_data)
403 #endif
404 end function fms_register_diag_field_scalar
405 
406 !> @brief Registers an array field
407 !! @return field index to be used in subsequent calls to send_data or DIAG_FIELD_NOT_FOUND if the field is not
408 !! in the diag_table.yaml
409 INTEGER FUNCTION fms_register_diag_field_array(this, module_name, field_name, axes, init_time, &
410  & long_name, units, missing_value, var_range, mask_variant, standard_name, verbose,&
411  & do_not_log, err_msg, interp_method, tile_count, area, volume, realm, &
412  & multiple_send_data)
413  class(fmsdiagobject_type),TARGET,INTENT(inout):: this !< Diaj_obj to fill
414  CHARACTER(len=*), INTENT(in) :: module_name !< Module where the field comes from
415  CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field
416  INTEGER, INTENT(in) :: axes(:) !< Ids corresponding to the variable axis
417  TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Time to start writing data from
418  CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Long_name to add as a variable attribute
419  CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to add as a variable_attribute
420  CLASS(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a variable attribute
421  CLASS(*), OPTIONAL, INTENT(in) :: var_range(:) !< Range to add a variable attribute
422  LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< .True. if mask changes over time
423  CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard_name to name the variable in the file
424  LOGICAL, OPTIONAL, INTENT(in) :: verbose !< Print more information
425  LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< If TRUE, field information is not logged
426  CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error_msg from call
427  CHARACTER(len=*), OPTIONAL, INTENT(in) :: interp_method !< The interp method to be used when
428  !! regridding the field in post-processing.
429  !! Valid options are "conserve_order1",
430  !! "conserve_order2", and "none".
431  INTEGER, OPTIONAL, INTENT(in) :: tile_count !< The current tile number
432  INTEGER, OPTIONAL, INTENT(in) :: area !< Id of the area field
433  INTEGER, OPTIONAL, INTENT(in) :: volume !< Id of the volume field
434  CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute
435  LOGICAL, OPTIONAL, INTENT(in) :: multiple_send_data !< .True. if send data is called, multiple times
436  !! for the same time
437 
438 
439 #ifndef use_yaml
440 fms_register_diag_field_array=diag_field_not_found
441 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
442 #else
443  fms_register_diag_field_array = this%register( &
444  & module_name, field_name, init_time=init_time, &
445  & axes=axes, longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
446  & mask_variant=mask_variant, standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
447  & interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
448  & multiple_send_data=multiple_send_data)
449 #endif
450 end function fms_register_diag_field_array
451 
452 !> @brief Return field index for subsequent call to send_data.
453 !! @return field index to be used in subsequent calls to send_data or DIAG_FIELD_NOT_FOUND if the field is not
454 !! in the diag_table.yaml
455 INTEGER FUNCTION fms_register_static_field(this, module_name, field_name, axes, long_name, units,&
456  & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,&
457  & tile_count, area, volume, realm)
458  class(fmsdiagobject_type),TARGET,INTENT(inout):: this !< Diaj_obj to fill
459  CHARACTER(len=*), INTENT(in) :: module_name !< Name of the module, the field is on
460  CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field
461  INTEGER, DIMENSION(:), INTENT(in) :: axes !< Axes_id of the field
462  CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Longname to be added as a attribute
463  CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to be added as a attribute
464  CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard name to be added as a attribute
465  CLASS(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to be added as a attribute
466  CLASS(*), OPTIONAL, INTENT(in) :: range(:) !< Range to be added as a attribute
467  LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< .True. if mask changes over time
468  LOGICAL, OPTIONAL, INTENT(in) :: dynamic !< Flag indicating if the field is dynamic
469  LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field information is not logged
470  CHARACTER(len=*), OPTIONAL, INTENT(in) :: interp_method !< The interp method to be used when
471  !! regridding the field in post-processing
472  !! Valid options are "conserve_order1",
473  !! "conserve_order2", and "none".
474  INTEGER, OPTIONAL, INTENT(in) :: tile_count !! Number of tiles
475  INTEGER, OPTIONAL, INTENT(in) :: area !< Field ID for the area field associated
476  !! with this field
477  INTEGER, OPTIONAL, INTENT(in) :: volume !< Field ID for the volume field associated
478  !! with this field
479  CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the value to the
480  !! modeling_realm attribute
481 
482 #ifndef use_yaml
483 fms_register_static_field=diag_field_not_found
484 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
485 #else
486  !TODO The register_static_field interface does not have the capabiliy to register a variable as a "scalar"
487  ! since the axes argument is required, this forced model code to pass in a null_axis_id as an argument
488  if (size(axes) .eq. 1 .and. axes(1) .eq. null_axis_id) then
489  ! If they are passing in the null_axis_ids, ignore the `axes` argument
490  fms_register_static_field = this%register( &
491  & module_name, field_name, &
492  & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
493  & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
494  & standname=standard_name, area=area, volume=volume, realm=realm, &
495  & static=.true.)
496  else
497  fms_register_static_field = this%register( &
498  & module_name, field_name, axes=axes, &
499  & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
500  & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
501  & standname=standard_name, area=area, volume=volume, realm=realm, &
502  & static=.true.)
503  endif
504 #endif
505 end function fms_register_static_field
506 
507 !> @brief Wrapper for the register_diag_axis subroutine. This is needed to keep the diag_axis_init
508 !! interface the same
509 !> @return Axis id
510 FUNCTION fms_diag_axis_init(this, axis_name, axis_data, units, cart_name, axis_length, long_name, direction,&
511  & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position ) &
512  & result(id)
513 
514  class(fmsdiagobject_type),TARGET,INTENT(inout):: this !< Diaj_obj to fill
515  CHARACTER(len=*), INTENT(in) :: axis_name !< Name of the axis
516  CLASS(*), INTENT(in) :: axis_data(:) !< Array of coordinate values
517  CHARACTER(len=*), INTENT(in) :: units !< Units for the axis
518  CHARACTER(len=1), INTENT(in) :: cart_name !< Cartesian axis ("X", "Y", "Z", "T", "U", "N")
519  integer, intent(in) :: axis_length !< The length of the axis size(axis_data(:))
520  CHARACTER(len=*), INTENT(in), OPTIONAL :: long_name !< Long name for the axis.
521  CHARACTER(len=*), INTENT(in), OPTIONAL :: set_name !< Name of the parent axis, if it is a subaxis
522  INTEGER, INTENT(in), OPTIONAL :: direction !< Indicates the direction of the axis
523  INTEGER, INTENT(in), OPTIONAL :: edges !< Axis ID for the previously defined "edges axis"
524  TYPE(domain1d), INTENT(in), OPTIONAL :: domain !< 1D domain
525  TYPE(domain2d), INTENT(in), OPTIONAL :: domain2 !< 2D domain
526  TYPE(domainug), INTENT(in), OPTIONAL :: domainu !< Unstructured domain
527  CHARACTER(len=*), INTENT(in), OPTIONAL :: aux !< Auxiliary name, can only be <TT>geolon_t</TT>
528  !! or <TT>geolat_t</TT>
529  CHARACTER(len=*), INTENT(in), OPTIONAL :: req !< Required field names.
530  INTEGER, INTENT(in), OPTIONAL :: tile_count !< Number of tiles
531  INTEGER, INTENT(in), OPTIONAL :: domain_position !< Domain position, "NORTH" or "EAST"
532  integer :: id
533 
534 #ifndef use_yaml
535 id = diag_null
536 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
537 #else
538  CHARACTER(len=:), ALLOCATABLE :: edges_name !< Name of the edges
539 
540  this%registered_axis = this%registered_axis + 1
541 
542  if (this%registered_axis > max_axes) call mpp_error(fatal, &
543  &"diag_axis_init: max_axes exceeded, increase via diag_manager_nml")
544 
545  allocate(fmsdiagfullaxis_type :: this%diag_axis(this%registered_axis)%axis)
546 
547  select type (axis => this%diag_axis(this%registered_axis)%axis )
548  type is (fmsdiagfullaxis_type)
549  if(present(edges)) then
550  if (edges < 0 .or. edges > this%registered_axis) &
551  call mpp_error(fatal, "diag_axit_init: The edge axis has not been defined. &
552  &Call diag_axis_init for the edge axis first")
553  select type (edges_axis => this%diag_axis(edges)%axis)
554  type is (fmsdiagfullaxis_type)
555  edges_name = edges_axis%get_axis_name()
556  call axis%set_edges(edges_name, edges)
557  end select
558  endif
559  call axis%register(axis_name, axis_data, units, cart_name, long_name=long_name, &
560  & direction=direction, set_name=set_name, domain=domain, domain2=domain2, domainu=domainu, aux=aux, &
561  & req=req, tile_count=tile_count, domain_position=domain_position, axis_length=axis_length)
562 
563  id = this%registered_axis
564  call axis%set_axis_id(id)
565  end select
566 #endif
567 end function fms_diag_axis_init
568 
569 !> Accepts data from the send_data functions. If this is in an openmp region with more than
570 !! one thread, the data is buffered in the field object and processed later. If only a single thread
571 !! is being used, then the processing can be done and stored in the buffer object. The hope is that
572 !! the increase in memory footprint related to buffering can be handled by the shared memory of the
573 !! multithreaded case.
574 !! \note If some of the diag manager is offloaded in the future, then it should be treated similarly
575 !! to the multi-threaded option for processing later
576 subroutine fms_diag_accept_data (this, diag_field_id, field_data, mask, rmask, &
577  time, is_in, js_in, ks_in, &
578  ie_in, je_in, ke_in, weight, err_msg)
579  class(fmsdiagobject_type),TARGET, INTENT(inout) :: this !< Diaj_obj to fill
580  INTEGER, INTENT(in) :: diag_field_id !< The ID of the diag field
581  CLASS(*), DIMENSION(:,:,:,:), INTENT(in) :: field_data !< The data for the diag_field
582  LOGICAL, allocatable, INTENT(in) :: mask(:,:,:,:) !< Logical mask indicating the grid
583  !! points to mask (null if no mask)
584  CLASS(*), allocatable, INTENT(in) :: rmask(:,:,:,:)!< real mask indicating the grid
585  !! points to mask (null if no mask)
586  CLASS(*), INTENT(in), OPTIONAL :: weight !< The weight used for averaging
587  TYPE (time_type), INTENT(in), OPTIONAL :: time !< The current time
588  INTEGER, INTENT(in), OPTIONAL :: is_in, js_in, ks_in !< Starting indices
589  INTEGER, INTENT(in), OPTIONAL :: ie_in, je_in, ke_in !< Ending indices
590  CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< An error message returned
591 
592  integer :: is, js, ks !< Starting indicies of the field_data
593  integer :: ie, je, ke !< Ending indicies of the field_data
594  integer :: omp_num_threads !< Number of openmp threads
595  integer :: omp_level !< The openmp active level
596  logical :: buffer_the_data !< True if the user selects to buffer the data and run
597  !! the calculationslater. \note This is experimental
598  character(len=128) :: error_string !< Store error text
599  logical :: data_buffer_is_allocated !< .true. if the data buffer is allocated
600  character(len=256) :: field_info !< String holding info about the field to append to the
601  !! error message
602  logical, allocatable, dimension(:,:,:,:) :: oor_mask !< Out of range mask
603  real(kind=r8_kind) :: field_weight !< Weight to use when averaging (it will be converted
604  !! based on the type of field_data when doing the math)
605  type(fmsdiagibounds_type) :: bounds !< Bounds (starting ending indices) for the field
606  logical :: has_halos !< .True. if field_data contains halos
607  logical :: using_blocking !< .True. if field_data is passed in blocks
608 #ifndef use_yaml
609 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
610 #else
611 
612  !TODO this%FMS_diag_fields(diag_field_id) should be a pointer!
613  field_info = " Check send data call for field:"//trim(this%FMS_diag_fields(diag_field_id)%get_varname())//&
614  " and module:"//trim(this%FMS_diag_fields(diag_field_id)%get_modname())
615 
616  !< Check if time should be present for this field
617  if (.not.this%FMS_diag_fields(diag_field_id)%is_static() .and. .not.present(time)) &
618  call mpp_error(fatal, "Time must be present if the field is not static. "//trim(field_info))
619 
620  !< Set the field_weight. If "weight" is not present it will be set to 1.0_r8_kind
621  field_weight = set_weight(weight)
622 
623  !< Check that the indices are present in the correct combination
624  error_string = check_indices_order(is_in, ie_in, js_in, je_in)
625  if (trim(error_string) .ne. "") call mpp_error(fatal, trim(error_string)//". "//trim(field_info))
626 
627  using_blocking = .false.
628  if ((present(is_in) .and. .not. present(ie_in)) .or. (present(js_in) .and. .not. present(je_in))) &
629  using_blocking = .true.
630 
631  has_halos = .false.
632  if ((present(is_in) .and. present(ie_in)) .or. (present(js_in) .and. present(je_in))) &
633  has_halos = .true.
634 
635  !< If the field has `mask_variant=.true.`, check that mask OR rmask are present
636  if (this%FMS_diag_fields(diag_field_id)%is_mask_variant()) then
637  if (.not. allocated(mask) .and. .not. allocated(rmask)) call mpp_error(fatal, &
638  "The field was registered with mask_variant, but mask or rmask are not present in the send_data call. "//&
639  trim(field_info))
640  endif
641 
642  !< Check that mask and rmask are not both present
643  if (allocated(mask) .and. allocated(rmask)) call mpp_error(fatal, &
644  "mask and rmask are both present in the send_data call. "//&
645  trim(field_info))
646 
647  !< Create the oor_mask based on the "mask" and "rmask" arguments
648  oor_mask = init_mask(rmask, mask, field_data)
649 
650  !> Does the user want to push off calculations until send_diag_complete?
651  buffer_the_data = .false.
652 
653  !> initialize the number of threads and level to be 0
654  omp_num_threads = 0
655  omp_level = 0
656 #if defined(_OPENMP)
657  omp_num_threads = omp_get_num_threads()
658  omp_level = omp_get_level()
659  buffer_the_data = (omp_num_threads > 1 .AND. omp_level > 0)
660 #endif
661 
662  !> Calculate the i,j,k start and end
663  ! If is, js, or ks not present default them to 1
664  is = 1
665  js = 1
666  ks = 1
667  IF ( PRESENT(is_in) ) is = is_in
668  IF ( PRESENT(js_in) ) js = js_in
669  IF ( PRESENT(ks_in) ) ks = ks_in
670  ie = is+SIZE(field_data, 1)-1
671  je = js+SIZE(field_data, 2)-1
672  ke = ks+SIZE(field_data, 3)-1
673  IF ( PRESENT(ie_in) ) ie = ie_in
674  IF ( PRESENT(je_in) ) je = je_in
675  IF ( PRESENT(ke_in) ) ke = ke_in
676 
677  if (.not. buffer_the_data .and. using_blocking) then
678  ! If running with only 1 thread and using blocking, check if the data was sent in blocks
679  ! if it is, then buffer the data
680  buffer_the_data = check_for_slices(this%FMS_diag_fields(diag_field_id), this%diag_axis, &
681  shape(field_data))
682  endif
683 
684  !< If send data is called multiple times, buffer the data
685  !! This is so that the other reduction methods work and just averaging
686  if (this%FMS_diag_fields(diag_field_id)%get_multiple_send_data()) &
687  buffer_the_data = .true.
688 
689  !If this is true, buffer data
690  main_if: if (buffer_the_data) then
691 !> Only 1 thread allocates the output buffer and sets set_math_needs_to_be_done
692 !$omp critical
693  !< Let diag_send_complete that there is new data to procress
694  if (.not. this%data_was_send) this%data_was_send = .true.
695 
696  !< These set_* calls need to be done inside an omp_critical to avoid any race conditions
697  !! and allocation issues
698  if(has_halos) call this%FMS_diag_fields(diag_field_id)%set_halo_present()
699 
700  !< Set the variable type based off passed in field data
701  if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
702  call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
703 
704  if (allocated(mask) .or. allocated(rmask)) then
705  call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
706  else
707  call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
708  endif
709 
710  if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated()) then
711  data_buffer_is_allocated = &
712  this%FMS_diag_fields(diag_field_id)%allocate_data_buffer(field_data, this%diag_axis)
713  if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
714  call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
715  endif
716  call this%FMS_diag_fields(diag_field_id)%set_send_data_time(time)
717  call this%FMS_diag_fields(diag_field_id)%set_data_buffer_is_allocated(.true.)
718  call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.true.)
719 !$omp end critical
720  call this%FMS_diag_fields(diag_field_id)%set_data_buffer(field_data, oor_mask, field_weight, &
721  is, js, ks, ie, je, ke)
722  else
723 
724  !< Let diag_send_complete that there is new data to procress
725  if (.not. this%data_was_send) this%data_was_send = .true.
726 
727  !< At this point if we are no longer in an openmp region or running with 1 thread
728  !! so it is safe to have these set_* calls
729  if(has_halos) call this%FMS_diag_fields(diag_field_id)%set_halo_present()
730 
731  !< Set the variable type based off passed in field data
732  if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
733  call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
734 
735  if (allocated(mask) .or. allocated(rmask)) then
736  call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
737  else
738  call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
739  endif
740 
741  error_string = bounds%set_bounds(field_data, is, ie, js, je, ks, ke, has_halos)
742  if (trim(error_string) .ne. "") call mpp_error(fatal, trim(error_string)//". "//trim(field_info))
743 
744  call this%allocate_diag_field_output_buffers(field_data, diag_field_id)
745  error_string = this%fms_diag_do_reduction(field_data, diag_field_id, oor_mask, field_weight, &
746  bounds, using_blocking, time=time)
747  if (trim(error_string) .ne. "") call mpp_error(fatal, trim(error_string)//". "//trim(field_info))
748  call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.false.)
749  if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
750  call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
751  call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask, field_info)
752  end if main_if
753  !> Return false if nothing is done
754 #endif
755 end subroutine fms_diag_accept_data
756 
757 !< @brief Do the math for all the buffers
758 subroutine do_buffer_math(this)
759  class(fmsdiagobject_type), target, intent (inout) :: this !< The diag object
760 
761 #ifdef use_yaml
762  integer :: i !< For do loops
763  integer :: ifile !< For file loops
764  integer :: ifield !< For field loops
765 
766  class(fmsdiagfilecontainer_type), pointer :: diag_file !< Pointer to this%FMS_diag_files(i) (for convenience
767  class(fmsdiagfield_type), pointer :: diag_field !< Pointer to this%FMS_diag_files(i)%diag_field(j)
768  logical :: math !< True if the math functions need to be called using the data buffer,
769  !! False if the math functions were done in accept_data
770  integer, dimension(:), allocatable :: file_field_ids !< Array of field IDs for a file
771  class(*), pointer :: input_data_buffer(:,:,:,:)
772  character(len=128) :: error_string
773  type(fmsdiagibounds_type) :: bounds
774  integer, dimension(:), allocatable :: file_ids !< Array of file IDs for a field
775  logical, parameter :: debug_sc = .false. !< turn on output for debugging
776 
777  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
778  !! In the future, this may be parallelized for offloading
779  ! loop through each field
780  field_loop: do ifield = 1, size(this%FMS_diag_fields)
781  diag_field => this%FMS_diag_fields(ifield)
782  if(.not. diag_field%is_registered()) cycle
783  if(debug_sc) call mpp_error(note, "fms_diag_send_complete:: var: "//diag_field%get_varname())
784  ! get files the field is in
785  allocate (file_ids(size(diag_field%get_file_ids() )))
786  file_ids = diag_field%get_file_ids()
787  math = diag_field%get_math_needs_to_be_done()
788  ! if doing math loop through each file for given field
789  doing_math: if (size(file_ids) .ge. 1 .and. math) then
790  ! Check if buffer alloc'd
791  has_input_buff: if (diag_field%has_input_data_buffer()) then
792  call diag_field%prepare_data_buffer()
793  input_data_buffer => diag_field%get_data_buffer()
794  ! reset bounds, allocate output buffer, and update it with reduction
795  call bounds%reset_bounds_from_array_4D(input_data_buffer)
796  call this%allocate_diag_field_output_buffers(input_data_buffer, ifield)
797  error_string = this%fms_diag_do_reduction(input_data_buffer, ifield, &
798  diag_field%get_mask(), diag_field%get_weight(), &
799  bounds, .false., time=diag_field%get_send_data_time())
800  call diag_field%init_data_buffer()
801  if (trim(error_string) .ne. "") call mpp_error(fatal, "Field:"//trim(diag_field%get_varname()//&
802  " -"//trim(error_string)))
803  else
804  call mpp_error(fatal, "diag_send_complete:: no input buffer allocated for field"//diag_field%get_longname())
805  endif has_input_buff
806  endif doing_math
807  call diag_field%set_math_needs_to_be_done(.false.)
808  !> Clean up, clean up, everybody do your share
809  if (allocated(file_ids)) deallocate(file_ids)
810  if (associated(diag_field)) nullify(diag_field)
811  enddo field_loop
812 #endif
813 end subroutine do_buffer_math
814 
815 !> @brief Loops through all the files, open the file, writes out axis and
816 !! variable metadata and data when necessary.
817 subroutine fms_diag_send_complete(this, time_step)
818  class(fmsdiagobject_type), target, intent (inout) :: this !< The diag object
819  TYPE (time_type), INTENT(in) :: time_step !< The time_step
820 
821 #ifndef use_yaml
822 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
823 #else
824  !< Go away if there is no new data
825  if (.not. this%data_was_send) return
826 
827  call this%do_buffer_math()
828  call this%fms_diag_do_io()
829 
830  this%data_was_send = .false.
831 #endif
832 
833 end subroutine fms_diag_send_complete
834 
835 !> @brief Loops through all the files, open the file, writes out axis and
836 !! variable metadata and data when necessary.
837 !! TODO: passing in the saved mask from the field obj to diag_reduction_done_wrapper
838 !! for performance
839 subroutine fms_diag_do_io(this, end_time)
840  class(fmsdiagobject_type), target, intent(inout) :: this !< The diag object
841  type(time_type), optional, target, intent(in) :: end_time !< the model end_time
842 #ifdef use_yaml
843  integer :: i !< For do loops
844  class(fmsdiagfilecontainer_type), pointer :: diag_file !< Pointer to this%FMS_diag_files(i) (for convenience)
845  class(fmsdiagoutputbuffer_type), pointer :: diag_buff !< pointer to output buffers iterated in buff_loop
846  class(fmsdiagfield_type), pointer :: diag_field !< pointer to output buffers iterated in buff_loop
847  class(diagyamlfilesvar_type), pointer :: field_yaml !< Pointer to a field from yaml fields
848  TYPE (time_type), pointer :: model_time!< The current model time
849  integer, allocatable :: buff_ids(:) !< ids for output buffers to loop through
850  integer :: ibuff !< buffer index
851  logical :: file_is_opened_this_time_step !< True if the file was opened in this time_step
852  !! If true the metadata will need to be written
853  logical :: force_write !< force the last write if at end of run
854  logical :: finish_writing !< true if finished writing for all the fields
855  logical :: has_mask !< whether we have a mask
856  logical, parameter :: debug_reduct = .false. !< enables debugging output
857  class(*), allocatable :: missing_val !< netcdf missing value for a given field
858  real(r8_kind) :: mval !< r8 copy of missing value
859  character(len=128) :: error_string !< outputted error string from reducti
860  logical :: unlim_dim_was_increased !< .True. if the unlimited dimension index was increased for any of the buffers
861  logical :: do_not_write !< .True. only if this is not a new time step and you are writing at every time step
862 
863  force_write = .false.
864 
865  do i = 1, size(this%FMS_diag_files)
866  diag_file => this%FMS_diag_files(i)
867 
868  !< Go away if the file is a subregional file and the current PE does not have any data for it
869  if (.not. diag_file%writing_on_this_pe()) cycle
870 
871  if (present (end_time)) then
872  force_write = .true.
873  model_time => end_time
874  else
875  model_time => diag_file%get_model_time()
876  endif
877  if (diag_file%FMS_diag_file%is_done_writing_data()) cycle
878 
879  call diag_file%open_diag_file(model_time, file_is_opened_this_time_step)
880  if (file_is_opened_this_time_step) then
881  ! Initialize unlimited dimension in file and the buffer to 0
882  call diag_file%init_unlim_dim(this%FMS_diag_output_buffers)
883 
884  call diag_file%write_global_metadata()
885  call diag_file%write_axis_metadata(this%diag_axis)
886  call diag_file%write_time_metadata()
887  call diag_file%write_field_metadata(this%FMS_diag_fields, this%diag_axis)
888  call diag_file%write_axis_data(this%diag_axis)
889  endif
890 
891  call diag_file%check_file_times(model_time, this%FMS_diag_output_buffers, &
892  this%FMS_diag_fields, do_not_write)
893  unlim_dim_was_increased = .false.
894 
895  ! finish reduction method if its time to write
896  buff_ids = diag_file%FMS_diag_file%get_buffer_ids()
897  ! loop through the buffers and finish reduction if needed
898  buff_loop: do ibuff=1, SIZE(buff_ids)
899  diag_buff => this%FMS_diag_output_buffers(buff_ids(ibuff))
900  field_yaml => diag_yaml%diag_fields(diag_buff%get_yaml_id())
901  diag_field => this%FMS_diag_fields(diag_buff%get_field_id())
902 
903  ! Go away if there is no data to write
904  if (.not. diag_buff%is_there_data_to_write()) cycle
905  if (diag_field%is_static() .and. diag_buff%get_unlim_dim() > 0) cycle
906 
907  if ( diag_buff%is_time_to_finish_reduction(end_time) .and. .not. do_not_write) then
908  ! sets missing value
909  mval = diag_field%find_missing_value(missing_val)
910  ! time_average and greater values all involve averaging so need to be "finished" before written
911  if( field_yaml%has_var_reduction()) then
912  if( field_yaml%get_var_reduction() .ge. time_average) then
913  if(debug_reduct)call mpp_error(note, "fms_diag_do_io:: finishing reduction for "//diag_field%get_longname())
914  error_string = diag_buff%diag_reduction_done_wrapper( &
915  field_yaml%get_var_reduction(), &
916  mval, diag_field%get_var_is_masked(), diag_field%get_mask_variant())
917  endif
918  endif
919  call diag_file%write_field_data(diag_field, diag_buff, unlim_dim_was_increased)
920  call diag_buff%set_next_output(diag_file%get_next_output(), diag_file%get_next_next_output())
921  endif
922  nullify(diag_buff)
923  nullify(field_yaml)
924  enddo buff_loop
925  deallocate(buff_ids)
926 
927  if (unlim_dim_was_increased) then
928  call diag_file%write_time_data()
929  call diag_file%flush_diag_file()
930  call diag_file%update_next_write(model_time)
931  call diag_file%update_current_new_file_freq_index(model_time)
932  if (diag_file%is_time_to_close_file(model_time, force_write)) &
933  call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
934  this%model_end_time, diag_fields = this%FMS_diag_fields)
935  else if (force_write) then
936  call diag_file%prepare_for_force_write()
937  call diag_file%write_time_data()
938  call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
939  this%model_end_time, diag_fields = this%FMS_diag_fields)
940  endif
941  enddo
942 #endif
943 end subroutine fms_diag_do_io
944 
945 !> @brief Computes average, min, max, rms error, etc.
946 !! based on the specified reduction method for the field.
947 !> @return Empty string if successful, error message if it fails
948 function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, &
949  bounds, using_blocking, time) &
950  result(error_msg)
951  class(fmsdiagobject_type), intent(inout), target:: this !< Diag Object
952  class(*), intent(in) :: field_data(:,:,:,:) !< Field data
953  integer, intent(in) :: diag_field_id !< ID of the input field
954  logical, intent(in), target :: oor_mask(:,:,:,:) !< mask
955  real(kind=r8_kind), intent(in) :: weight !< Must be a updated weight
956  type(fmsdiagibounds_type), intent(in) :: bounds !< Bounds for the field
957  logical, intent(in) :: using_blocking !< .True. if field data is passed
958  !! in blocks
959  type(time_type), intent(in), optional :: time !< Current time
960 
961  character(len=150) :: error_msg !< Error message to check
962  !TODO Mostly everything
963 #ifdef use_yaml
964  type(fmsdiagfield_type), pointer :: field_ptr !< Pointer to the field's object
965  type(fmsdiagoutputbuffer_type), pointer :: buffer_ptr !< Pointer to the field's buffer
966  class(fmsdiagfilecontainer_type), pointer :: file_ptr !< Pointer to the field's file
967  type(diagyamlfilesvar_type), pointer :: field_yaml_ptr !< Pointer to the field's yaml
968 
969  integer :: reduction_method !< Integer representing a reduction method
970  integer :: ids !< For looping through buffer ids
971  integer :: buffer_id !< Id of the buffer
972  integer :: file_id !< File id
973  integer, pointer :: axis_ids(:) !< Axis ids for the buffer
974  logical :: is_subregional !< .True. if the buffer is subregional
975  logical :: reduced_k_range !< .True. is the field is only outputing a section
976  !! of the z dimension
977  type(fmsdiagibounds_type) :: bounds_in !< Starting and ending indices of the input field_data
978  type(fmsdiagibounds_type) :: bounds_out !< Starting and ending indices of the output buffer
979  integer :: i !< For looping through axid ids
980  integer :: sindex !< Starting index of a subregion
981  integer :: eindex !< Ending index of a subregion
982  integer :: compute_idx(2) !< Starting and Ending of the compute domain
983  character(len=1) :: cart_axis !< Cartesian axis of the axis
984  logical :: block_in_subregion !< .True. if the current block is part of the subregion
985  integer :: starting !< Starting index of the subregion relative to the compute domain
986  integer :: ending !< Ending index of the subregion relative to the compute domain
987  real(kind=r8_kind) :: missing_value !< Missing_value for data points that are masked
988  !! This will obtained as r8 and converted to the right type as
989  !! needed. This is to avoid yet another select type ...
990 
991  !TODO mostly everything
992  field_ptr => this%FMS_diag_fields(diag_field_id)
993  if (field_ptr%has_missing_value()) then
994  select type (missing_val => field_ptr%get_missing_value(r8))
995  type is (real(kind=r8_kind))
996  missing_value = missing_val
997  class default
998  call mpp_error(fatal, "The missing value for the field:"//trim(field_ptr%get_varname())//&
999  &" was not allocated to the correct type. This shouldn't have happened")
1000  end select
1001  else
1002  select type (missing_val => get_default_missing_value(r8))
1003  type is (real(kind=r8_kind))
1004  missing_value = missing_val
1005  class default
1006  call mpp_error(fatal, "The missing value for the field:"//trim(field_ptr%get_varname())//&
1007  &" was not allocated to the correct type. This shouldn't have happened")
1008  end select
1009  endif
1010 
1011  buffer_loop: do ids = 1, size(field_ptr%buffer_ids)
1012  error_msg = ""
1013  buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids)
1014  file_id = this%FMS_diag_fields(diag_field_id)%file_ids(ids)
1015 
1016  !< Gather all the objects needed for the buffer
1017  field_yaml_ptr => field_ptr%diag_field(ids)
1018  buffer_ptr => this%FMS_diag_output_buffers(buffer_id)
1019  file_ptr => this%FMS_diag_files(file_id)
1020 
1021  !< Go away if the file is a subregional file and the current PE does not have any data for it
1022  if (.not. file_ptr%writing_on_this_pe()) cycle
1023 
1024  !< Go away if finished doing math for this buffer
1025  if (buffer_ptr%is_done_with_math()) cycle
1026 
1027  if (present(time)) call file_ptr%set_model_time(time)
1028  if (.not. file_ptr%time_to_start_doing_math()) cycle
1029 
1030  bounds_out = bounds
1031  if (.not. using_blocking) then
1032  !< Set output bounds to start at 1:size(buffer_ptr%buffer)
1033  call bounds_out%reset_bounds_from_array_4D(buffer_ptr%buffer(:,:,:,:,1))
1034  endif
1035 
1036  bounds_in = bounds
1037  if (.not. bounds%has_halos) then
1038  !< If field_data does not contain halos, set bounds_in to start at 1:size(field_data)
1039  call bounds_in%reset_bounds_from_array_4D(field_data)
1040  endif
1041 
1042  is_subregional = file_ptr%is_regional()
1043  reduced_k_range = field_yaml_ptr%has_var_zbounds()
1044 
1045  !< Reset the bounds based on the reduced k range and subregional
1046  is_subregional_reduced_k_range: if (is_subregional .or. reduced_k_range) then
1047  call buffer_ptr%get_axis_ids(axis_ids)
1048  block_in_subregion = .true.
1049  axis_loops: do i = 1, size(axis_ids)
1050  !< Move on if the block does not have any data for the subregion
1051  if (.not. block_in_subregion) cycle
1052 
1053  select type (diag_axis => this%diag_axis(axis_ids(i))%axis)
1054  type is (fmsdiagsubaxis_type)
1055  sindex = diag_axis%get_starting_index()
1056  eindex = diag_axis%get_ending_index()
1057  compute_idx = diag_axis%get_compute_indices()
1058  starting=sindex-compute_idx(1)+1
1059  ending=eindex-compute_idx(1)+1
1060  if (using_blocking) then
1061  block_in_subregion = determine_if_block_is_in_region(starting, ending, bounds, i)
1062  if (.not. block_in_subregion) cycle
1063 
1064  !< Set bounds_in so that you can the correct section of the data for the block (starting at 1)
1065  call bounds_in%rebase_input(bounds, starting, ending, i)
1066 
1067  !< Set bounds_out to be the correct section relative to the block starting and ending indices
1068  call bounds_out%rebase_output(starting, ending, i)
1069  else
1070  !< Set bounds_in so that only the subregion section of the data will be used (starting at 1)
1071  call bounds_in%update_index(starting, ending, i, .false.)
1072 
1073  !< Set bounds_out to 1:size(subregion) for the PE
1074  call bounds_out%update_index(1, ending-starting+1, i, .true.)
1075  endif
1076  end select
1077  enddo axis_loops
1078  nullify(axis_ids)
1079  !< Move on to the next buffer if the block does not have any data for the subregion
1080  if (.not. block_in_subregion) cycle
1081  endif is_subregional_reduced_k_range
1082 
1083  !< Determine the reduction method for the buffer
1084  reduction_method = field_yaml_ptr%get_var_reduction()
1085  if (present(time)) call buffer_ptr%update_buffer_time(time)
1086  call buffer_ptr%set_send_data_called()
1087  select case(reduction_method)
1088  case (time_none)
1089  error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1090  bounds_in, bounds_out, missing_value)
1091  if (trim(error_msg) .ne. "") then
1092  return
1093  endif
1094  case (time_min)
1095  error_msg = buffer_ptr%do_time_min_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1096  bounds_in, bounds_out, missing_value)
1097  if (trim(error_msg) .ne. "") then
1098  return
1099  endif
1100  case (time_max)
1101  error_msg = buffer_ptr%do_time_max_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1102  bounds_in, bounds_out, missing_value)
1103  if (trim(error_msg) .ne. "") then
1104  return
1105  endif
1106  case (time_sum)
1107  error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1108  field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value())
1109  if (trim(error_msg) .ne. "") then
1110  return
1111  endif
1112  case (time_average)
1113  error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1114  field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1115  weight=weight)
1116  if (trim(error_msg) .ne. "") then
1117  return
1118  endif
1119  case (time_power)
1120  error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1121  field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1122  weight=weight, pow_value=field_yaml_ptr%get_pow_value())
1123  if (trim(error_msg) .ne. "") then
1124  return
1125  endif
1126  case (time_rms)
1127  error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1128  field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1129  weight=weight, pow_value = 2)
1130  if (trim(error_msg) .ne. "") then
1131  return
1132  endif
1133  case (time_diurnal)
1134  if(.not. present(time)) call mpp_error(fatal, &
1135  "fms_diag_do_reduction:: time must be present when using diurnal reductions")
1136  ! sets the diurnal index for reduction within the buffer object
1137  call buffer_ptr%set_diurnal_section_index(time)
1138  error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1139  field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1140  weight=weight)
1141  if (trim(error_msg) .ne. "") then
1142  return
1143  endif
1144  case default
1145  error_msg = "The reduction method is not supported. "//&
1146  "Only none, min, max, sum, average, power, rms, and diurnal are supported."
1147  end select
1148 
1149  if (field_ptr%is_static() .or. file_ptr%FMS_diag_file%is_done_writing_data()) then
1150  call buffer_ptr%set_done_with_math()
1151  endif
1152  enddo buffer_loop
1153 #else
1154  error_msg = ""
1155  CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1156 #endif
1157 end function fms_diag_do_reduction
1158 
1159 !> @brief Adds the diag ids of the Area and or Volume of the diag_field_object
1160 subroutine fms_diag_field_add_cell_measures(this, diag_field_id, area, volume)
1161  class(fmsdiagobject_type), intent (inout) :: this !< The diag object
1162  integer, intent(in) :: diag_field_id !< diag_field to add the are and volume to
1163  INTEGER, optional, INTENT(in) :: area !< diag ids of area
1164  INTEGER, optional, INTENT(in) :: volume !< diag ids of volume
1165 
1166 #ifndef use_yaml
1167  CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1168 #else
1169  call this%FMS_diag_fields(diag_field_id)%add_area_volume(area, volume)
1170 #endif
1171 end subroutine fms_diag_field_add_cell_measures
1172 
1173 !> @brief Add a attribute to the diag_obj using the diag_field_id
1174 subroutine fms_diag_field_add_attribute(this, diag_field_id, att_name, att_value)
1175  class(fmsdiagobject_type), intent (inout) :: this !< The diag object
1176  integer, intent(in) :: diag_field_id !< Id of the axis to add the attribute to
1177  character(len=*), intent(in) :: att_name !< Name of the attribute
1178  class(*), intent(in) :: att_value(:) !< The attribute value to add
1179 #ifndef use_yaml
1180 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1181 #else
1182 !TODO: Value for diag not found
1183  if ( diag_field_id .LE. 0 ) THEN
1184  RETURN
1185  else
1186  if (this%FMS_diag_fields(diag_field_id)%is_registered() ) then
1187 #ifdef __NVCOMPILER
1188  call mpp_error(note, "use_modern_diag:: metadata output is currently unsupported for NVHPC compilers")
1189 #endif
1190  call this%FMS_diag_fields(diag_field_id)%add_attribute(att_name, att_value)
1191  endif
1192  endif
1193 #endif
1194 end subroutine fms_diag_field_add_attribute
1195 
1196 !> @brief Add an attribute to an axis
1197 subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
1198  class(fmsdiagobject_type), intent (inout) :: this !< The diag object
1199  integer, intent(in) :: axis_id !< Id of the axis to add the attribute to
1200  character(len=*), intent(in) :: att_name !< Name of the attribute
1201  class(*), intent(in) :: att_value(:) !< The attribute value to add
1202 
1203  character(len=20) :: axis_names(2) !< Names of the uncompress axis
1204  character(len=20) :: set_name !< Name of the axis set
1205  integer :: uncmx_ids(2) !< Ids of the uncompress axis
1206  integer :: j !< For do loops
1207 #ifndef use_yaml
1208 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1209 #else
1210  if (axis_id < 0 .and. axis_id > this%registered_axis) &
1211  call mpp_error(fatal, "diag_axis_add_attribute: The axis_id is not valid")
1212 
1213  select type (axis => this%diag_axis(axis_id)%axis)
1214  type is (fmsdiagfullaxis_type)
1215  call axis%add_axis_attribute(att_name, att_value)
1216 
1217  !! Axis that are in the "unstructured" domain require a "compress" attribute for the
1218  !! combiner and PP. This attribute is passed in via a diag_axis_add_attribute call in the model code
1219  !! The compress attribute indicates the names of the axis that were compressed
1220  !! For example grid_index:compress = "grid_yt grid_xt"
1221  !! The metadata and the data for these axis also needs to be written to the file
1222  if (trim(att_name) .eq. "compress") then
1223  !< If the attribute is the "compress" attribute, get the axis names,
1224  !! and the ids of the axis and add it to the axis object so it can be written to netcdf files
1225  !! that use this axis
1226  axis_names = parse_compress_att(att_value)
1227  set_name = ""
1228  if (axis%has_set_name()) set_name = axis%get_set_name()
1229  do j = 1, size(axis_names)
1230  uncmx_ids(j) = get_axis_id_from_name(axis_names(j), this%diag_axis, this%registered_axis, set_name)
1231  if (uncmx_ids(j) .eq. diag_null) call mpp_error(fatal, &
1232  &"Error parsing the compress attribute for axis: "//trim(axis%get_axis_name())//&
1233  &". Be sure that the axes in the compress attribute are registered")
1234  enddo
1235  call axis%add_structured_axis_ids(uncmx_ids)
1236  endif
1237 #ifdef __NVCOMPILER
1238  call mpp_error(note, "use_modern_diag:: metadata output is currently unsupported for NVHPC compilers")
1239 #endif
1240  end select
1241 #endif
1242 end subroutine fms_diag_axis_add_attribute
1243 
1244 !> \brief Gets the field_name from the diag_field
1245 !> \returns a copy of the field_name
1246 function fms_get_field_name_from_id (this, field_id) &
1247  result(field_name)
1248 
1249  class(fmsdiagobject_type), intent (in) :: this !< The diag object, the caller
1250  integer, intent (in) :: field_id !< Field id to get the name for
1251  character(len=:), allocatable :: field_name
1252 #ifndef use_yaml
1253  CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1254 #else
1255  field_name = this%FMS_diag_fields(field_id)%get_varname()
1256 #endif
1257 end function fms_get_field_name_from_id
1258 
1259 !> \brief Gets the diag field ID from the module name and field name.
1260 !> \returns a copy of the ID of the diag field or DIAG_FIELD_NOT_FOUND if the field is not registered
1261 FUNCTION fms_get_diag_field_id_from_name(this, module_name, field_name) &
1262  result(diag_field_id)
1263  class(fmsdiagobject_type), intent (in) :: this !< The diag object, the caller
1264  CHARACTER(len=*), INTENT(in) :: module_name !< Module name that registered the variable
1265  CHARACTER(len=*), INTENT(in) :: field_name !< Variable name
1266  integer :: diag_field_id
1267 
1268 #ifdef use_yaml
1269  integer :: i !< For looping
1270  integer, allocatable :: diag_field_indices(:) !< indices where the field was found in the yaml
1271 
1272  diag_field_id = diag_field_not_found
1273 
1274  !> Loop through fields to find it.
1275  do i=1, this%registered_variables
1276  !< Check if the field was registered, if it was return the diag_field_id
1277  diag_field_id = this%FMS_diag_fields(i)%id_from_name(module_name, field_name)
1278  if(diag_field_id .ne. diag_field_not_found) return
1279  enddo
1280 
1281  !< Check if the field is in the diag_table.yaml. If it is, return DIAG_FIELD_NOT_REGISTERED
1282  !! Otherwsie it will return DIAG_FIELD_NOT_FOUND
1283  diag_field_indices = find_diag_field(field_name, module_name)
1284  if (diag_field_indices(1) .ne. diag_null) then
1285  diag_field_id = diag_not_registered
1286  endif
1287  deallocate(diag_field_indices)
1288 #else
1289  diag_field_id = diag_field_not_found
1290  CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1291 #endif
1292 END FUNCTION fms_get_diag_field_id_from_name
1293 
1294 #ifdef use_yaml
1295 !> returns the buffer object for the given id
1296 !! actual data comes from %get_buffer_data() on the returned object
1297 function get_diag_buffer(this, bufferid) &
1298 result(rslt)
1299  class(fmsdiagobject_type), intent(in) :: this
1300  integer, intent(in) :: bufferid
1301  type(fmsdiagoutputbuffer_type),allocatable:: rslt
1302  if( (bufferid .gt. ubound(this%FMS_diag_output_buffers, 1)) .or. &
1303  (bufferid .lt. lbound(this%FMS_diag_output_buffers, 1))) &
1304  call mpp_error(fatal, 'get_diag_bufer: invalid bufferid given')
1305  rslt = this%FMS_diag_output_buffers(bufferid)
1306 end function
1307 #endif
1308 
1309 !> @brief Return the 2D domain for the axis IDs given.
1310 !! @return 2D domain for the axis IDs given
1311 type(domain2d) function fms_get_domain2d(this, ids)
1312  class(fmsdiagobject_type), intent (in) :: this !< The diag object
1313  INTEGER, DIMENSION(:), INTENT(in) :: ids !< Axis IDs.
1314 
1315 #ifndef use_yaml
1316 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1317 fms_get_domain2d = null_domain2d
1318 #else
1319  INTEGER :: type_of_domain !< The type of domain
1320  CLASS(diagdomain_t), POINTER :: domain !< Diag Domain pointer
1321 
1322  call get_domain_and_domain_type(fms_diag_object%diag_axis, ids, type_of_domain, domain, "get_domain2d")
1323  if (type_of_domain .ne. two_d_domain) &
1324  call mpp_error(fatal, 'diag_axis_mod::get_domain2d- The axis do not correspond to a 2d Domain')
1325  select type(domain)
1326  type is (diagdomain2d_t)
1327  fms_get_domain2d = domain%domain2
1328  end select
1329 #endif
1330 END FUNCTION fms_get_domain2d
1331 
1332  !> @brief Gets the length of the axis based on the axis_id
1333  !> @return Axis_length
1334  integer function fms_get_axis_length(this, axis_id)
1335  class(fmsdiagobject_type), intent (in) :: this !< The diag object
1336  INTEGER, INTENT(in) :: axis_id !< Axis ID of the axis to the length of
1337 
1338 #ifndef use_yaml
1339 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1340 fms_get_axis_length = 0
1341 #else
1342 fms_get_axis_length = 0
1343 
1344  if (axis_id < 0 .and. axis_id > this%registered_axis) &
1345  call mpp_error(fatal, "fms_get_axis_length: The axis_id is not valid")
1346 
1347  select type (axis => this%diag_axis(axis_id)%axis)
1348  type is (fmsdiagfullaxis_type)
1349  fms_get_axis_length = axis%axis_length()
1350  type is (fmsdiagsubaxis_type)
1351  fms_get_axis_length = axis%axis_length()
1352  end select
1353 #endif
1354 end function fms_get_axis_length
1355 
1356 !> @brief Gets the name of the axis based on the axis_id
1357  !> @return The axis_name
1358 function fms_get_axis_name_from_id (this, axis_id) &
1359 result(axis_name)
1360  class(fmsdiagobject_type), intent (in) :: this !< The diag object
1361  INTEGER, INTENT(in) :: axis_id !< Axis ID of the axis to the length of
1362 
1363  character (len=:), allocatable :: axis_name
1364 
1365 #ifndef use_yaml
1366 CALL mpp_error(fatal,"You can not use the modern diag manager without compiling with -Duse_yaml")
1367 axis_name=" "
1368 #else
1369  if (axis_id < 0 .and. axis_id > this%registered_axis) &
1370  call mpp_error(fatal, "fms_get_axis_length: The axis_id is not valid")
1371 
1372  !! if its a scalar (null axis id) just returns n/a since no axis is defined
1373  if (axis_id .eq. null_axis_id) then
1374  allocate(character(len=3) :: axis_name)
1375  axis_name = "n/a"
1376  return
1377  endif
1378 
1379 
1380  select type (axis => this%diag_axis(axis_id)%axis)
1381  type is (fmsdiagfullaxis_type)
1382  axis_name = axis%get_axis_name()
1383  end select
1384 #endif
1385 end function fms_get_axis_name_from_id
1386 
1387 !> Dumps as much data as it can from the fmsDiagObject_type.
1388 !! Will dump any fields and files as well (see d)
1389 subroutine dump_diag_obj( filename )
1390  character(len=*), intent(in), optional :: filename !< optional filename to print to,
1391  !! otherwise prints to stdout
1392 #ifdef use_yaml
1393  !type(fmsDiagObject_type) :: diag_obj
1394  type(fmsdiagfile_type), pointer :: fileptr !< pointer for traversing file list
1395  type(fmsdiagfield_type), pointer :: fieldptr !< pointer for traversing field list
1396  integer :: i !< do loops
1397  integer :: unit_num !< unit num of opened log file or stdout
1398 
1399  if( present(filename) ) then
1400  open(newunit=unit_num, file=trim(filename), action='WRITE')
1401  else
1402  unit_num = stdout()
1403  endif
1404  if( mpp_pe() .eq. mpp_root_pe()) then
1405  write(unit_num, *) '********** dumping diag object ***********'
1406  write(unit_num, *) 'registered_variables:', fms_diag_object%registered_variables
1407  write(unit_num, *) 'registered_axis:', fms_diag_object%registered_axis
1408  write(unit_num, *) 'initialized:', fms_diag_object%initialized
1409  write(unit_num, *) 'files_initialized:', fms_diag_object%files_initialized
1410  write(unit_num, *) 'fields_initialized:', fms_diag_object%fields_initialized
1411  write(unit_num, *) 'buffers_initialized:', fms_diag_object%buffers_initialized
1412  write(unit_num, *) 'axes_initialized:', fms_diag_object%axes_initialized
1413  write(unit_num, *) 'Files:'
1414  if( fms_diag_object%files_initialized ) then
1415  do i=1, SIZE(fms_diag_object%FMS_diag_files)
1416  write(unit_num, *) 'File num:', i
1417  fileptr => fms_diag_object%FMS_diag_files(i)%FMS_diag_file
1418  call fileptr%dump_file_obj(unit_num)
1419  enddo
1420  else
1421  write(unit_num, *) 'files not initialized'
1422  endif
1423  if( fms_diag_object%fields_initialized) then
1424  do i=1, SIZE(fms_diag_object%FMS_diag_fields)
1425  write(unit_num, *) 'Field num:', i
1426  fieldptr => fms_diag_object%FMS_diag_fields(i)
1427  call fieldptr%dump_field_obj(unit_num)
1428  enddo
1429  else
1430  write(unit_num, *) 'fields not initialized'
1431  endif
1432  if( present(filename) ) close(unit_num)
1433  endif
1434 #else
1435  call mpp_error( fatal, "You can not use the modern diag manager without compiling with -Duse_yaml")
1436 #endif
1437 end subroutine
1438 
1439 !> @brief Allocates the output buffers of the fields corresponding to the registered variable
1440 !! Input arguments are the field and its ID passed to routine fms_diag_accept_data()
1441 subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
1442  class(fmsdiagobject_type), target, intent(inout) :: this !< diag object
1443  class(*), dimension(:,:,:,:), intent(in) :: field_data !< field data
1444  integer, intent(in) :: field_id !< Id of the field data
1445 #ifdef use_yaml
1446  integer :: ndims !< Number of dimensions in the input field data
1447  integer :: buffer_id !< Buffer index of FMS_diag_buffers
1448  integer :: num_diurnal_samples !< Number of diurnal samples from diag_yaml
1449  integer :: axes_length(4) !< Length of each axis
1450  integer :: i, j !< For looping
1451  class(fmsdiagoutputbuffer_type), pointer :: ptr_diag_buffer_obj !< Pointer to the buffer class
1452  class(diagyamlfilesvar_type), pointer :: ptr_diag_field_yaml !< Pointer to a field from yaml fields
1453  integer, pointer :: axis_ids(:) !< Pointer to indices of axes of the field variable
1454  integer :: var_type !< Stores type of the field data (r4, r8, i4, i8, and string) represented as an integer.
1455  character(len=:), allocatable :: var_name !< Field name to initialize output buffers
1456  logical :: is_scalar !< Flag indicating that the variable is a scalar
1457  integer :: yaml_id !< Yaml id for the buffer
1458  integer :: file_id !< File id for the buffer
1459 
1460  if (this%FMS_diag_fields(field_id)%buffer_allocated) return
1461 
1462  ! Determine the type of the field data
1463  var_type = get_var_type(field_data(1, 1, 1, 1))
1464 
1465  ! Get variable/field name
1466  var_name = this%FMS_diag_fields(field_id)%get_varname()
1467 
1468  ! Determine dimensions of the field
1469  is_scalar = this%FMS_diag_fields(field_id)%is_scalar()
1470 
1471  ! Loop over a number of fields/buffers where this variable occurs
1472  do i = 1, size(this%FMS_diag_fields(field_id)%buffer_ids)
1473  buffer_id = this%FMS_diag_fields(field_id)%buffer_ids(i)
1474  file_id = this%FMS_diag_fields(field_id)%file_ids(i)
1475 
1476  !< Go away if the file is a subregional file and the current PE does not have any data for it
1477  if (.not. this%FMS_diag_files(file_id)%writing_on_this_pe()) cycle
1478 
1479  ndims = 0
1480  if (.not. is_scalar) then
1481  call this%FMS_diag_output_buffers(buffer_id)%get_axis_ids(axis_ids)
1482  ndims = size(axis_ids)
1483  endif
1484 
1485  yaml_id = this%FMS_diag_output_buffers(buffer_id)%get_yaml_id()
1486 
1487  ptr_diag_field_yaml => diag_yaml%diag_fields(yaml_id)
1488  num_diurnal_samples = ptr_diag_field_yaml%get_n_diurnal() !< Get number of diurnal samples
1489 
1490  axes_length = 1
1491  do j = 1, ndims
1492  axes_length(j) = this%fms_get_axis_length(axis_ids(j))
1493  enddo
1494 
1495  if (num_diurnal_samples .ne. 0) then
1496  ndims = ndims + 1 !< Add one more dimension for the diurnal axis
1497  endif
1498 
1499  ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)
1500  call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, axes_length(1:4), &
1501  this%FMS_diag_fields(field_id)%get_mask_variant(), var_name, num_diurnal_samples)
1502  call ptr_diag_buffer_obj%initialize_buffer(ptr_diag_field_yaml%get_var_reduction(), var_name)
1503 
1504  enddo
1505  nullify(axis_ids)
1506 
1507  this%FMS_diag_fields(field_id)%buffer_allocated = .true.
1508 #else
1509  call mpp_error( fatal, "allocate_diag_field_output_buffers: "//&
1510  "you can not use the modern diag manager without compiling with -Duse_yaml")
1511 #endif
1512 end subroutine allocate_diag_field_output_buffers
1513 
1514 !> @brief Determines if the window defined by the input bounds is a physics window.
1515 !> @return TRUE if the window size is less then the actual field size else FALSE.
1516 function fms_diag_compare_window(this, field, field_id, &
1517  is_in, ie_in, js_in, je_in, ks_in, ke_in) result(is_phys_win)
1518  class(fmsdiagobject_type), intent(in) :: this !< Diag Object
1519  class(*), intent(in) :: field(:,:,:,:) !< Field data
1520  integer, intent(in) :: field_id !< ID of the input field
1521  integer, intent(in) :: is_in, js_in !< Starting field indices for the first 2 dimensions;
1522  !< pass reconditioned indices fis and fjs
1523  !< which are computed elsewhere.
1524  integer, intent(in) :: ie_in, je_in !< Ending field indices for the first 2 dimensions;
1525  !< pass reconditioned indices fie and fje
1526  !< which are computed elsewhere.
1527  integer, intent(in) :: ks_in, ke_in !< Starting and ending indices of the field in 3rd dimension
1528  logical :: is_phys_win !< Return flag
1529 #ifdef use_yaml
1530  integer, pointer :: axis_ids(:)
1531  integer :: total_elements
1532  integer :: i !< For do loop
1533  integer :: field_size
1534  integer, allocatable :: field_shape(:) !< Shape of the field data
1535  integer :: window_size
1536 
1537  !> Determine shape of the field defined by the input bounds
1538  field_shape = shape(field(is_in:ie_in, js_in:je_in, ks_in:ke_in, :))
1539 
1540  window_size = field_shape(1) * field_shape(2) * field_shape(3)
1541 
1542  total_elements = 1
1543  axis_ids => this%FMS_diag_fields(field_id)%get_axis_id()
1544  do i=1, size(axis_ids)
1545  total_elements = total_elements * this%fms_get_axis_length(axis_ids(i))
1546  enddo
1547 
1548  if (total_elements > window_size) then
1549  is_phys_win = .true.
1550  else
1551  is_phys_win = .false.
1552  end if
1553 #else
1554  is_phys_win = .false.
1555  call mpp_error( fatal, "fms_diag_compare_window: "//&
1556  "you can not use the modern diag manager without compiling with -Duse_yaml")
1557 #endif
1558 end function fms_diag_compare_window
1559 
1560 !> @brief Set the model_end_time in a diag object
1561 subroutine set_time_end(this, time_end_in)
1562  class(fmsdiagobject_type), intent(inout) :: this !< Diag Object
1563  type(time_type), intent(in) :: time_end_in !< Time at the end of the simulation
1564 #ifdef use_yaml
1565  this%model_end_time = time_end_in
1566 #endif
1567 end subroutine
1568 
1569 end module fms_diag_object_mod
diag_data_mod::get_var_type
integer function get_var_type(var)
gets the type of a variable
Definition: diag_data.F90:599
diag_data_mod::no_domain
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
Definition: diag_data.F90:100
diag_data_mod::get_base_time
type(time_type) function get_base_time()
gets the module variable base_time
Definition: diag_data.F90:509
diag_data_mod::max_axes
integer max_axes
Maximum number of independent axes.
Definition: diag_data.F90:361
diag_data_mod::diag_field_not_found
integer, parameter diag_field_not_found
Return value for a diag_field that isn't found in the diag_table.
Definition: diag_data.F90:112
diag_data_mod::diag_init_time
type(time_type) diag_init_time
Time diag_manager_init called. If init_time not included in diag_manager_init call,...
Definition: diag_data.F90:416
diag_data_mod::time_min
integer, parameter time_min
The reduction method is min value.
Definition: diag_data.F90:117
diag_data_mod::time_diurnal
integer, parameter time_diurnal
The reduction method is diurnal.
Definition: diag_data.F90:122
diag_data_mod::time_power
integer, parameter time_power
The reduction method is average with exponents.
Definition: diag_data.F90:123
diag_data_mod::time_average
integer, parameter time_average
The reduction method is average of values.
Definition: diag_data.F90:120
diag_data_mod::time_sum
integer, parameter time_sum
The reduction method is sum of values.
Definition: diag_data.F90:119
diag_data_mod::time_rms
integer, parameter time_rms
The reudction method is root mean square of values.
Definition: diag_data.F90:121
diag_data_mod::time_none
integer, parameter time_none
There is no reduction method.
Definition: diag_data.F90:116
diag_data_mod::time_max
integer, parameter time_max
The reduction method is max value.
Definition: diag_data.F90:118
diag_data_mod::r8
integer, parameter r8
Supported type/kind of the variable.
Definition: diag_data.F90:83
diag_data_mod::two_d_domain
integer, parameter two_d_domain
Use the FmsNetcdfDomainFile_t fileobj.
Definition: diag_data.F90:101
fms_diag_bbox_mod::determine_if_block_is_in_region
logical pure function, public determine_if_block_is_in_region(subregion_start, subregion_end, bounds, dim)
The PEs grid points are divided further into "blocks". This function determines if a block.
Definition: fms_diag_bbox.F90:101
fms_diag_reduction_methods_mod::set_weight
pure real(kind=r8_kind) function, public set_weight(weight)
Sets the weight based on the weight passed into send_data (1.0_r8_kind if the weight is not passed in...
Definition: fms_diag_reduction_methods.F90:169
fms_diag_reduction_methods_mod::init_mask
logical function, dimension(:,:,:,:), allocatable, public init_mask(rmask, mask, field)
Sets the logical mask based on mask or rmask.
Definition: fms_diag_reduction_methods.F90:142
fms_diag_reduction_methods_mod::check_indices_order
pure character(len=128) function, public check_indices_order(is_in, ie_in, js_in, je_in)
Checks improper combinations of is, ie, js, and je.
Definition: fms_diag_reduction_methods.F90:111
fms_diag_yaml_mod::diag_yaml_object_end
subroutine, public diag_yaml_object_end()
Destroys the diag_yaml object.
Definition: fms_diag_yaml.F90:601
fms_diag_axis_object_mod::fms_diag_axis_object_end
logical function, public fms_diag_axis_object_end(axis_array)
Definition: fms_diag_axis_object.F90:1025
fms_diag_axis_object_mod::get_axis_id_from_name
pure integer function, public get_axis_id_from_name(axis_name, diag_axis, naxis, set_name)
Definition: fms_diag_axis_object.F90:1405
fms_diag_yaml_mod::fms_diag_yaml_out
subroutine, public fms_diag_yaml_out(ntimes, ntiles, ndistributedfiles)
Writes an output yaml with all available information on the written files. Will only write with root ...
Definition: fms_diag_yaml.F90:1776
fms_diag_yaml_mod::get_diag_field_ids
integer function, dimension(:), allocatable, public get_diag_field_ids(indices)
Gets field indices corresponding to the indices (input argument) in the sorted variable_list.
Definition: fms_diag_yaml.F90:1655
fms_diag_yaml_mod::diag_yaml_object_init
subroutine, public diag_yaml_object_init(diag_subset_output)
Uses the yaml_parser_mod to read in the diag_table and fill in the diag_yaml object.
Definition: fms_diag_yaml.F90:372
fms_diag_axis_object_mod::fms_diag_axis_object_init
logical function, public fms_diag_axis_object_init(axis_array)
Definition: fms_diag_axis_object.F90:1013
fms_diag_yaml_mod::find_diag_field
integer function, dimension(:), allocatable, public find_diag_field(diag_field_name, module_name)
Determines if a diag_field is in the diag_yaml_object.
Definition: fms_diag_yaml.F90:1622
fms_diag_axis_object_mod::parse_compress_att
pure character(len=120) function, dimension(2), public parse_compress_att(compress_att)
Definition: fms_diag_axis_object.F90:1387
fms_diag_yaml_mod::get_diag_files_id
integer function, dimension(:), allocatable, public get_diag_files_id(indices)
Finds the indices of the diag_yamldiag_files(:) corresponding to fields in variable_list(indices)
Definition: fms_diag_yaml.F90:1672
fms_diag_axis_object_mod::get_domain_and_domain_type
subroutine, public get_domain_and_domain_type(diag_axis, axis_id, domain_type, domain, var_name)
Loop through a variable's axis_id to determine and return the domain type and domain to use.
Definition: fms_diag_axis_object.F90:1106
fms_mod::fms_error_handler
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
Definition: fms.F90:468
fms_string_utils_mod::string
character(:) function, allocatable, public string(v, fmt)
Converts a number or a Boolean value to a string.
Definition: fms_string_utils.F90:246
mpp_domains_mod::domain1d
One dimensional domain used to manage shared data access between pes.
Definition: mpp_domains.F90:640
mpp_domains_mod::domain2d
The domain2D type contains all the necessary information to define the global, compute and data domai...
Definition: mpp_domains.F90:370
mpp_domains_mod::domainug
Domain information for managing data on unstructured grids.
Definition: mpp_domains.F90:269
stdout
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:42
mpp_pe
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:406
mpp_mod::mpp_error
Error handler.
Definition: mpp.F90:385
time_manager_mod::get_ticks_per_second
integer function, public get_ticks_per_second()
Returns the number of ticks per second.
Definition: time_manager.F90:1126
time_manager_mod::get_time
subroutine, public get_time(Time, seconds, days, ticks, err_msg)
Returns days and seconds ( < 86400 ) corresponding to a time. err_msg should be checked for any error...
Definition: time_manager.F90:491
time_manager_mod::date_to_string
character(len=15) function, public date_to_string(time, err_msg)
Get the a character string that represents the time. The format will be yyyymmdd.hhmmss.
Definition: time_manager.F90:2619
time_manager_mod::get_date
subroutine, public get_date(time, year, month, day, hour, minute, second, tick, err_msg)
Gets the date for different calendar types. Given a time_interval, returns the corresponding date und...
Definition: time_manager.F90:1145
time_manager_mod::set_date
Given an input date in year, month, days, etc., creates a time_type that represents this time interva...
Definition: time_manager.F90:246
time_manager_mod::set_time
Given some number of seconds and days, returns the corresponding time_type.
Definition: time_manager.F90:206
time_manager_mod::time_type
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.
Definition: time_manager.F90:140
fms_diag_output_buffer_mod
Contains buffer types and routines for the diag manager.
Definition: fms_diag_output_buffer.F90:25
fms_diag_axis_object_mod::diagdomain2d_t
Type to hold the 2d domain.
Definition: fms_diag_axis_object.F90:76
fms_diag_axis_object_mod::diagdomain_t
Type to hold the domain info for an axis This type was created to avoid having to send in "Domain",...
Definition: fms_diag_axis_object.F90:63
fms_diag_axis_object_mod::fmsdiagaxis_type
Type to hold the diagnostic axis description.
Definition: fms_diag_axis_object.F90:87
fms_diag_axis_object_mod::fmsdiagaxiscontainer_type
Type to hold the diag_axis (either subaxis or a full axis)
Definition: fms_diag_axis_object.F90:105
fms_diag_axis_object_mod::fmsdiagfullaxis_type
Type to hold the diagnostic axis description.
Definition: fms_diag_axis_object.F90:148
fms_diag_axis_object_mod::fmsdiagsubaxis_type
Type to hold the subaxis.
Definition: fms_diag_axis_object.F90:111
fms_diag_bbox_mod::fmsdiagibounds_type
Data structure holding a 3D bounding box. It is commonlyused to represent the interval bounds or limi...
Definition: fms_diag_bbox.F90:40
fms_diag_field_object_mod::fmsdiagfield_type
Object that holds all variable information.
Definition: fms_diag_field_object.F90:56
fms_diag_file_object_mod::fmsdiagfile_type
Definition: fms_diag_file_object.F90:65
fms_diag_file_object_mod::fmsdiagfilecontainer_type
A container for fmsDiagFile_type. This is used to create the array of files.
Definition: fms_diag_file_object.F90:177
fms_diag_object_mod::fmsdiagobject_type
Definition: fms_diag_object.F90:54
fms_diag_output_buffer_mod::fmsdiagoutputbuffer_type
holds an allocated buffer0-5d object
Definition: fms_diag_output_buffer.F90:45
fms_diag_yaml_mod::diagyamlfilesvar_type
type to hold the info a diag_field
Definition: fms_diag_yaml.F90:196