FMS  2026.01.01-dev
Flexible Modeling System
netcdf_io.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 !> @defgroup netcdf_io_mod netcdf_io_mod
19 !> @ingroup fms2_io
20 !> @brief This module defines the derived type, FmsNetcdfFile_t, and routines
21 !! to handle calls to the netcdf library in order to read and write netcdf files.
22 !!
23 !! This module is specifically for netcdf input/output when domain decomposition is not involved
24 !! The FmsNetcdfFile_t type is the base class that is extended by both
25 !! FmsNetcdfDomainFile_t and FmsNetcdfUnstructuredDomainFile_t.
26 !!
27 !! This module is not intended to be used externally. Please use the public interfaces in fms2_io_mod
28 !! for IO operations.
29 !!
30 !> @addtogroup netcdf_io_mod
31 !> @{
32 module netcdf_io_mod
33 #ifndef MAX_NUM_RESTART_VARS_
34 #define MAX_NUM_RESTART_VARS_ 250
35 #endif
36 use netcdf
37 use mpp_mod
38 use mpp_domains_mod
39 use fms_io_utils_mod
40 use platform_mod
41 implicit none
42 private
43 
44 
45 !Module constants.
46 integer, parameter, public :: default_deflate_level = 0 !< The default (no compression) deflate level to use
47 integer, parameter :: variable_missing = -1
48 integer, parameter :: dimension_missing = -1
49 integer, parameter, public :: no_unlimited_dimension = -1 !> No unlimited dimension in file.
50 character(len=1), parameter :: missing_path = ""
51 integer, parameter :: missing_ncid = -1
52 integer, parameter :: missing_rank = -1
53 integer, parameter, public :: define_mode = 0
54 integer, parameter, public :: data_mode = 1
55 integer, parameter, public :: max_num_restart_vars = max_num_restart_vars_
56 integer, parameter, public :: unlimited = nf90_unlimited !> Wrapper to specify unlimited dimension.
57 integer, parameter :: dimension_not_found = 0
58 integer, parameter, public :: max_num_compressed_dims = 10 !> Maximum number of compressed
59  !! dimensions allowed.
60 integer, private :: fms2_ncchksz = -1 !< Chunksize (bytes) used in nc_open and nc_create
61 integer, private :: fms2_nc_format_param = -1 !< Netcdf format type param used in nc_create
62 character (len = 10), private :: fms2_nc_format !< Netcdf format type used in netcdf_file_open
63 integer, private :: fms2_header_buffer_val = -1 !< value used in NF__ENDDEF
64 integer, private :: fms2_deflate_level = default_deflate_level !< Netcdf deflate level to use in
65  !! nf90_def_var (integer between 1 to 9)
66 logical, private :: fms2_shuffle = .false. !< Flag indicating whether to use the netcdf shuffle filter
67 logical, private :: fms2_is_netcdf4 = .false. !< Flag indicating whether the default netcdf file format is netcdf4
68 
69 !> @}
70 
71 !> @brief information needed fr regional restart variables
72 !> @ingroup netcdf_io_mod
73 type, private :: bc_information
74  integer, dimension(:), allocatable :: indices !< Indices for the halo region for the variable
75  !! (starting x, ending x, starting y, ending y)
76  integer, dimension(:), allocatable :: global_size !< Size of the variable for each dimension
77  integer, dimension(:), allocatable :: pelist !< List of pelist that have the data for the variable
78  logical :: is_root_pe !< Flag indicating if this is the root_pe from the pelist
79  integer :: x_halo !< Number of halos in x
80  integer :: y_halo !< Number of halos in y
81  integer :: jshift !< Shift in the x axis (from center)
82  integer :: ishift !< Shift in the y axis (from center)
83  real(kind=r4_kind), dimension(:,:), allocatable :: globaldata2d_r4 !< 2d data pointer.
84  real(kind=r4_kind), dimension(:,:,:), allocatable :: globaldata3d_r4 !< 3d data pointer.
85  real(kind=r8_kind), dimension(:,:), allocatable :: globaldata2d_r8 !< 2d data pointer.
86  real(kind=r8_kind), dimension(:,:,:), allocatable :: globaldata3d_r8 !< 3d data pointer.
87  character(len=32) :: chksum !< The variable's checksum
88  logical :: data_on_file_root !< Flag indicating if the file root is part of the pelist that
89  !!contains data
90 endtype bc_information
91 
92 !> @brief Restart variable.
93 !> @ingroup netcdf_io_mod
94 type, private :: restartvariable_t
95  character(len=256) :: varname !< Variable name.
96  class(*), pointer :: data0d => null() !< Scalar data pointer.
97  class(*), dimension(:), pointer :: data1d => null() !< 1d data pointer.
98  class(*), dimension(:,:), pointer :: data2d => null() !< 2d data pointer.
99  class(*), dimension(:,:,:), pointer :: data3d => null() !< 3d data pointer.
100  class(*), dimension(:,:,:,:), pointer :: data4d => null() !< 4d data pointer.
101  class(*), dimension(:,:,:,:,:), pointer :: data5d => null() !< 5d data pointer.
102  logical :: was_read !< Flag to support legacy "query_initialized" feature, which
103  !! keeps track if a file was read.
104  logical :: is_bc_variable !< Flag indicating if variable is a bc_variable
105  type(bc_information) :: bc_info !< information about the boundary condition variable
106 endtype restartvariable_t
107 
108 !> @brief Compressed dimension.
109 !> @ingroup netcdf_io_mod
110 type, private :: compresseddimension_t
111  character(len=256) :: dimname !< Dimension name.
112  integer, dimension(:), allocatable :: npes_corner !< Array of starting
113  !! indices for each rank.
114  integer, dimension(:), allocatable :: npes_nelems !< Number of elements
115  !! associated with each
116  !! rank.
117  integer :: nelems !< Total size of the dimension.
118 endtype compresseddimension_t
119 
120 !> @brief information about the current dimensions for regional restart variables
121 !> @ingroup netcdf_io_mod
122 type, private :: dimension_information
123  integer, dimension(5) :: xlen !> The size of each unique x dimension
124  integer, dimension(5) :: ylen !> The size of each unique y dimension
125  integer, dimension(5) :: zlen !> The size of each unique z dimension
126  integer, dimension(3) :: cur_dim_len !> Number of unique:
127  !! cur_dim_len(1) : x dimensions
128  !! cur_dim_len(2) : y dimensions
129  !! cur_dim_len(3) : z dimensions
130 endtype dimension_information
131 
132 type, public :: fmsoffloadingin_type
133  !TODO should be private, need getter functions
134  integer, public :: id !< unique identifier for each type
135  integer, public, allocatable :: offloading_pes(:) !< list of pe numbers that will be used to just write
136  integer, public, allocatable :: model_pes(:) !< list of pe numbers that will be running the model
137  logical :: is_model_pe !< true if current pe is in model_pes
138  type(domain2d) :: domain_in !< domain for grid that is to be written out
139  contains
140  procedure :: init
141 endtype fmsoffloadingin_type
142 
143 !> @brief Type to represent a netCDF file. Can be used with multiple cores
144 !! but only the root pe will perform any I/O operations before sending the
145 !! data to the other pes.
146 !> @ingroup netcdf_io_mod
147 type, public :: fmsnetcdffile_t
148  character(len=FMS_PATH_LEN) :: path !< File path.
149  logical :: is_readonly !< Flag telling if the file is readonly.
150  integer :: ncid !< Netcdf file id.
151  character(len=256) :: nc_format !< Netcdf file format.
152  logical :: is_netcdf4 !< Flag indicating if the netcdf file type is netcdf4
153  integer, dimension(:), allocatable :: pelist !< List of ranks who will
154  !! communicate.
155  integer :: io_root !< I/O root rank of the pelist.
156  logical :: is_root !< Flag telling if the current rank is the
157  !! I/O root.
158  logical :: is_restart !< Flag telling if the this file is a restart
159  !! file (that has internal pointers to data).
160  logical :: mode_is_append !! true if file is open in "append" mode
161  logical, allocatable :: is_open !< Allocated and set to true if opened.
162  type(restartvariable_t), dimension(:), allocatable :: restart_vars !< Array of registered
163  !! restart variables.
164  integer :: num_restart_vars !< Number of registered restart variables.
165  type(compresseddimension_t), dimension(:), allocatable :: compressed_dims !< "Compressed" dimension.
166  integer :: num_compressed_dims !< Number of compressed dimensions.
167  logical :: is_diskless !< Flag telling whether this is a diskless file.
168  character (len=20) :: time_name
169  type(dimension_information) :: bc_dimensions !<information about the current dimensions for regional
170  !! restart variables
171  type(fmsoffloadingin_type) :: offloading_obj_in
172  logical :: use_collective = .false. !< Flag indicating if we should open the file for collective input
173  integer :: tile_comm=mpp_comm_null !< MPI communicator used for MPI-IO reads.
174  logical :: use_netcdf_mpi = .false.
175 
176  contains
177 
178  procedure :: is_file_using_netcdf_mpi
179 
180 endtype fmsnetcdffile_t
181 
182 
183 !> @brief Range type for a netcdf variable.
184 !> @ingroup netcdf_io_mod
185 type, public :: valid_t
186  logical :: has_range !< Flag that's true if both min/max exist for a variable.
187  logical :: has_min !< Flag that's true if min exists for a variable.
188  logical :: has_max !< Flag that's true if max exists for a variable.
189  logical :: has_fill !< Flag that's true a user defined fill value.
190  logical :: has_missing !< Flag that's true a user defined missing value.
191  real(kind=r8_kind) :: fill_val !< Unpacked fill value for a variable.
192  real(kind=r8_kind) :: min_val !< Unpacked minimum value allowed for a variable.
193  real(kind=r8_kind) :: max_val !< Unpacked maximum value allowed for a variable.
194  real(kind=r8_kind) :: missing_val !< Unpacked missing value for a variable.
195 endtype valid_t
196 
197 
198 public :: netcdf_io_init
199 public :: netcdf_file_open
200 public :: netcdf_file_close
201 public :: netcdf_add_dimension
202 public :: netcdf_add_variable
204 public :: global_att_exists
205 public :: variable_att_exists
208 public :: get_global_attribute
209 public :: get_variable_attribute
210 public :: get_num_dimensions
211 public :: get_dimension_names
212 public :: dimension_exists
213 public :: is_dimension_unlimited
214 public :: get_dimension_size
215 public :: get_num_variables
216 public :: get_variable_names
217 public :: variable_exists
220 public :: get_variable_size
222 public :: netcdf_read_data
223 public :: netcdf_write_data
224 public :: compressed_write
225 public :: netcdf_save_restart
226 public :: netcdf_restore_state
227 public :: get_valid
228 public :: is_valid
230 public :: netcdf_file_open_wrap
231 public :: netcdf_file_close_wrap
232 public :: netcdf_add_variable_wrap
233 public :: netcdf_save_restart_wrap
234 public :: compressed_write_0d_wrap
235 public :: compressed_write_1d_wrap
236 public :: compressed_write_2d_wrap
237 public :: compressed_write_3d_wrap
238 public :: compressed_write_4d_wrap
239 public :: compressed_write_5d_wrap
240 public :: compressed_read_0d
241 public :: compressed_read_1d
242 public :: compressed_read_2d
243 public :: compressed_read_3d
244 public :: compressed_read_4d
245 public :: compressed_read_5d
257 public :: get_fill_value
258 public :: get_variable_sense
259 public :: get_variable_missing
260 public :: get_variable_units
261 public :: get_time_calendar
262 public :: is_registered_to_restart
263 public :: set_netcdf_mode
264 public :: check_netcdf_code
265 public :: check_if_open
266 public :: set_fileobj_time_name
267 public :: write_restart_bc
268 public :: read_restart_bc
269 public :: flush_file
270 public :: get_variable_id
271 
272 !> @ingroup netcdf_io_mod
274  module procedure netcdf_add_restart_variable_0d
275  module procedure netcdf_add_restart_variable_1d
276  module procedure netcdf_add_restart_variable_2d
277  module procedure netcdf_add_restart_variable_3d
278  module procedure netcdf_add_restart_variable_4d
279  module procedure netcdf_add_restart_variable_5d
280 end interface netcdf_add_restart_variable
281 
282 !> @ingroup netcdf_io_mod
284  module procedure netcdf_read_data_0d
285  module procedure netcdf_read_data_1d
286  module procedure netcdf_read_data_2d
287  module procedure netcdf_read_data_3d
288  module procedure netcdf_read_data_4d
289  module procedure netcdf_read_data_5d
290 end interface netcdf_read_data
291 
292 
293 !> @ingroup netcdf_io_mod
295  module procedure netcdf_write_data_0d
296  module procedure netcdf_write_data_1d
297  module procedure netcdf_write_data_2d
298  module procedure netcdf_write_data_3d
299  module procedure netcdf_write_data_4d
300  module procedure netcdf_write_data_5d
301 end interface netcdf_write_data
302 
303 
304 !> @ingroup netcdf_io_mod
306  module procedure compressed_write_0d
307  module procedure compressed_write_1d
308  module procedure compressed_write_2d
309  module procedure compressed_write_3d
310  module procedure compressed_write_4d
311  module procedure compressed_write_5d
312 end interface compressed_write
313 
314 
315 !> @ingroup netcdf_io_mod
317  module procedure register_global_attribute_0d
318  module procedure register_global_attribute_1d
319 end interface register_global_attribute
320 
321 
322 !> @ingroup netcdf_io_mod
324  module procedure register_variable_attribute_0d
325  module procedure register_variable_attribute_1d
326 end interface register_variable_attribute
327 
328 
329 !> @ingroup netcdf_io_mod
331  module procedure get_global_attribute_0d
332  module procedure get_global_attribute_1d
333 end interface get_global_attribute
334 
335 
336 !> @ingroup netcdf_io_mod
338  module procedure get_variable_attribute_0d
339  module procedure get_variable_attribute_1d
340 end interface get_variable_attribute
341 
342 
343 !> @ingroup netcdf_io_mod
345  module procedure scatter_data_bc_2d
346  module procedure scatter_data_bc_3d
347 end interface scatter_data_bc
348 
349 !> @ingroup netcdf_io_mod
350 interface gather_data_bc
351  module procedure gather_data_bc_2d
352  module procedure gather_data_bc_3d
353 end interface gather_data_bc
354 
355 !> The interface is needed to accomodate pgi because it can't handle class * and there was no other way around it
356 !> @ingroup netcdf_io_mod
357 interface is_valid
358  module procedure is_valid_r8
359  module procedure is_valid_r4
360 end interface is_valid
361 
362 !> @addtogroup netcdf_io_mod
363 !> @{
364 
365 contains
366 
367 !> @brief Accepts the namelist fms2_io_nml variables relevant to netcdf_io_mod
368 subroutine netcdf_io_init (chksz, header_buffer_val, netcdf_default_format, deflate_level, shuffle)
369 integer, intent(in) :: chksz !< Chunksize (bytes) used in nc_open and nc_create
370 character (len = 10), intent(in) :: netcdf_default_format !< Netcdf format type param used in nc_create
371 integer, intent(in) :: header_buffer_val !< Value used in NF__ENDDEF
372 integer, intent(in) :: deflate_level !< Netcdf deflate level to use in nf90_def_var
373  !! (integer between 1 to 9)
374 logical, intent(in) :: shuffle !< Flag indicating whether to use the netcdf shuffle filter
375 
376  fms2_ncchksz = chksz
377  fms2_deflate_level = deflate_level
378  fms2_shuffle = shuffle
379  fms2_is_netcdf4 = .false.
380  fms2_header_buffer_val = header_buffer_val
381  if (string_compare(netcdf_default_format, "64bit", .true.)) then
382  fms2_nc_format_param = nf90_64bit_offset
383  call string_copy(fms2_nc_format, "64bit")
384  elseif (string_compare(netcdf_default_format, "classic", .true.)) then
385  fms2_nc_format_param = nf90_classic_model
386  call string_copy(fms2_nc_format, "classic")
387  elseif (string_compare(netcdf_default_format, "netcdf4", .true.)) then
388  fms2_nc_format_param = nf90_netcdf4
389  fms2_is_netcdf4 = .true.
390  call string_copy(fms2_nc_format, "netcdf4")
391  else
392  call error("unrecognized netcdf file format "//trim(netcdf_default_format)// &
393  '. The acceptable values are "64bit", "classic", "netcdf4". Check fms2_io_nml: netcdf_default_format')
394  endif
395 
396 end subroutine netcdf_io_init
397 
398 !> @brief Check for errors returned by netcdf.
399 !! @internal
400 subroutine check_netcdf_code(err, msg)
401 
402  integer, intent(in) :: err !< Code returned by netcdf.
403  character(len=*), intent(in) :: msg !< Error message to be appended to the FATAL
404 
405  character(len=80) :: buf
406 
407  if (err .ne. nf90_noerr) then
408  buf = nf90_strerror(err)
409  call error(trim(buf)//": "//trim(msg))
410  endif
411 end subroutine check_netcdf_code
412 
413 
414 !> @brief Switch to the correct netcdf mode.
415 !! @internal
416 subroutine set_netcdf_mode(ncid, mode)
417 
418  integer, intent(in) :: ncid !< Netcdf file id.
419  integer, intent(in) :: mode !< Netcdf file mode.
420 
421  integer :: err
422 
423  if (mode .eq. define_mode) then
424  err = nf90_redef(ncid)
425  if (err .eq. nf90_eindefine .or. err .eq. nf90_eperm) then
426  return
427  endif
428  elseif (mode .eq. data_mode) then
429  if (fms2_header_buffer_val == -1) call error("set_netcdf_mode: fms2_header_buffer_val not set, call fms2_io_init")
430  err = nf90_enddef(ncid, h_minfree=fms2_header_buffer_val)
431  if (err .eq. nf90_enotindefine .or. err .eq. nf90_eperm) then
432  return
433  endif
434  else
435  call error("mode must be either define_mode or data_mode.")
436  endif
437  call check_netcdf_code(err, "set_netcdf_mode")
438 end subroutine set_netcdf_mode
439 
440 
441 !> @brief Get the id of a dimension from its name.
442 !! @return Dimension id, or dimension_missing if it doesn't exist.
443 !! @internal
444 function get_dimension_id(ncid, dimension_name, msg, allow_failure) &
445  result(dimid)
446 
447  integer, intent(in) :: ncid !< Netcdf file id.
448  character(len=*), intent(in) :: dimension_name !< Dimension name.
449  character(len=*), intent(in) :: msg !< Error message
450  logical, intent(in), optional :: allow_failure !< Flag that prevents
451  !! crash if dimension
452  !! does not exist.
453 
454  integer :: dimid
455 
456  integer :: err
457 
458  err = nf90_inq_dimid(ncid, trim(dimension_name), dimid)
459  if (present(allow_failure)) then
460  if (allow_failure .and. err .eq. nf90_ebaddim) then
461  dimid = dimension_missing
462  return
463  endif
464  endif
465  call check_netcdf_code(err, msg)
466 end function get_dimension_id
467 
468 
469 !> @brief Get the id of a variable from its name.
470 !! @return Variable id, or variable_missing if it doesn't exist.
471 !! @internal
472 function get_variable_id(ncid, variable_name, msg, allow_failure) &
473  result(varid)
474 
475  integer, intent(in) :: ncid !< Netcdf file object.
476  character(len=*), intent(in) :: variable_name !< Variable name.
477  character(len=*), intent(in) :: msg !< Error message
478  logical, intent(in), optional :: allow_failure !< Flag that prevents
479  !! crash if variable does
480  !! not exist.
481 
482  integer :: varid
483 
484  integer :: err
485 
486  err = nf90_inq_varid(ncid, trim(variable_name), varid)
487  if (present(allow_failure)) then
488  if (allow_failure .and. err .eq. nf90_enotvar) then
489  varid = variable_missing
490  return
491  endif
492  endif
493  call check_netcdf_code(err, msg)
494 end function get_variable_id
495 
496 
497 !> @brief Determine if an attribute exists.
498 !! @return Flag telling if the attribute exists.
499 !! @internal
500 function attribute_exists(ncid, varid, attribute_name, msg) &
501  result(att_exists)
502 
503  integer, intent(in) :: ncid !< Netcdf file id.
504  integer, intent(in) :: varid !< Variable id.
505  character(len=*), intent(in) :: attribute_name !< Attribute name.
506  character(len=*), intent(in), optional :: msg !< Error message
507 
508  logical :: att_exists
509 
510  integer :: err
511 
512  err = nf90_inquire_attribute(ncid, varid, trim(attribute_name))
513  if (err .eq. nf90_enotatt) then
514  att_exists = .false.
515  else
516  call check_netcdf_code(err, msg)
517  att_exists = .true.
518  endif
519 end function attribute_exists
520 
521 
522 !> @brief Get the type of a netcdf attribute.
523 !! @return The netcdf type of the attribute.
524 !! @internal
525 function get_attribute_type(ncid, varid, attname, msg) &
526  result(xtype)
527 
528  integer, intent(in) :: ncid !< Netcdf file id.
529  integer, intent(in) :: varid !< Variable id.
530  character(len=*), intent(in) :: attname !< Attribute name.
531  character(len=*), intent(in), optional :: msg !< Error message
532 
533  integer :: xtype
534 
535  integer :: err
536 
537  err = nf90_inquire_attribute(ncid, varid, attname, xtype=xtype)
538  call check_netcdf_code(err, msg)
539 end function get_attribute_type
540 
541 
542 !> @brief Get the type of a netcdf variable.
543 !! @return The netcdf type of the variable.
544 !! @internal
545 function get_variable_type(ncid, varid, msg) &
546  result(xtype)
547 
548  integer, intent(in) :: ncid !< Netcdf file id.
549  integer, intent(in) :: varid !< Variable id.
550  character(len=*), intent(in), optional :: msg !< Error message to append to netcdf error code
551 
552  integer :: xtype
553 
554  integer :: err
555 
556  err = nf90_inquire_variable(ncid, varid, xtype=xtype)
557  call check_netcdf_code(err, msg)
558 end function get_variable_type
559 
560 
561 !> @brief Open a netcdf file.
562 !! @return .true. if open succeeds, or else .false.
563 function netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename, &
564  tile_comm, use_collective) result(success)
565 
566  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
567  character(len=*), intent(in) :: path !< File path.
568  character(len=*), intent(in) :: mode !< File mode. Allowed values are:
569  !! "read", "append", "write", or
570  !! "overwrite".
571  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
572  !! new files are written
573  !! as. Allowed values
574  !! are: "64bit", "classic",
575  !! or "netcdf4". Defaults to
576  !! "64bit". This overwrites
577  !! the value set in the fms2io
578  !! namelist
579  integer, dimension(:), intent(in), optional :: pelist !< List of ranks associated
580  !! with this file. If not
581  !! provided, only the current
582  !! rank will be able to
583  !! act on the file.
584  logical, intent(in), optional :: is_restart !< Flag telling if this file
585  !! is a restart file. Defaults
586  !! to false.
587  logical, intent(in), optional :: dont_add_res_to_filename !< Flag indicating not to add
588  !! ".res" to the filename
589  integer, intent(in), optional :: tile_comm !< MPI communicator used for parallel I/O. Passing this
590  !! argument enables parallel I/O.
591  logical, intent(in), optional :: use_collective !< Flag indicating whether reads and writes should be performed
592  !! collectively rather than independently.
593  logical :: success
594 
595  integer :: nc_format_param
596  integer :: err
597  integer :: netcdf4 !< Query the file for the _IsNetcdf4 global attribute in the event
598  !! that the open for collective reads fails
599  character(len=FMS_PATH_LEN) :: full_path !< File path with .res in the filename if it is a restart
600  logical :: is_res
601  logical :: dont_add_res !< flag indicated to not add ".res" to the filename
602 
603  success = .true.
604 
605  if (fms2_nc_format_param.eq.-1) then
606  call error("netcdf_file_open :: fms2_io has not been initialized")
607  endif
608 
609  if (allocated(fileobj%is_open)) then
610  if (fileobj%is_open) return
611  endif
612 
613  fileobj%use_netcdf_mpi = .false.
614 
615  if (fileobj%tile_comm.ne.mpp_comm_null) then
616  call mpp_error(note, "netcdf_file_open :: Setting fileobj%tile_comm is deprecated. &
617  Please use open_file(..., tile_comm=...) instead.")
618  fileobj%use_netcdf_mpi = .true.
619  elseif (present(tile_comm)) then
620  fileobj%use_netcdf_mpi = .true.
621  fileobj%tile_comm = tile_comm
622  endif
623 
624  if (fileobj%use_collective) then
625  fileobj%use_netcdf_mpi = .true.
626  call mpp_error(note, "Setting fileobj%use_collective to enable collective reads is deprecated. &
627  Please use open_file(..., use_collective=.true.) instead.")
628  else
629  fileobj%use_collective = .false.
630  if (present(use_collective)) fileobj%use_collective = use_collective
631  endif
632 
633  !< Only add ".res" to the file path if is_restart is set to true
634  !! and dont_add_res_to_filename is set to false.
635  is_res = .false.
636  if (present(is_restart)) then
637  is_res = is_restart
638  endif
639  fileobj%is_restart = is_res
640 
641  dont_add_res = .false.
642  if (present(dont_add_res_to_filename)) then
643  dont_add_res = dont_add_res_to_filename
644  endif
645 
646  if (is_res .and. .not. dont_add_res) then
647  call restart_filepath_mangle(full_path, trim(path))
648  else
649  call string_copy(full_path, trim(path))
650  endif
651 
652  !< If it is a restart add the filename_appendix to the filename
653  if (is_res) then
654  call get_instance_filename(trim(full_path), fileobj%path)
655  else
656  call string_copy(fileobj%path, trim(full_path))
657  endif
658 
659  ! Check if the file exists.
660  if (string_compare(mode, "read", .true.) .or. string_compare(mode, "append", .true.)) then
661  success = file_exists(fileobj%path)
662  if (.not.success) return
663  endif
664 
665  if (present(pelist)) then
666  allocate(fileobj%pelist(size(pelist)))
667  fileobj%pelist(:) = pelist(:)
668  else
669  allocate(fileobj%pelist(1))
670  fileobj%pelist(1) = mpp_pe()
671  endif
672  fileobj%io_root = fileobj%pelist(1)
673  fileobj%is_root = mpp_pe().eq.fileobj%io_root
674 
675  fileobj%is_netcdf4 = .false.
676 
677  if (present(nc_format)) then
678  if (string_compare(nc_format, "64bit", .true.)) then
679  nc_format_param = nf90_64bit_offset
680  elseif (string_compare(nc_format, "classic", .true.)) then
681  nc_format_param = nf90_classic_model
682  elseif (string_compare(nc_format, "netcdf4", .true.)) then
683  fileobj%is_netcdf4 = .true.
684  nc_format_param = nf90_netcdf4
685  else
686  call error("unrecognized netcdf file format: '"//trim(nc_format)//"' for file:"//trim(fileobj%path)//&
687  &"Check your open_file call, the acceptable values are 64bit, classic, netcdf4")
688  endif
689  call string_copy(fileobj%nc_format, nc_format)
690  else
691  call string_copy(fileobj%nc_format, trim(fms2_nc_format))
692  nc_format_param = fms2_nc_format_param
693  fileobj%is_netcdf4 = fms2_is_netcdf4
694  endif
695 
696  if (fileobj%use_netcdf_mpi) then
697 #ifdef NO_NC_PARALLEL4
698  call error("NetCDF was not built with HDF5 parallel I/O features, so use_netcdf_mpi cannot be used. &
699  &Please turn use_netcdf_mpi off for the file: " // trim(path))
700 #endif
701  nc_format_param = ior(nc_format_param, nf90_mpiio)
702  endif
703 
704  if (fileobj%use_netcdf_mpi) then
705  ! Using MPI-IO: Every PE opens the file
706  if(string_compare(mode, "read", .true.)) then
707  err = nf90_open(trim(fileobj%path), ior(nf90_nowrite, nf90_mpiio), fileobj%ncid, &
708  comm=fileobj%tile_comm, info=mpp_info_null)
709  elseif(string_compare(mode, "append", .true.)) then
710  err = nf90_open(trim(fileobj%path), ior(nf90_write, nf90_mpiio), fileobj%ncid, &
711  comm=fileobj%tile_comm, info=mpp_info_null)
712  elseif (string_compare(mode, "write", .true.)) then
713  err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, &
714  comm=fileobj%tile_comm, info=mpp_info_null)
715  elseif (string_compare(mode,"overwrite",.true.)) then
716  err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, &
717  comm=fileobj%tile_comm, info=mpp_info_null)
718  else
719  call error("unrecognized file mode: '"//trim(mode)//"' for file:"//trim(fileobj%path)//&
720  &"Check your open_file call, the acceptable values are read, append, write, overwrite")
721  endif
722  call check_netcdf_code(err, "netcdf_file_open (using netcdf mpi): "//trim(fileobj%path))
723  elseif (fileobj%is_root) then
724  ! Not using MPI-IO: Only the root PE opens the file
725  if (string_compare(mode, "read", .true.)) then
726  err = nf90_open(trim(fileobj%path), nf90_nowrite, fileobj%ncid, chunksize=fms2_ncchksz)
727  elseif (string_compare(mode, "append", .true.)) then
728  err = nf90_open(trim(fileobj%path), nf90_write, fileobj%ncid, chunksize=fms2_ncchksz)
729  elseif (string_compare(mode, "write", .true.)) then
730  err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, chunksize=fms2_ncchksz)
731  elseif (string_compare(mode,"overwrite",.true.)) then
732  err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, chunksize=fms2_ncchksz)
733  else
734  call error("unrecognized file mode: '"//trim(mode)//"' for file:"//trim(fileobj%path)//&
735  &"Check your open_file call, the acceptable values are read, append, write, overwrite")
736  endif
737  call check_netcdf_code(err, "netcdf_file_open: "//trim(fileobj%path))
738  else
739  fileobj%ncid = missing_ncid
740  endif
741 
742  fileobj%is_diskless = .false.
743 
744  !Allocate memory.
745  if (fileobj%is_restart) then
746  allocate(fileobj%restart_vars(max_num_restart_vars))
747  fileobj%num_restart_vars = 0
748  endif
749 
750  fileobj%is_readonly = string_compare(mode, "read", .true.)
751  fileobj%mode_is_append = string_compare(mode, "append", .true.)
752  allocate(fileobj%compressed_dims(max_num_compressed_dims))
753  fileobj%num_compressed_dims = 0
754  ! Set the is_open flag to true for this file object.
755  if (.not.allocated(fileobj%is_open)) allocate(fileobj%is_open)
756  fileobj%is_open = .true.
757 
758  fileobj%bc_dimensions%xlen = 0
759  fileobj%bc_dimensions%ylen = 0
760  fileobj%bc_dimensions%zlen = 0
761  fileobj%bc_dimensions%cur_dim_len = 0
762 
763 end function netcdf_file_open
764 
765 
766 !> @brief Close a netcdf file.
767 subroutine netcdf_file_close(fileobj)
768 
769  class(fmsnetcdffile_t),intent(inout) :: fileobj !< File object.
770 
771  integer :: err
772  integer :: i
773 
774  if (fileobj%is_root) then
775  err = nf90_close(fileobj%ncid)
776  call check_netcdf_code(err, "netcdf_file_close:"//trim(fileobj%path))
777  endif
778  if (allocated(fileobj%is_open)) fileobj%is_open = .false.
779  fileobj%path = missing_path
780  fileobj%ncid = missing_ncid
781  if (allocated(fileobj%pelist)) then
782  deallocate(fileobj%pelist)
783  endif
784  fileobj%io_root = missing_rank
785  fileobj%is_root = .false.
786  if (allocated(fileobj%restart_vars)) then
787  deallocate(fileobj%restart_vars)
788  endif
789  fileobj%is_restart = .false.
790  fileobj%num_restart_vars = 0
791  do i = 1, fileobj%num_compressed_dims
792  if (allocated(fileobj%compressed_dims(i)%npes_corner)) then
793  deallocate(fileobj%compressed_dims(i)%npes_corner)
794  endif
795  if (allocated(fileobj%compressed_dims(i)%npes_nelems)) then
796  deallocate(fileobj%compressed_dims(i)%npes_nelems)
797  endif
798  enddo
799  if (allocated(fileobj%compressed_dims)) then
800  deallocate(fileobj%compressed_dims)
801  endif
802 end subroutine netcdf_file_close
803 
804 
805 !> @brief Get the index of a compressed dimension in a file object.
806 !! @return Index of the compressed dimension.
807 !! @internal
808 function get_compressed_dimension_index(fileobj, dim_name) &
809  result(dindex)
810 
811  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
812  character(len=*), intent(in) :: dim_name !< Dimension name.
813 
814  integer :: dindex
815  integer :: i
816 
817  dindex = dimension_not_found
818  do i = 1, fileobj%num_compressed_dims
819  if (string_compare(fileobj%compressed_dims(i)%dimname, dim_name)) then
820  dindex = i
821  return
822  endif
823  enddo
825 
826 
827 !> @brief Add a compressed dimension to a file object.
828 !! @internal
829 subroutine append_compressed_dimension(fileobj, dim_name, npes_corner, &
830  npes_nelems)
831 
832  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
833  character(len=*), intent(in) :: dim_name !< Dimension name.
834  integer, dimension(:), intent(in) :: npes_corner !< Array of starting
835  !! indices for each rank.
836  integer, dimension(:), intent(in) :: npes_nelems !< Number of elements
837  !! associated with each
838  !! rank.
839 
840  integer :: n
841 
842  if (get_compressed_dimension_index(fileobj, dim_name) .ne. dimension_not_found) then
843  call error("dimension "//trim(dim_name)//" already registered" &
844  //" to file "//trim(fileobj%path)//".")
845  endif
846  fileobj%num_compressed_dims = fileobj%num_compressed_dims + 1
847  n = fileobj%num_compressed_dims
848  if (n .gt. max_num_compressed_dims) then
849  call error("number of compressed dimensions exceeds limit.")
850  endif
851  call string_copy(fileobj%compressed_dims(n)%dimname, dim_name)
852  if (size(npes_corner) .ne. size(fileobj%pelist) .or. &
853  size(npes_nelems) .ne. size(fileobj%pelist)) then
854  call error("incorrect size for input npes_corner or npes_nelems arrays.")
855  endif
856  allocate(fileobj%compressed_dims(n)%npes_corner(size(fileobj%pelist)))
857  fileobj%compressed_dims(n)%npes_corner(:) = npes_corner(:)
858  allocate(fileobj%compressed_dims(n)%npes_nelems(size(fileobj%pelist)))
859  fileobj%compressed_dims(n)%npes_nelems(:) = npes_nelems(:)
860  fileobj%compressed_dims(n)%nelems = sum(fileobj%compressed_dims(n)%npes_nelems)
861 end subroutine append_compressed_dimension
862 
863 !> @brief Add a "compressed" unlimited dimension to a netcdf file.
864 !! @note Here compressed means that every rank has a different dimension_length
865 !! compressed. This was written specifically for the icebergs restarts.
866 subroutine register_unlimited_compressed_axis(fileobj, dimension_name, dimension_length)
867  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
868  character(len=*), intent(in) :: dimension_name !< Dimension name.
869  integer, intent(in) :: dimension_length !< Dimension length for the current rank
870 
871  integer, dimension(:), allocatable :: npes_start !< The starting index of the dimension for each of the PEs
872  integer, dimension(:), allocatable :: npes_count !< The size of the dimension for each of the PEs
873  integer :: i !< For do loops
874  integer :: err !< Netcdf error
875  integer :: dimid !< Netcdf id for the dimension
876 
877  !Gather all local dimension lengths on the I/O root pe.
878  allocate(npes_start(size(fileobj%pelist)))
879  allocate(npes_count(size(fileobj%pelist)))
880 
881  call mpp_gather((/dimension_length/),npes_count,pelist=fileobj%pelist)
882 
883  npes_start(1) = 1
884  do i = 1, size(fileobj%pelist)-1
885  npes_start(i+1) = npes_start(i) + npes_count(i)
886  enddo
887  call append_compressed_dimension(fileobj, dimension_name, npes_start, &
888  npes_count)
889 
890  if (fileobj%is_root .and. .not. fileobj%is_readonly) then
891  call set_netcdf_mode(fileobj%ncid, define_mode)
892  err = nf90_def_dim(fileobj%ncid, trim(dimension_name), unlimited, dimid)
893  call check_netcdf_code(err, "Netcdf_add_dimension: file:"//trim(fileobj%path)//" dimension name:"// &
894  & trim(dimension_name))
895  endif
897 
898 !> @brief Add a dimension to a file.
899 subroutine netcdf_add_dimension(fileobj, dimension_name, dimension_length, &
900  is_compressed)
901 
902  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
903  character(len=*), intent(in) :: dimension_name !< Dimension name.
904  integer, intent(in) :: dimension_length !< Dimension length.
905  logical, intent(in), optional :: is_compressed !< Changes the meaning of dim_len from
906  !! referring to the total size of the
907  !! dimension (when false) to the local
908  !! size for the current rank (when true).
909 
910  integer :: dim_len
911  integer, dimension(:), allocatable :: npes_start
912  integer, dimension(:), allocatable :: npes_count
913  integer :: i
914  integer :: err
915  integer :: dimid
916 
917  dim_len = dimension_length
918  if (present(is_compressed)) then
919  if (is_compressed) then
920  !Gather all local dimension lengths on the I/O root pe.
921  allocate(npes_start(size(fileobj%pelist)))
922  allocate(npes_count(size(fileobj%pelist)))
923  do i = 1, size(fileobj%pelist)
924  if (fileobj%pelist(i) .eq. mpp_pe()) then
925  npes_count(i) = dim_len
926  else
927  call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
928  call mpp_send(dim_len, fileobj%pelist(i))
929  endif
930  enddo
931  call mpp_sync_self(check=event_recv)
932  call mpp_sync_self(check=event_send)
933  npes_start(1) = 1
934  do i = 1, size(fileobj%pelist)-1
935  npes_start(i+1) = npes_start(i) + npes_count(i)
936  enddo
937  call append_compressed_dimension(fileobj, dimension_name, npes_start, &
938  npes_count)
939  dim_len = sum(npes_count)
940  endif
941  endif
942  if ((fileobj%is_root) .and. .not. fileobj%is_readonly) then
943  call set_netcdf_mode(fileobj%ncid, define_mode)
944  err = nf90_def_dim(fileobj%ncid, trim(dimension_name), dim_len, dimid)
945  call check_netcdf_code(err, "Netcdf_add_dimension: file:"//trim(fileobj%path)//" dimension name:"// &
946  & trim(dimension_name))
947  endif
948 end subroutine netcdf_add_dimension
949 
950 
951 !> @brief Add a compressed dimension.
952 subroutine register_compressed_dimension(fileobj, dimension_name, &
953  npes_corner, npes_nelems)
954 
955  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
956  character(len=*), intent(in) :: dimension_name !< Dimension name.
957  integer, dimension(:), intent(in) :: npes_corner !< Array of starting
958  !! indices for each rank.
959  integer, dimension(:), intent(in) :: npes_nelems !< Number of elements
960  !! associated with each
961  !! rank.
962 
963  integer :: dsize
964  integer :: fdim_size
965 
966  call append_compressed_dimension(fileobj, dimension_name, npes_corner, npes_nelems)
967  dsize = sum(npes_nelems)
968  if (fileobj%is_readonly) then
969  call get_dimension_size(fileobj, dimension_name, fdim_size, broadcast=.true.)
970  if (fdim_size .ne. dsize) then
971  call error("dimension "//trim(dimension_name)//" does not match" &
972  //" the size of the associated compressed axis.")
973  endif
974  else
975  call netcdf_add_dimension(fileobj, dimension_name, dsize)
976  endif
977 end subroutine register_compressed_dimension
978 
979 
980 !> @brief Add a variable to a file.
981 subroutine netcdf_add_variable(fileobj, variable_name, variable_type, dimensions, chunksizes)
982 
983  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
984  character(len=*), intent(in) :: variable_name !< Variable name.
985  character(len=*), intent(in) :: variable_type !< Variable type. Allowed
986  !! values are: "char", "int", "int64",
987  !! "float", or "double".
988  character(len=*), dimension(:), intent(in), optional :: dimensions !< Dimension names.
989  integer, optional, intent(in) :: chunksizes(:) !< netcdf chunksize to use for this variable
990  !! This feature is only
991  !! available for netcdf4 files
992  integer :: err
993  integer, dimension(:), allocatable :: dimids
994  integer :: vtype
995  integer :: varid
996  integer :: i
997  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
998 
999  append_error_msg = "netcdf_add_variable: file:"//trim(fileobj%path)//" variable:"//trim(variable_name)
1000 
1001  if (fileobj%is_root) then
1002  call set_netcdf_mode(fileobj%ncid, define_mode)
1003  if (string_compare(variable_type, "int", .true.)) then
1004  vtype = nf90_int
1005  elseif (string_compare(variable_type, "int64", .true.)) then
1006  if ( .not. fileobj%is_netcdf4) call error(trim(fileobj%path)//&
1007  &": 64 bit integers are only supported with 'netcdf4' file format"//&
1008  &". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
1009  &"add nc_format='netcdf4' to your open_file call")
1010  vtype = nf90_int64
1011  elseif (string_compare(variable_type, "float", .true.)) then
1012  vtype = nf90_float
1013  elseif (string_compare(variable_type, "double", .true.)) then
1014  vtype = nf90_double
1015  elseif (string_compare(variable_type, "char", .true.)) then
1016  vtype = nf90_char
1017  if (.not. present(dimensions)) then
1018  call error("String variables require a string length dimension:"//trim(append_error_msg))
1019  endif
1020  else
1021  call error("Unsupported variable type:"//trim(append_error_msg))
1022  endif
1023  if (present(dimensions)) then
1024  allocate(dimids(size(dimensions)))
1025  do i = 1, size(dimids)
1026  dimids(i) = get_dimension_id(fileobj%ncid, trim(dimensions(i)),msg=append_error_msg)
1027  enddo
1028  if (fileobj%is_netcdf4) then
1029  err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid, &
1030  &deflate_level=fms2_deflate_level, shuffle=fms2_shuffle, chunksizes=chunksizes)
1031  else
1032  if (fms2_deflate_level .ne. default_deflate_level .or. fms2_shuffle .or. present(chunksizes)) &
1033  &call mpp_error(note,"Not able to use deflate_level or chunksizes if not using netcdf4"// &
1034  & " ignoring them")
1035  err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid)
1036  endif
1037  deallocate(dimids)
1038  else
1039  err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, varid)
1040  endif
1041  call check_netcdf_code(err, append_error_msg)
1042  endif
1043 
1044  if (fileobj%use_netcdf_mpi.and.fileobj%use_collective) then
1045  err = nf90_var_par_access(fileobj%ncid, varid, nf90_collective)
1046  call check_netcdf_code(err, append_error_msg)
1047  endif
1048 end subroutine netcdf_add_variable
1049 
1050 
1051 !> @brief Given a compressed variable, get the index of the compressed
1052 !! dimension.
1053 !! @return Index of the compressed dimension or dimension_not_found.
1054 function get_variable_compressed_dimension_index(fileobj, variable_name, broadcast) &
1055  result(compressed_dimension_index)
1056 
1057  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1058  character(len=*), intent(in) :: variable_name !< Variable name.
1059  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1060  !! not the data will be
1061  !! broadcasted to non
1062  !! "I/O root" ranks.
1063  !! The broadcast will be done
1064  !! by default.
1065  integer, dimension(2) :: compressed_dimension_index
1066 
1067  integer :: ndims
1068  character(len=nf90_max_name), dimension(:), allocatable :: dim_names
1069  integer :: i
1070  integer :: j
1071 
1072  compressed_dimension_index = dimension_not_found
1073  if (fileobj%is_root) then
1074  ndims = get_variable_num_dimensions(fileobj, variable_name, broadcast=.false.)
1075  if (ndims .gt. 0) then
1076  allocate(dim_names(ndims))
1077  call get_variable_dimension_names(fileobj, variable_name, dim_names, broadcast=.false.)
1078  do i = 1, size(dim_names)
1079  j = get_compressed_dimension_index(fileobj,dim_names(i))
1080  if (j .ne. dimension_not_found) then
1081  compressed_dimension_index(1) = i
1082  compressed_dimension_index(2) = j
1083  exit
1084  endif
1085  enddo
1086  deallocate(dim_names)
1087  endif
1088  endif
1089  if (present(broadcast)) then
1090  if (.not. broadcast) then
1091  return
1092  endif
1093  endif
1094  call mpp_broadcast(compressed_dimension_index(1), fileobj%io_root, pelist=fileobj%pelist)
1095  call mpp_broadcast(compressed_dimension_index(2), fileobj%io_root, pelist=fileobj%pelist)
1097 
1098 
1099 !> @brief Add a restart variable to a FmsNetcdfFile_t type.
1100 !! @internal
1101 subroutine add_restart_var_to_array(fileobj, variable_name)
1102 
1103  class(fmsnetcdffile_t), intent(inout) :: fileobj !< Netcdf file object.
1104  character(len=*), intent(in) :: variable_name !< Variable name.
1105 
1106  integer :: i
1107 
1108  if (.not. fileobj%is_restart) then
1109  call error("file "//trim(fileobj%path)//" is not a restart file.")
1110  endif
1111  do i = 1, fileobj%num_restart_vars
1112  if (string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.)) then
1113  call error("variable "//trim(variable_name)//" has already" &
1114  //" been added to restart file "//trim(fileobj%path)//".")
1115  endif
1116  enddo
1117  fileobj%num_restart_vars = fileobj%num_restart_vars + 1
1118  if (fileobj%num_restart_vars .gt. max_num_restart_vars) then
1119  call error("Number of restart variables exceeds limit.")
1120  endif
1121  call string_copy(fileobj%restart_vars(fileobj%num_restart_vars)%varname, &
1122  variable_name)
1123 end subroutine add_restart_var_to_array
1124 
1125 
1126 !> @brief Loop through registered restart variables and write them to
1127 !! a netcdf file.
1128 subroutine netcdf_save_restart(fileobj, unlim_dim_level)
1129 
1130  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1131  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
1132  !! level.
1133 
1134  integer :: i
1135 
1136  if (.not. fileobj%is_restart) then
1137  call error("write_restart:: file "//trim(fileobj%path)//" is not a restart file. &
1138  &Be sure the file was opened with is_restart=.true.")
1139  endif
1140  do i = 1, fileobj%num_restart_vars
1141  if (associated(fileobj%restart_vars(i)%data0d)) then
1142  call compressed_write(fileobj, fileobj%restart_vars(i)%varname, &
1143  fileobj%restart_vars(i)%data0d, &
1144  unlim_dim_level=unlim_dim_level)
1145  elseif (associated(fileobj%restart_vars(i)%data1d)) then
1146  call compressed_write(fileobj, fileobj%restart_vars(i)%varname, &
1147  fileobj%restart_vars(i)%data1d, &
1148  unlim_dim_level=unlim_dim_level)
1149  elseif (associated(fileobj%restart_vars(i)%data2d)) then
1150  call compressed_write(fileobj, fileobj%restart_vars(i)%varname, &
1151  fileobj%restart_vars(i)%data2d, &
1152  unlim_dim_level=unlim_dim_level)
1153  elseif (associated(fileobj%restart_vars(i)%data3d)) then
1154  call compressed_write(fileobj, fileobj%restart_vars(i)%varname, &
1155  fileobj%restart_vars(i)%data3d, &
1156  unlim_dim_level=unlim_dim_level)
1157  elseif (associated(fileobj%restart_vars(i)%data4d)) then
1158  call compressed_write(fileobj, fileobj%restart_vars(i)%varname, &
1159  fileobj%restart_vars(i)%data4d, &
1160  unlim_dim_level=unlim_dim_level)
1161  else
1162  call error("this branch should not be reached.")
1163  endif
1164  enddo
1165 end subroutine netcdf_save_restart
1166 
1167 
1168 !> @brief Loop through registered restart variables and read them from
1169 !! a netcdf file.
1170 subroutine netcdf_restore_state(fileobj, unlim_dim_level)
1171 
1172  type(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
1173  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
1174  !! level.
1175 
1176  integer :: i
1177 
1178  if (.not. fileobj%is_restart) then
1179  call error("read_restart:: file "//trim(fileobj%path)//" is not a restart file. &
1180  &Be sure the file was opened with is_restart=.true.")
1181  endif
1182  do i = 1, fileobj%num_restart_vars
1183  if (associated(fileobj%restart_vars(i)%data0d)) then
1184  call netcdf_read_data(fileobj, fileobj%restart_vars(i)%varname, &
1185  fileobj%restart_vars(i)%data0d, &
1186  unlim_dim_level=unlim_dim_level, &
1187  broadcast=.true.)
1188  elseif (associated(fileobj%restart_vars(i)%data1d)) then
1189  call netcdf_read_data(fileobj, fileobj%restart_vars(i)%varname, &
1190  fileobj%restart_vars(i)%data1d, &
1191  unlim_dim_level=unlim_dim_level, &
1192  broadcast=.true.)
1193  elseif (associated(fileobj%restart_vars(i)%data2d)) then
1194  call netcdf_read_data(fileobj, fileobj%restart_vars(i)%varname, &
1195  fileobj%restart_vars(i)%data2d, &
1196  unlim_dim_level=unlim_dim_level, &
1197  broadcast=.true.)
1198  elseif (associated(fileobj%restart_vars(i)%data3d)) then
1199  call netcdf_read_data(fileobj, fileobj%restart_vars(i)%varname, &
1200  fileobj%restart_vars(i)%data3d, &
1201  unlim_dim_level=unlim_dim_level, &
1202  broadcast=.true.)
1203  elseif (associated(fileobj%restart_vars(i)%data4d)) then
1204  call netcdf_read_data(fileobj, fileobj%restart_vars(i)%varname, &
1205  fileobj%restart_vars(i)%data4d, &
1206  unlim_dim_level=unlim_dim_level, &
1207  broadcast=.true.)
1208  else
1209  call error("this branch should not be reached.")
1210  endif
1211  enddo
1212 end subroutine netcdf_restore_state
1213 
1214 
1215 !> @brief Determine if a global attribute exists.
1216 !! @return Flag telling if a global attribute exists.
1217 function global_att_exists(fileobj, attribute_name, broadcast) &
1218  result(att_exists)
1219 
1220  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1221  character(len=*), intent(in) :: attribute_name !< Attribute name.
1222  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1223  !! not the data will be
1224  !! broadcasted to non
1225  !! "I/O root" ranks.
1226  !! The broadcast will be done
1227  !! by default.
1228  logical :: att_exists
1229 
1230  if (fileobj%is_root) then
1231  att_exists = attribute_exists(fileobj%ncid, nf90_global, trim(attribute_name), &
1232  & msg="global_att_exists: file:"//trim(fileobj%path)//" attribute name:"//trim(attribute_name))
1233  endif
1234  if (present(broadcast)) then
1235  if (.not. broadcast) then
1236  return
1237  endif
1238  endif
1239  call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1240 end function global_att_exists
1241 
1242 
1243 !> @brief Determine if a variable's attribute exists.
1244 !! @return Flag telling if the variable's attribute exists.
1245 function variable_att_exists(fileobj, variable_name, attribute_name, &
1246  broadcast) &
1247  result(att_exists)
1248 
1249  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1250  character(len=*), intent(in) :: variable_name !< Variable name.
1251  character(len=*), intent(in) :: attribute_name !< Attribute name.
1252  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1253  !! not the data will be
1254  !! broadcasted to non
1255  !! "I/O root" ranks.
1256  !! The broadcast will be done
1257  !! by default.
1258  logical :: att_exists
1259 
1260  integer :: varid
1261 
1262  att_exists = .false.
1263  if (fileobj%is_root) then
1264  varid = get_variable_id(fileobj%ncid, trim(variable_name), &
1265  & msg="variable_att_exists: file:"//trim(fileobj%path)//"- variable:"//&
1266  &trim(variable_name))
1267  att_exists = attribute_exists(fileobj%ncid, varid, trim(attribute_name), &
1268  &msg="variable_att_exists: file:"//trim(fileobj%path)//" variable:"//trim(variable_name)//&
1269  &" attribute name:"//trim(attribute_name))
1270  endif
1271  if (present(broadcast)) then
1272  if (.not. broadcast) then
1273  return
1274  endif
1275  endif
1276  call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1277 end function variable_att_exists
1278 
1279 
1280 !> @brief Determine the number of dimensions in a file.
1281 !! @return The number of dimensions in the file.
1282 function get_num_dimensions(fileobj, broadcast) &
1283  result(ndims)
1284 
1285  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1286  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1287  !! not the data will be
1288  !! broadcasted to non
1289  !! "I/O root" ranks.
1290  !! The broadcast will be done
1291  !! by default.
1292  integer :: ndims
1293 
1294  integer :: err
1295 
1296  if (fileobj%is_root) then
1297  err = nf90_inquire(fileobj%ncid, ndimensions=ndims)
1298  call check_netcdf_code(err, "get_num_dimensions: file:"//trim(fileobj%path))
1299  endif
1300  if (present(broadcast)) then
1301  if (.not. broadcast) then
1302  return
1303  endif
1304  endif
1305  call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1306 end function get_num_dimensions
1307 
1308 
1309 !> @brief Get the names of the dimensions in a file.
1310 subroutine get_dimension_names(fileobj, names, broadcast)
1311 
1312  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1313  character(len=*), dimension(:), intent(inout) :: names !< Names of the
1314  !! dimensions.
1315  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1316  !! not the data will be
1317  !! broadcasted to non
1318  !! "I/O root" ranks.
1319  !! The broadcast will be done
1320  !! by default.
1321 
1322  integer :: ndims
1323  integer :: i
1324  integer :: err
1325 
1326  if (fileobj%is_root) then
1327  ndims = get_num_dimensions(fileobj, broadcast=.false.)
1328  if (ndims .gt. 0) then
1329  if (size(names) .ne. ndims) then
1330  call error("'names' has to be the same size of the number of dimensions. &
1331  &Check your get_dimension_names call for file "//trim(fileobj%path))
1332  endif
1333  else
1334  call error("get_dimension_names: the file "//trim(fileobj%path)//" does not have any dimensions")
1335  endif
1336  names(:) = ""
1337  do i = 1, ndims
1338  err = nf90_inquire_dimension(fileobj%ncid, i, name=names(i))
1339  call check_netcdf_code(err, "get_dimension_names: file:"//trim(fileobj%path))
1340  enddo
1341  endif
1342  if (present(broadcast)) then
1343  if (.not. broadcast) then
1344  return
1345  endif
1346  endif
1347  call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1348  if (.not. fileobj%is_root) then
1349  if (ndims .gt. 0) then
1350  if (size(names) .ne. ndims) then
1351  call error("'names' has to be the same size of the number of dimensions. &
1352  &Check your get_dimension_names call for file "//trim(fileobj%path))
1353  endif
1354  else
1355  call error("get_dimension_names: the file "//trim(fileobj%path)//" does not have any dimensions")
1356  endif
1357  names(:) = ""
1358  endif
1359  call mpp_broadcast(names, len(names(ndims)), fileobj%io_root, &
1360  pelist=fileobj%pelist)
1361 end subroutine get_dimension_names
1362 
1363 
1364 !> @brief Determine if a dimension exists.
1365 !! @return Flag telling if the dimension exists.
1366 function dimension_exists(fileobj, dimension_name, broadcast) &
1367  result(dim_exists)
1368 
1369  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1370  character(len=*), intent(in) :: dimension_name !< Dimension name.
1371  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1372  !! not the data will be
1373  !! broadcasted to non
1374  !! "I/O root" ranks.
1375  !! The broadcast will be done
1376  !! by default.
1377  logical :: dim_exists
1378 
1379  integer :: dimid
1380 
1381  if (fileobj%is_root) then
1382  dimid = get_dimension_id(fileobj%ncid, trim(dimension_name), &
1383  msg="dimension_exists: file:"//trim(fileobj%path)//" dimension:"//trim(dimension_name), &
1384  allow_failure=.true.)
1385  if (dimid .eq. dimension_missing) then
1386  dim_exists = .false.
1387  else
1388  dim_exists = .true.
1389  endif
1390  endif
1391  if (present(broadcast)) then
1392  if (.not. broadcast) then
1393  return
1394  endif
1395  endif
1396  call mpp_broadcast(dim_exists, fileobj%io_root, pelist=fileobj%pelist)
1397 end function dimension_exists
1398 
1399 
1400 !> @brief Determine where or not the dimension is unlimited.
1401 !! @return True if the dimension is unlimited, or else false.
1402 function is_dimension_unlimited(fileobj, dimension_name, broadcast) &
1403  result(is_unlimited)
1404 
1405  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1406  character(len=*), intent(in) :: dimension_name !< Dimension name.
1407  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1408  !! not the data will be
1409  !! broadcasted to non
1410  !! "I/O root" ranks.
1411  !! The broadcast will be done
1412  !! by default.
1413  logical :: is_unlimited
1414 
1415  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
1416  integer :: dimid
1417  integer :: err
1418  integer :: ulim_dimid
1419 
1420  if (fileobj%is_root) then
1421  append_error_msg="is_dimension_unlimited: file:"//trim(fileobj%path)//&
1422  & " dimension_name:"//trim(dimension_name)
1423  dimid = get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1424  err = nf90_inquire(fileobj%ncid, unlimiteddimid=ulim_dimid)
1425  call check_netcdf_code(err, append_error_msg)
1426  is_unlimited = dimid .eq. ulim_dimid
1427  endif
1428  if (present(broadcast)) then
1429  if (.not. broadcast) then
1430  return
1431  endif
1432  endif
1433  call mpp_broadcast(is_unlimited, fileobj%io_root, pelist=fileobj%pelist)
1434 end function is_dimension_unlimited
1435 
1436 
1437 !> @brief Get the name of the unlimited dimension.
1438 subroutine get_unlimited_dimension_name(fileobj, dimension_name, broadcast)
1439 
1440  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1441  character(len=*), intent(out) :: dimension_name !< Dimension name.
1442  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1443  !! not the data will be
1444  !! broadcasted to non
1445  !! "I/O root" ranks.
1446  !! The broadcast will be done
1447  !! by default.
1448 
1449  integer :: err
1450  integer :: dimid
1451  character(len=nf90_max_name), dimension(1) :: buffer
1452 
1453  dimension_name = ""
1454  if (fileobj%is_root) then
1455  err = nf90_inquire(fileobj%ncid, unlimiteddimid=dimid)
1456  call check_netcdf_code(err, "get_unlimited_dimension_name: file:"//trim(fileobj%path))
1457  err = nf90_inquire_dimension(fileobj%ncid, dimid, dimension_name)
1458  call check_netcdf_code(err, "get_unlimited_dimension_name: file:"//trim(fileobj%path))
1459  call string_copy(buffer(1), dimension_name)
1460  endif
1461  if (present(broadcast)) then
1462  if (.not. broadcast) then
1463  return
1464  endif
1465  endif
1466  call mpp_broadcast(buffer, nf90_max_name, fileobj%io_root, &
1467  pelist=fileobj%pelist)
1468  call string_copy(dimension_name, buffer(1))
1469 end subroutine get_unlimited_dimension_name
1470 
1471 
1472 !> @brief Get the length of a dimension.
1473 subroutine get_dimension_size(fileobj, dimension_name, dim_size, broadcast)
1474 
1475  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1476  character(len=*), intent(in) :: dimension_name !< Dimension name.
1477  integer, intent(inout) :: dim_size !< Dimension size.
1478  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1479  !! not the data will be
1480  !! broadcasted to non
1481  !! "I/O root" ranks.
1482  !! The broadcast will be done
1483  !! by default.
1484 
1485  integer :: dimid
1486  integer :: err
1487  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
1488 
1489  if (fileobj%is_root) then
1490  append_error_msg = "get_dimension_size: file:"//trim(fileobj%path)//" dimension_name: "//trim(dimension_name)
1491  dimid = get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1492  err = nf90_inquire_dimension(fileobj%ncid, dimid, len=dim_size)
1493  call check_netcdf_code(err, append_error_msg)
1494  endif
1495  if (present(broadcast)) then
1496  if (.not. broadcast) then
1497  return
1498  endif
1499  endif
1500  call mpp_broadcast(dim_size, fileobj%io_root, pelist=fileobj%pelist)
1501 end subroutine get_dimension_size
1502 
1503 
1504 !> @brief Determine the number of variables in a file.
1505 !! @return The number of variables in the file.
1506 function get_num_variables(fileobj, broadcast) &
1507  result(nvars)
1508 
1509  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1510  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1511  !! not the data will be
1512  !! broadcasted to non
1513  !! "I/O root" ranks.
1514  !! The broadcast will be done
1515  !! by default.
1516  integer :: nvars
1517 
1518  integer :: err
1519 
1520  if (fileobj%is_root) then
1521  err = nf90_inquire(fileobj%ncid, nvariables=nvars)
1522  call check_netcdf_code(err, "get_num_variables: file: "//trim(fileobj%path))
1523  endif
1524  if (present(broadcast)) then
1525  if (.not. broadcast) then
1526  return
1527  endif
1528  endif
1529  call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1530 end function get_num_variables
1531 
1532 
1533 !> @brief Get the names of the variables in a file.
1534 subroutine get_variable_names(fileobj, names, broadcast)
1535 
1536  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1537  character(len=*), dimension(:), intent(inout) :: names !< Names of the
1538  !! variables.
1539  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1540  !! not the data will be
1541  !! broadcasted to non
1542  !! "I/O root" ranks.
1543  !! The broadcast will be done
1544  !! by default.
1545 
1546  integer :: nvars
1547  integer :: i
1548  integer :: err
1549 
1550  if (fileobj%is_root) then
1551  nvars = get_num_variables(fileobj, broadcast=.false.)
1552  if (nvars .gt. 0) then
1553  if (size(names) .ne. nvars) then
1554  call error("'names' has to be the same size of the number of variables. &
1555  &Check your get_variable_names call for file "//trim(fileobj%path))
1556  endif
1557  else
1558  call error("get_variable_names: the file "//trim(fileobj%path)//" does not have any variables")
1559  endif
1560  names(:) = ""
1561  do i = 1, nvars
1562  err = nf90_inquire_variable(fileobj%ncid, i, name=names(i))
1563  call check_netcdf_code(err, "get_variable_names: "//trim(fileobj%path))
1564  enddo
1565  endif
1566  if (present(broadcast)) then
1567  if (.not. broadcast) then
1568  return
1569  endif
1570  endif
1571  call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1572  if (.not. fileobj%is_root) then
1573  if (nvars .gt. 0) then
1574  if (size(names) .ne. nvars) then
1575  call error("'names' has to be the same size of the number of variables. &
1576  &Check your get_variable_names call for file "//trim(fileobj%path))
1577  endif
1578  else
1579  call error("get_variable_names: the file "//trim(fileobj%path)//" does not have any variables")
1580  endif
1581  names(:) = ""
1582  endif
1583  call mpp_broadcast(names, len(names(nvars)), fileobj%io_root, &
1584  pelist=fileobj%pelist)
1585 end subroutine get_variable_names
1586 
1587 
1588 !> @brief Determine if a variable exists.
1589 !! @return Flag telling if the variable exists.
1590 function variable_exists(fileobj, variable_name, broadcast) &
1591  result(var_exists)
1592 
1593  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1594  character(len=*), intent(in) :: variable_name !< Variable name.
1595  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1596  !! not the data will be
1597  !! broadcasted to non
1598  !! "I/O root" ranks.
1599  !! The broadcast will be done
1600  !! by default.
1601  logical :: var_exists
1602 
1603  integer :: varid
1604 
1605  if (fileobj%is_root) then
1606  varid = get_variable_id(fileobj%ncid, trim(variable_name), &
1607  msg="variable_exists: file:"//trim(fileobj%path)//" variable:"//trim(variable_name), &
1608  allow_failure=.true.)
1609  var_exists = varid .ne. variable_missing
1610  endif
1611  if (present(broadcast)) then
1612  if (.not. broadcast) then
1613  return
1614  endif
1615  endif
1616  call mpp_broadcast(var_exists, fileobj%io_root, pelist=fileobj%pelist)
1617 end function variable_exists
1618 
1619 
1620 !> @brief Get the number of dimensions a variable depends on.
1621 !! @return Number of dimensions that the variable depends on.
1622 function get_variable_num_dimensions(fileobj, variable_name, broadcast) &
1623  result(ndims)
1624 
1625  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1626  character(len=*), intent(in) :: variable_name !< Variable name.
1627  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1628  !! not the data will be
1629  !! broadcasted to non
1630  !! "I/O root" ranks.
1631  !! The broadcast will be done
1632  !! by default.
1633  integer :: ndims
1634 
1635  integer :: varid
1636  integer :: err
1637  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
1638 
1639 
1640  if (fileobj%is_root) then
1641  append_error_msg = "get_variable_num_dimension: file:"//trim(fileobj%path)//" variable: "//trim(variable_name)
1642  varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1643  err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims)
1644  call check_netcdf_code(err, append_error_msg)
1645  endif
1646  if (present(broadcast)) then
1647  if (.not. broadcast) then
1648  return
1649  endif
1650  endif
1651  call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1652 end function get_variable_num_dimensions
1653 
1654 
1655 !> @brief Get the name of a variable's dimensions.
1656 subroutine get_variable_dimension_names(fileobj, variable_name, dim_names, &
1657  broadcast)
1658 
1659  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1660  character(len=*), intent(in) :: variable_name !< Variable name.
1661  character(len=*), dimension(:), intent(inout) :: dim_names !< Array of
1662  !! dimension
1663  !! names.
1664  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1665  !! not the data will be
1666  !! broadcasted to non
1667  !! "I/O root" ranks.
1668  !! The broadcast will be done
1669  !! by default.
1670 
1671  integer :: varid
1672  integer :: err
1673  integer :: ndims
1674  integer,dimension(nf90_max_var_dims) :: dimids
1675  integer :: i
1676  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
1677 
1678 
1679  if (fileobj%is_root) then
1680  append_error_msg = "get_variable_dimension_names: file:"//trim(fileobj%path)//" variable: "//trim(variable_name)
1681 
1682  varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1683  err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, &
1684  dimids=dimids)
1685  call check_netcdf_code(err, append_error_msg)
1686  if (ndims .gt. 0) then
1687  if (size(dim_names) .ne. ndims) then
1688  call error("'names' has to be the same size of the number of dimensions for the variable. &
1689  &Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1690  " and variable:"//trim(variable_name))
1691  endif
1692  else
1693  call error("get_variable_dimension_names: the variable: "//trim(variable_name)//" in file: "//trim(fileobj%path)&
1694  & //" does not any dimensions. ")
1695  endif
1696  dim_names(:) = ""
1697  do i = 1, ndims
1698  err = nf90_inquire_dimension(fileobj%ncid, dimids(i), name=dim_names(i))
1699  call check_netcdf_code(err, append_error_msg)
1700  enddo
1701  endif
1702  if (present(broadcast)) then
1703  if (.not. broadcast) then
1704  return
1705  endif
1706  endif
1707  call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1708  if (.not. fileobj%is_root) then
1709  if (ndims .gt. 0) then
1710  if (size(dim_names) .ne. ndims) then
1711  call error("'names' has to be the same size of the number of dimensions for the variable. &
1712  & Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1713  " and variable:"//trim(variable_name))
1714  endif
1715  else
1716  call error("get_variable_dimension_names: the variable: "//trim(variable_name)//" in file: "//trim(fileobj%path)&
1717  & //" does not any dimensions. ")
1718  endif
1719  dim_names(:) = ""
1720  endif
1721  call mpp_broadcast(dim_names, len(dim_names(ndims)), fileobj%io_root, &
1722  pelist=fileobj%pelist)
1723 end subroutine get_variable_dimension_names
1724 
1725 
1726 !> @brief Get the size of a variable's dimensions.
1727 subroutine get_variable_size(fileobj, variable_name, dim_sizes, broadcast)
1728 
1729  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1730  character(len=*), intent(in) :: variable_name !< Variable name.
1731  integer, dimension(:), intent(inout) :: dim_sizes !< Array of dimension
1732  !! sizes.
1733  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1734  !! not the data will be
1735  !! broadcasted to non
1736  !! "I/O root" ranks.
1737  !! The broadcast will be done
1738  !! by default.
1739 
1740  integer :: varid
1741  integer :: err
1742  integer :: ndims
1743  integer,dimension(nf90_max_var_dims) :: dimids
1744  integer :: i
1745  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
1746 
1747  if (fileobj%is_root) then
1748  append_error_msg = "get_variable_size: file:"//trim(fileobj%path)//" variable:"//trim(variable_name)
1749  varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1750  err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, dimids=dimids)
1751  call check_netcdf_code(err, append_error_msg)
1752  if (ndims .gt. 0) then
1753  if (size(dim_sizes) .ne. ndims) then
1754  call error("'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1755  &Check your get_variable_size call for file "//trim(fileobj%path)// &
1756  " and variable:"//trim(variable_name))
1757  endif
1758  else
1759  call error("get_variable_size: the variable: "//trim(variable_name)//" in file: "//trim(fileobj%path)//&
1760  &" does not any dimensions. ")
1761  endif
1762  do i = 1, ndims
1763  err = nf90_inquire_dimension(fileobj%ncid, dimids(i), len=dim_sizes(i))
1764  call check_netcdf_code(err, append_error_msg)
1765  enddo
1766  endif
1767  if (present(broadcast)) then
1768  if (.not. broadcast) then
1769  return
1770  endif
1771  endif
1772  call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1773  if (.not. fileobj%is_root) then
1774  if (ndims .gt. 0) then
1775  if (size(dim_sizes) .ne. ndims) then
1776  call error("'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1777  &Check your get_variable_size call for file "//trim(fileobj%path)// &
1778  " and variable:"//trim(variable_name))
1779  endif
1780  else
1781  call error("get_variable_size: the variable: "//trim(variable_name)//" in file: "//trim(fileobj%path)//&
1782  &" does not any dimensions. ")
1783  endif
1784  endif
1785  call mpp_broadcast(dim_sizes, ndims, fileobj%io_root, pelist=fileobj%pelist)
1786 end subroutine get_variable_size
1787 
1788 
1789 !> @brief Get the index of a variable's unlimited dimensions.
1790 !! @return The index of the unlimited dimension, or else
1791 !! no_unlimited_dimension.
1792 function get_variable_unlimited_dimension_index(fileobj, variable_name, &
1793  broadcast) &
1794  result(unlim_dim_index)
1795 
1796  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1797  character(len=*), intent(in) :: variable_name !< Variable name.
1798  logical, intent(in), optional :: broadcast !< Flag controlling whether or
1799  !! not the data will be
1800  !! broadcasted to non
1801  !! "I/O root" ranks.
1802  !! The broadcast will be done
1803  !! by default.
1804  integer :: unlim_dim_index
1805 
1806  integer :: ndims
1807  character(len=nf90_max_name), dimension(:), allocatable :: dim_names
1808  integer :: i
1809 
1810  unlim_dim_index = no_unlimited_dimension
1811  if (fileobj%is_root) then
1812  ndims = get_variable_num_dimensions(fileobj, variable_name, broadcast=.false.)
1813  allocate(dim_names(ndims))
1814  call get_variable_dimension_names(fileobj, variable_name, dim_names, &
1815  broadcast=.false.)
1816  do i = 1, size(dim_names)
1817  if (is_dimension_unlimited(fileobj, dim_names(i), .false.)) then
1818  unlim_dim_index = i
1819  exit
1820  endif
1821  enddo
1822  deallocate(dim_names)
1823  endif
1824  if (present(broadcast)) then
1825  if (.not. broadcast) then
1826  return
1827  endif
1828  endif
1829  call mpp_broadcast(unlim_dim_index, fileobj%io_root, pelist=fileobj%pelist)
1831 
1832 
1833 !> @brief Store the valid range for a variable.
1834 !! @return A ValidType_t object containing data about the valid
1835 !! range data for this variable can take.
1836 function get_valid(fileobj, variable_name) &
1837  result(valid)
1838 
1839  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
1840  character(len=*), intent(in) :: variable_name !< Variable name.
1841  type(valid_t) :: valid
1842 
1843  integer :: varid
1844  real(kind=r8_kind) :: scale_factor
1845  real(kind=r8_kind) :: add_offset
1846  real(kind=r8_kind), dimension(2) :: buffer
1847  integer :: xtype
1848  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
1849 
1850  append_error_msg = "get_valid: file:"//trim(fileobj%path)
1851  if (fileobj%is_root) then
1852  varid = get_variable_id(fileobj%ncid, variable_name, msg=append_error_msg)
1853  valid%has_max = .false.
1854  valid%has_min = .false.
1855  valid%has_fill = .false.
1856  valid%has_missing = .false.
1857  valid%has_range = .false.
1858 
1859  !This routine makes use of netcdf's automatic type conversion to
1860  !store all range information in double precision.
1861  if (attribute_exists(fileobj%ncid, varid, "scale_factor", msg=append_error_msg)) then
1862  call get_variable_attribute(fileobj, variable_name, "scale_factor", scale_factor, &
1863  broadcast=.false.)
1864  else
1865  scale_factor = 1._r8_kind
1866  endif
1867  if (attribute_exists(fileobj%ncid, varid, "add_offset", msg=append_error_msg)) then
1868  call get_variable_attribute(fileobj, variable_name, "add_offset", add_offset, &
1869  broadcast=.false.)
1870  else
1871  add_offset = 0._r8_kind
1872  endif
1873 
1874  !valid%max_val and valid%min_val are defined by the "valid_range", "valid_min", and
1875  !"valid_max" variable attributes if they are present in the file. If either the maximum value
1876  !or minimum value is defined, valid%has_range is set to .true. (i.e. open ended ranges
1877  !are valid and should be tested within the is_valid function).
1878  if (attribute_exists(fileobj%ncid, varid, "valid_range", msg=append_error_msg)) then
1879  call get_variable_attribute(fileobj, variable_name, "valid_range", buffer, &
1880  broadcast=.false.)
1881  valid%max_val = buffer(2)*scale_factor + add_offset
1882  valid%has_max = .true.
1883  valid%min_val = buffer(1)*scale_factor + add_offset
1884  valid%has_min = .true.
1885  else
1886  if (attribute_exists(fileobj%ncid, varid, "valid_max", msg=append_error_msg)) then
1887  call get_variable_attribute(fileobj, variable_name, "valid_max", buffer(1), &
1888  broadcast=.false.)
1889  valid%max_val = buffer(1)*scale_factor + add_offset
1890  valid%has_max = .true.
1891  endif
1892  if (attribute_exists(fileobj%ncid, varid, "valid_min", msg=append_error_msg)) then
1893  call get_variable_attribute(fileobj, variable_name, "valid_min", buffer(1), &
1894  broadcast=.false.)
1895  valid%min_val = buffer(1)*scale_factor + add_offset
1896  valid%has_min = .true.
1897  endif
1898  endif
1899  valid%has_range = valid%has_min .or. valid%has_max
1900 
1901 
1902  !Get the missing value from the file if it exists.
1903  if (attribute_exists(fileobj%ncid, varid, "missing_value", msg=append_error_msg)) then
1904  call get_variable_attribute(fileobj, variable_name, "missing_value", buffer(1), &
1905  broadcast=.false.)
1906  valid%missing_val = buffer(1)*scale_factor + add_offset
1907  valid%has_missing = .true.
1908  endif
1909 
1910  !Get the fill value from the file if it exists.
1911  !If the _FillValue attribute is present and the maximum or minimum value is not defined,
1912  !then the maximum or minimum value will be determined by the _FillValue according to the NUG convention.
1913  !The NUG convention states that a positive fill value will be the exclusive upper
1914  !bound (i.e. valid values are less than the fill value), while a
1915  !non-positive fill value will be the exclusive lower bound (i.e. valis
1916  !values are greater than the fill value). As before, valid%has_range is true
1917  !if either a maximum or minimum value is set.
1918  if (attribute_exists(fileobj%ncid, varid, "_FillValue", msg=append_error_msg)) then
1919  call get_variable_attribute(fileobj, variable_name, "_FillValue", buffer(1), &
1920  broadcast=.false.)
1921  valid%fill_val = buffer(1)*scale_factor + add_offset
1922  valid%has_fill = .true.
1923  xtype = get_variable_type(fileobj%ncid, varid, msg=append_error_msg)
1924 
1925  if (.not. valid%has_range) then
1926  if (xtype .eq. nf90_short .or. xtype .eq. nf90_int) then
1927  if (buffer(1) .gt. 0) then
1928  valid%max_val = (buffer(1) - 1._r8_kind)*scale_factor + add_offset
1929  valid%has_max = .true.
1930  else
1931  valid%min_val = (buffer(1) + 1._r8_kind)*scale_factor + add_offset
1932  valid%has_min = .true.
1933  endif
1934  elseif (xtype .eq. nf90_float .or. xtype .eq. nf90_double) then
1935  if (buffer(1) .gt. 0) then
1936  valid%max_val = (nearest(nearest(buffer(1), -1._r8_kind), -1._r8_kind)) &
1937  *scale_factor + add_offset
1938  valid%has_max = .true.
1939  else
1940  valid%min_val = (nearest(nearest(buffer(1), 1._r8_kind), 1._r8_kind)) &
1941  *scale_factor + add_offset
1942  valid%has_min = .true.
1943  endif
1944  else
1945  call error("Unsupported variable type:"//trim(append_error_msg))
1946  endif
1947  valid%has_range = .true.
1948  endif
1949  endif
1950 
1951  endif
1952 
1953  call mpp_broadcast(valid%has_min, fileobj%io_root, pelist=fileobj%pelist)
1954  if (valid%has_min) then
1955  call mpp_broadcast(valid%min_val, fileobj%io_root, pelist=fileobj%pelist)
1956  endif
1957  call mpp_broadcast(valid%has_max, fileobj%io_root, pelist=fileobj%pelist)
1958  if (valid%has_max) then
1959  call mpp_broadcast(valid%max_val, fileobj%io_root, pelist=fileobj%pelist)
1960  endif
1961  call mpp_broadcast(valid%has_range, fileobj%io_root, pelist=fileobj%pelist)
1962 
1963  call mpp_broadcast(valid%has_fill, fileobj%io_root, pelist=fileobj%pelist)
1964  if (valid%has_fill) then
1965  call mpp_broadcast(valid%fill_val, fileobj%io_root, pelist=fileobj%pelist)
1966  endif
1967 
1968  call mpp_broadcast(valid%has_missing, fileobj%io_root, pelist=fileobj%pelist)
1969  if (valid%has_missing) then
1970  call mpp_broadcast(valid%missing_val, fileobj%io_root, pelist=fileobj%pelist)
1971  endif
1972 
1973 end function get_valid
1974 
1975 !> @brief Determine if a piece of (r4) data is "valid" (in the correct range.)
1976 !! @return A flag telling if the data element is "valid."
1977 elemental function is_valid_r8(datum, validobj) &
1978  result(valid_data)
1979 
1980  real(kind=r8_kind), intent(in) :: datum !< Unpacked data element.
1981  type(valid_t), intent(in) :: validobj !< Valid object.
1982  logical :: valid_data
1983 
1984  valid_data = check_if_valid(datum, validobj)
1985 
1986 end function is_valid_r8
1987 
1988 !> @brief Determine if a piece of (r8) data is "valid" (in the correct range.)
1989 !! @return A flag telling if the data element is "valid."
1990 elemental function is_valid_r4(datum, validobj) &
1991  result(valid_data)
1992 
1993  real(kind=r4_kind), intent(in) :: datum !< Unpacked data element.
1994  type(valid_t), intent(in) :: validobj !< Valid object.
1995  logical :: valid_data
1996 
1997  real(kind=r8_kind) :: rdatum
1998 
1999  !< Convert the data to r8 so it can be compared correctly since validobj%*_val are defined as r8
2000  rdatum = real(datum, kind=r8_kind)
2001  valid_data = check_if_valid(rdatum, validobj)
2002 
2003 end function is_valid_r4
2004 
2005 !> @brief Determine if a piece of data is "valid" (in the correct range.)
2006 !! @return A flag telling if the data element is "valid."
2007 elemental function check_if_valid(rdatum, validobj) &
2008  result(valid_data)
2009 
2010  real(kind=r8_kind), intent(in) :: rdatum !< packed data element.
2011  type(valid_t), intent(in) :: validobj !< Valid object.
2012  logical :: valid_data
2013 
2014  valid_data = .true.
2015  ! If the variable has a range (open or closed), valid values must be in that
2016  ! range.
2017  if (validobj%has_range) then
2018  if (validobj%has_min .and. .not. validobj%has_max) then
2019  valid_data = rdatum .ge. validobj%min_val
2020  elseif (validobj%has_max .and. .not. validobj%has_min) then
2021  valid_data = rdatum .le. validobj%max_val
2022  else
2023  valid_data = .not. (rdatum .lt. validobj%min_val .or. rdatum .gt. validobj%max_val)
2024  endif
2025  endif
2026  ! If the variable has a fill value or missing value, valid values must not be
2027  ! equal to either.
2028  if (validobj%has_fill .or. validobj%has_missing) then
2029  if (validobj%has_fill .and. .not. validobj%has_missing) then
2030  valid_data = rdatum .ne. validobj%fill_val
2031  elseif (validobj%has_missing .and. .not. validobj%has_fill) then
2032  valid_data = rdatum .ne. validobj%missing_val
2033  else
2034  valid_data = .not. (rdatum .eq. validobj%missing_val .or. rdatum .eq. validobj%fill_val)
2035  endif
2036  endif
2037 end function check_if_valid
2038 
2039 
2040 !> @brief Gathers a compressed arrays size and offset for each pe.
2041 subroutine compressed_start_and_count(fileobj, nelems, npes_start, npes_count)
2042 
2043  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
2044  integer, intent(in) :: nelems !< Number of elements on the current pe.
2045  integer, dimension(:), allocatable, intent(out) :: npes_start !< Offset for each pe.
2046  integer, dimension(:), allocatable, intent(out) :: npes_count !< Number of elements for
2047  !! each pe.
2048 
2049  integer :: i
2050 
2051  allocate(npes_start(size(fileobj%pelist)))
2052  allocate(npes_count(size(fileobj%pelist)))
2053  do i = 1, size(fileobj%pelist)
2054  if (fileobj%pelist(i) .eq. mpp_pe()) then
2055  npes_count(i) = nelems
2056  else
2057  call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
2058  call mpp_send(nelems, fileobj%pelist(i))
2059  endif
2060  enddo
2061  call mpp_sync_self(check=event_recv)
2062  call mpp_sync_self(check=event_send)
2063  npes_start(1) = 1
2064  do i = 1, size(fileobj%pelist)-1
2065  npes_start(i+1) = npes_start(i) + npes_count(i)
2066  enddo
2067 end subroutine compressed_start_and_count
2068 
2069 
2070 include "netcdf_add_restart_variable.inc"
2071 include "netcdf_read_data.inc"
2072 include "netcdf_write_data.inc"
2073 include "register_global_attribute.inc"
2074 include "register_variable_attribute.inc"
2075 include "get_global_attribute.inc"
2076 include "get_variable_attribute.inc"
2077 include "compressed_write.inc"
2078 include "compressed_read.inc"
2079 include "scatter_data_bc.inc"
2080 include "gather_data_bc.inc"
2081 include "unpack_data.inc"
2082 
2083 !> @brief Wrapper to distinguish interfaces.
2084 function netcdf_file_open_wrap(fileobj, path, mode, nc_format, pelist, is_restart, &
2085  dont_add_res_to_filename) result(success)
2086 
2087  type(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
2088  character(len=*), intent(in) :: path !< File path.
2089  character(len=*), intent(in) :: mode !< File mode. Allowed values are:
2090  !! "read", "append", "write", or
2091  !! "overwrite".
2092  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
2093  !! new files are written
2094  !! as. Allowed values
2095  !! are: "64bit", "classic",
2096  !! or "netcdf4". Defaults to
2097  !! "64bit".
2098  integer, dimension(:), intent(in), optional :: pelist !< List of ranks associated
2099  !! with this file. If not
2100  !! provided, only the current
2101  !! rank will be able to
2102  !! act on the file.
2103  logical, intent(in), optional :: is_restart !< Flag telling if this file
2104  !! is a restart file. Defaults
2105  !! to false.
2106  logical, intent(in), optional :: dont_add_res_to_filename !< Flag indicating not to add
2107  !! ".res" to the filename
2108  logical :: success
2109 
2110  success = netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
2111 end function netcdf_file_open_wrap
2112 
2113 
2114 !> @brief Wrapper to distinguish interfaces.
2115 subroutine netcdf_file_close_wrap(fileobj)
2116 
2117  type(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
2118 
2119  call netcdf_file_close(fileobj)
2120 end subroutine netcdf_file_close_wrap
2121 
2122 
2123 !> @brief Wrapper to distinguish interfaces.
2124 subroutine netcdf_add_variable_wrap(fileobj, variable_name, variable_type, dimensions, chunksizes)
2125 
2126  type(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
2127  character(len=*), intent(in) :: variable_name !< Variable name.
2128  character(len=*), intent(in) :: variable_type !< Variable type. Allowed
2129  !! values are: "int", "int64",
2130  !! "float", or "double".
2131  character(len=*), dimension(:), intent(in), optional :: dimensions !< Dimension names.
2132  integer, intent(in), optional :: chunksizes(:) !< netcdf chunksize to use for this variable (netcdf4 only)
2133 
2134  call netcdf_add_variable(fileobj, variable_name, variable_type, dimensions, chunksizes)
2135 end subroutine netcdf_add_variable_wrap
2136 
2137 !> @brief Wrapper to distinguish interfaces.
2138 subroutine netcdf_save_restart_wrap(fileobj, unlim_dim_level)
2139 
2140  type(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
2141  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
2142  !! level.
2143 
2144  call netcdf_save_restart(fileobj, unlim_dim_level)
2145 end subroutine netcdf_save_restart_wrap
2146 
2147 
2148 !> @brief Returns a variable's fill value if it exists in the file.
2149 !! @return Flag telling if a fill value exists.
2150 function get_fill_value(fileobj, variable_name, fill_value, broadcast) &
2151  result(fill_exists)
2152 
2153  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
2154  character(len=*), intent(in) :: variable_name !< Variable name.
2155  class(*), intent(out) :: fill_value !< Fill value.
2156  logical, intent(in), optional :: broadcast !< Flag controlling whether or
2157  !! not the data will be
2158  !! broadcasted to non
2159  !! "I/O root" ranks.
2160  !! The broadcast will be done
2161  !! by default.
2162  logical :: fill_exists
2163 
2164  character(len=32), dimension(2) :: attribute_names
2165  logical :: bcast
2166  integer :: i
2167 
2168  fill_exists = .false.
2169  call string_copy(attribute_names(1), "_FillValue")
2170  call string_copy(attribute_names(2), "missing_value")
2171  if (present(broadcast)) then
2172  bcast = broadcast
2173  else
2174  bcast = .true.
2175  endif
2176  do i = 1, size(attribute_names)
2177  fill_exists = variable_att_exists(fileobj, variable_name, attribute_names(i), &
2178  broadcast=bcast)
2179  if (fill_exists) then
2180  call get_variable_attribute(fileobj, variable_name, attribute_names(i), &
2181  fill_value, broadcast=bcast)
2182  exit
2183  endif
2184  enddo
2185 end function get_fill_value
2186 
2187 
2188 function get_variable_sense(fileobj, variable_name) &
2189  result(variable_sense)
2190 
2191  class(fmsnetcdffile_t), intent(in) :: fileobj
2192  character(len=*), intent(in) :: variable_name
2193  integer :: variable_sense
2194 
2195  character(len=256) :: buf
2196 
2197  variable_sense = 0
2198  if (variable_att_exists(fileobj, variable_name, "positive")) then
2199  call get_variable_attribute(fileobj, variable_name, "positive", buf)
2200  if (string_compare(buf, "down")) then
2201  variable_sense = -1
2202  elseif (string_compare(buf, "up")) then
2203  variable_sense = 1
2204  endif
2205  endif
2206 end function get_variable_sense
2207 
2208 
2209 function get_variable_missing(fileobj, variable_name) &
2210  result(variable_missing)
2211 
2212  type(fmsnetcdffile_t), intent(in) :: fileobj
2213  character(len=*), intent(in) :: variable_name
2214  real(kind=r8_kind) :: variable_missing
2215 
2216  real(kind=r8_kind) :: variable_missing_1d(1) !< Workaround for pgi
2217 
2218  if (variable_att_exists(fileobj, variable_name, "_FillValue")) then
2219  call get_variable_attribute(fileobj, variable_name, "_FillValue", variable_missing_1d)
2220  elseif (variable_att_exists(fileobj, variable_name, "missing_value")) then
2221  call get_variable_attribute(fileobj, variable_name, "missing_value", variable_missing_1d)
2222  elseif (variable_att_exists(fileobj, variable_name, "missing")) then
2223  call get_variable_attribute(fileobj, variable_name, "missing", variable_missing_1d)
2224  else
2225  variable_missing_1d = mpp_fill_double
2226  endif
2227 
2228  variable_missing = variable_missing_1d(1)
2229 
2230 end function get_variable_missing
2231 
2232 
2233 subroutine get_variable_units(fileobj, variable_name, units)
2234 
2235  class(fmsnetcdffile_t), intent(in) :: fileobj
2236  character(len=*), intent(in) :: variable_name
2237  character(len=*), intent(out) :: units
2238 
2239  if (variable_att_exists(fileobj, variable_name, "units")) then
2240  call get_variable_attribute(fileobj, variable_name, "units", units)
2241  else
2242  units = "nounits"
2243  endif
2244 end subroutine get_variable_units
2245 
2246 
2247 subroutine get_time_calendar(fileobj, time_name, calendar_type)
2248 
2249  class(fmsnetcdffile_t), intent(in) :: fileobj
2250  character(len=*), intent(in) :: time_name
2251  character(len=*), intent(out) :: calendar_type
2252 
2253  if (variable_att_exists(fileobj, time_name, "calendar")) then
2254  call get_variable_attribute(fileobj, time_name, "calendar", calendar_type)
2255  elseif (variable_att_exists(fileobj, time_name, "calendar_type")) then
2256  call get_variable_attribute(fileobj, time_name, "calendar_type", calendar_type)
2257  else
2258  calendar_type = "unspecified"
2259  endif
2260 end subroutine get_time_calendar
2261 
2262 
2263 !> @brief Determine if a variable has been registered to a restart file..
2264 !! @return Flag telling if the variable has been registered to a restart file.
2265 function is_registered_to_restart(fileobj, variable_name) &
2266  result(is_registered)
2267 
2268  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
2269  character(len=*), intent(in) :: variable_name !< Variable name.
2270  logical :: is_registered
2271 
2272  integer :: i
2273 
2274  if (.not. fileobj%is_restart) then
2275  call error("file "//trim(fileobj%path)//" is not a restart file. &
2276  &Add is_restart=.true. to your open_file call")
2277  endif
2278  is_registered = .false.
2279  do i = 1, fileobj%num_restart_vars
2280  if (string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.)) then
2281  is_registered = .true.
2282  exit
2283  endif
2284  enddo
2285 end function is_registered_to_restart
2286 
2287 
2288 function check_if_open(fileobj, fname) result(is_open)
2289  logical :: is_open !< True if the file in the file object is opened
2290  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
2291  character(len=*), intent(in), optional :: fname !< Optional filename for checking
2292 
2293  !Check if the is_open variable in the object has been allocated
2294  if (allocated(fileobj%is_open)) then
2295  is_open = fileobj%is_open !Return the value of the fileobj%is_open
2296  else
2297  is_open = .false. !If fileobj%is_open is not allocated, that the file has not been opened
2298  endif
2299 
2300  if (present(fname)) then
2301  !If the filename does not match the name in path,
2302  !then this is considered not open
2303  if (is_open .AND. trim(fname) .ne. trim(fileobj%path)) is_open = .false.
2304  endif
2305 end function check_if_open
2306 
2307 subroutine set_fileobj_time_name (fileobj,time_name)
2308  class(fmsnetcdffile_t), intent(inout) :: fileobj
2309  character(*),intent(in) :: time_name
2310  integer :: len_of_name
2311  len_of_name = len(trim(time_name))
2312  fileobj%time_name = ' '
2313  fileobj%time_name = time_name(1:len_of_name)
2314 ! if (.not. allocated(fileobj%time_name)) then
2315 ! allocate(character(len=len_of_name) :: fileobj%time_name)
2316 ! fileobj%time_name = time_name(1:len_of_name)
2317 ! else
2318 ! call error ("set_fileobj_time_name :: The time_name has already been set")
2319 ! endif
2320 end subroutine set_fileobj_time_name
2321 
2322 !> @brief Loop through the registered restart variables (including regional
2323 !! variables) and read them from the netcdf file
2324 subroutine read_restart_bc(fileobj, unlim_dim_level, ignore_checksum)
2325  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object
2326  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
2327  !! level.
2328  logical, intent(in), optional :: ignore_checksum !< Checksum data integrity flag.
2329 
2330  integer :: i !< No description
2331 
2332  if (.not. fileobj%is_restart) then
2333  call error("file "//trim(fileobj%path)//" is not a restart file.")
2334  endif
2335 
2336  do i = 1, fileobj%num_restart_vars
2337  !> Go away if you are not in the pelist!
2338  if (.not.any(mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2339 
2340  !> The file's root pe reads the file and scatters it to the rest of the pes
2341  if (associated(fileobj%restart_vars(i)%data2d)) then
2342  call scatter_data_bc (fileobj, fileobj%restart_vars(i)%varname, &
2343  fileobj%restart_vars(i)%data2d, &
2344  fileobj%restart_vars(i)%bc_info, &
2345  unlim_dim_level = unlim_dim_level, &
2346  ignore_checksum=ignore_checksum)
2347  else if (associated(fileobj%restart_vars(i)%data3d)) then
2348  call scatter_data_bc (fileobj, fileobj%restart_vars(i)%varname, &
2349  fileobj%restart_vars(i)%data3d, &
2350  fileobj%restart_vars(i)%bc_info, &
2351  unlim_dim_level = unlim_dim_level, &
2352  ignore_checksum=ignore_checksum)
2353  endif
2354  end do
2355 
2356 
2357 end subroutine read_restart_bc
2358 
2359 !> @brief Loop through the registered restart variables (including regional
2360 !! variables) and write them to the netcdf file
2361 subroutine write_restart_bc(fileobj, unlim_dim_level)
2362  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object
2363  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
2364  !! level.
2365  integer :: i !< No description
2366 
2367  if (.not. fileobj%is_restart) then
2368  call error("file "//trim(fileobj%path)//" is not a restart file. &
2369  &Add is_restart=.true. to your open_file call")
2370  endif
2371 
2372  !> Loop through the variables, root pe gathers the data from the other pes and writes out the checksum.
2373  !! Then loop through the variables again to write the data to the netcdf file.
2374  !! All the metadata should be written before the data to prevent netcdf from rewriting the file
2375  !! if the header is not big enough. That is why the two do loops are needed.
2376 
2377  do i = 1, fileobj%num_restart_vars
2378  !> Go away if you are not in the pelist!
2379  if (.not.any(mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2380 
2381  !> Go away if this is not a BC variable
2382  if (.not. fileobj%restart_vars(i)%is_bc_variable) cycle
2383 
2384  !> Root pe gathers the data from the other ranks, saves it in a buffer, and writes out the checksum.
2385  if (associated(fileobj%restart_vars(i)%data2d)) then
2386  call gather_data_bc(fileobj, fileobj%restart_vars(i)%data2d, fileobj%restart_vars(i)%bc_info)
2387  call register_variable_attribute(fileobj, fileobj%restart_vars(i)%varname, "checksum", &
2388  fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2389  str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2390  else if (associated(fileobj%restart_vars(i)%data3d)) then
2391  call gather_data_bc(fileobj, fileobj%restart_vars(i)%data3d, fileobj%restart_vars(i)%bc_info)
2392  call register_variable_attribute(fileobj, fileobj%restart_vars(i)%varname, "checksum", &
2393  fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2394  str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2395  endif
2396  enddo
2397 
2398  !> Write the data to the netcdf file
2399  do i = 1, fileobj%num_restart_vars
2400  if (allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r8 )) then
2401  call netcdf_write_data(fileobj, fileobj%restart_vars(i)%varname, &
2402  fileobj%restart_vars(i)%bc_info%globaldata2d_r8 , &
2403  unlim_dim_level=unlim_dim_level)
2404  deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r8)
2405  else if (allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r4 )) then
2406  call netcdf_write_data(fileobj, fileobj%restart_vars(i)%varname, &
2407  fileobj%restart_vars(i)%bc_info%globaldata2d_r4 , &
2408  unlim_dim_level=unlim_dim_level)
2409  deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r4)
2410  else if (allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r8 )) then
2411  call netcdf_write_data(fileobj, fileobj%restart_vars(i)%varname, &
2412  fileobj%restart_vars(i)%bc_info%globaldata3d_r8 , &
2413  unlim_dim_level=unlim_dim_level)
2414  deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r8)
2415  else if (allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 )) then
2416  call netcdf_write_data(fileobj, fileobj%restart_vars(i)%varname, &
2417  fileobj%restart_vars(i)%bc_info%globaldata3d_r4 , &
2418  unlim_dim_level=unlim_dim_level)
2419  deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 )
2420  endif
2421 
2422  enddo
2423 
2424 end subroutine write_restart_bc
2425 
2426 !> @brief flushes the netcdf file into disk
2427 subroutine flush_file(fileobj)
2428  class(fmsnetcdffile_t), intent(inout) :: fileobj !< FMS2_io fileobj
2429 
2430  integer :: err !< Netcdf error code
2431 
2432  if (fileobj%is_root) then
2433  err = nf90_sync(fileobj%ncid)
2434  call check_netcdf_code(err, "Flush_file: File:"//trim(fileobj%path))
2435  endif
2436 end subroutine flush_file
2437 
2438 !> Initialization routine for fmsOffloadingIn_type
2439 subroutine init(this, offloading_obj_id, offloading_pes, model_pes, domain)
2440  class(fmsoffloadingin_type), intent(inout) :: this !< offloading object to initialize
2441  integer, intent(in) :: offloading_obj_id !< unique id number to set
2442  integer, intent(in) :: offloading_pes(:) !< list of pe's from current list to offload writes to
2443  integer, intent(in) :: model_pes(:) !< list of model pe's (any pes not in offloading_pes argument)
2444  type(domain2d) :: domain
2445 
2446  this%id = offloading_obj_id
2447  allocate(this%offloading_pes(size(offloading_pes)))
2448  this%offloading_pes = offloading_pes
2449  allocate(this%model_pes(size(model_pes)))
2450  this%model_pes = model_pes
2451 
2452  this%is_model_pe = .false.
2453  if (any(model_pes .eq. mpp_pe())) &
2454  this%is_model_pe = .true.
2455  this%domain_in = domain
2456 end subroutine
2457 !> @brief Getter for use_netcdf_mpi
2458 pure logical function is_file_using_netcdf_mpi(this)
2459  class(fmsnetcdffile_t), intent(in) :: this !< fms2io fileobj to query
2460 
2461  is_file_using_netcdf_mpi = this%use_netcdf_mpi
2462 end function is_file_using_netcdf_mpi
2463 
2464 end module netcdf_io_mod
2465 !> @}
2466 ! close documentation grouping
subroutine compressed_write_1d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine register_variable_attribute_1d(fileobj, variable_name, attribute_name, attribute_value, str_len)
Add an attribute to a variable.
subroutine compressed_write_3d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_write_5d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine compressed_write_0d(fileobj, variable_name, cdata, unlim_dim_level, corner)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_read_0d(fileobj, variable_name, cdata, unlim_dim_level, corner)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_5d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_read_5d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_read_3d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_0d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner)
Wrapper to distinguish interfaces.
subroutine compressed_read_1d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_read_2d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_4d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_write_2d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine compressed_write_1d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_write_4d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine compressed_read_4d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_2d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine register_variable_attribute_0d(fileobj, variable_name, attribute_name, attribute_value, str_len)
Add an attribute to a variable.
subroutine compressed_write_3d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine, public get_instance_filename(name_in, name_out)
Adds the filename_appendix to name_in and sets it as name_out.
subroutine, public restart_filepath_mangle(dest, source)
Add ".res" to an input file path.
logical function, public file_exists(path)
Determine if a file exists.
logical function, public string_compare(string1, string2, ignore_case)
Compare strings.
The domain2D type contains all the necessary information to define the global, compute and data domai...
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
integer, parameter, public mpp_comm_null
MPP_COMM_NULL acts as an analagous mpp-macro for MPI_COMM_NULL to share with fms2_io NetCDF4 mpi-io....
Definition: mpp.F90:1398
integer, parameter, public mpp_info_null
MPP_INFO_NULL acts as an analagous mpp-macro for MPI_INFO_NULL to share with fms2_io NetCDF4 mpi-io....
Definition: mpp.F90:1394
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:406
Perform parallel broadcasts.
Definition: mpp.F90:1153
Error handler.
Definition: mpp.F90:385
Gather data sent from pelist onto the root pe Wrapper for MPI_gather, can be used with and without in...
Definition: mpp.F90:728
Receive data from another PE.
Definition: mpp.F90:999
Send data to a receiving PE.
Definition: mpp.F90:1066
integer, private fms2_ncchksz
Chunksize (bytes) used in nc_open and nc_create.
Definition: netcdf_io.F90:60
subroutine, public netcdf_restore_state(fileobj, unlim_dim_level)
Loop through registered restart variables and read them from a netcdf file.
Definition: netcdf_io.F90:1171
subroutine append_compressed_dimension(fileobj, dim_name, npes_corner, npes_nelems)
Add a compressed dimension to a file object.
Definition: netcdf_io.F90:831
subroutine, public netcdf_file_close(fileobj)
Close a netcdf file.
Definition: netcdf_io.F90:768
subroutine netcdf_add_restart_variable_4d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
integer function, dimension(2) get_variable_compressed_dimension_index(fileobj, variable_name, broadcast)
Given a compressed variable, get the index of the compressed dimension.
Definition: netcdf_io.F90:1056
elemental logical function is_valid_r8(datum, validobj)
Determine if a piece of (r4) data is "valid" (in the correct range.)
Definition: netcdf_io.F90:1979
logical function attribute_exists(ncid, varid, attribute_name, msg)
Determine if an attribute exists.
Definition: netcdf_io.F90:502
subroutine, public get_variable_size(fileobj, variable_name, dim_sizes, broadcast)
Get the size of a variable's dimensions.
Definition: netcdf_io.F90:1728
subroutine, public netcdf_add_dimension(fileobj, dimension_name, dimension_length, is_compressed)
Add a dimension to a file.
Definition: netcdf_io.F90:901
subroutine netcdf_add_restart_variable_0d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
type(valid_t) function, public get_valid(fileobj, variable_name)
Store the valid range for a variable.
Definition: netcdf_io.F90:1838
subroutine, public read_restart_bc(fileobj, unlim_dim_level, ignore_checksum)
Loop through the registered restart variables (including regional variables) and read them from the n...
Definition: netcdf_io.F90:2325
logical function, public is_dimension_unlimited(fileobj, dimension_name, broadcast)
Determine where or not the dimension is unlimited.
Definition: netcdf_io.F90:1404
character(len=10), private fms2_nc_format
Netcdf format type used in netcdf_file_open.
Definition: netcdf_io.F90:62
integer function, public get_variable_unlimited_dimension_index(fileobj, variable_name, broadcast)
Get the index of a variable's unlimited dimensions.
Definition: netcdf_io.F90:1795
logical function, public netcdf_file_open_wrap(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
Wrapper to distinguish interfaces.
Definition: netcdf_io.F90:2086
integer function get_compressed_dimension_index(fileobj, dim_name)
Get the index of a compressed dimension in a file object.
Definition: netcdf_io.F90:810
subroutine, public compressed_start_and_count(fileobj, nelems, npes_start, npes_count)
Gathers a compressed arrays size and offset for each pe.
Definition: netcdf_io.F90:2042
subroutine scatter_data_bc_2d(fileobj, varname, vdata, bc_info, unlim_dim_level, ignore_checksum)
integer, private fms2_header_buffer_val
value used in NF__ENDDEF
Definition: netcdf_io.F90:63
integer, private fms2_nc_format_param
Netcdf format type param used in nc_create.
Definition: netcdf_io.F90:61
elemental logical function is_valid_r4(datum, validobj)
Determine if a piece of (r8) data is "valid" (in the correct range.)
Definition: netcdf_io.F90:1992
integer function, public get_variable_num_dimensions(fileobj, variable_name, broadcast)
Get the number of dimensions a variable depends on.
Definition: netcdf_io.F90:1624
subroutine, public get_dimension_size(fileobj, dimension_name, dim_size, broadcast)
Get the length of a dimension.
Definition: netcdf_io.F90:1474
subroutine netcdf_add_restart_variable_3d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine netcdf_write_data_4d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine netcdf_read_data_1d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
subroutine netcdf_add_restart_variable_5d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
elemental logical function check_if_valid(rdatum, validobj)
Determine if a piece of data is "valid" (in the correct range.)
Definition: netcdf_io.F90:2009
subroutine netcdf_add_restart_variable_1d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
logical function, public global_att_exists(fileobj, attribute_name, broadcast)
Determine if a global attribute exists.
Definition: netcdf_io.F90:1219
subroutine, public set_netcdf_mode(ncid, mode)
Switch to the correct netcdf mode.
Definition: netcdf_io.F90:417
subroutine init(this, offloading_obj_id, offloading_pes, model_pes, domain)
Initialization routine for fmsOffloadingIn_type.
Definition: netcdf_io.F90:2440
subroutine netcdf_write_data_0d(fileobj, variable_name, variable_data, unlim_dim_level, corner)
Write data to a variable in a netcdf file.
subroutine register_global_attribute_0d(fileobj, attribute_name, attribute_value, str_len)
Add a global attribute.
subroutine get_variable_attribute_1d(fileobj, variable_name, attribute_name, attribute_value, broadcast)
Get the value of a variable's attribute.
subroutine netcdf_add_restart_variable_0d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
logical, private fms2_shuffle
Flag indicating whether to use the netcdf shuffle filter.
Definition: netcdf_io.F90:66
subroutine get_global_attribute_1d(fileobj, attribute_name, attribute_value, broadcast)
Get the value of a global attribute.
subroutine netcdf_add_restart_variable_3d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
subroutine netcdf_add_restart_variable_1d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine get_variable_attribute_0d(fileobj, variable_name, attribute_name, attribute_value, broadcast, reproduce_null_char_bug_flag)
Get the value of a variable's attribute.
subroutine register_restart_region_3d(fileobj, variable_name, vdata, indices, global_size, pelist, is_root_pe, x_halo, y_halo, jshift, ishift, is_optional)
Registers a regional 3D variable and stores the information needed.
subroutine register_global_attribute_1d(fileobj, attribute_name, attribute_value, str_len)
Add a global attribute.
logical function, public dimension_exists(fileobj, dimension_name, broadcast)
Determine if a dimension exists.
Definition: netcdf_io.F90:1368
logical function, public is_registered_to_restart(fileobj, variable_name)
Determine if a variable has been registered to a restart file..
Definition: netcdf_io.F90:2267
integer function get_dimension_id(ncid, dimension_name, msg, allow_failure)
Get the id of a dimension from its name.
Definition: netcdf_io.F90:446
subroutine, public register_compressed_dimension(fileobj, dimension_name, npes_corner, npes_nelems)
Add a compressed dimension.
Definition: netcdf_io.F90:954
logical function, public variable_att_exists(fileobj, variable_name, attribute_name, broadcast)
Determine if a variable's attribute exists.
Definition: netcdf_io.F90:1248
integer, private fms2_deflate_level
Netcdf deflate level to use in nf90_def_var (integer between 1 to 9)
Definition: netcdf_io.F90:64
subroutine netcdf_read_data_5d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
subroutine netcdf_add_restart_variable_2d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine netcdf_write_data_3d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
logical function, public get_fill_value(fileobj, variable_name, fill_value, broadcast)
Returns a variable's fill value if it exists in the file.
Definition: netcdf_io.F90:2152
subroutine gather_data_bc_3d(fileobj, vdata, bc_info)
gathers the 2d vdata from all of the relevant pes into the root_pe and saves it to a buffer.
subroutine, public get_variable_dimension_names(fileobj, variable_name, dim_names, broadcast)
Get the name of a variable's dimensions.
Definition: netcdf_io.F90:1658
subroutine, public check_netcdf_code(err, msg)
Check for errors returned by netcdf.
Definition: netcdf_io.F90:401
subroutine netcdf_write_data_1d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine, public flush_file(fileobj)
flushes the netcdf file into disk
Definition: netcdf_io.F90:2428
subroutine netcdf_add_restart_variable_4d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
subroutine get_global_attribute_0d(fileobj, attribute_name, attribute_value, broadcast)
Get the value of a global attribute.
subroutine netcdf_add_restart_variable_5d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine, public register_unlimited_compressed_axis(fileobj, dimension_name, dimension_length)
Add a "compressed" unlimited dimension to a netcdf file.
Definition: netcdf_io.F90:867
subroutine, public netcdf_save_restart(fileobj, unlim_dim_level)
Loop through registered restart variables and write them to a netcdf file.
Definition: netcdf_io.F90:1129
subroutine netcdf_read_data_3d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
integer function, public get_variable_id(ncid, variable_name, msg, allow_failure)
Get the id of a variable from its name.
Definition: netcdf_io.F90:474
subroutine, public netcdf_add_variable_wrap(fileobj, variable_name, variable_type, dimensions, chunksizes)
Wrapper to distinguish interfaces.
Definition: netcdf_io.F90:2125
subroutine netcdf_write_data_2d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine, public write_restart_bc(fileobj, unlim_dim_level)
Loop through the registered restart variables (including regional variables) and write them to the ne...
Definition: netcdf_io.F90:2362
integer function get_variable_type(ncid, varid, msg)
Get the type of a netcdf variable.
Definition: netcdf_io.F90:547
logical, private fms2_is_netcdf4
Flag indicating whether the default netcdf file format is netcdf4.
Definition: netcdf_io.F90:67
subroutine, public netcdf_save_restart_wrap(fileobj, unlim_dim_level)
Wrapper to distinguish interfaces.
Definition: netcdf_io.F90:2139
subroutine, public get_variable_names(fileobj, names, broadcast)
Get the names of the variables in a file.
Definition: netcdf_io.F90:1535
subroutine netcdf_read_data_2d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
subroutine netcdf_add_restart_variable_2d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
subroutine, public get_dimension_names(fileobj, names, broadcast)
Get the names of the dimensions in a file.
Definition: netcdf_io.F90:1311
subroutine gather_data_bc_2d(fileobj, vdata, bc_info)
gathers the 2d vdata from all of the relevant pes into the root_pe and saves it to a buffer.
logical function, public check_if_open(fileobj, fname)
Definition: netcdf_io.F90:2289
subroutine, public netcdf_io_init(chksz, header_buffer_val, netcdf_default_format, deflate_level, shuffle)
Accepts the namelist fms2_io_nml variables relevant to netcdf_io_mod.
Definition: netcdf_io.F90:369
integer function, public get_num_variables(fileobj, broadcast)
Determine the number of variables in a file.
Definition: netcdf_io.F90:1508
subroutine, public get_unlimited_dimension_name(fileobj, dimension_name, broadcast)
Get the name of the unlimited dimension.
Definition: netcdf_io.F90:1439
integer function get_attribute_type(ncid, varid, attname, msg)
Get the type of a netcdf attribute.
Definition: netcdf_io.F90:527
pure logical function is_file_using_netcdf_mpi(this)
Getter for use_netcdf_mpi.
Definition: netcdf_io.F90:2459
subroutine, public netcdf_add_variable(fileobj, variable_name, variable_type, dimensions, chunksizes)
Add a variable to a file.
Definition: netcdf_io.F90:982
subroutine scatter_data_bc_3d(fileobj, varname, vdata, bc_info, unlim_dim_level, ignore_checksum)
subroutine netcdf_write_data_5d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine register_restart_region_2d(fileobj, variable_name, vdata, indices, global_size, pelist, is_root_pe, x_halo, y_halo, jshift, ishift, is_optional)
Registers a regional 2D variable and stores the information needed.
logical function, public netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename, tile_comm, use_collective)
Open a netcdf file.
Definition: netcdf_io.F90:565
subroutine, public netcdf_file_close_wrap(fileobj)
Wrapper to distinguish interfaces.
Definition: netcdf_io.F90:2116
subroutine netcdf_read_data_0d(fileobj, variable_name, buf, unlim_dim_level, corner, broadcast)
Read in data from a variable in a netcdf file.
logical function, public variable_exists(fileobj, variable_name, broadcast)
Determine if a variable exists.
Definition: netcdf_io.F90:1592
subroutine add_restart_var_to_array(fileobj, variable_name)
Add a restart variable to a FmsNetcdfFile_t type.
Definition: netcdf_io.F90:1102
integer function, public get_num_dimensions(fileobj, broadcast)
Determine the number of dimensions in a file.
Definition: netcdf_io.F90:1284
subroutine netcdf_read_data_4d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
The interface is needed to accomodate pgi because it can't handle class * and there was no other way ...
Definition: netcdf_io.F90:357
information needed fr regional restart variables
Definition: netcdf_io.F90:73
information about the current dimensions for regional restart variables
Definition: netcdf_io.F90:122
Type to represent a netCDF file. Can be used with multiple cores but only the root pe will perform an...
Definition: netcdf_io.F90:147
Range type for a netcdf variable.
Definition: netcdf_io.F90:185