← back to index

src/framework/MOM_io_file.F90

portedportable, not yet portedexecuted, not portableexecutable, not hit by this run

1! This file is part of MOM6, the Modular Ocean Model version 6.
2! See the LICENSE file for licensing information.
3! SPDX-License-Identifier: Apache-2.0
4
5!> This module contains the MOM file handler types
6module MOM_io_file
7
8use, intrinsic :: iso_fortran_env, only : int64
9
10use MOM_domains, only : MOM_domain_type, domain1D
11use MOM_domains, only : clone_MOM_domain
12use MOM_domains, only : deallocate_MOM_domain
13use MOM_io_infra, only : file_type, get_file_info, get_file_fields
14use MOM_io_infra, only : open_file, close_file, flush_file
15use MOM_io_infra, only : fms2_file_is_open => file_is_open
16use MOM_io_infra, only : fieldtype
17use MOM_io_infra, only : get_file_times, axistype
18use MOM_io_infra, only : write_field, write_metadata
19use MOM_io_infra, only : get_field_atts
20use MOM_io_infra, only : read_field_chksum
21use MOM_io_infra, only : SINGLE_FILE
22
23use MOM_hor_index, only : hor_index_type
24use MOM_hor_index, only : hor_index_init
25
26use MOM_netcdf, only : netcdf_file_type
27use MOM_netcdf, only : netcdf_axis
28use MOM_netcdf, only : netcdf_field
29use MOM_netcdf, only : open_netcdf_file
30use MOM_netcdf, only : close_netcdf_file
31use MOM_netcdf, only : flush_netcdf_file
32use MOM_netcdf, only : register_netcdf_axis
33use MOM_netcdf, only : register_netcdf_field
34use MOM_netcdf, only : write_netcdf_field
35use MOM_netcdf, only : write_netcdf_axis
36use MOM_netcdf, only : write_netcdf_attribute
37use MOM_netcdf, only : get_netcdf_size
38use MOM_netcdf, only : get_netcdf_fields
39use MOM_netcdf, only : get_netcdf_filename
40use MOM_netcdf, only : read_netcdf_field
41
42use MOM_error_handler, only : MOM_error, FATAL
43use MOM_error_handler, only : is_root_PE
44
45implicit none ; private
46
47public :: MOM_file
48public :: MOM_infra_file
49public :: MOM_netcdf_file
50public :: MOM_axis
51public :: MOM_field
52
53
54! Internal types
55
56! NOTE: MOM_axis and MOM_field do not contain the actual axes and fields stored
57! in the file. They are very thin wrappers to the keys (as strings) used to
58! reference the associated object inside of the MOM_file.
59
60!> Handle for axis in MOM file
61type :: MOM_axis
62 character(len=:), allocatable :: label
63 !< Identifier for the axis in handle's list
64end type MOM_axis
65
66
67!> Linked list of framework axes
68type :: axis_list_infra
69 private
70 type(axis_node_infra), pointer :: head => null()
71 !< Head of axis linked list
72 type(axis_node_infra), pointer :: tail => null()
73 !< Tail of axis linked list
74contains
75 !> Initialize the framework axis list
76 procedure :: init => initialize_axis_list_infra
77 !> Append a new axis to the framework axis list
78 procedure :: append => append_axis_list_infra
79 !> Get an axis from the framework axis list
80 procedure :: get => get_axis_list_infra
81 !> Deallocate the framework axis list
82 procedure :: finalize => finalize_axis_list_infra
83end type axis_list_infra
84
85
86!> Framework axis linked list node
87type :: axis_node_infra
88 private
89 character(len=:), allocatable :: label
90 !< Axis identifier
91 type(axis_node_infra), pointer :: next => null()
92 !< Pointer to next axis node
93 type(axistype) :: axis
94 !< Axis node contents
95end type axis_node_infra
96
97
98!> Linked list of framework axes
99type :: axis_list_nc
100 private
101 type(axis_node_nc), pointer :: head => null()
102 !< Head of axis linked list
103 type(axis_node_nc), pointer :: tail => null()
104 !< Tail of axis linked list
105contains
106 !> Initialize the netCDF axis list
107 procedure :: init => initialize_axis_list_nc
108 !> Append a new axis to the netCDF axis list
109 procedure :: append => append_axis_list_nc
110 !> Get an axis from the netCDF axis list
111 procedure :: get => get_axis_list_nc
112 !> Deallocate the netCDF axis list
113 procedure :: finalize => finalize_axis_list_nc
114end type axis_list_nc
115
116
117!> Framework axis linked list node
118type :: axis_node_nc
119 private
120 character(len=:), allocatable :: label
121 !< Axis identifier
122 type(axis_node_nc), pointer :: next => null()
123 !< Pointer to next axis node
124 type(netcdf_axis) :: axis
125 !< Axis node contents
126end type axis_node_nc
127
128
129!> Handle for field in MOM file
130type :: MOM_field
131 character(len=:), allocatable :: label
132 !< Identifier for the field in the handle's list
133 real :: conversion
134 !< A factor to use to rescale the field before output [a A-1 ~> 1]
135end type MOM_field
136
137
138!> Linked list of framework fields
139type :: field_list_infra
140 private
141 type(field_node_infra), pointer :: head => null()
142 !< Head of field linked list
143 type(field_node_infra), pointer :: tail => null()
144 !< Tail of field linked list
145contains
146 !> Initialize the framework field list
147 procedure :: init => initialize_field_list_infra
148 !> Append a new axis to the framework field list
149 procedure :: append => append_field_list_infra
150 !> Get an axis from the framework field list
151 procedure :: get => get_field_list_infra
152 !> Deallocate the framework field list
153 procedure :: finalize => finalize_field_list_infra
154end type field_list_infra
155
156
157!> Framework field linked list node
158type :: field_node_infra
159 private
160 character(len=:), allocatable :: label
161 !< Field identifier
162 type(fieldtype) :: field
163 !< Field node contents
164 type(field_node_infra), pointer :: next => null()
165 !< Pointer to next field node
166end type field_node_infra
167
168
169!> Linked list of framework fields
170type :: field_list_nc
171 private
172 type(field_node_nc), pointer :: head => null()
173 !< Head of field linked list
174 type(field_node_nc), pointer :: tail => null()
175 !< Tail of field linked list
176contains
177 !> Initialize the netCDF field list
178 procedure :: init => initialize_field_list_nc
179 !> Append a new axis to the netCDF field list
180 procedure :: append => append_field_list_nc
181 !> Get an axis from the netCDF field list
182 procedure :: get => get_field_list_nc
183 !> Deallocate the netCDF field list
184 procedure :: finalize => finalize_field_list_nc
185end type field_list_nc
186
187
188!> Framework field linked list node
189type :: field_node_nc
190 private
191 character(len=:), allocatable :: label
192 !< Field identifier
193 type(netcdf_field) :: field
194 !< Field node contents
195 type(field_node_nc), pointer :: next => null()
196 !< Pointer to next field node
197end type field_node_nc
198
199
200!> Generic MOM file abstraction for common operations
201type, abstract :: MOM_file
202 private
203
204 contains
205
206 !> Open a file and connect to the MOM_file object
207 procedure(i_open_file), deferred :: open
208 !> Close the MOM file
209 procedure(i_close_file), deferred :: close
210 !> Flush buffered output to the MOM file
211 procedure(i_flush_file), deferred :: flush
212
213 !> Register an axis to the MOM file
214 procedure(i_register_axis), deferred :: register_axis
215 !> Register a field to the MOM file
216 procedure(i_register_field), deferred :: register_field
217 !> Write metadata to the MOM file
218 procedure(i_write_attribute), deferred :: write_attribute
219
220 !> Write field to a MOM file
221 generic :: write_field => &
222 write_field_4d, &
223 write_field_3d, &
224 write_field_2d, &
225 write_field_1d, &
226 write_field_0d, &
227 write_field_axis
228
229 !> Write a 4D field to the MOM file
230 procedure(i_write_field_4d), deferred :: write_field_4d
231 !> Write a 3D field to the MOM file
232 procedure(i_write_field_3d), deferred :: write_field_3d
233 !> Write a 2D field to the MOM file
234 procedure(i_write_field_2d), deferred :: write_field_2d
235 !> Write a 1D field to the MOM file
236 procedure(i_write_field_1d), deferred :: write_field_1d
237 !> Write a 0D field to the MOM file
238 procedure(i_write_field_0d), deferred :: write_field_0d
239 !> Write an axis field to the MOM file
240 procedure(i_write_field_axis), deferred :: write_field_axis
241
242 !> Return true if MOM file has been opened
243 procedure(i_file_is_open), deferred :: file_is_open
244 !> Return number of dimensions, variables, or time levels in a MOM file
245 procedure(i_get_file_info), deferred :: get_file_info
246 !> Get field objects from a MOM file
247 procedure(i_get_file_fields), deferred :: get_file_fields
248 !> Get attributes from a field
249 procedure(i_get_field_atts), deferred :: get_field_atts
250 !> Get checksum from a field
251 procedure(i_read_field_chksum), deferred :: read_field_chksum
252end type MOM_file
253
254
255!> MOM file from the supporting framework ("infra") layer
256type, extends(MOM_file) :: MOM_infra_file
257 private
258
259 type(MOM_domain_type), public, pointer :: domain => null()
260 !< Internal domain used for single-file IO
261
262 ! NOTE: This will be made private after the API transition
263 type(file_type), public :: handle_infra
264 !< Framework-specific file handler content
265 type(axis_list_infra) :: axes
266 !< List of axes in file
267 type(field_list_infra) :: fields
268 !< List of fields in file
269
270 contains
271
272 !> Open a framework file and connect to the MOM_file object
273 procedure :: open => open_file_infra
274 !> Close the MOM framework file
275 procedure :: close => close_file_infra
276 !> Flush buffered output to the MOM framework file
277 procedure :: flush => flush_file_infra
278
279 !> Register an axis to the MOM framework file
280 procedure :: register_axis => register_axis_infra
281 !> Register a field to the MOM framework file
282 procedure :: register_field => register_field_infra
283 !> Write global metadata to the MOM framework file
284 procedure :: write_attribute => write_attribute_infra
285
286 !> Write a 4D field to the MOM framework file
287 procedure :: write_field_4d => write_field_4d_infra
288 !> Write a 3D field to the MOM framework file
289 procedure :: write_field_3d => write_field_3d_infra
290 !> Write a 2D field to the MOM framework file
291 procedure :: write_field_2d => write_field_2d_infra
292 !> Write a 1D field to the MOM framework file
293 procedure :: write_field_1d => write_field_1d_infra
294 !> Write a 0D field to the MOM framework file
295 procedure :: write_field_0d => write_field_0d_infra
296 !> Write an axis field to the MOM framework file
297 procedure :: write_field_axis => write_field_axis_infra
298
299 !> Return true if MOM infra file has been opened
300 procedure :: file_is_open => file_is_open_infra
301 !> Return number of dimensions, variables, or time levels in a MOM infra file
302 procedure :: get_file_info => get_file_info_infra
303 !> Get field metadata from a MOM infra file
304 procedure :: get_file_fields => get_file_fields_infra
305 !> Get attributes from a field
306 procedure :: get_field_atts => get_field_atts_infra
307 !> Get checksum from a field
308 procedure :: read_field_chksum => read_field_chksum_infra
309
310 ! MOM_infra_file methods
311 ! NOTE: These could naturally reside in MOM_file but is currently not needed.
312
313 !> Get time levels of a MOM framework file
314 procedure :: get_file_times => get_file_times_infra
315
316 !> Get the fields as fieldtypes from a file
317 procedure :: get_file_fieldtypes
318 ! NOTE: This is provided to support the legacy API and may be removed.
319end type MOM_infra_file
320
321
322!> MOM file using netCDF backend
323type, extends(MOM_file) :: MOM_netcdf_file
324 private
325
326 !> Framework-specific file handler content
327 type(netcdf_file_type) :: handle_nc
328 !> List of netCDF axes
329 type(axis_list_nc) :: axes
330 !> List of netCDF fields
331 type(field_list_nc) :: fields
332 !> True if the file has been opened
333 logical :: is_open = .false.
334 !> True if I/O content is domain-decomposed
335 logical :: domain_decomposed = .false.
336 !> True if I/O content is domain-decomposed
337 type(hor_index_type) :: HI
338
339 contains
340
341 !> Open a framework file and connect to the MOM_netcdf_file object
342 procedure :: open => open_file_nc
343 !> Close the MOM netcdf file
344 procedure :: close => close_file_nc
345 !> Flush buffered output to the MOM netcdf file
346 procedure :: flush => flush_file_nc
347
348 !> Register an axis to the MOM netcdf file
349 procedure :: register_axis => register_axis_nc
350 !> Register a field to the MOM netcdf file
351 procedure :: register_field => register_field_nc
352 !> Write global metadata to the MOM netcdf file
353 procedure :: write_attribute => write_attribute_nc
354
355 !> Write a 4D field to the MOM netcdf file
356 procedure :: write_field_4d => write_field_4d_nc
357 !> Write a 3D field to the MOM netcdf file
358 procedure :: write_field_3d => write_field_3d_nc
359 !> Write a 2D field to the MOM netcdf file
360 procedure :: write_field_2d => write_field_2d_nc
361 !> Write a 1D field to the MOM netcdf file
362 procedure :: write_field_1d => write_field_1d_nc
363 !> Write a 0D field to the MOM netcdf file
364 procedure :: write_field_0d => write_field_0d_nc
365 !> Write an axis field to the MOM netcdf file
366 procedure :: write_field_axis => write_field_axis_nc
367
368 !> Return true if MOM netcdf file has been opened
369 procedure :: file_is_open => file_is_open_nc
370 !> Return number of dimensions, variables, or time levels in a MOM netcdf file
371 procedure :: get_file_info => get_file_info_nc
372 !> Get field metadata from a MOM netcdf file
373 procedure :: get_file_fields => get_file_fields_nc
374 !> Get attributes from a netCDF field
375 procedure :: get_field_atts => get_field_atts_nc
376 !> Get checksum from a netCDF field
377 procedure :: read_field_chksum => read_field_chksum_nc
378
379 ! NOTE: These are currently exclusive to netCDF I/O but could be generalized
380 !> Read the values of a netCDF field
381 procedure :: read => get_field_nc
382 !> Update the axes and fields descriptors of a MOM netCDF file
383 procedure :: update => update_file_contents_nc
384end type MOM_netcdf_file
385
386
387interface
388 !> Interface for opening a MOM file
389 subroutine i_open_file(handle, filename, action, MOM_domain, threading, fileset)
390 import :: MOM_file, MOM_domain_type
391
392 class(MOM_file), intent(inout) :: handle
393 !< The handle for the opened file
394 character(len=*), intent(in) :: filename
395 !< The path name of the file being opened
396 integer, optional, intent(in) :: action
397 !< A flag indicating whether the file can be read or written to and how
398 !! to handle existing files. The default is WRITE_ONLY.
399 type(MOM_domain_type), optional, intent(in) :: MOM_Domain
400 !< A MOM_Domain that describes the decomposition
401 integer, optional, intent(in) :: threading
402 !< A flag indicating whether one (SINGLE_FILE) or multiple PEs (MULTIPLE)
403 !! participate in I/O. With the default, the root PE does I/O.
404 integer, optional, intent(in) :: fileset
405 !< A flag indicating whether multiple PEs doing I/O due to
406 !! threading=MULTIPLE write to the same file (SINGLE_FILE) or to one file
407 !! per PE (MULTIPLE, the default).
408 end subroutine i_open_file
409
410
411 !> Interface for closing a MOM file
412 subroutine i_close_file(handle)
413 import :: MOM_file
414 class(MOM_file), intent(inout) :: handle
415 !< The MOM file to be closed
416 end subroutine i_close_file
417
418
419 !> Interface for flushing I/O in a MOM file
420 subroutine i_flush_file(handle)
421 import :: MOM_file
422 class(MOM_file), intent(in) :: handle
423 !< The MOM file to be flushed
424 end subroutine i_flush_file
425
426
427 !> Interface to register an axis to a MOM file
428 function i_register_axis(handle, label, units, longname, cartesian, sense, &
429 domain, data, edge_axis, calendar) result(axis)
430 import :: MOM_file, MOM_axis, domain1D
431
432 class(MOM_file), intent(inout) :: handle
433 !< Handle for a file that is open for writing
434 character(len=*), intent(in) :: label
435 !< The name in the file of this axis
436 character(len=*), intent(in) :: units
437 !< The units of this axis
438 character(len=*), intent(in) :: longname
439 !< The long description of this axis
440 character(len=*), optional, intent(in) :: cartesian
441 !< A variable indicating which direction this axis corresponds with.
442 !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none.
443 integer, optional, intent(in) :: sense
444 !< This is 1 for axes whose values increase upward, or -1 if they
445 !! increase downward.
446 type(domain1D), optional, intent(in) :: domain
447 !< The domain decomposion for this axis
448 real, dimension(:), optional, intent(in) :: data
449 !< The coordinate values of the points on this axis
450 logical, optional, intent(in) :: edge_axis
451 !< If true, this axis marks an edge of the tracer cells
452 character(len=*), optional, intent(in) :: calendar
453 !< The name of the calendar used with a time axis
454 type(MOM_axis) :: axis
455 !< IO handle for axis in MOM_file
456 end function i_register_axis
457
458
459 !> Interface to register a field to a netCDF file
460 function i_register_field(handle, axes, label, units, longname, &
461 pack, standard_name, checksum, conversion) result(field)
462 import :: MOM_file, MOM_axis, MOM_field, int64
463 class(MOM_file), intent(inout) :: handle
464 !< Handle for a file that is open for writing
465 type(MOM_axis), intent(in) :: axes(:)
466 !< Handles for the axis used for this variable
467 character(len=*), intent(in) :: label
468 !< The name in the file of this variable
469 character(len=*), intent(in) :: units
470 !< The units of this variable
471 character(len=*), intent(in) :: longname
472 !< The long description of this variable
473 integer, optional, intent(in) :: pack
474 !< A precision reduction factor with which the variable. The default, 1,
475 !! has no reduction, but 2 is not uncommon.
476 character(len=*), optional, intent(in) :: standard_name
477 !< The standard (e.g., CMOR) name for this variable
478 integer(kind=int64), dimension(:), optional, intent(in) :: checksum
479 !< Checksum values that can be used to verify reads.
480 real, optional, intent(in) :: conversion
481 !< A factor to use to rescale the field before output [a A-1 ~> 1]
482 type(MOM_field) :: field
483 !< IO handle for field in MOM_file
484 end function i_register_field
485
486
487 !> Interface for writing global metata to a MOM file
488 subroutine i_write_attribute(handle, name, attribute)
489 import :: MOM_file
490 class(MOM_file), intent(in) :: handle
491 !< Handle for a file that is open for writing
492 character(len=*), intent(in) :: name
493 !< The name in the file of this global attribute
494 character(len=*), intent(in) :: attribute
495 !< The value of this attribute
496 end subroutine i_write_attribute
497
498
499 !> Interface to write_field_4d()
500 subroutine i_write_field_4d(handle, field_md, MOM_domain, field, tstamp, &
501 tile_count, fill_value)
502 import :: MOM_file, MOM_field, MOM_domain_type
503 class(MOM_file), intent(inout) :: handle
504 !< Handle for a file that is open for writing
505 type(MOM_field), intent(in) :: field_md
506 !< Field type with metadata
507 type(MOM_domain_type), intent(in) :: MOM_domain
508 !< The MOM_Domain that describes the decomposition
509 real, intent(inout) :: field(:,:,:,:)
510 !< Field to write
511 real, optional, intent(in) :: tstamp
512 !< Model time of this field
513 integer, optional, intent(in) :: tile_count
514 !< PEs per tile (default: 1)
515 real, optional, intent(in) :: fill_value
516 !< Missing data fill value
517 end subroutine i_write_field_4d
518
519
520 !> Interface to write_field_3d()
521 subroutine i_write_field_3d(handle, field_md, MOM_domain, field, tstamp, &
522 tile_count, fill_value)
523 import :: MOM_file, MOM_field, MOM_domain_type
524 class(MOM_file), intent(inout) :: handle
525 !< Handle for a file that is open for writing
526 type(MOM_field), intent(in) :: field_md
527 !< Field type with metadata
528 type(MOM_domain_type), intent(in) :: MOM_domain
529 !< The MOM_Domain that describes the decomposition
530 real, intent(inout) :: field(:,:,:)
531 !< Field to write
532 real, optional, intent(in) :: tstamp
533 !< Model time of this field
534 integer, optional, intent(in) :: tile_count
535 !< PEs per tile (default: 1)
536 real, optional, intent(in) :: fill_value
537 !< Missing data fill value
538 end subroutine i_write_field_3d
539
540
541 !> Interface to write_field_2d()
542 subroutine i_write_field_2d(handle, field_md, MOM_domain, field, tstamp, &
543 tile_count, fill_value)
544 import :: MOM_file, MOM_field, MOM_domain_type
545 class(MOM_file), intent(inout) :: handle
546 !< Handle for a file that is open for writing
547 type(MOM_field), intent(in) :: field_md
548 !< Field type with metadata
549 type(MOM_domain_type), intent(in) :: MOM_domain
550 !< The MOM_Domain that describes the decomposition
551 real, dimension(:,:), intent(inout) :: field
552 !< Field to write
553 real, optional, intent(in) :: tstamp
554 !< Model time of this field
555 integer, optional, intent(in) :: tile_count
556 !< PEs per tile (default: 1)
557 real, optional, intent(in) :: fill_value
558 !< Missing data fill value
559 end subroutine i_write_field_2d
560
561
562 !> Interface to write_field_1d()
563 subroutine i_write_field_1d(handle, field_md, field, tstamp)
564 import :: MOM_file, MOM_field
565 class(MOM_file), intent(inout) :: handle
566 !< Handle for a file that is open for writing
567 type(MOM_field), intent(in) :: field_md
568 !< Field type with metadata
569 real, dimension(:), intent(in) :: field
570 !< Field to write
571 real, optional, intent(in) :: tstamp
572 !< Model time of this field
573 end subroutine i_write_field_1d
574
575
576 !> Interface to write_field_0d()
577 subroutine i_write_field_0d(handle, field_md, field, tstamp)
578 import :: MOM_file, MOM_field
579 class(MOM_file), intent(inout) :: handle
580 !< Handle for a file that is open for writing
581 type(MOM_field), intent(in) :: field_md
582 !< Field type with metadata
583 real, intent(in) :: field
584 !< Field to write
585 real, optional, intent(in) :: tstamp
586 !< Model time of this field
587 end subroutine i_write_field_0d
588
589
590 !> Interface to write_field_axis()
591 subroutine i_write_field_axis(handle, axis)
592 import :: MOM_file, MOM_axis
593 class(MOM_file), intent(inout) :: handle
594 !< Handle for a file that is open for writing
595 type(MOM_axis), intent(in) :: axis
596 !< An axis type variable with information to write
597 end subroutine i_write_field_axis
598
599
600 !> Interface to file_is_open()
601 logical function i_file_is_open(handle)
602 import :: MOM_file
603 class(MOM_file), intent(in) :: handle
604 !< Handle to a file to inquire about
605 end function i_file_is_open
606
607
608 !> Interface to get_file_info()
609 subroutine i_get_file_info(handle, ndim, nvar, ntime)
610 import :: MOM_file
611 class(MOM_file), intent(in) :: handle
612 !< Handle for a file that is open for I/O
613 integer, optional, intent(out) :: ndim
614 !< The number of dimensions in the file
615 integer, optional, intent(out) :: nvar
616 !< The number of variables in the file
617 integer, optional, intent(out) :: ntime
618 !< The number of time levels in the file
619 end subroutine i_get_file_info
620
621
622 !> Interface to get_file_fields()
623 subroutine i_get_file_fields(handle, fields)
624 import :: MOM_file, MOM_field
625 class(MOM_file), intent(inout) :: handle
626 !< Handle for a file that is open for I/O
627 type(MOM_field), dimension(:), intent(inout) :: fields
628 !< Field-type descriptions of all of the variables in a file.
629 end subroutine i_get_file_fields
630
631
632 !> Interface to get_field_atts()
633 subroutine i_get_field_atts(handle, field, name, units, longname, checksum)
634 import :: MOM_file, MOM_field, int64
635 class(MOM_file), intent(in) :: handle
636 !< File where field is stored
637 type(MOM_field), intent(in) :: field
638 !< The field to extract information from
639 character(len=*), optional, intent(out) :: name
640 !< The variable name
641 character(len=*), optional, intent(out) :: units
642 !< The units of the variable
643 character(len=*), optional, intent(out) :: longname
644 !< The long name of the variable
645 integer(kind=int64), optional, intent(out) :: checksum(:)
646 !< The checksums of the variable in a file
647 end subroutine i_get_field_atts
648
649
650 !> Interface to read_field_chksum
651 subroutine i_read_field_chksum(handle, field, chksum, valid_chksum)
652 import :: MOM_file, MOM_field, int64
653 class(MOM_file), intent(in) :: handle
654 !< File where field is stored
655 type(MOM_field), intent(in) :: field
656 !< The field whose checksum attribute is to be read
657 integer(kind=int64), intent(out) :: chksum
658 !< The checksum for the field.
659 logical, intent(out) :: valid_chksum
660 !< If true, chksum has been successfully read
661 end subroutine i_read_field_chksum
662end interface
663
664contains
665
666!> Initialize the linked list of framework axes
6672subroutine initialize_axis_list_infra(list)
668 class(axis_list_infra), intent(inout) :: list
669
670 ! Pre-allocate the first node and set the tail to this empty node
6712 allocate(list%head)
6722 list%tail => list%head
6732end subroutine initialize_axis_list_infra
674
675
676!> Append a new axis to the list
67714subroutine append_axis_list_infra(list, axis, label)
678 class(axis_list_infra), intent(inout) :: list
679 type(axistype), intent(in) :: axis
680 character(len=*), intent(in) :: label
681
682 type(axis_node_infra), pointer :: empty_node
683
684 ! Transfer value to tail
68514 list%tail%label = label
68614 list%tail%axis = axis
687
688 ! Extend list to next empty node
68914 allocate(empty_node)
69014 list%tail%next => empty_node
69114 list%tail => empty_node
69214end subroutine append_axis_list_infra
693
694
695!> Get axis based on label
696224function get_axis_list_infra(list, label) result(axis)
697 class(axis_list_infra), intent(in) :: list
698 character(len=*), intent(in) :: label
699 type(axistype) :: axis
700
701 type(axis_node_infra), pointer :: node
702
703 ! NOTE: The tail is a pre-allocated empty node, so we check node%next
704224 node => list%head
705870 do while(associated(node%next))
706870 if (node%label == label) exit
707646 node => node%next
708 enddo
709224 if (.not. associated(node)) &
7100 call MOM_error(FATAL, "axis associated with " // label // " not found.")
711
712224 axis = node%axis
713448end function get_axis_list_infra
714
715
716!> Deallocate axes of list
7172subroutine finalize_axis_list_infra(list)
718 class(axis_list_infra), intent(inout) :: list
719
720 type(axis_node_infra), pointer :: node, next_node
721
7222 node => list%head
72318 do while(associated(node))
72416 next_node => node
72516 node => node%next
72616 deallocate(next_node)
727 enddo
7282end subroutine finalize_axis_list_infra
729
730
731!> Initialize the linked list of framework axes
7322subroutine initialize_axis_list_nc(list)
733 class(axis_list_nc), intent(inout) :: list
734
735 ! Pre-allocate the first node and set the tail to this empty node
7362 allocate(list%head)
7372 list%tail => list%head
7382end subroutine initialize_axis_list_nc
739
740
741!> Append a new axis to the list
7425subroutine append_axis_list_nc(list, axis, label)
743 class(axis_list_nc), intent(inout) :: list
744 type(netcdf_axis), intent(in) :: axis
745 character(len=*), intent(in) :: label
746
747 type(axis_node_nc), pointer :: empty_node
748
749 ! Transfer value to tail
7505 list%tail%label = label
7515 list%tail%axis = axis
752
753 ! Extend list to next empty node
7545 allocate(empty_node)
7555 list%tail%next => empty_node
7565 list%tail => empty_node
7575end subroutine append_axis_list_nc
758
759
760!> Get axis based on label
76128function get_axis_list_nc(list, label) result(axis)
762 class(axis_list_nc), intent(in) :: list
763 character(len=*), intent(in) :: label
764 type(netcdf_axis) :: axis
765
766 type(axis_node_nc), pointer :: node
767
768 ! NOTE: The tail is a pre-allocated empty node, so we check node%next
76928 node => list%head
77069 do while(associated(node%next))
77169 if (node%label == label) exit
77241 node => node%next
773 enddo
77428 if (.not. associated(node)) &
7750 call MOM_error(FATAL, "axis associated with " // label // " not found.")
776
77728 axis = node%axis
77856end function get_axis_list_nc
779
780
781!> Deallocate axes of list
7820subroutine finalize_axis_list_nc(list)
783 class(axis_list_nc), intent(inout) :: list
784
785 type(axis_node_nc), pointer :: node, next_node
786
7870 node => list%head
7880 do while(associated(node))
7890 next_node => node
7900 node => node%next
7910 deallocate(next_node)
792 enddo
7930end subroutine finalize_axis_list_nc
794
795
796!> Initialize the linked list of framework axes
7972subroutine initialize_field_list_infra(list)
798 class(field_list_infra), intent(inout) :: list
799
800 ! Pre-allocate the first node and set the tail to this empty node
8012 allocate(list%head)
8022 list%tail => list%head
8032end subroutine initialize_field_list_infra
804
805
806!> Append a new field to the list
80763subroutine append_field_list_infra(list, field, label)
808 class(field_list_infra), intent(inout) :: list
809 type(fieldtype), intent(in) :: field
810 character(len=*), intent(in) :: label
811
812 type(field_node_infra), pointer :: empty_node
813
814 ! Transfer value to tail
81563 list%tail%label = label
81663 list%tail%field = field
817
818 ! Extend list to next empty node
81963 allocate(empty_node)
82063 list%tail%next => empty_node
82163 list%tail => empty_node
82263end subroutine append_field_list_infra
823
824
825!> Get axis based on label
82663function get_field_list_infra(list, label) result(field)
827 class(field_list_infra), intent(in) :: list
828 character(len=*), intent(in) :: label
829 type(fieldtype) :: field
830
831 type(field_node_infra), pointer :: node
832
833 ! NOTE: The tail is a pre-allocated empty node, so we check node%next
83463 node => list%head
8351024 do while(associated(node%next))
8361024 if (node%label == label) exit
837961 node => node%next
838 enddo
83963 if (.not. associated(node)) &
8400 call MOM_error(FATAL, "field associated with " // label // " not found.")
841
84263 field = node%field
843126end function get_field_list_infra
844
845
846!> Deallocate fields of list
8472subroutine finalize_field_list_infra(list)
848 class(field_list_infra), intent(inout) :: list
849
850 type(field_node_infra), pointer :: node, next_node
851
8522 node => list%head
85367 do while(associated(node))
85465 next_node => node
85565 node => node%next
85665 deallocate(next_node)
857 enddo
8582end subroutine finalize_field_list_infra
859
860
861!> Initialize the linked list of framework axes
8622subroutine initialize_field_list_nc(list)
863 class(field_list_nc), intent(inout) :: list
864
865 ! Pre-allocate the first node and set the tail to this empty node
8662 allocate(list%head)
8672 list%tail => list%head
8682end subroutine initialize_field_list_nc
869
870
871!> Append a new field to the list
87220subroutine append_field_list_nc(list, field, label)
873 class(field_list_nc), intent(inout) :: list
874 type(netcdf_field), intent(in) :: field
875 character(len=*), intent(in) :: label
876
877 type(field_node_nc), pointer :: empty_node
878
879 ! Transfer value to tail
88020 list%tail%label = label
88120 list%tail%field = field
882
883 ! Extend list to next empty node
88420 allocate(empty_node)
88520 list%tail%next => empty_node
88620 list%tail => empty_node
88720end subroutine append_field_list_nc
888
889
890!> Get axis based on label
89156function get_field_list_nc(list, label) result(field)
892 class(field_list_nc), intent(in) :: list
893 character(len=*), intent(in) :: label
894 type(netcdf_field) :: field
895
896 type(field_node_nc), pointer :: node
897
898 ! NOTE: The tail is a pre-allocated empty node, so we check node%next
89956 node => list%head
900516 do while(associated(node%next))
901516 if (node%label == label) exit
902460 node => node%next
903 enddo
90456 if (.not. associated(node)) &
9050 call MOM_error(FATAL, "field associated with " // label // " not found.")
906
90756 field = node%field
908112end function get_field_list_nc
909
910
911!> Deallocate fields of list
9120subroutine finalize_field_list_nc(list)
913 class(field_list_nc), intent(inout) :: list
914
915 type(field_node_nc), pointer :: node, next_node
916
9170 node => list%head
9180 do while(associated(node))
9190 next_node => node
9200 node => node%next
9210 deallocate(next_node)
922 enddo
9230end subroutine finalize_field_list_nc
924
925
926!> Open a MOM framework file
9272subroutine open_file_infra(handle, filename, action, MOM_domain, threading, fileset)
928 class(MOM_infra_file), intent(inout) :: handle
929 character(len=*), intent(in) :: filename
930 integer, intent(in), optional :: action
931 type(MOM_domain_type), optional, intent(in) :: MOM_domain
932 integer, intent(in), optional :: threading
933 integer, intent(in), optional :: fileset
934
935 logical :: use_single_file_domain
936 ! True if the domain is replaced with a single-file IO layout.
937
9382 use_single_file_domain = .false.
9392 if (present(MOM_domain) .and. present(fileset)) then
9402 if (fileset == SINGLE_FILE) &
9410 use_single_file_domain = .true.
942 endif
943
9442 if (use_single_file_domain) then
9450 call clone_MOM_domain(MOM_domain, handle%domain, io_layout=[1,1])
946 call open_file(handle%handle_infra, filename, action=action, &
9470 MOM_domain=handle%domain, threading=threading, fileset=fileset)
948 else
949 call open_file(handle%handle_infra, filename, action=action, &
9502 MOM_domain=MOM_domain, threading=threading, fileset=fileset)
951 endif
952
9532 call handle%axes%init()
9542 call handle%fields%init()
9552end subroutine open_file_infra
956
957!> Close a MOM framework file
9582subroutine close_file_infra(handle)
959 class(MOM_infra_file), intent(inout) :: handle
960
9612 if (associated(handle%domain)) &
9620 call deallocate_MOM_domain(handle%domain)
963
9642 call close_file(handle%handle_infra)
9652 call handle%axes%finalize()
9662 call handle%fields%finalize()
9672end subroutine close_file_infra
968
969!> Flush the buffer of a MOM framework file
9700subroutine flush_file_infra(handle)
971 class(MOM_infra_file), intent(in) :: handle
972
9730 call flush_file(handle%handle_infra)
9740end subroutine flush_file_infra
975
976
977!> Register an axis to the MOM framework file
97814function register_axis_infra(handle, label, units, longname, &
97914 cartesian, sense, domain, data, edge_axis, calendar) result(axis)
980
981 class(MOM_infra_file), intent(inout) :: handle
982 !< Handle for a file that is open for writing
983 character(len=*), intent(in) :: label
984 !< The name in the file of this axis
985 character(len=*), intent(in) :: units
986 !< The units of this axis
987 character(len=*), intent(in) :: longname
988 !< The long description of this axis
989 character(len=*), optional, intent(in) :: cartesian
990 !< A variable indicating which direction this axis corresponds with.
991 !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none.
992 integer, optional, intent(in) :: sense
993 !< This is 1 for axes whose values increase upward, or -1 if they increase
994 !! downward.
995 type(domain1D), optional, intent(in) :: domain
996 !< The domain decomposion for this axis
997 real, dimension(:), optional, intent(in) :: data
998 !< The coordinate values of the points on this axis
999 logical, optional, intent(in) :: edge_axis
1000 !< If true, this axis marks an edge of the tracer cells
1001 character(len=*), optional, intent(in) :: calendar
1002 !< The name of the calendar used with a time axis
1003 type(MOM_axis) :: axis
1004 !< The axis type where this information is stored
1005
100614 type(axistype) :: ax_infra
1007
1008 ! Create new infra axis and assign to pre-allocated tail of axes
1009 call write_metadata(handle%handle_infra, ax_infra, label, units, longname, &
1010 cartesian=cartesian, sense=sense, domain=domain, data=data, &
101114 edge_axis=edge_axis, calendar=calendar)
1012
101314 call handle%axes%append(ax_infra, label)
101414 axis%label = label
101528end function register_axis_infra
1016
1017
1018!> Register a field to the MOM framework file
101963function register_field_infra(handle, axes, label, units, longname, pack, &
102063 standard_name, checksum, conversion) result(field)
1021 class(MOM_infra_file), intent(inout) :: handle
1022 !< Handle for a file that is open for writing
1023 type(MOM_axis), dimension(:), intent(in) :: axes
1024 !< Handles for the axis used for this variable
1025 character(len=*), intent(in) :: label
1026 !< The name in the file of this variable
1027 character(len=*), intent(in) :: units
1028 !< The units of this variable
1029 character(len=*), intent(in) :: longname
1030 !< The long description of this variable
1031 integer, optional, intent(in) :: pack
1032 !< A precision reduction factor with which the variable. The default, 1,
1033 !! has no reduction, but 2 is not uncommon.
1034 character(len=*), optional, intent(in) :: standard_name
1035 !< The standard (e.g., CMOR) name for this variable
1036 integer(kind=int64), dimension(:), optional, intent(in) :: checksum
1037 !< Checksum values that can be used to verify reads.
1038 real, optional, intent(in) :: conversion
1039 !< A factor to use to rescale the field before output [a A-1 ~> 1]
1040 type(MOM_field) :: field
1041 !< The field type where this information is stored
1042
104363 type(fieldtype) :: field_infra
104463 type(axistype), allocatable :: field_axes(:)
1045 integer :: i
1046
1047 ! Construct array of framework axes
1048275 allocate(field_axes(size(axes)))
1049275 do i = 1, size(axes)
1050275 field_axes(i) = handle%axes%get(axes(i)%label)
1051 enddo
1052
1053 call write_metadata(handle%handle_infra, field_infra, field_axes, label, &
105463 units, longname, pack=pack, standard_name=standard_name, checksum=checksum)
1055
105663 call handle%fields%append(field_infra, label)
105763 field%label = label
105863 field%conversion = 1.0 ; if (present(conversion)) field%conversion = conversion
1059338end function register_field_infra
1060
1061
1062!> Write a 4D field to the MOM framework file
10630subroutine write_field_4d_infra(handle, field_md, MOM_domain, field, tstamp, &
1064 tile_count, fill_value)
1065 class(MOM_infra_file), intent(inout) :: handle
1066 !< Handle for a file that is open for writing
1067 type(MOM_field), intent(in) :: field_md
1068 !< Field type with metadata
1069 type(MOM_domain_type), intent(in) :: MOM_domain
1070 !< The MOM_Domain that describes the decomposition
1071 real, intent(inout) :: field(:,:,:,:)
1072 !< Field to write
1073 real, optional, intent(in) :: tstamp
1074 !< Model time of this field
1075 integer, optional, intent(in) :: tile_count
1076 !< PEs per tile (default: 1)
1077 real, optional, intent(in) :: fill_value
1078 !< Missing data fill value
1079
10800 type(fieldtype) :: field_infra
10810 real, allocatable :: unscaled_field(:,:,:,:) ! An unscaled version of field for output [a]
1082
10830 field_infra = handle%fields%get(field_md%label)
10840 if (field_md%conversion == 1.0) then
1085 call write_field(handle%handle_infra, field_infra, MOM_domain, field, &
10860 tstamp=tstamp, tile_count=tile_count, fill_value=fill_value)
1087 else
10880 allocate(unscaled_field, source=field)
10890 unscaled_field(:,:,:,:) = field_md%conversion * field(:,:,:,:)
1090 call write_field(handle%handle_infra, field_infra, MOM_domain, unscaled_field, &
10910 tstamp=tstamp, tile_count=tile_count, fill_value=fill_value)
10920 deallocate(unscaled_field)
1093 endif
10940end subroutine write_field_4d_infra
1095
1096
1097!> Write a 3D field to the MOM framework file
109831subroutine write_field_3d_infra(handle, field_md, MOM_domain, field, tstamp, &
1099 tile_count, fill_value)
1100 class(MOM_infra_file), intent(inout) :: handle
1101 !< Handle for a file that is open for writing
1102 type(MOM_field), intent(in) :: field_md
1103 !< Field type with metadata
1104 type(MOM_domain_type), intent(in) :: MOM_domain
1105 !< The MOM_Domain that describes the decomposition
1106 real, intent(inout) :: field(:,:,:)
1107 !< Field to write, perhaps in arbitrary rescaled units [A ~> a]
1108 real, optional, intent(in) :: tstamp
1109 !< Model time of this field
1110 integer, optional, intent(in) :: tile_count
1111 !< PEs per tile (default: 1)
1112 real, optional, intent(in) :: fill_value
1113 !< Missing data fill value
1114
111531 type(fieldtype) :: field_infra
111631 real, allocatable :: unscaled_field(:,:,:) ! An unscaled version of field for output [a]
1117
111831 field_infra = handle%fields%get(field_md%label)
111931 if (field_md%conversion == 1.0) then
1120 call write_field(handle%handle_infra, field_infra, MOM_domain, field, &
112131 tstamp=tstamp, tile_count=tile_count, fill_value=fill_value)
1122 else
11230 allocate(unscaled_field, source=field)
11240 unscaled_field(:,:,:) = field_md%conversion * field(:,:,:)
1125 call write_field(handle%handle_infra, field_infra, MOM_domain, unscaled_field, &
11260 tstamp=tstamp, tile_count=tile_count, fill_value=fill_value)
11270 deallocate(unscaled_field)
1128 endif
1129
113031end subroutine write_field_3d_infra
1131
1132
1133!> Write a 2D field to the MOM framework file
113428subroutine write_field_2d_infra(handle, field_md, MOM_domain, field, tstamp, &
1135 tile_count, fill_value)
1136 class(MOM_infra_file), intent(inout) :: handle
1137 !< Handle for a file that is open for writing
1138 type(MOM_field), intent(in) :: field_md
1139 !< Field type with metadata
1140 type(MOM_domain_type), intent(in) :: MOM_domain
1141 !< The MOM_Domain that describes the decomposition
1142 real, dimension(:,:), intent(inout) :: field
1143 !< Field to write
1144 real, optional, intent(in) :: tstamp
1145 !< Model time of this field
1146 integer, optional, intent(in) :: tile_count
1147 !< PEs per tile (default: 1)
1148 real, optional, intent(in) :: fill_value
1149 !< Missing data fill value
1150
115128 type(fieldtype) :: field_infra
115228 real, allocatable :: unscaled_field(:,:) ! An unscaled version of field for output [a]
1153
115428 field_infra = handle%fields%get(field_md%label)
115528 if (field_md%conversion == 1.0) then
1156 call write_field(handle%handle_infra, field_infra, MOM_domain, field, &
115728 tstamp=tstamp, tile_count=tile_count, fill_value=fill_value)
1158 else
11590 allocate(unscaled_field, source=field)
11600 unscaled_field(:,:) = field_md%conversion * field(:,:)
1161 call write_field(handle%handle_infra, field_infra, MOM_domain, unscaled_field, &
11620 tstamp=tstamp, tile_count=tile_count, fill_value=fill_value)
11630 deallocate(unscaled_field)
1164 endif
116528end subroutine write_field_2d_infra
1166
1167
1168!> Write a 1D field to the MOM framework file
11690subroutine write_field_1d_infra(handle, field_md, field, tstamp)
1170 class(MOM_infra_file), intent(inout) :: handle
1171 !< Handle for a file that is open for writing
1172 type(MOM_field), intent(in) :: field_md
1173 !< Field type with metadata
1174 real, dimension(:), intent(in) :: field
1175 !< Field to write
1176 real, optional, intent(in) :: tstamp
1177 !< Model time of this field
1178
11790 type(fieldtype) :: field_infra
11800 real, allocatable :: unscaled_field(:) ! An unscaled version of field for output [a]
1181
11820 field_infra = handle%fields%get(field_md%label)
11830 if (field_md%conversion == 1.0) then
11840 call write_field(handle%handle_infra, field_infra, field, tstamp=tstamp)
1185 else
11860 allocate(unscaled_field, source=field)
11870 unscaled_field(:) = field_md%conversion * field(:)
11880 call write_field(handle%handle_infra, field_infra, unscaled_field, tstamp=tstamp)
11890 deallocate(unscaled_field)
1190 endif
11910end subroutine write_field_1d_infra
1192
1193
1194!> Write a 0D field to the MOM framework file
11954subroutine write_field_0d_infra(handle, field_md, field, tstamp)
1196 class(MOM_infra_file), intent(inout) :: handle
1197 !< Handle for a file that is open for writing
1198 type(MOM_field), intent(in) :: field_md
1199 !< Field type with metadata
1200 real, intent(in) :: field
1201 !< Field to write
1202 real, optional, intent(in) :: tstamp
1203 !< Model time of this field
1204
12054 type(fieldtype) :: field_infra
1206 real :: unscaled_field ! An unscaled version of field for output [a]
1207
12084 field_infra = handle%fields%get(field_md%label)
12094 unscaled_field = field_md%conversion*field
12104 call write_field(handle%handle_infra, field_infra, unscaled_field, tstamp=tstamp)
12114end subroutine write_field_0d_infra
1212
1213
1214!> Write an axis field to the MOM framework file
121512subroutine write_field_axis_infra(handle, axis)
1216 class(MOM_infra_file), intent(inout) :: handle
1217 !< Handle for a file that is open for writing
1218 type(MOM_axis), intent(in) :: axis
1219 !< An axis type variable with information to write
1220
122112 type(axistype) :: axis_infra
1222 !< An axis type variable with information to write
1223
122412 axis_infra = handle%axes%get(axis%label)
122512 call write_field(handle%handle_infra, axis_infra)
122612end subroutine write_field_axis_infra
1227
1228
1229!> Write global metadata to the MOM framework file
12300subroutine write_attribute_infra(handle, name, attribute)
1231 class(MOM_infra_file), intent(in) :: handle
1232 !< Handle for a file that is open for writing
1233 character(len=*), intent(in) :: name
1234 !< The name in the file of this global attribute
1235 character(len=*), intent(in) :: attribute
1236 !< The value of this attribute
1237
12380 call write_metadata(handle%handle_infra, name, attribute)
12390end subroutine write_attribute_infra
1240
1241
1242!> True if the framework file has been opened
12430logical function file_is_open_infra(handle)
1244 class(MOM_infra_file), intent(in) :: handle
1245 !< Handle to a file to inquire about
1246
12470 file_is_open_infra = fms2_file_is_open(handle%handle_infra)
12480end function file_is_open_infra
1249
1250
1251!> Return number of dimensions, variables, or time levels in a MOM infra file
12520subroutine get_file_info_infra(handle, ndim, nvar, ntime)
1253 class(MOM_infra_file), intent(in) :: handle
1254 !< Handle for a file that is open for I/O
1255 integer, optional, intent(out) :: ndim
1256 !< The number of dimensions in the file
1257 integer, optional, intent(out) :: nvar
1258 !< The number of variables in the file
1259 integer, optional, intent(out) :: ntime
1260 !< The number of time levels in the file
1261
12620 call get_file_info(handle%handle_infra, ndim, nvar, ntime)
12630end subroutine get_file_info_infra
1264
1265
1266!> Return the field metadata associated with a MOM framework file
12670subroutine get_file_fields_infra(handle, fields)
1268 class(MOM_infra_file), intent(inout) :: handle
1269 !< Handle for a file that is open for I/O
1270 type(MOM_field), intent(inout) :: fields(:)
1271 !< Field-type descriptions of all of the variables in a file.
1272
12730 type(fieldtype), allocatable :: fields_infra(:)
1274 integer :: i
1275 character(len=64) :: label
1276
12770 allocate(fields_infra(size(fields)))
12780 call get_file_fields(handle%handle_infra, fields_infra)
1279
12800 do i = 1, size(fields)
12810 call get_field_atts(fields_infra(i), name=label)
12820 call handle%fields%append(fields_infra(i), trim(label))
12830 fields(i)%label = trim(label)
1284 enddo
12850end subroutine get_file_fields_infra
1286
1287
1288!> Get time levels of a MOM framework file
12890subroutine get_file_times_infra(handle, time_values, ntime)
1290 class(MOM_infra_file), intent(in) :: handle
1291 !< Handle for a file that is open for I/O
1292 real, allocatable, dimension(:), intent(inout) :: time_values
1293 !< The real times for the records in file.
1294 integer, optional, intent(out) :: ntime
1295 !< The number of time levels in the file
1296
12970 call get_file_times(handle%handle_infra, time_values, ntime=ntime)
12980end subroutine get_file_times_infra
1299
1300
1301!> Get attributes from a field
13020subroutine get_field_atts_infra(handle, field, name, units, longname, checksum)
1303 class(MOM_infra_file), intent(in) :: handle
1304 !< File where field is stored
1305 type(MOM_field), intent(in) :: field
1306 !< The field to extract information from
1307 character(len=*), optional, intent(out) :: name
1308 !< The variable name
1309 character(len=*), optional, intent(out) :: units
1310 !< The units of the variable
1311 character(len=*), optional, intent(out) :: longname
1312 !< The long name of the variable
1313 integer(kind=int64), optional, intent(out) :: checksum(:)
1314 !< The checksums of the variable in a file
1315
13160 type(fieldtype) :: field_infra
1317
13180 field_infra = handle%fields%get(field%label)
13190 call get_field_atts(field_infra, name, units, longname, checksum)
13200end subroutine get_field_atts_infra
1321
1322
1323!> Interface to read_field_chksum
13240subroutine read_field_chksum_infra(handle, field, chksum, valid_chksum)
1325 class(MOM_infra_file), intent(in) :: handle
1326 !< File where field is stored
1327 type(MOM_field), intent(in) :: field
1328 !< The field whose checksum attribute is to be read
1329 integer(kind=int64), intent(out) :: chksum
1330 !< The checksum for the field.
1331 logical, intent(out) :: valid_chksum
1332 !< If true, chksum has been successfully read
1333
13340 type(fieldtype) :: field_infra
1335
13360 field_infra = handle%fields%get(field%label)
13370 call read_field_chksum(field_infra, chksum, valid_chksum)
13380end subroutine read_field_chksum_infra
1339
1340!> Get the native (fieldtype) fields of a MOM framework file
13410subroutine get_file_fieldtypes(handle, fields)
1342 class(MOM_infra_file), intent(in) :: handle
1343 type(fieldtype), intent(out) :: fields(:)
1344
1345 type(field_node_infra), pointer :: node
1346 integer :: i
1347
1348 ! NOTE: The tail is a pre-allocated empty node, so we check node%next
13490 node => handle%fields%head
13500 do i = 1, size(fields)
13510 if (.not. associated(node%next)) &
13520 call MOM_error(FATAL, 'fields(:) size exceeds number of registered fields.')
13530 fields(i) = node%field
13540 node => node%next
1355 enddo
13560end subroutine get_file_fieldtypes
1357
1358
1359! MOM_netcdf_file methods
1360
1361!> Open a MOM netCDF file
13622subroutine open_file_nc(handle, filename, action, MOM_domain, threading, fileset)
1363 class(MOM_netcdf_file), intent(inout) :: handle
1364 character(len=*), intent(in) :: filename
1365 integer, intent(in), optional :: action
1366 type(MOM_domain_type), optional, intent(in) :: MOM_domain
1367 integer, intent(in), optional :: threading
1368 integer, intent(in), optional :: fileset
1369
13702 if (.not. present(MOM_domain) .and. .not. is_root_PE()) return
1371
13722 call open_netcdf_file(handle%handle_nc, filename, action)
13732 handle%is_open = .true.
1374
13752 if (present(MOM_domain)) then
13761 handle%domain_decomposed = .true.
1377
1378 ! Input files use unrotated indexing.
13791 if (associated(MOM_domain%domain_in)) then
13800 call hor_index_init(MOM_domain%domain_in, handle%HI)
1381 else
13821 call hor_index_init(MOM_domain, handle%HI)
1383 endif
1384 endif
1385
13862 call handle%axes%init()
13872 call handle%fields%init()
13882end subroutine open_file_nc
1389
1390
1391!> Close a MOM netCDF file
13921subroutine close_file_nc(handle)
1393 class(MOM_netcdf_file), intent(inout) :: handle
1394
13951 if (.not. handle%domain_decomposed .and. .not. is_root_PE()) return
1396
13971 handle%is_open = .false.
13981 call close_netcdf_file(handle%handle_nc)
1399end subroutine close_file_nc
1400
1401
1402!> Flush the buffer of a MOM netCDF file
14033subroutine flush_file_nc(handle)
1404 class(MOM_netcdf_file), intent(in) :: handle
1405
14063 if (.not. is_root_PE()) return
1407
14083 call flush_netcdf_file(handle%handle_nc)
1409end subroutine flush_file_nc
1410
1411
1412!> Register an axis to the MOM netcdf file
14135function register_axis_nc(handle, label, units, longname, cartesian, sense, &
14145 domain, data, edge_axis, calendar) result(axis)
1415 class(MOM_netcdf_file), intent(inout) :: handle
1416 !< Handle for a netCDF file that is open for writing
1417 character(len=*), intent(in) :: label
1418 !< The name in the file of this axis
1419 character(len=*), intent(in) :: units
1420 !< The units of this axis
1421 character(len=*), intent(in) :: longname
1422 !< The long description of this axis
1423 character(len=*), optional, intent(in) :: cartesian
1424 !< A variable indicating which direction this axis corresponds with.
1425 !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none.
1426 integer, optional, intent(in) :: sense
1427 !< This is 1 for axes whose values increase upward, or -1 if they increase
1428 !! downward.
1429 type(domain1D), optional, intent(in) :: domain
1430 !< The domain decomposion for this axis
1431 real, dimension(:), optional, intent(in) :: data
1432 !< The coordinate values of the points on this axis
1433 logical, optional, intent(in) :: edge_axis
1434 !< If true, this axis marks an edge of the tracer cells
1435 character(len=*), optional, intent(in) :: calendar
1436 !< The name of the calendar used with a time axis
1437 type(MOM_axis) :: axis
1438
14395 type(netcdf_axis) :: axis_nc
1440
14415 if (is_root_PE()) then
1442 axis_nc = register_netcdf_axis(handle%handle_nc, label, units, longname, &
14435 data, cartesian, sense)
1444
14455 call handle%axes%append(axis_nc, label)
1446 endif
14475 axis%label = label
144810end function register_axis_nc
1449
1450
1451!> Register a field to the MOM netcdf file
145220function register_field_nc(handle, axes, label, units, longname, pack, &
1453 standard_name, checksum, conversion) result(field)
1454 class(MOM_netcdf_file), intent(inout) :: handle
1455 !< Handle for a file that is open for writing
1456 type(MOM_axis), intent(in) :: axes(:)
1457 !< Handles for the axis used for this variable
1458 character(len=*), intent(in) :: label
1459 !< The name in the file of this variable
1460 character(len=*), intent(in) :: units
1461 !< The units of this variable
1462 character(len=*), intent(in) :: longname
1463 !< The long description of this variable
1464 integer, optional, intent(in) :: pack
1465 !< A precision reduction factor with which the variable. The default, 1,
1466 !! has no reduction, but 2 is not uncommon.
1467 character(len=*), optional, intent(in) :: standard_name
1468 !< The standard (e.g., CMOR) name for this variable
1469 integer(kind=int64), dimension(:), optional, intent(in) :: checksum
1470 !< Checksum values that can be used to verify reads.
1471 real, optional, intent(in) :: conversion
1472 !< A factor to use to rescale the field before output [a A-1 ~> 1]
1473 type(MOM_field) :: field
1474
147520 type(netcdf_field) :: field_nc
147620 type(netcdf_axis), allocatable :: axes_nc(:)
1477 integer :: i
1478
147920 if (is_root_PE()) then
148044 allocate(axes_nc(size(axes)))
148144 do i = 1, size(axes)
148244 axes_nc(i) = handle%axes%get(axes(i)%label)
1483 enddo
1484
148520 field_nc = register_netcdf_field(handle%handle_nc, label, axes_nc, longname, units)
1486
148720 call handle%fields%append(field_nc, label)
1488 endif
148920 field%label = label
149020 field%conversion = 1.0 ; if (present(conversion)) field%conversion = conversion
149164end function register_field_nc
1492
1493
1494!> Write global metadata to the MOM netcdf file
14950subroutine write_attribute_nc(handle, name, attribute)
1496 class(MOM_netcdf_file), intent(in) :: handle
1497 !< Handle for a file that is open for writing
1498 character(len=*), intent(in) :: name
1499 !< The name in the file of this global attribute
1500 character(len=*), intent(in) :: attribute
1501 !< The value of this attribute
1502
15030 if (.not. is_root_PE()) return
1504
15050 call write_netcdf_attribute(handle%handle_nc, name, attribute)
15060end subroutine write_attribute_nc
1507
1508
1509!> Write a 4D field to the MOM netcdf file
15100subroutine write_field_4d_nc(handle, field_md, MOM_domain, field, tstamp, &
1511 tile_count, fill_value)
1512 class(MOM_netcdf_file), intent(inout) :: handle
1513 !< Handle for a file that is open for writing
1514 type(MOM_field), intent(in) :: field_md
1515 !< Field type with metadata
1516 type(MOM_domain_type), intent(in) :: MOM_domain
1517 !< The MOM_Domain that describes the decomposition
1518 real, intent(inout) :: field(:,:,:,:)
1519 !< Field to write
1520 real, optional, intent(in) :: tstamp
1521 !< Model time of this field
1522 integer, optional, intent(in) :: tile_count
1523 !< PEs per tile (default: 1)
1524 real, optional, intent(in) :: fill_value
1525 !< Missing data fill value
1526
15270 type(netcdf_field) :: field_nc
15280 real, allocatable :: unscaled_field(:,:,:,:) ! An unscaled version of field for output [a]
1529
15300 if (.not. is_root_PE()) return
1531
15320 field_nc = handle%fields%get(field_md%label)
15330 if (field_md%conversion == 1.0) then
15340 call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp)
1535 else
15360 allocate(unscaled_field, source=field)
15370 unscaled_field(:,:,:,:) = field_md%conversion * field(:,:,:,:)
15380 call write_netcdf_field(handle%handle_nc, field_nc, unscaled_field, time=tstamp)
15390 deallocate(unscaled_field)
1540 endif
15410end subroutine write_field_4d_nc
1542
1543
1544!> Write a 3D field to the MOM netcdf file
15450subroutine write_field_3d_nc(handle, field_md, MOM_domain, field, tstamp, &
1546 tile_count, fill_value)
1547 class(MOM_netcdf_file), intent(inout) :: handle
1548 !< Handle for a file that is open for writing
1549 type(MOM_field), intent(in) :: field_md
1550 !< Field type with metadata
1551 type(MOM_domain_type), intent(in) :: MOM_domain
1552 !< The MOM_Domain that describes the decomposition
1553 real, intent(inout) :: field(:,:,:)
1554 !< Field to write
1555 real, optional, intent(in) :: tstamp
1556 !< Model time of this field
1557 integer, optional, intent(in) :: tile_count
1558 !< PEs per tile (default: 1)
1559 real, optional, intent(in) :: fill_value
1560 !< Missing data fill value
1561
15620 type(netcdf_field) :: field_nc
15630 real, allocatable :: unscaled_field(:,:,:) ! An unscaled version of field for output [a]
1564
15650 if (.not. is_root_PE()) return
1566
15670 field_nc = handle%fields%get(field_md%label)
15680 if (field_md%conversion == 1.0) then
15690 call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp)
1570 else
15710 allocate(unscaled_field, source=field)
15720 unscaled_field(:,:,:) = field_md%conversion * field(:,:,:)
15730 call write_netcdf_field(handle%handle_nc, field_nc, unscaled_field, time=tstamp)
15740 deallocate(unscaled_field)
1575 endif
15760end subroutine write_field_3d_nc
1577
1578
1579!> Write a 2D field to the MOM netcdf file
15800subroutine write_field_2d_nc(handle, field_md, MOM_domain, field, tstamp, &
1581 tile_count, fill_value)
1582 class(MOM_netcdf_file), intent(inout) :: handle
1583 !< Handle for a file that is open for writing
1584 type(MOM_field), intent(in) :: field_md
1585 !< Field type with metadata
1586 type(MOM_domain_type), intent(in) :: MOM_domain
1587 !< The MOM_Domain that describes the decomposition
1588 real, dimension(:,:), intent(inout) :: field
1589 !< Field to write
1590 real, optional, intent(in) :: tstamp
1591 !< Model time of this field
1592 integer, optional, intent(in) :: tile_count
1593 !< PEs per tile (default: 1)
1594 real, optional, intent(in) :: fill_value
1595 !< Missing data fill value
1596
15970 type(netcdf_field) :: field_nc
15980 real, allocatable :: unscaled_field(:,:) ! An unscaled version of field for output [a]
1599
16000 if (.not. is_root_PE()) return
1601
16020 field_nc = handle%fields%get(field_md%label)
16030 if (field_md%conversion == 1.0) then
16040 call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp)
1605 else
16060 allocate(unscaled_field, source=field)
16070 unscaled_field(:,:) = field_md%conversion * field(:,:)
16080 call write_netcdf_field(handle%handle_nc, field_nc, unscaled_field, time=tstamp)
16090 deallocate(unscaled_field)
1610 endif
16110end subroutine write_field_2d_nc
1612
1613
1614!> Write a 1D field to the MOM netcdf file
161514subroutine write_field_1d_nc(handle, field_md, field, tstamp)
1616 class(MOM_netcdf_file), intent(inout) :: handle
1617 !< Handle for a file that is open for writing
1618 type(MOM_field), intent(in) :: field_md
1619 !< Field type with metadata
1620 real, dimension(:), intent(in) :: field
1621 !< Field to write
1622 real, optional, intent(in) :: tstamp
1623 !< Model time of this field
1624
162514 type(netcdf_field) :: field_nc
162614 real, allocatable :: unscaled_field(:) ! An unscaled version of field for output [a]
1627
162814 if (.not. is_root_PE()) return
1629
163014 field_nc = handle%fields%get(field_md%label)
163114 if (field_md%conversion == 1.0) then
163214 call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp)
1633 else
16340 allocate(unscaled_field, source=field)
16350 unscaled_field(:) = field_md%conversion * field(:)
16360 call write_netcdf_field(handle%handle_nc, field_nc, unscaled_field, time=tstamp)
16370 deallocate(unscaled_field)
1638 endif
163914end subroutine write_field_1d_nc
1640
1641
1642!> Write a 0D field to the MOM netcdf file
164342subroutine write_field_0d_nc(handle, field_md, field, tstamp)
1644 class(MOM_netcdf_file), intent(inout) :: handle
1645 !< Handle for a file that is open for writing
1646 type(MOM_field), intent(in) :: field_md
1647 !< Field type with metadata
1648 real, intent(in) :: field
1649 !< Field to write
1650 real, optional, intent(in) :: tstamp
1651 !< Model time of this field
1652
165342 type(netcdf_field) :: field_nc
1654 real :: unscaled_field ! An unscaled version of field for output [a]
1655
165642 if (.not. is_root_PE()) return
1657
165842 field_nc = handle%fields%get(field_md%label)
165942 unscaled_field = field_md%conversion * field
166042 call write_netcdf_field(handle%handle_nc, field_nc, unscaled_field, time=tstamp)
166142end subroutine write_field_0d_nc
1662
1663
1664!> Write an axis field to the MOM netcdf file
16654subroutine write_field_axis_nc(handle, axis)
1666 class(MOM_netcdf_file), intent(inout) :: handle
1667 !< Handle for a file that is open for writing
1668 type(MOM_axis), intent(in) :: axis
1669 !< An axis type variable with information to write
1670
16714 type(netcdf_axis) :: axis_nc
1672
16734 if (.not. is_root_PE()) return
1674
16754 axis_nc = handle%axes%get(axis%label)
16764 call write_netcdf_axis(handle%handle_nc, axis_nc)
16774end subroutine write_field_axis_nc
1678
1679
1680!> True if the framework file has been opened
16810logical function file_is_open_nc(handle)
1682 class(MOM_netcdf_file), intent(in) :: handle
1683 !< Handle to a file to inquire about
1684
16850 file_is_open_nc = handle%is_open
16860end function file_is_open_nc
1687
1688
1689!> Return number of dimensions, variables, or time levels in a MOM netcdf file
16900subroutine get_file_info_nc(handle, ndim, nvar, ntime)
1691 class(MOM_netcdf_file), intent(in) :: handle
1692 !< Handle for a file that is open for I/O
1693 integer, optional, intent(out) :: ndim
1694 !< The number of dimensions in the file
1695 integer, optional, intent(out) :: nvar
1696 !< The number of variables in the file
1697 integer, optional, intent(out) :: ntime
1698 !< The number of time levels in the file
1699
1700 integer :: ndim_nc, nvar_nc
1701
17020 if (.not. is_root_PE()) return
1703
17040 call get_netcdf_size(handle%handle_nc, ndims=ndim_nc, nvars=nvar_nc, nsteps=ntime)
1705
1706 ! MOM I/O follows legacy FMS behavior and excludes axes from field count
17070 if (present(ndim)) ndim = ndim_nc
17080 if (present(nvar)) nvar = nvar_nc - ndim_nc
1709end subroutine get_file_info_nc
1710
1711
1712!> Update the axes and fields descriptors of a MOM netCDF file
17130subroutine update_file_contents_nc(handle)
1714 class(MOM_netcdf_file), intent(inout) :: handle
1715 !< Handle for a file that is open for I/O
1716
17170 type(netcdf_axis), allocatable :: axes_nc(:)
1718 ! netCDF axis descriptors
17190 type(netcdf_field), allocatable :: fields_nc(:)
1720 ! netCDF field descriptors
1721 integer :: i
1722 ! Index counter
1723
17240 if (.not. handle%domain_decomposed .and. .not. is_root_PE()) return
1725
17260 call get_netcdf_fields(handle%handle_nc, axes_nc, fields_nc)
1727
17280 do i = 1, size(axes_nc)
17290 call handle%axes%append(axes_nc(i), axes_nc(i)%label)
1730 enddo
1731
17320 do i = 1, size(fields_nc)
17330 call handle%fields%append(fields_nc(i), fields_nc(i)%label)
1734 enddo
17350end subroutine update_file_contents_nc
1736
1737
1738!> Return the field descriptors of a MOM netCDF file
17390subroutine get_file_fields_nc(handle, fields)
1740 class(MOM_netcdf_file), intent(inout) :: handle
1741 !< Handle for a file that is open for I/O
1742 type(MOM_field), intent(inout) :: fields(:)
1743 !< Field-type descriptions of all of the variables in a file.
1744
1745 type(field_node_nc), pointer :: node => null()
1746 ! Current field list node
1747 integer :: n
1748 ! Field counter
1749
17500 if (.not. is_root_PE()) return
1751
1752 ! Generate the manifest of axes and fields
17530 call handle%update()
1754
17550 n = 0
17560 node => handle%fields%head
17570 do while (associated(node%next))
17580 n = n + 1
17590 fields(n)%label = trim(node%label)
17600 node => node%next
1761 enddo
1762end subroutine get_file_fields_nc
1763
1764
1765!> Get attributes from a netCDF field
17660subroutine get_field_atts_nc(handle, field, name, units, longname, checksum)
1767 class(MOM_netcdf_file), intent(in) :: handle
1768 !< File where field is stored
1769 type(MOM_field), intent(in) :: field
1770 !< The field to extract information from
1771 character(len=*), optional, intent(out) :: name
1772 !< The variable name
1773 character(len=*), optional, intent(out) :: units
1774 !< The units of the variable
1775 character(len=*), optional, intent(out) :: longname
1776 !< The long name of the variable
1777 integer(kind=int64), optional, intent(out) :: checksum(:)
1778 !< The checksums of the variable in a file
1779
17800 call MOM_error(FATAL, 'get_field_atts over netCDF is not yet implemented.')
17810end subroutine get_field_atts_nc
1782
1783
1784!> Interface to read_field_chksum
17850subroutine read_field_chksum_nc(handle, field, chksum, valid_chksum)
1786 class(MOM_netcdf_file), intent(in) :: handle
1787 !< File where field is stored
1788 type(MOM_field), intent(in) :: field
1789 !< The field whose checksum attribute is to be read
1790 integer(kind=int64), intent(out) :: chksum
1791 !< The checksum for the field.
1792 logical, intent(out) :: valid_chksum
1793 !< If true, chksum has been successfully read
1794
17950 call MOM_error(FATAL, 'read_field_chksum over netCDF is not yet implemented.')
17960 chksum = -1_int64
17970 valid_chksum = .false.
17980end subroutine read_field_chksum_nc
1799
1800
1801!> Read the values of a netCDF field into an array that might have halos
18020subroutine get_field_nc(handle, label, values, rescale)
1803 class(MOM_netcdf_file), intent(in) :: handle
1804 !< Handle of netCDF file to be read
1805 character(len=*), intent(in) :: label
1806 !< Field variable name
1807 real, intent(inout) :: values(:,:)
1808 !< Field values read from the file. It would be intent(out) but for the
1809 !! need to preserve any initialized values in the halo regions.
1810 real, optional, intent(in) :: rescale
1811 !< A multiplicative rescaling factor for the values that are read.
1812 !! Omitting this is the same as setting it to 1.
1813
1814 logical :: data_domain
1815 ! True if values matches the data domain size
1816 logical :: compute_domain
1817 ! True if values matches the compute domain size
18180 type(netcdf_field) :: field_nc
1819 ! netCDF field associated with label
1820 integer :: isc, iec, jsc, jec
1821 ! Index bounds of compute domain
1822 integer :: isd, ied, jsd, jed
1823 ! Index bounds of data domain
1824 integer :: iscl, iecl, jscl, jecl
1825 ! Local 1-based index bounds of compute domain
1826 integer :: bounds(2,2)
1827 ! Index bounds of domain
18280 real, allocatable :: values_c(:,:)
1829 ! Field values on the compute domain, used for copying to a data domain
1830
18310 isc = handle%HI%isc
18320 iec = handle%HI%iec
18330 jsc = handle%HI%jsc
18340 jec = handle%HI%jec
1835
18360 isd = handle%HI%isd
18370 ied = handle%HI%ied
18380 jsd = handle%HI%jsd
18390 jed = handle%HI%jed
1840
18410 data_domain = all(shape(values) == [ied-isd+1, jed-jsd+1])
18420 compute_domain = all(shape(values) == [iec-isc+1, jec-jsc+1])
1843
1844 ! NOTE: Data on face and vertex points is not yet supported. This is a
1845 ! temporary check to detect such cases, but may be removed in the future.
18460 if (.not. (compute_domain .or. data_domain)) &
1847 call MOM_error(FATAL, 'get_field_nc trying to read '//trim(label)//' from '//&
1848 trim(get_netcdf_filename(handle%handle_nc))//&
18490 ': Only compute and data domains are currently supported.')
1850
18510 field_nc = handle%fields%get(label)
1852
18530 if (data_domain) &
18540 allocate(values_c(1:iec-isc+1,1:jec-jsc+1))
1855
18560 if (handle%domain_decomposed) then
18570 bounds(1,:) = [isc, jsc] + [handle%HI%idg_offset, handle%HI%jdg_offset]
18580 bounds(2,:) = [iec, jec] + [handle%HI%idg_offset, handle%HI%jdg_offset]
18590 if (data_domain) then
18600 call read_netcdf_field(handle%handle_nc, field_nc, values_c, bounds=bounds)
1861 else
18620 call read_netcdf_field(handle%handle_nc, field_nc, values, bounds=bounds)
1863 endif
1864 else
18650 if (data_domain) then
18660 call read_netcdf_field(handle%handle_nc, field_nc, values_c)
1867 else
18680 call read_netcdf_field(handle%handle_nc, field_nc, values)
1869 endif
1870 endif
1871
18720 if (data_domain) then
18730 iscl = isc - isd + 1
18740 iecl = iec - isd + 1
18750 jscl = jsc - jsd + 1
18760 jecl = jec - jsd + 1
1877
18780 values(iscl:iecl,jscl:jecl) = values_c(:,:)
1879 else
18800 iscl = 1
18810 iecl = iec - isc + 1
18820 jscl = 1
18830 jecl = jec - jsc + 1
1884 endif
1885
1886 ! NOTE: It is more efficient to do the rescale in-place while copying
1887 ! values_c(:,:) to values(:,:). But since rescale is only present for
1888 ! debugging, we can probably disregard this impact on performance.
18890 if (present(rescale)) then
18900 if (rescale /= 1.0) then
18910 values(iscl:iecl,jscl:jecl) = rescale * values(iscl:iecl,jscl:jecl)
1892 endif
1893 endif
18940end subroutine get_field_nc
1895
1896
1897!> \namespace MOM_IO_file
1898!!
1899!! This file defines the MOM_file classes used to inferface with the internal
1900!! IO handlers, such as the configured "infra" layer (FMS) or native netCDF.
1901!!
1902!! `MOM_file`: The generic class used to reference any file type
1903!! Cannot be used in a variable declaration.
1904!!
1905!! `MOM_infra_file`: A file handler for use by the infra layer. Currently this
1906!! means an FMS file, such a restart or diagnostic output.
1907!!
1908!! `MOM_netcdf_file`: A netCDF file handler for MOM-specific I/O. This may
1909!! include operations outside the scope of FMS or other infra frameworks.
1910
19110end module MOM_io_file