FMS  2024.03
Flexible Modeling System
fms_diag_axis_object.F90
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
20 !> @defgroup fms_diag_axis_object_mod fms_diag_axis_object_mod
21 !> @ingroup diag_manager
22 !! @brief fms_diag_axis_object_mod stores the diag axis object, a diag domain
23 !! object, and a subaxis object.
24 
25 !> @file
26 !> @brief File for @ref diag_axis_object_mod
27 
28 !> @addtogroup fms_diag_axis_object_mod
29 !> @{
30 module fms_diag_axis_object_mod
31 #ifdef use_yaml
32  use mpp_domains_mod, only: domain1d, domain2d, domainug, mpp_get_compute_domain, center, &
33  & mpp_get_global_domain, north, east, mpp_get_tile_id, &
35  use platform_mod, only: r8_kind, r4_kind, i4_kind, i8_kind
36  use diag_data_mod, only: diag_atttype, max_axes, no_domain, two_d_domain, ug_domain, &
38  diag_null, index_gridtype, latlon_gridtype, pack_size_str, &
41  use mpp_mod, only: fatal, mpp_error, uppercase, mpp_pe, mpp_root_pe, stdout
42  use fms2_io_mod, only: fmsnetcdffile_t, fmsnetcdfdomainfile_t, fmsnetcdfunstructureddomainfile_t, &
43  & register_axis, register_field, register_variable_attribute, write_data
44  use fms_diag_yaml_mod, only: subregion_type, diag_yaml, max_subaxes
45  use diag_grid_mod, only: get_local_indices_cubesphere => get_local_indexes
46  use axis_utils2_mod, only: nearest_index
47  implicit none
48 
49  PRIVATE
50 
57 
58  !> @}
59 
60  !> @brief Type to hold the domain info for an axis
61  !! This type was created to avoid having to send in "Domain", "Domain2", "DomainUG" as arguments into subroutines
62  !! and instead only 1 class(diagDomain_t) argument can be send
63  !> @ingroup diag_axis_object_mod
65  contains
66  procedure :: set => set_axis_domain
67  procedure :: length => get_length
68  procedure :: get_ntiles
69  end type diagdomain_t
70 
71  !> @brief Type to hold the 1d domain
72  type, extends(diagdomain_t) :: diagdomain1d_t
73  type(domain1d) :: domain !< 1d Domain of the axis
74  end type
75 
76  !> @brief Type to hold the 2d domain
77  type, extends(diagdomain_t) :: diagdomain2d_t
78  type(domain2d) :: domain2 !< 2d Domain of an "X" or "Y" axis
79  end type
80 
81  !> @brief Type to hold the unstructured domain
82  type, extends(diagdomain_t) :: diagdomainug_t
83  type(domainug) :: domainug !< Domain of "U" axis
84  end type
85 
86  !> @brief Type to hold the diagnostic axis description.
87  !> @ingroup diag_axis_object_mod
89  INTEGER , private :: axis_id !< ID of the axis
90 
91  contains
92  procedure :: get_parent_axis_id
93  procedure :: get_subaxes_id
94  procedure :: get_axis_name
95  procedure :: is_z_axis
96  procedure :: write_axis_metadata
97  procedure :: write_axis_data
98  procedure :: add_structured_axis_ids
99  procedure :: get_structured_axis
100  procedure :: is_unstructured_grid
101  procedure :: get_edges_id
102  END TYPE fmsdiagaxis_type
103 
104  !> @brief Type to hold the diag_axis (either subaxis or a full axis)
105  !> @ingroup diag_axis_object_mod
107  class(fmsDiagAxis_type), allocatable :: axis
108  end type
109 
110  !> @brief Type to hold the subaxis
111  !> @ingroup diag_axis_object_mod
113  CHARACTER(len=:), ALLOCATABLE , private :: subaxis_name !< Name of the subaxis
114  INTEGER , private :: starting_index !< Starting index of the subaxis relative to the
115  !! parent axis
116  INTEGER , private :: ending_index !< Ending index of the subaxis relative to the
117  !! parent axis
118  INTEGER , private :: parent_axis_id !< Id of the parent_axis
119  INTEGER , private :: compute_idx(2) !< Starting and ending index of the compute domain
120  INTEGER, allocatable, private :: global_idx(:) !< Starting and ending index of the global domain
121  real(kind=r4_kind), allocatable, private :: zbounds(:) !< Bounds of the Z axis
122  contains
123  procedure :: fill_subaxis
124  procedure :: axis_length
125  procedure :: get_starting_index
126  procedure :: get_ending_index
127  procedure :: get_compute_indices
128  END TYPE fmsdiagsubaxis_type
129 
130  !> @brief Type to hold the diurnal axis
131  !> @ingroup diag_axis_object_mod
133  INTEGER , private :: ndiurnal_samples !< The number of diurnal samples
134  CHARACTER(len=:), ALLOCATABLE, private :: axis_name !< The diurnal axis name
135  CHARACTER(len=:), ALLOCATABLE, private :: long_name !< The longname of the diurnal axis
136  CHARACTER(len=:), ALLOCATABLE, private :: units !< The units
137  INTEGER , private :: edges_id !< The id of the diurnal edges
138  CHARACTER(len=:), ALLOCATABLE, private :: edges_name !< The name of the edges axis
139  CLASS(*), ALLOCATABLE, private :: diurnal_data(:) !< The diurnal data
140 
141  contains
142  procedure :: get_diurnal_axis_samples
143  procedure :: write_diurnal_metadata
144  END TYPE fmsdiagdiurnalaxis_type
145 
146  !> @brief Type to hold the diagnostic axis description.
147  !> @ingroup diag_axis_object_mod
149  CHARACTER(len=:), ALLOCATABLE, private :: axis_name !< Name of the axis
150  CHARACTER(len=:), ALLOCATABLE, private :: units !< Units of the axis
151  CHARACTER(len=:), ALLOCATABLE, private :: long_name !< Long_name attribute of the axis
152  CHARACTER(len=1) , private :: cart_name !< Cartesian name "X", "Y", "Z", "T", "U", "N"
153  CLASS(*), ALLOCATABLE, private :: axis_data(:) !< Data of the axis
154  CHARACTER(len=:), ALLOCATABLE, private :: type_of_data !< The type of the axis_data ("float" or "double")
155  !< TO DO this can be a dlinked to avoid having limits
156  integer, ALLOCATABLE, private :: subaxis(:) !< Array of subaxis
157  integer , private :: nsubaxis !< Number of subaxis
158  class(diagdomain_t),ALLOCATABLE, private :: axis_domain !< Domain
159  INTEGER , private :: type_of_domain !< The type of domain ("NO_DOMAIN", "TWO_D_DOMAIN",
160  !! or "UG_DOMAIN")
161  INTEGER , private :: length !< Global axis length
162  INTEGER , private :: direction !< Direction of the axis 0, 1, -1
163  INTEGER, ALLOCATABLE, private :: edges_id !< Axis ID for the edges axis
164  !! This axis will be written to the file
165  CHARACTER(len=:), ALLOCATABLE, private :: edges_name !< Name for the previously defined "edges axis"
166  !! This will be written as an attribute
167  CHARACTER(len=:), ALLOCATABLE, private :: aux !< Auxiliary name, can only be <TT>geolon_t</TT>
168  !! or <TT>geolat_t</TT>
169  CHARACTER(len=128) , private :: req !< Required field names.
170  INTEGER , private :: tile_count !< The number of tiles
171  TYPE(fmsdiagattribute_type),allocatable , private :: attributes(:) !< Array to hold user definable attributes
172  INTEGER , private :: num_attributes !< Number of defined attibutes
173  INTEGER , private :: domain_position !< The position in the doman (NORTH, EAST or CENTER)
174  integer, allocatable , private :: structured_ids(:) !< If the axis is in the unstructured grid,
175  !! this is the axis ids of the structured axis
176  CHARACTER(len=:), ALLOCATABLE, private :: set_name !< Name of the axis set. This is to distinguish
177  !! two axis with the same name
178 
179  contains
180 
181  PROCEDURE :: add_axis_attribute
182  PROCEDURE :: register => register_diag_axis_obj
183  PROCEDURE :: axis_length => get_axis_length
184  PROCEDURE :: set_edges
185  PROCEDURE :: set_axis_id
186  PROCEDURE :: get_compute_domain
187  PROCEDURE :: get_indices
188  PROCEDURE :: get_global_io_domain
189  PROCEDURE :: get_aux
190  PROCEDURE :: has_aux
191  PROCEDURE :: get_set_name
192  PROCEDURE :: has_set_name
193  PROCEDURE :: is_x_or_y_axis
194  ! TO DO:
195  ! Get/has/is subroutines as needed
196  END TYPE fmsdiagfullaxis_type
197 
198  !> @addtogroup fms_diag_yaml_mod
199  !> @{
200  contains
201 
202  !!!!!!!!!!!!!!!!! DIAG AXIS PROCEDURES !!!!!!!!!!!!!!!!!
203  !> @brief Initialize the axis
204  subroutine register_diag_axis_obj(this, axis_name, axis_data, units, cart_name, long_name, direction,&
205  & set_name, Domain, Domain2, DomainU, aux, req, tile_count, domain_position, axis_length )
206  class(fmsdiagfullaxis_type),INTENT(inout):: this !< Diag_axis obj
207  CHARACTER(len=*), INTENT(in) :: axis_name !< Name of the axis
208  class(*), INTENT(in) :: axis_data(:) !< Array of coordinate values
209  CHARACTER(len=*), INTENT(in) :: units !< Units for the axis
210  CHARACTER(len=1), INTENT(in) :: cart_name !< Cartesian axis ("X", "Y", "Z", "T", "U", "N")
211  CHARACTER(len=*), INTENT(in), OPTIONAL :: long_name !< Long name for the axis.
212  CHARACTER(len=*), INTENT(in), OPTIONAL :: set_name !< Name of the parent axis, if it is a subaxis
213  INTEGER, INTENT(in), OPTIONAL :: direction !< Indicates the direction of the axis
214  TYPE(domain1d), INTENT(in), OPTIONAL :: Domain !< 1D domain
215  TYPE(domain2d), INTENT(in), OPTIONAL :: Domain2 !< 2D domain
216  TYPE(domainug), INTENT(in), OPTIONAL :: DomainU !< Unstructured domain
217  CHARACTER(len=*), INTENT(in), OPTIONAL :: aux !< Auxiliary name, can only be <TT>geolon_t</TT>
218  !! or <TT>geolat_t</TT>
219  CHARACTER(len=*), INTENT(in), OPTIONAL :: req !< Required field names.
220  INTEGER, INTENT(in), OPTIONAL :: tile_count !< Number of tiles
221  INTEGER, INTENT(in), OPTIONAL :: domain_position !< Domain position, "NORTH" or "EAST"
222  integer, intent(in), optional :: axis_length !< The length of the axis size(axis_data(:))
223 
224  this%axis_name = trim(axis_name)
225  this%units = trim(units)
226  this%cart_name = uppercase(cart_name)
227  call check_if_valid_cart_name(this%cart_name)
228 
229  if (present(long_name)) this%long_name = trim(long_name)
230 
231  select type (axis_data)
232  type is (real(kind=r8_kind))
233  allocate(real(kind=r8_kind) :: this%axis_data(axis_length))
234  this%axis_data = axis_data
235  this%length = axis_length
236  this%type_of_data = "double" !< This is what fms2_io expects in the register_field call
237  type is (real(kind=r4_kind))
238  allocate(real(kind=r4_kind) :: this%axis_data(axis_length))
239  this%axis_data = axis_data
240  this%length = axis_length
241  this%type_of_data = "float" !< This is what fms2_io expects in the register_field call
242  class default
243  call mpp_error(fatal, "The axis_data in your diag_axis_init call is not a supported type. &
244  & Currently only r4 and r8 data is supported.")
245  end select
246 
247  this%type_of_domain = no_domain
248  if (present(domain)) then
249  if (present(domain2) .or. present(domainu)) call mpp_error(fatal, &
250  "The presence of Domain with any other domain type is prohibited. "//&
251  "Check you diag_axis_init call for axis_name:"//trim(axis_name))
252  allocate(diagdomain1d_t :: this%axis_domain)
253  call this%axis_domain%set(domain=domain)
254  else if (present(domain2)) then
255  if (present(domainu)) call mpp_error(fatal, &
256  "The presence of Domain2 with any other domain type is prohibited. "//&
257  "Check you diag_axis_init call for axis_name:"//trim(axis_name))
258  allocate(diagdomain2d_t :: this%axis_domain)
259  call this%axis_domain%set(domain2=domain2)
260  this%type_of_domain = two_d_domain
261  else if (present(domainu)) then
262  allocate(diagdomainug_t :: this%axis_domain)
263  call this%axis_domain%set(domainu=domainu)
264  this%type_of_domain = ug_domain
265  endif
266 
267  this%tile_count = 1
268  if (present(tile_count)) this%tile_count = tile_count
269 
270  this%domain_position = center
271  if (present(domain_position)) this%domain_position = domain_position
272  call check_if_valid_domain_position(this%domain_position)
273 
274  this%direction = 0
275  if (present(direction)) this%direction = direction
276  call check_if_valid_direction(this%direction)
277 
278  if (present(aux)) this%aux = trim(aux)
279  if (present(req)) this%req = trim(req)
280  this%set_name = ""
281  if (present(set_name)) this%set_name = trim(set_name)
282 
283  if (max_subaxes .gt. 0) then
284  allocate(this%subaxis(max_subaxes))
285  this%subaxis = diag_null
286  endif
287 
288  this%nsubaxis = 0
289  this%num_attributes = 0
290  end subroutine register_diag_axis_obj
291 
292  !> @brief Add an attribute to an axis
293  subroutine add_axis_attribute(this, att_name, att_value)
294  class(fmsdiagfullaxis_type),INTENT(INOUT) :: this !< diag_axis obj
295  character(len=*), intent(in) :: att_name !< Name of the attribute
296  class(*), intent(in) :: att_value(:) !< The attribute value to add
297 
298  integer :: j !< obj%num_attributes (for less typing)
299 
300  if (.not. allocated(this%attributes)) &
301  allocate(this%attributes(max_axis_attributes))
302 
303  this%num_attributes = this%num_attributes + 1
304 
305  j = this%num_attributes
306  call this%attributes(j)%add(att_name, att_value)
307  end subroutine add_axis_attribute
308 
309  !> @brief Write the axis meta data to an open fileobj
310  subroutine write_axis_metadata(this, fms2io_fileobj, edges_in_file, parent_axis)
311  class(fmsdiagaxis_type), target, INTENT(IN) :: this !< diag_axis obj
312  class(fmsnetcdffile_t), INTENT(INOUT) :: fms2io_fileobj!< Fms2_io fileobj to write the data to
313  logical, INTENT(IN) :: edges_in_file !< .True. if the edges to this axis are
314  !! already in the file
315  class(fmsdiagaxis_type), OPTIONAL, target, INTENT(IN) :: parent_axis !< If the axis is a subaxis, axis object
316  !! for the parent axis (this will be used
317  !! to get some of the metadata info)
318 
319  character(len=:), ALLOCATABLE :: axis_edges_name !< Name of the edges, if it exist
320  character(len=:), pointer :: axis_name !< Name of the axis
321  integer :: axis_length !< Size of the axis
322  integer :: i !< For do loops
323  type(fmsdiagfullaxis_type), pointer :: diag_axis !< Local pointer to the diag_axis
324 
325  integer :: type_of_domain !< The type of domain the current axis is in
326  logical :: is_subaxis !< .true. if the axis is a subaxis
327  logical :: needs_domain_decomposition !< .True. if the axis needs the domain decomposition attribute
328  !! (i.e for "X" and "Y" subaxis)
329  integer :: domain_decomposition(4) !< indices of the global (1:2) and compute (3:4) domain for a "X" and "Y" subaxis
330 
331  is_subaxis = .false.
332  needs_domain_decomposition = .false.
333 
334  select type(this)
335  type is (fmsdiagfullaxis_type)
336  axis_name => this%axis_name
337  axis_length = this%length
338  diag_axis => this
339  type_of_domain = this%type_of_domain
340  type is (fmsdiagsubaxis_type)
341  is_subaxis = .true.
342  axis_name => this%subaxis_name
343  axis_length = this%ending_index - this%starting_index + 1
344  if (allocated(this%global_idx)) then
345  needs_domain_decomposition = .true.
346  domain_decomposition(1:2) = this%global_idx
347  domain_decomposition(3) = this%starting_index
348  domain_decomposition(4) = this%ending_index
349  endif
350  !< Get all the other information from the parent axis (i.e the cart_name, units, etc)
351  if (present(parent_axis)) then
352  select type(parent_axis)
353  type is (fmsdiagfullaxis_type)
354  diag_axis => parent_axis
355  end select
356  endif
357  type_of_domain = no_domain !< All subaxes are treated as non-domain decomposed (each rank writes it own file)
358  type is (fmsdiagdiurnalaxis_type)
359  call this%write_diurnal_metadata(fms2io_fileobj)
360  return
361  end select
362 
363  !< Add the axis as a dimension in the netcdf file based on the type of axis_domain and the fileobj type
364  select type (fms2io_fileobj)
365  !< The register_field calls need to be inside the select type block so that it can go inside the correct
366  !! register_field interface
367  type is (fmsnetcdffile_t)
368  !< Here the axis is not domain decomposed (i.e z_axis)
369  call register_axis(fms2io_fileobj, axis_name, axis_length)
370  call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
371  if (needs_domain_decomposition) then
372  call register_variable_attribute(fms2io_fileobj, axis_name, "domain_decomposition", &
373  domain_decomposition)
374  endif
375  type is (fmsnetcdfdomainfile_t)
376  select case (type_of_domain)
377  case (no_domain)
378  !< Here the fms2io_fileobj is domain decomposed, but the axis is not
379  !! Domain decomposed fileobjs can have axis that are not domain decomposed (i.e "Z" axis)
380  call register_axis(fms2io_fileobj, axis_name, axis_length)
381  call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
382  case (two_d_domain)
383  !< Here the axis is domain decomposed
384  call register_axis(fms2io_fileobj, axis_name, diag_axis%cart_name, domain_position=diag_axis%domain_position)
385  call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
386  end select
387  type is (fmsnetcdfunstructureddomainfile_t)
388  select case (type_of_domain)
389  case (ug_domain)
390  !< Here the axis is in a unstructured domain
391  call register_axis(fms2io_fileobj, axis_name)
392  call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
393  case default
394  !< Here the fms2io_fileobj is in the unstructured domain, but the axis is not
395  !< Unstructured domain fileobjs can have axis that are not domain decomposed (i.e "Z" axis)
396  call register_axis(fms2io_fileobj, axis_name, axis_length)
397  call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
398  end select
399  end select
400 
401  !< Write its metadata
402  if(allocated(diag_axis%long_name)) &
403  call register_variable_attribute(fms2io_fileobj, axis_name, "long_name", diag_axis%long_name, &
404  str_len=len_trim(diag_axis%long_name))
405 
406  if (diag_axis%cart_name .NE. "N") &
407  call register_variable_attribute(fms2io_fileobj, axis_name, "axis", diag_axis%cart_name, str_len=1)
408 
409  if (trim(diag_axis%units) .NE. "none") &
410  call register_variable_attribute(fms2io_fileobj, axis_name, "units", diag_axis%units, &
411  str_len=len_trim(diag_axis%units))
412 
413  select case (diag_axis%direction)
414  case (direction_up)
415  call register_variable_attribute(fms2io_fileobj, axis_name, "positive", "up", str_len=2)
416  case (direction_down)
417  call register_variable_attribute(fms2io_fileobj, axis_name, "positive", "down", str_len=4)
418  end select
419 
420  !< Ignore the edges attribute, if the edges are already in the file or if it is subaxis
421  if (.not. edges_in_file .and. allocated(diag_axis%edges_name) .and. .not. is_subaxis) then
422  call register_variable_attribute(fms2io_fileobj, axis_name, "edges", diag_axis%edges_name, &
423  str_len=len_trim(diag_axis%edges_name))
424  endif
425 
426  if(allocated(diag_axis%attributes)) then
427  do i = 1, diag_axis%num_attributes
428  select type (att_value => diag_axis%attributes(i)%att_value)
429  type is (character(len=*))
430  call register_variable_attribute(fms2io_fileobj, axis_name, diag_axis%attributes(i)%att_name, &
431  trim(att_value(1)), str_len=len_trim(att_value(1)))
432  class default
433  call register_variable_attribute(fms2io_fileobj, axis_name, diag_axis%attributes(i)%att_name, att_value)
434  end select
435  enddo
436  endif
437 
438  end subroutine write_axis_metadata
439 
440  !> @brief Write the axis data to an open fms2io_fileobj
441  subroutine write_axis_data(this, fms2io_fileobj, parent_axis)
442  class(fmsdiagaxis_type), target, INTENT(IN) :: this !< diag_axis obj
443  class(fmsnetcdffile_t), INTENT(INOUT) :: fms2io_fileobj!< Fms2_io fileobj to write the data to
444  class(fmsdiagaxis_type), OPTIONAL, target, INTENT(IN) :: parent_axis !< The parent axis if this is a subaxis
445 
446  integer :: i !< Starting index of a sub_axis
447  integer :: j !< Ending index of a sub_axis
448  integer :: global_io_index(2)!< Global io domain starting and ending index
449  select type(this)
450  type is (fmsdiagfullaxis_type)
451  call this%get_global_io_domain(global_io_index)
452  call write_data(fms2io_fileobj, this%axis_name, this%axis_data(global_io_index(1):global_io_index(2)))
453  type is (fmsdiagsubaxis_type)
454  i = this%starting_index
455  j = this%ending_index
456 
457  if (present(parent_axis)) then
458  select type(parent_axis)
459  type is (fmsdiagfullaxis_type)
460  call write_data(fms2io_fileobj, this%subaxis_name, parent_axis%axis_data(i:j))
461  end select
462  endif
463  type is (fmsdiagdiurnalaxis_type)
464  call write_data(fms2io_fileobj, this%axis_name, this%diurnal_data)
465  end select
466  end subroutine write_axis_data
467 
468 
469  !> @brief Defined a new diurnal axis
470  subroutine define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges)
471  class(fmsdiagaxiscontainer_type), target, intent(inout) :: diag_axis(:) !< Array of axis containers
472  integer, intent(inout) :: naxis !< Number of axis that have
473  !! been defined
474  integer, intent(in) :: n_diurnal_samples !< The number of diurnal samples
475  !! for the curent axis
476  logical, intent(in) :: is_edges !< Flag indicating if this is
477  !! an edge axis
478 
479  CHARACTER(32) :: axis_name !< name of the axis
480  CHARACTER(32) :: long_name !< long name of the axis
481  CHARACTER(32) :: edges_name !< name of the axis edge
482  CHARACTER(128) :: units !< units of the axis
483  real(kind=r8_kind), allocatable :: diurnal_data(:) !< Data for the axis
484  integer :: edges_id !< Id of the axis edge
485  integer :: i !< For do loops
486 
487  naxis = naxis + 1
488 
489  axis_name = ''
490  edges_name = ''
491  if (is_edges) then
492  WRITE (axis_name,'(a,i2.2)') 'time_of_day_edges_', n_diurnal_samples
493  long_name = "time of day edges"
494  allocate(diurnal_data(n_diurnal_samples + 1))
495  diurnal_data(1) = 0.0
496  edges_id = diag_null
497  do i = 1, n_diurnal_samples
498  diurnal_data(i+1) = 24.0* real(i)/n_diurnal_samples
499  enddo
500  else
501  WRITE (axis_name,'(a,i2.2)') 'time_of_day_', n_diurnal_samples
502  long_name = "time of day"
503  allocate(diurnal_data(n_diurnal_samples))
504  edges_id = naxis -1 !< The diurnal edges is the last defined axis
505  do i = 1, n_diurnal_samples
506  diurnal_data(i) = 24.0*(real(i)-0.5)/n_diurnal_samples
507  enddo
508  WRITE (edges_name,'(a,i2.2)') 'time_of_day_edges_', n_diurnal_samples
509  endif
510 
511  WRITE (units,11) 'hours', get_base_year(), get_base_month(), &
513 11 FORMAT(a,' since ',i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':',i2.2)
514 
515  allocate(fmsdiagdiurnalaxis_type :: diag_axis(naxis)%axis)
516  select type (diurnal_axis => diag_axis(naxis)%axis)
517  type is (fmsdiagdiurnalaxis_type)
518  diurnal_axis%axis_id = naxis
519  diurnal_axis%ndiurnal_samples = n_diurnal_samples
520  diurnal_axis%axis_name = trim(axis_name)
521  diurnal_axis%long_name = trim(long_name)
522  diurnal_axis%units = trim(units)
523  diurnal_axis%diurnal_data = diurnal_data
524  diurnal_axis%edges_id = edges_id
525  if (is_edges) &
526  WRITE (edges_name,'(a,i2.2)') 'time_of_day_edges_', n_diurnal_samples
527  diurnal_axis%edges_name = trim(edges_name)
528  end select
529  end subroutine define_diurnal_axis
530 
531  !< @brief Determine if the axis is in the unstructured grid
532  !! @return .True. if the axis is in unstructured grid
533  pure logical function is_unstructured_grid(this)
534  class(fmsdiagaxis_type), target, INTENT(in) :: this !< diag_axis obj
535 
536  is_unstructured_grid = .false.
537  select type (this)
538  type is (fmsdiagfullaxis_type)
539  is_unstructured_grid = trim(this%cart_name) .eq. "U"
540  end select
541  end function is_unstructured_grid
542 
543  !< @brief Adds the structured axis ids to the axis object
544  subroutine add_structured_axis_ids(this, axis_ids)
545  class(fmsdiagaxis_type), target, INTENT(inout) :: this !< diag_axis obj
546  integer, intent(in) :: axis_ids(2) !< axis ids to add to the axis object
547 
548  select type (this)
549  type is (fmsdiagfullaxis_type)
550  allocate(this%structured_ids(2))
551  this%structured_ids = axis_ids
552  end select
553  end subroutine add_structured_axis_ids
554 
555  !< @brief Get the structured axis ids from the axis object
556  !! @return the structured axis ids
557  pure function get_structured_axis(this) &
558  result(rslt)
559  class(fmsdiagaxis_type), target, INTENT(in) :: this !< diag_axis obj
560  integer :: rslt(2)
561 
562  rslt = diag_null
563  select type (this)
564  type is (fmsdiagfullaxis_type)
565  rslt = this%structured_ids
566  end select
567  end function get_structured_axis
568 
569 
570  !< @brief Get the edges_id of an axis_object
571  !! @return The edges_id of an axis object
572  pure integer function get_edges_id(this)
573  class(fmsdiagaxis_type), INTENT(in) :: this !< diag_axis obj
574 
575  get_edges_id = diag_null
576  select type (this)
577  type is (fmsdiagfullaxis_type)
578  if (allocated(this%edges_id)) get_edges_id = this%edges_id
579  end select
580  end function
581 
582  !> @brief Get the starting and ending indices of the global io domain of the axis
583  subroutine get_global_io_domain(this, global_io_index)
584  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
585  integer, intent(out) :: global_io_index(2) !< Global io domain starting and ending index
586 
587  type(domain2d), pointer :: io_domain !< pointer to the io domain
588 
589  global_io_index(1) = 1
590  global_io_index(2) = this%length
591 
592  if (allocated(this%axis_domain)) then
593  select type(domain => this%axis_domain)
594  type is (diagdomain2d_t)
595  io_domain => mpp_get_io_domain(domain%domain2)
596  if (this%cart_name .eq. "X") then
597  call mpp_get_global_domain(io_domain, xbegin=global_io_index(1), xend=global_io_index(2), &
598  position=this%domain_position)
599  elseif (this%cart_name .eq. "Y") then
600  call mpp_get_global_domain(io_domain, ybegin=global_io_index(1), yend=global_io_index(2), &
601  position=this%domain_position)
602  endif
603  end select
604  endif
605  end subroutine get_global_io_domain
606 
607  !> @brief Get the length of the axis
608  !> @return axis length
609  function get_axis_length(this) &
610  result(axis_length)
611  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
612  integer :: axis_length
613 
614  !< If the axis is domain decomposed axis_length will be set to the length for the current PE:
615  if (allocated(this%axis_domain)) then
616  axis_length = this%axis_domain%length(this%cart_name, this%domain_position, this%length)
617  else
618  axis_length = this%length
619  endif
620 
621  end function
622 
623 
624  !> @brief Determine if an axis object has an auxiliary name
625  !! @return .true. if an axis object has an auxiliary name
626  pure function has_aux(this) &
627  result(rslt)
628  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
629  logical :: rslt
630 
631  rslt = .false.
632  if (allocated(this%aux)) rslt = trim(this%aux) .ne. ""
633  end function has_aux
634 
635  !> @brief Determine if an axis object has a set_name
636  !! @return .true. if an axis object has a set_name
637  pure function has_set_name(this) &
638  result(rslt)
639  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
640  logical :: rslt
641 
642  rslt = .false.
643  if (allocated(this%set_name)) rslt = trim(this%set_name) .ne. ""
644  end function has_set_name
645 
646  !> @brief Determine if an axis object is an x or y axis
647  !! @return .true. if an axis object is an x or y axis, optionally return a flag indicating which it is
648  function is_x_or_y_axis(this, x_or_y) &
649  result(rslt)
650  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
651  integer, optional, intent(inout) :: x_or_y !< returns is_x_axis if it is a x axis
652  !! is_y_axis if it is a y axis
653  logical :: rslt
654 
655  select case (trim(this%cart_name))
656  case ("X")
657  if (present(x_or_y)) x_or_y = is_x_axis
658  rslt = .true.
659  case ("Y")
660  if (present(x_or_y)) x_or_y = is_y_axis
661  rslt = .true.
662  case default
663  rslt = .false.
664  if (present(x_or_y)) x_or_y = diag_null
665  end select
666  end function is_x_or_y_axis
667 
668  !> @brief Get the set name of an axis object
669  !! @return the set name of an axis object
670  pure function get_set_name(this) &
671  result(rslt)
672  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
673  character(len=:), allocatable :: rslt
674 
675  rslt = this%set_name
676  end function get_set_name
677 
678  !> @brief Get the auxiliary name of an axis object
679  !! @return the auxiliary name of an axis object
680  pure function get_aux(this) &
681  result(rslt)
682  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
683  character(len=:), allocatable :: rslt
684 
685  rslt = this%aux
686  end function get_aux
687 
688  !> @brief Set the axis_id
689  subroutine set_axis_id(this, axis_id)
690  class(fmsdiagfullaxis_type), intent(inout) :: this !< diag_axis obj
691  integer, intent(in) :: axis_id !< Axis_id
692 
693  this%axis_id = axis_id
694 
695  end subroutine set_axis_id
696 
697  !> @brief Set the name and ids of the edges
698  subroutine set_edges(this, edges_name, edges_id)
699  class(fmsdiagfullaxis_type), intent(inout) :: this !< diag_axis obj
700  CHARACTER(len=*), intent(in) :: edges_name !< Name of the edges
701  integer, intent(in) :: edges_id !< Axis id of the edges
702 
703  !< Saving the name and the id of the edges axis because it will make it easier to use
704  !! downstream (i.e you need the edges name to write the attribute to the current axis,
705  !! and you need the edges id to add to the diag file object so that you can write the edges
706  !! to the file)
707  this%edges_name = edges_name
708  this%edges_id = edges_id
709  end subroutine set_edges
710 
711  !> @brief Determine if the subRegion is in the current PE.
712  !! If it is, determine the starting and ending indices of the current PE that belong to the subRegion
713  subroutine get_indices(this, compute_idx, corners_indices, starting_index, ending_index, need_to_define_axis)
714  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
715  integer, intent(in) :: compute_idx(:) !< Current PE's compute domain
716  class(*), intent(in) :: corners_indices(:) !< The indices of the corners of the subRegion
717  integer, intent(out) :: starting_index !< Starting index of the subRegion
718  !! for the current PE
719  integer, intent(out) :: ending_index !< Ending index of the subRegion
720  !! for the current PE
721  logical, intent(out) :: need_to_define_axis !< .true. if it is needed to define
722  !! an axis
723 
724  integer :: subregion_start !< Starting index of the subRegion
725  integer :: subregion_end !< Ending index of the subRegion
726 
727  !< Get the rectangular coordinates of the subRegion
728  !! If the subRegion is not rectangular, the points outside of the subRegion will be masked
729  !! out later
730  select type (corners_indices)
731  type is (integer(kind=i4_kind))
732  subregion_start = minval(corners_indices)
733  subregion_end = maxval(corners_indices)
734  end select
735 
736  !< Initiliaze the output
737  need_to_define_axis = .false.
738  starting_index = diag_null
739  ending_index = diag_null
740 
741  !< If the compute domain of the current PE is outisde of the range of sub_axis, return
742  if (compute_idx(1) < subregion_start .and. compute_idx(2) < subregion_start) return
743  if (compute_idx(1) > subregion_end .and. compute_idx(2) > subregion_end) return
744 
745  need_to_define_axis = .true.
746  if (compute_idx(1) >= subregion_start .and. compute_idx(2) >= subregion_end) then
747  !< In this case all the point of the current PE are inside the range of the sub_axis
748  starting_index = compute_idx(1)
749  ending_index = subregion_end
750  else if (compute_idx(1) >= subregion_start .and. compute_idx(2) <= subregion_end) then
751  !< In this case all the points of the current PE are valid up to the end point
752  starting_index = compute_idx(1)
753  ending_index = compute_idx(2)
754  else if (compute_idx(1) <= subregion_start .and. compute_idx(2) <= subregion_end) then
755  !< In this case all the points of the current PE are valid starting with t subregion_start
756  starting_index = subregion_start
757  ending_index = compute_idx(2)
758  else if (compute_idx(1) <= subregion_start .and. compute_idx(2) >= subregion_end) then
759  !< In this case only the points in the current PE ar valid
760  starting_index = subregion_start
761  ending_index = subregion_end
762  endif
763 
764  if (this%domain_position .ne. center) then
765  if (subregion_end - subregion_start + 1 .eq. 1) then
766  !< If your subregion consitsts of just 1 one, only include 1 PE
767  if (ending_index .eq. compute_idx(2)) need_to_define_axis = .false.
768  else
769  if (ending_index - starting_index + 1 .eq. 1) then
770  !< If the PEs section is only 1, only include 1 PE
771  if (starting_index .eq. compute_idx(2) .or. ending_index .eq. compute_idx(1)) &
772  need_to_define_axis = .false.
773  endif
774  endif
775  endif
776 
777  end subroutine get_indices
778 
779  !< Get the compute domain of the axis
780  subroutine get_compute_domain(this, compute_idx, need_to_define_axis, tile_number)
781  class(fmsdiagfullaxis_type), intent(in) :: this !< diag_axis obj
782  integer, intent(inout) :: compute_idx(:) !< Compute domain of the axis
783  logical, intent(out) :: need_to_define_axis !< .true. if it needed to define the axis
784  integer, optional, intent(in) :: tile_number !< The tile number of the axis
785 
786  !< Initialize the output
787  need_to_define_axis = .false.
788  compute_idx = diag_null
789 
790  if (.not. allocated(this%axis_domain)) then
791  !< If the axis is not domain decomposed, use the whole axis as the compute domain
792  if (this%cart_name .eq. "X" .or. this%cart_name .eq. "Y") then
793  compute_idx(1) = 1
794  compute_idx(2) = size(this%axis_data)
795  need_to_define_axis = .true.
796  endif
797  return
798  endif
799 
800  select type(domain => this%axis_domain)
801  type is (diagdomain2d_t)
802  if (present(tile_number)) then
803  !< If the the tile number is present and the current PE is not on the tile, then there is no need
804  !! to define the axis
805  if (any(mpp_get_tile_id(domain%Domain2) .ne. tile_number)) then
806  need_to_define_axis = .false.
807  return
808  endif
809  endif
810 
811  !< Get the compute domain for the current PE if it is an "X" or "Y" axis
812  select case (this%cart_name)
813  case ("X")
814  call mpp_get_compute_domain(domain%Domain2, xbegin=compute_idx(1), xend=compute_idx(2), &
815  & position=this%domain_position)
816  need_to_define_axis = .true.
817  case ("Y")
818  call mpp_get_compute_domain(domain%Domain2, ybegin=compute_idx(1), yend=compute_idx(2), &
819  & position=this%domain_position)
820  need_to_define_axis = .true.
821  end select
822  end select
823 
824  end subroutine get_compute_domain
825 
826  !!!!!!!!!!!!!!!!!! SUB AXIS PROCEDURES !!!!!!!!!!!!!!!!!
827  !> @brief Fills in the information needed to define a subaxis
828  subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, compute_idx, &
829  global_idx, zbounds, nz_subaxis)
830  class(fmsdiagsubaxis_type) , INTENT(INOUT) :: this !< diag_sub_axis obj
831  integer , intent(in) :: starting_index !< Starting index of the subRegion for the PE
832  integer , intent(in) :: ending_index !< Ending index of the subRegion for the PE
833  integer , intent(in) :: axis_id !< Axis id to assign to the subaxis
834  integer , intent(in) :: parent_id !< The id of the parent axis the subaxis belongs to
835  character(len=*) , intent(in) :: parent_axis_name !< Name of the parent_axis
836  integer , intent(in) :: compute_idx(2) !< Starting and ending index of
837  !! the axis's compute domain
838  integer, optional, intent(in) :: global_idx(2) !< Starting and ending index of
839  !! the axis's compute domain
840  real(kind=r4_kind), optional, intent(in) :: zbounds(2) !< Bounds of the z-axis
841  integer, optional, intent(in) :: nz_subaxis !< The number of z subaxis that have been defined
842  !! in the file
843 
844  integer :: nsubaxis !< The subaxis number in the axis name subXX
845  character(len=2) :: nsubaxis_char !< nsubaxis converted to a string
846 
847  nsubaxis = 1
848  if (present(nz_subaxis)) nsubaxis = nz_subaxis
849 
850  this%axis_id = axis_id
851  this%starting_index = starting_index
852  this%ending_index = ending_index
853  this%parent_axis_id = parent_id
854  write(nsubaxis_char, '(i2.2)') nsubaxis
855  this%subaxis_name = trim(parent_axis_name)//"_sub"//nsubaxis_char
856  this%compute_idx = compute_idx
857 
858  if (present(zbounds)) then
859  ! This is needed to avoid duplicating z sub axis!
860  allocate(this%zbounds(2))
861  this%zbounds = zbounds
862  endif
863 
864  if (present(global_idx)) then
865  ! This is needed for the "domain_decomposition" attribute which is needed for the combiner
866  allocate(this%global_idx(2))
867  this%global_idx = global_idx
868  endif
869  end subroutine fill_subaxis
870 
871  !> @brief Get the axis length of a subaxis
872  !> @return the axis length
873  function axis_length(this) &
874  result(res)
875  class(fmsdiagsubaxis_type) , INTENT(IN) :: this !< diag_sub_axis obj
876  integer :: res
877 
878  res = this%ending_index - this%starting_index + 1
879  end function
880 
881  !> @brief Accesses its member starting_index
882  !! @return a copy of the starting_index
883  function get_starting_index(this) result(indx)
884  class(fmsdiagsubaxis_type), intent(in) :: this !< diag_sub_axis object
885  integer :: indx !< Result to return
886  indx = this%starting_index
887  end function get_starting_index
888 
889  !> @brief Accesses its member ending_index
890  !! @return a copy of the ending_index
891  function get_ending_index(this) result(indx)
892  class(fmsdiagsubaxis_type), intent(in) :: this !< diag_sub_axis object
893  integer :: indx !< Result to return
894  indx = this%ending_index
895  end function get_ending_index
896 
897  !> @brief Accesses its member compute_indices
898  !! @return a copy of the ending_index
899  function get_compute_indices(this) result(indx)
900  class(fmsdiagsubaxis_type), intent(in) :: this !< diag_sub_axis object
901  integer :: indx(2) !< Result to return
902  indx = this%compute_idx
903  end function get_compute_indices
904 
905  !> @brief Get the ntiles in a domain
906  !> @return the number of tiles in a domain
907  function get_ntiles(this) &
908  result(ntiles)
909  class(diagdomain_t), INTENT(IN) :: this !< diag_axis obj
910 
911  integer :: ntiles
912 
913  select type (this)
914  type is (diagdomain2d_t)
915  ntiles = mpp_get_ntile_count(this%domain2)
916  end select
917  end function get_ntiles
918 
919  !> @brief Get the length of a 2D domain
920  !> @return Length of the 2D domain
921  function get_length(this, cart_axis, domain_position, global_length) &
922  result(length)
923  class(diagdomain_t), INTENT(IN) :: this !< diag_axis obj
924  character(len=*), INTENT(IN) :: cart_axis !< cart_axis of the axis
925  integer, INTENT(IN) :: domain_position !< Domain position (CENTER, NORTH, EAST)
926  integer, INTENT(IN) :: global_length !< global_length of the axis
927 
928  integer :: length
929 
930  select type (this)
931  type is(diagdomain2d_t)
932  if (trim(cart_axis) == "X") call mpp_get_compute_domain(this%Domain2, xsize=length, position=domain_position)
933  if (trim(cart_axis) == "Y") call mpp_get_compute_domain(this%Domain2, ysize=length, position=domain_position)
934  class default
935  !< If domain is 1D or UG, just set it to the global length
936  length = global_length
937  end select
938  end function get_length
939 
940  !!!!!!!!!!!!!!!!! FMS_DOMAIN PROCEDURES !!!!!!!!!!!!!!!!!
941 
942  !> @brief Set the axis domain
943  subroutine set_axis_domain(this, Domain, Domain2, DomainU)
944  class(diagdomain_t) :: this !< fms_domain obj
945  TYPE(domain1d), INTENT(in), OPTIONAL :: Domain !< 1d domain
946  TYPE(domain2d), INTENT(in), OPTIONAL :: Domain2 !< 2d domain
947  TYPE(domainug), INTENT(in), OPTIONAL :: DomainU !< Unstructured domain
948 
949  select type(this)
950  type is (diagdomain1d_t)
951  this%Domain = domain
952  type is (diagdomain2d_t)
953  this%Domain2 = domain2
954  type is (diagdomainug_t)
955  this%DomainUG = domainu
956  end select
957  end subroutine set_axis_domain
958 
959  !< @brief Allocates the array of axis/subaxis objects
960  !! @return true if there the aray of axis/subaxis objects is allocated
961  logical function fms_diag_axis_object_init(axis_array)
962  class(fmsdiagaxiscontainer_type) , allocatable, intent(inout) :: axis_array(:) !< Array of diag_axis
963 
964  if (allocated(axis_array)) call mpp_error(fatal, "The diag_axis containers is already allocated")
965  allocate(axis_array(max_axes))
966  !axis_array%axis_id = DIAG_NULL
967 
969  end function fms_diag_axis_object_init
970 
971  !< @brief Deallocates the array of axis/subaxis objects
972  !! @return false if the aray of axis/subaxis objects was allocated
973  logical function fms_diag_axis_object_end(axis_array)
974  class(fmsdiagaxiscontainer_type) , allocatable, intent(inout) :: axis_array(:) !< Array of diag_axis
975 
976  if (allocated(axis_array)) deallocate(axis_array)
977  fms_diag_axis_object_end = .false.
978 
979  end function fms_diag_axis_object_end
980 
981  !< @brief Determine the axis name of an axis_object
982  !! @return The name of the axis
983  !! @note This function may be called from the field object (i.e. to determine the dimension names for io),
984  !! The field object only contains the parent axis ids, because the subregion is defined in a per file basis,
985  !! so the is_regional flag is needed so that the correct axis name can be used
986  pure function get_axis_name(this, is_regional) &
987  result(axis_name)
988  class(fmsdiagaxis_type), intent(in) :: this !< Axis object
989  logical, intent(in), optional :: is_regional !< Flag indicating if the axis is regional
990 
991  character(len=:), allocatable :: axis_name
992 
993  select type (this)
994  type is (fmsdiagfullaxis_type)
995  axis_name = this%axis_name
996  if (present(is_regional)) then
997  if (is_regional) then
998  if (this%cart_name .eq. "X" .or. this%cart_name .eq. "Y") axis_name = axis_name//"_sub01"
999  endif
1000  endif
1001  type is (fmsdiagsubaxis_type)
1002  axis_name = this%subaxis_name
1003  end select
1004  end function get_axis_name
1005 
1006  !< @brief Determine if the axis is a Z axis by looking at the cartesian name
1007  !! @return .True. if the axis is a Z axis
1008  pure logical function is_z_axis(this)
1009  class(fmsdiagaxis_type), intent(in) :: this !< Axis object
1010  is_z_axis = .false.
1011  select type (this)
1012  type is (fmsdiagfullaxis_type)
1013  if (this%cart_name .eq. "Z") is_z_axis = .true.
1014  end select
1015  end function
1016 
1017  !> @brief Check if a cart_name is valid and crashes if it isn't
1018  subroutine check_if_valid_cart_name(cart_name)
1019  character(len=*), intent(in) :: cart_name
1020 
1021  select case (cart_name)
1022  case ("X", "Y", "Z", "T", "U", "N")
1023  case default
1024  call mpp_error(fatal, "diag_axit_init: Invalid cart_name: "//cart_name//&
1025  "The acceptable values are X, Y, Z, T, U, N.")
1026  end select
1027  end subroutine check_if_valid_cart_name
1028 
1029  !> @brief Check if a domain_position is valid and crashes if it isn't
1030  subroutine check_if_valid_domain_position(domain_position)
1031  integer, INTENT(IN) :: domain_position
1032 
1033  select case (domain_position)
1034  case (center, north, east)
1035  case default
1036  call mpp_error(fatal, "diag_axit_init: Invalid domain_positon. &
1037  &The acceptable values are NORTH, EAST, CENTER")
1038  end select
1039  end subroutine check_if_valid_domain_position
1040 
1041  !> @brief Check if a direction is valid and crashes if it isn't
1042  subroutine check_if_valid_direction(direction)
1043  integer, INTENT(IN) :: direction
1044 
1045  select case(direction)
1046  case(-1, 0, 1)
1047  case default
1048  call mpp_error(fatal, "diag_axit_init: Invalid direction. &
1049  &The acceptable values are-1 0 1")
1050  end select
1051  end subroutine check_if_valid_direction
1052 
1053  !> @brief Loop through a variable's axis_id to determine and return the domain type and domain to use
1054  subroutine get_domain_and_domain_type(diag_axis, axis_id, domain_type, domain, var_name)
1055  class(fmsdiagaxiscontainer_type), target, intent(in) :: diag_axis(:) !< Array of diag_axis
1056  integer, INTENT(IN) :: axis_id(:) !< Array of axis ids
1057  integer, INTENT(OUT) :: domain_type !< fileobj_type to use
1058  CLASS(diagdomain_t), POINTER, INTENT(OUT) :: domain !< Domain
1059  character(len=*), INTENT(IN) :: var_name !< Name of the variable (for error messages)
1060 
1061  integer :: i !< For do loops
1062  integer :: j !< axis_id(i) (for less typing)
1063 
1064  domain_type = no_domain
1065  domain => null()
1066 
1067  do i = 1, size(axis_id)
1068  j = axis_id(i)
1069  select type (axis => diag_axis(j)%axis)
1070  type is (fmsdiagfullaxis_type)
1071  !< Check that all the axis are in the same domain
1072  if (domain_type .ne. axis%type_of_domain) then
1073  !< If they are different domains, one of them can be NO_DOMAIN
1074  !! i.e a variable can have axis that are domain decomposed (x,y) and an axis that isn't (z)
1075  if (domain_type .eq. no_domain .or. axis%type_of_domain .eq. no_domain ) then
1076  !< Update the domain_type and domain, if needed
1077  if ((axis%type_of_domain .eq. two_d_domain .and. size(axis_id) > 1) &
1078  & .or. axis%type_of_domain .eq. ug_domain) then
1079  domain_type = axis%type_of_domain
1080  domain => axis%axis_domain
1081  endif
1082  else
1083  call mpp_error(fatal, "The variable:"//trim(var_name)//" has axis that are not in the same domain")
1084  endif
1085  endif
1086  end select
1087  enddo
1088  end subroutine get_domain_and_domain_type
1089 
1090  !> @brief Fill in the subaxis object for a subRegion defined by index
1091  subroutine define_new_subaxis_index(parent_axis, subRegion, diag_axis, naxis, is_x_or_y, write_on_this_pe)
1092  class(fmsdiagaxiscontainer_type), target, intent(inout) :: diag_axis(:) !< Diag_axis object
1093  type(fmsdiagfullaxis_type), intent(inout) :: parent_axis !< axis object of the parent
1094  integer, intent(inout) :: naxis !< Number of axis registered
1095  type(subregion_type), intent(in) :: subregion !< SubRegion definition from the yaml
1096  integer, intent(in) :: is_x_or_y !< Flag indicating if it is
1097  !! a x or y axis
1098  logical, intent(out) :: write_on_this_pe !< .true. if the subregion
1099  !! is on this PE
1100  integer :: compute_idx(2) !< Indices of the compute domain
1101  integer :: global_idx(2) !< Indices of the "global" domain
1102  integer :: starting_index !< starting index of the subregion
1103  integer :: ending_index !< ending index of the subregion
1104 
1105  call parent_axis%get_compute_domain(compute_idx, write_on_this_pe, tile_number=subregion%tile)
1106  if (.not. write_on_this_pe) return
1107 
1108  !< Determine if the PE's compute domain is inside the subRegion
1109  !! If it is get the starting and ending indices for that PE
1110  call parent_axis%get_indices(compute_idx, subregion%corners(:,is_x_or_y), starting_index, ending_index, &
1111  write_on_this_pe)
1112 
1113  if (.not. write_on_this_pe) return
1114 
1115  select type(corners=> subregion%corners)
1116  type is (integer(kind=i4_kind))
1117  global_idx(1) = minval(corners(:,is_x_or_y))
1118  global_idx(2) = maxval(corners(:,is_x_or_y))
1119  end select
1120 
1121  !< If it made it to this point, the current PE is in the subRegion!
1122  call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, &
1123  starting_index, ending_index, compute_idx, global_idx)
1124 
1125  end subroutine define_new_subaxis_index
1126 
1127  !> @brief Fill in the subaxis object for a subRegion defined by lat lon
1128  subroutine define_new_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_sphere, write_on_this_pe)
1129  class(fmsdiagaxiscontainer_type), target, intent(inout) :: diag_axis(:) !< Diag_axis object
1130  integer, INTENT(in) :: axis_ids(:) !< Array of axes_ids
1131  integer, intent(inout) :: naxis !< Number of axis registered
1132  type(subregion_type), intent(in) :: subregion !< SubRegion definition from the yaml
1133  logical, intent(in) :: is_cube_sphere !< .true. if this is a cubesphere
1134  logical, intent(out) :: write_on_this_pe !< .true. if the subregion
1135  !! is on this PE
1136 
1137  real :: lat(2) !< Starting and ending lattiude of the subRegion
1138  real :: lon(2) !< Starting and ending longitude or the subRegion
1139  integer :: lat_indices(2) !< Starting and ending latitude indices of the subRegion
1140  integer :: lon_indices(2) !< Starting and ending longitude indices of the subRegion
1141  integer :: compute_idx(2) !< Compute domain of the current axis
1142  integer :: starting_index(2) !< Starting index of the subRegion for the current PE for the "x" and "y"
1143  !! direction
1144  integer :: ending_index(2) !< Ending index of the subRegion for the current PE for the "x" and "y" direction
1145  logical :: need_to_define_axis(2) !< .true. if it is needed to define the subaxis for the "x" and "y" direction
1146  integer :: i !< For do loops
1147  integer :: parent_axis_ids(2) !< The axis id of the parent axis for the "x" and "y" direction
1148  logical :: is_x_y_axis !< .true. if the axis is x or y
1149  integer :: compute_idx_2(2, 2) !< Starting and ending indices of the compute domain for the "x" and "y" direction
1150  integer :: global_idx (2, 2) !< Starting and ending indices of the global domain for the "x" and "y" direction
1151 
1152  write_on_this_pe = .false.
1153  need_to_define_axis = .true.
1154  parent_axis_ids = diag_null
1155 
1156  !< Get the rectangular coordinates of the subRegion
1157  !! If the subRegion is not rectangular, the points outside of the subRegion will be masked
1158  !! out later
1159  select type (corners => subregion%corners)
1160  type is (real(kind=r4_kind))
1161  lon(1) = minval(corners(:,1))
1162  lon(2) = maxval(corners(:,1))
1163  lat(1) = minval(corners(:,2))
1164  lat(2) = maxval(corners(:,2))
1165  end select
1166 
1167  if_is_cube_sphere: if (is_cube_sphere) then
1168  !< Get the starting and ending indices of the subregion in the cubesphere relative to the global domain
1169  call get_local_indices_cubesphere(lat(1), lat(2), lon(1), lon(2),&
1170  & lon_indices(1), lon_indices(2), lat_indices(1), lat_indices(2))
1171  loop_over_axis_ids: do i = 1, size(axis_ids)
1172  select_axis_type: select type (parent_axis => diag_axis(axis_ids(i))%axis)
1173  type is (fmsdiagfullaxis_type)
1174  !< Get the PEs compute domain
1175  call parent_axis%get_compute_domain(compute_idx, is_x_y_axis)
1176 
1177  !< If this is not a "X" or "Y" axis go to the next axis
1178  if (.not. is_x_y_axis) cycle
1179 
1180  !< Determine if the PE's compute domain is inside the subRegion
1181  !! If it is get the starting and ending indices for that PE
1182  if (parent_axis%cart_name .eq. "X") then
1183  call parent_axis%get_indices(compute_idx, lon_indices, starting_index(1), ending_index(1), &
1184  need_to_define_axis(1))
1185  parent_axis_ids(1) = axis_ids(i)
1186  compute_idx_2(1,:) = compute_idx
1187  global_idx(1,:) = lon_indices
1188  else if (parent_axis%cart_name .eq. "Y") then
1189  call parent_axis%get_indices(compute_idx, lat_indices, starting_index(2), ending_index(2), &
1190  need_to_define_axis(2))
1191  parent_axis_ids(2) = axis_ids(i)
1192  compute_idx_2(2,:) = compute_idx
1193  global_idx(2,:) = lat_indices
1194  endif
1195  end select select_axis_type
1196  enddo loop_over_axis_ids
1197  else if_is_cube_sphere
1198  loop_over_axis_ids2: do i = 1, size(axis_ids)
1199  select type (parent_axis => diag_axis(axis_ids(i))%axis)
1200  type is (fmsdiagfullaxis_type)
1201  !< Get the PEs compute domain
1202  call parent_axis%get_compute_domain(compute_idx, is_x_y_axis)
1203 
1204  !< If this is not a "X" or "Y" axis go to the next axis
1205  if (.not. is_x_y_axis) cycle
1206 
1207  !< Get the starting and ending indices of the subregion relative to the global grid
1208  if (parent_axis%cart_name .eq. "X") then
1209  select type(adata=>parent_axis%axis_data)
1210  type is (real(kind=r8_kind))
1211  lon_indices(1) = nearest_index(real(lon(1), kind=r8_kind), adata)
1212  lon_indices(2) = nearest_index(real(lon(2), kind=r8_kind), adata)
1213  type is (real(kind=r4_kind))
1214  lon_indices(1) = nearest_index(real(lon(1), kind=r4_kind), adata)
1215  lon_indices(2) = nearest_index(real(lon(2), kind=r4_kind), adata)
1216  end select
1217  call parent_axis%get_indices(compute_idx, lon_indices, starting_index(1), ending_index(1), &
1218  need_to_define_axis(1))
1219  parent_axis_ids(1) = axis_ids(i)
1220  compute_idx_2(1,:) = compute_idx
1221  global_idx(1,:) = lon_indices
1222  else if (parent_axis%cart_name .eq. "Y") then
1223  select type(adata=>parent_axis%axis_data)
1224  type is (real(kind=r8_kind))
1225  lat_indices(1) = nearest_index(real(lat(1), kind=r8_kind), adata)
1226  lat_indices(2) = nearest_index(real(lat(2), kind=r8_kind), adata)
1227  type is (real(kind=r4_kind))
1228  lat_indices(1) = nearest_index(real(lat(1), kind=r4_kind), adata)
1229  lat_indices(2) = nearest_index(real(lat(2), kind=r4_kind), adata)
1230  end select
1231  call parent_axis%get_indices(compute_idx, lat_indices, starting_index(2), ending_index(2), &
1232  need_to_define_axis(2))
1233  parent_axis_ids(2) = axis_ids(i)
1234  compute_idx_2(2,:) = compute_idx
1235  global_idx(2,:) = lat_indices
1236  endif
1237  end select
1238  enddo loop_over_axis_ids2
1239  endif if_is_cube_sphere
1240 
1241  !< If the PE's compute is not inside the subRegion move to the next axis
1242  if (any(.not. need_to_define_axis )) return
1243 
1244  !< If it made it to this point, the current PE is in the subRegion!
1245  write_on_this_pe = .true.
1246 
1247  do i = 1, size(parent_axis_ids)
1248  if (parent_axis_ids(i) .eq. diag_null) cycle
1249  select type (parent_axis => diag_axis(parent_axis_ids(i))%axis)
1250  type is (fmsdiagfullaxis_type)
1251  call define_new_axis(diag_axis, parent_axis, naxis, parent_axis_ids(i), &
1252  starting_index(i), ending_index(i), compute_idx_2(i,:), global_idx(i,:))
1253  end select
1254  enddo
1255 
1256  end subroutine define_new_subaxis_latlon
1257 
1258  !> @brief Creates a new subaxis and fills it will all the information it needs
1259  subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, &
1260  starting_index, ending_index, compute_idx, global_idx, new_axis_id, zbounds, &
1261  nz_subaxis)
1262 
1263  class(fmsdiagaxiscontainer_type), target, intent(inout) :: diag_axis(:) !< Diag_axis object
1264  class(fmsdiagfullaxis_type), intent(inout) :: parent_axis !< The parent axis
1265  integer, intent(inout) :: naxis !< The number of axis that
1266  !! have been defined
1267  integer, intent(in) :: parent_id !< Id of the parent axis
1268  integer, intent(in) :: starting_index !< PE's Starting index
1269  integer, intent(in) :: ending_index !< PE's Ending index
1270  integer, intent(in) :: compute_idx(2) !< Starting and ending index of
1271  !! the axis's compute domain
1272  integer, optional, intent(in) :: global_idx(2) !< Starting and ending index of
1273  !! the axis's global domain
1274  integer, optional, intent(out) :: new_axis_id !< Axis id of the axis this is creating
1275  real(kind=r4_kind), optional, intent(in) :: zbounds(2) !< Bounds of the Z axis
1276  integer, optional, intent(in) :: nz_subaxis !< The number of z subaxis that have
1277  !! been defined in the file
1278 
1279  naxis = naxis + 1 !< This is the axis id of the new axis!
1280 
1281  !< Add the axis_id of the new subaxis to the parent axis
1282  parent_axis%nsubaxis = parent_axis%nsubaxis + 1
1283  parent_axis%subaxis(parent_axis%nsubaxis) = naxis
1284 
1285  !< Allocate the new axis as a subaxis and fill it
1286  allocate(fmsdiagsubaxis_type :: diag_axis(naxis)%axis)
1287  diag_axis(naxis)%axis%axis_id = naxis
1288  if (present(new_axis_id)) new_axis_id = naxis
1289 
1290  select type (sub_axis => diag_axis(naxis)%axis)
1291  type is (fmsdiagsubaxis_type)
1292  call sub_axis%fill_subaxis(starting_index, ending_index, naxis, parent_id, &
1293  parent_axis%axis_name, compute_idx, global_idx=global_idx, zbounds=zbounds, nz_subaxis=nz_subaxis)
1294  end select
1295  end subroutine define_new_axis
1296 
1297  !< @brief Determine the parent_axis_id of a subaxis
1298  !! @return parent_axis_id if it is a subaxis and diag_null if is not a subaxis
1299  pure function get_parent_axis_id(this) &
1300  result(parent_axis_id)
1301 
1302  class(fmsdiagaxis_type), intent(in) :: this !< Axis Object
1303  integer :: parent_axis_id
1304 
1305  select type (this)
1306  type is (fmsdiagfullaxis_type)
1307  parent_axis_id = diag_null
1308  type is (fmsdiagsubaxis_type)
1309  parent_axis_id = this%parent_axis_id
1310  type is (fmsdiagdiurnalaxis_type)
1311  parent_axis_id = diag_null
1312  end select
1313 
1314  end function
1315 
1316  !< @brief Determine the most recent subaxis id in a diag_axis object
1317  !! @return the most recent subaxis id in a diag_axis object
1318  pure function get_subaxes_id(this) &
1319  result(sub_axis_id)
1320 
1321  class(fmsdiagaxis_type), intent(in) :: this !< Axis Object
1322  integer :: sub_axis_id
1323 
1324  sub_axis_id = this%axis_id
1325  select type (this)
1326  type is (fmsdiagfullaxis_type)
1327  if (this%cart_name .ne. "Z") sub_axis_id = this%subaxis(this%nsubaxis)
1328  end select
1329 
1330  end function
1331 
1332  !< @brief Parses the "compress" attribute to get the names of the two axis
1333  !! @return the names of the structured axis
1334  pure function parse_compress_att(compress_att) &
1335  result(axis_names)
1336  class(*), intent(in) :: compress_att(:) !< The compress attribute to parse
1337  character(len=120) :: axis_names(2)
1338 
1339  integer :: ios !< Errorcode after parsing the compress attribute
1340 
1341  select type (compress_att)
1342  type is (character(len=*))
1343  read(compress_att(1),*, iostat=ios) axis_names
1344  if (ios .ne. 0) axis_names = ""
1345  class default
1346  axis_names = ""
1347  end select
1348  end function parse_compress_att
1349 
1350  !< @brief Determine the axis id of a axis
1351  !! @return Axis id
1352  pure function get_axis_id_from_name(axis_name, diag_axis, naxis, set_name) &
1353  result(axis_id)
1354  class(fmsdiagaxiscontainer_type), intent(in) :: diag_axis(:) !< Array of axis object
1355  character(len=*), intent(in) :: axis_name !< Name of the axis
1356  integer, intent(in) :: naxis !< Number of axis that have been registered
1357  character(len=*), intent(in) :: set_name !< Name of the axis set
1358  integer :: axis_id
1359 
1360  integer :: i !< For do loops
1361 
1362  axis_id = diag_null
1363  do i = 1, naxis
1364  select type(axis => diag_axis(i)%axis)
1365  type is (fmsdiagfullaxis_type)
1366  if (trim(axis%axis_name) .eq. trim(axis_name)) then
1367  if (trim(axis%set_name) .eq. trim(set_name)) then
1368  axis_id = i
1369  return
1370  endif
1371  endif
1372  end select
1373  enddo
1374 
1375  end function get_axis_id_from_name
1376 
1377  !< @brief Get the number of diurnal samples for a diurnal axis
1378  !! @return The number of diurnal samples
1379  pure function get_diurnal_axis_samples(this) &
1380  result(n_diurnal_samples)
1381 
1382  class(fmsdiagdiurnalaxis_type), intent(in) :: this !< Axis Object
1383  integer :: n_diurnal_samples
1384 
1385  n_diurnal_samples = this%ndiurnal_samples
1386  end function get_diurnal_axis_samples
1387 
1388  !< @brief Writes out the metadata for a diurnal axis
1389  subroutine write_diurnal_metadata(this, fms2io_fileobj)
1390  class(fmsdiagdiurnalaxis_type), intent(in) :: this !< Diurnal axis Object
1391  class(fmsnetcdffile_t), intent(inout) :: fms2io_fileobj !< Fms2_io fileobj to write the data to
1392 
1393  call register_axis(fms2io_fileobj, this%axis_name, size(this%diurnal_data))
1394  call register_field(fms2io_fileobj, this%axis_name, pack_size_str, (/trim(this%axis_name)/))
1395  call register_variable_attribute(fms2io_fileobj, this%axis_name, "units", &
1396  &trim(this%units), str_len=len_trim(this%units))
1397  call register_variable_attribute(fms2io_fileobj, this%axis_name, "long_name", &
1398  &trim(this%long_name), str_len=len_trim(this%long_name))
1399  if (this%edges_id .ne. diag_null) &
1400  call register_variable_attribute(fms2io_fileobj, this%axis_name, "edges", &
1401  &trim(this%edges_name), str_len=len_trim(this%edges_name))
1402  end subroutine write_diurnal_metadata
1403 
1404  !> @brief Creates a new z subaxis to use
1405  subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_axis_id, nfile_axis, nz_subaxis)
1406  real(kind=r4_kind), intent(in) :: zbounds(2) !< Bounds of the Z axis
1407  integer, intent(inout) :: var_axis_ids(:) !< The variable's axis_ids
1408  class(fmsdiagaxiscontainer_type), target, intent(inout) :: diag_axis(:) !< Array of diag_axis objects
1409  integer, intent(inout) :: naxis !< Number of axis that have been
1410  !! registered
1411  integer, intent(inout) :: file_axis_id(:) !< The file's axis_ids
1412  integer, intent(inout) :: nfile_axis !< Number of axis that have been
1413  !! defined in file
1414  integer, intent(inout) :: nz_subaxis !< The number of z subaxis currently
1415  !! defined in the file
1416 
1417  class(*), pointer :: zaxis_data(:) !< The data of the full zaxis
1418  integer :: subaxis_indices(2) !< The starting and ending indices of the subaxis relative to the full
1419  !! axis
1420  integer :: i !< For do loops
1421  integer :: subaxis_id !< The id of the new z subaxis
1422  logical :: axis_found !< Flag that indicated if the zsubaxis already exists
1423 
1424  !< Determine if the axis was already created
1425  axis_found = .false.
1426  do i = 1, nfile_axis
1427  select type (axis => diag_axis(file_axis_id(i))%axis)
1428  type is (fmsdiagsubaxis_type)
1429  if (axis%zbounds(1) .eq. zbounds(1) .and. axis%zbounds(2) .eq. zbounds(2)) then
1430  axis_found = .true.
1431  subaxis_id = file_axis_id(i)
1432  exit
1433  endif
1434  end select
1435  enddo
1436 
1437  !< Determine which of the variable's axis is the zaxis!
1438  do i = 1, size(var_axis_ids)
1439  select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
1440  type is (fmsdiagfullaxis_type)
1441  if (parent_axis%cart_name .eq. "Z") then
1442  !< If the axis was previously defined set the var_axis_ids and leave
1443  if (axis_found) then
1444  var_axis_ids(i) = subaxis_id
1445  return
1446  endif
1447  zaxis_data => parent_axis%axis_data
1448 
1449  select type(zaxis_data)
1450  type is (real(kind=r4_kind))
1451  !TODO need to include the conversion to "real" because nearest_index doesn't take r4s and r8s
1452  subaxis_indices(1) = nearest_index(real(zbounds(1)), real(zaxis_data))
1453  subaxis_indices(2) = nearest_index(real(zbounds(2)), real(zaxis_data))
1454  type is (real(kind=r8_kind))
1455  subaxis_indices(1) = nearest_index(real(zbounds(1)), real(zaxis_data))
1456  subaxis_indices(2) = nearest_index(real(zbounds(2)), real(zaxis_data))
1457  end select
1458 
1459  nz_subaxis = nz_subaxis + 1
1460  call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, &
1461  &subaxis_indices(1), subaxis_indices(2), (/lbound(zaxis_data,1), ubound(zaxis_data,1)/), &
1462  &new_axis_id=subaxis_id, zbounds=zbounds, nz_subaxis=nz_subaxis)
1463  var_axis_ids(i) = subaxis_id
1464  return
1465  endif
1466  end select
1467  enddo
1468 
1469  end subroutine
1470 
1471  !> @brief Determine if the diag_axis(parent_axis_id) is the parent of diag_axis(axis_id)
1472  !! @return .True. if diag_axis(parent_axis_id) is the parent of diag_axis(axis_id)
1473  function is_parent_axis(axis_id, parent_axis_id, diag_axis) &
1474  result(rslt)
1475  integer, intent(in) :: axis_id !< Axis id to check
1476  integer, intent(in) :: parent_axis_id !< Axis id of the parent to check
1477  class(fmsdiagaxiscontainer_type), target, intent(in) :: diag_axis(:) !< Array of diag_axis objects
1478 
1479  logical :: rslt
1480 
1481  rslt = .false.
1482  select type(axis => diag_axis(axis_id)%axis)
1483  type is (fmsdiagsubaxis_type)
1484  if (axis%parent_axis_id .eq. parent_axis_id) rslt = .true.
1485  end select
1486  end function is_parent_axis
1487 
1488 #endif
1489 end module fms_diag_axis_object_mod
1490 !> @}
1491 ! close documentation grouping
integer, parameter direction_down
The axis points down if positive.
Definition: diag_data.F90:106
integer function get_base_minute()
gets the module variable base_minute
Definition: diag_data.F90:551
integer function get_base_year()
gets the module variable base_year
Definition: diag_data.F90:519
integer function get_base_hour()
gets the module variable base_hour
Definition: diag_data.F90:543
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
Definition: diag_data.F90:101
integer max_axis_attributes
Maximum number of user definable attributes per axis.
Definition: diag_data.F90:385
character(len=6) pack_size_str
Pack size as a string to be used in fms2_io register call set to "double" or "float".
Definition: diag_data.F90:409
integer max_axes
Maximum number of independent axes.
Definition: diag_data.F90:361
integer, parameter is_x_axis
integer indicating that it is a x axis
Definition: diag_data.F90:130
integer, parameter is_y_axis
integer indicating that it is a y axis
Definition: diag_data.F90:131
integer function get_base_day()
gets the module variable base_day
Definition: diag_data.F90:535
integer, parameter ug_domain
Use the FmsNetcdfUnstructuredDomainFile_t fileobj.
Definition: diag_data.F90:103
integer, parameter direction_up
The axis points up if positive.
Definition: diag_data.F90:105
integer function get_base_month()
gets the module variable base_month
Definition: diag_data.F90:527
integer function get_base_second()
gets the module variable base_second
Definition: diag_data.F90:559
integer, parameter two_d_domain
Use the FmsNetcdfDomainFile_t fileobj.
Definition: diag_data.F90:102
Attribute type for diagnostic fields.
Definition: diag_data.F90:157
Type to hold the attributes of the field/axis/file.
Definition: diag_data.F90:334
subroutine, public get_local_indexes(latStart, latEnd, lonStart, lonEnd, istart, iend, jstart, jend)
Find the local start and local end indexes on the local PE for regional output.
Definition: diag_grid.F90:392
Add a dimension to a given file.
Definition: fms2_io.F90:190
Defines a new field within the given file Example usage:
Definition: fms2_io.F90:212
Write data to a defined field within a file Example usage:
Definition: fms2_io.F90:262
subroutine get_global_io_domain(this, global_io_index)
Get the starting and ending indices of the global io domain of the axis.
subroutine, public define_new_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_sphere, write_on_this_pe)
Fill in the subaxis object for a subRegion defined by lat lon.
pure character(len=:) function, allocatable get_axis_name(this, is_regional)
integer function get_length(this, cart_axis, domain_position, global_length)
Get the length of a 2D domain.
integer function get_ending_index(this)
Accesses its member ending_index.
logical function, public fms_diag_axis_object_end(axis_array)
subroutine check_if_valid_domain_position(domain_position)
Check if a domain_position is valid and crashes if it isn't.
logical function is_x_or_y_axis(this, x_or_y)
Determine if an axis object is an x or y axis.
pure logical function is_unstructured_grid(this)
subroutine set_axis_id(this, axis_id)
Set the axis_id.
pure logical function is_z_axis(this)
integer function axis_length(this)
Get the axis length of a subaxis.
pure integer function get_diurnal_axis_samples(this)
integer function get_ntiles(this)
Get the ntiles in a domain.
subroutine, public define_new_subaxis_index(parent_axis, subRegion, diag_axis, naxis, is_x_or_y, write_on_this_pe)
Fill in the subaxis object for a subRegion defined by index.
pure integer function, public get_axis_id_from_name(axis_name, diag_axis, naxis, set_name)
subroutine get_compute_domain(this, compute_idx, need_to_define_axis, tile_number)
subroutine, public define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges)
Defined a new diurnal axis.
pure integer function, dimension(2) get_structured_axis(this)
pure logical function has_aux(this)
Determine if an axis object has an auxiliary name.
subroutine add_structured_axis_ids(this, axis_ids)
subroutine check_if_valid_cart_name(cart_name)
Check if a cart_name is valid and crashes if it isn't.
subroutine write_axis_metadata(this, fms2io_fileobj, edges_in_file, parent_axis)
Write the axis meta data to an open fileobj.
subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, compute_idx, global_idx, zbounds, nz_subaxis)
Fills in the information needed to define a subaxis.
logical function, public fms_diag_axis_object_init(axis_array)
pure integer function get_subaxes_id(this)
integer function get_starting_index(this)
Accesses its member starting_index.
subroutine get_indices(this, compute_idx, corners_indices, starting_index, ending_index, need_to_define_axis)
Determine if the subRegion is in the current PE. If it is, determine the starting and ending indices ...
pure integer function get_parent_axis_id(this)
subroutine check_if_valid_direction(direction)
Check if a direction is valid and crashes if it isn't.
subroutine, public create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_axis_id, nfile_axis, nz_subaxis)
Creates a new z subaxis to use.
subroutine register_diag_axis_obj(this, axis_name, axis_data, units, cart_name, long_name, direction, set_name, Domain, Domain2, DomainU, aux, req, tile_count, domain_position, axis_length)
Initialize the axis.
subroutine write_axis_data(this, fms2io_fileobj, parent_axis)
Write the axis data to an open fms2io_fileobj.
subroutine, public define_new_axis(diag_axis, parent_axis, naxis, parent_id, starting_index, ending_index, compute_idx, global_idx, new_axis_id, zbounds, nz_subaxis)
Creates a new subaxis and fills it will all the information it needs.
integer function get_axis_length(this)
Get the length of the axis.
pure character(len=:) function, allocatable get_set_name(this)
Get the set name of an axis object.
pure character(len=120) function, dimension(2), public parse_compress_att(compress_att)
subroutine set_edges(this, edges_name, edges_id)
Set the name and ids of the edges.
logical function, public is_parent_axis(axis_id, parent_axis_id, diag_axis)
Determine if the diag_axis(parent_axis_id) is the parent of diag_axis(axis_id)
subroutine add_axis_attribute(this, att_name, att_value)
Add an attribute to an axis.
subroutine write_diurnal_metadata(this, fms2io_fileobj)
pure logical function has_set_name(this)
Determine if an axis object has a set_name.
pure integer function get_edges_id(this)
integer function, dimension(2) get_compute_indices(this)
Accesses its member compute_indices.
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.
subroutine set_axis_domain(this, Domain, Domain2, DomainU)
Set the axis domain.
pure character(len=:) function, allocatable get_aux(this)
Get the auxiliary name of an axis object.
integer function, dimension(size(domain%tile_id(:))) mpp_get_tile_id(domain)
Returns the tile_id on current pe.
integer function mpp_get_ntile_count(domain)
Returns number of tiles in mosaic.
type(domain2d) function, pointer mpp_get_io_domain(domain)
Set user stack size.
These routines retrieve the axis specifications associated with the compute domains....
These routines retrieve the axis specifications associated with the global domains....
One dimensional domain used to manage shared data access between pes.
The domain2D type contains all the necessary information to define the global, compute and data domai...
Domain information for managing data on unstructured grids.
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:43
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407
Error handler.
Definition: mpp.F90:382
Type to hold the domain info for an axis This type was created to avoid having to send in "Domain",...
Type to hold the unstructured domain.
Type to hold the diagnostic axis description.
Type to hold the diag_axis (either subaxis or a full axis)
Type to hold the diagnostic axis description.
type to hold the sub region information about a file