← back to index

src/framework/MOM_io.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 I/O framework code
6module MOM_io
7
8use MOM_array_transform, only : allocate_rotated_array, rotate_array
9use MOM_array_transform, only : rotate_array_pair, rotate_vector
10use MOM_domains, only : MOM_domain_type, domain1D, broadcast, get_domain_components
11use MOM_domains, only : rescale_comp_data, num_PEs, AGRID, BGRID_NE, CGRID_NE
12use MOM_dyn_horgrid, only : dyn_horgrid_type
13use MOM_ensemble_manager, only : get_ensemble_id
14use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING, is_root_PE
15use MOM_file_parser, only : log_version, param_file_type
16use MOM_grid, only : ocean_grid_type
17use MOM_io_infra, only : read_field, read_vector
18use MOM_io_infra, only : read_data => read_field ! Deprecated
19use MOM_io_infra, only : read_field_chksum
20use MOM_io_infra, only : file_exists
21use MOM_io_infra, only : open_ASCII_file, close_file, file_is_open
22use MOM_io_infra, only : get_field_size, field_exists, get_field_atts
23use MOM_io_infra, only : get_axis_data, get_filename_suffix
24use MOM_io_infra, only : write_version
25use MOM_io_infra, only : MOM_namelist_file, check_namelist_error, io_infra_init, io_infra_end
26use MOM_io_infra, only : APPEND_FILE, ASCII_FILE, MULTIPLE, NETCDF_FILE, OVERWRITE_FILE
27use MOM_io_infra, only : READONLY_FILE, SINGLE_FILE, WRITEONLY_FILE
28use MOM_io_infra, only : CENTER, CORNER, NORTH_FACE, EAST_FACE
29use MOM_io_file, only : MOM_file, MOM_infra_file, MOM_netcdf_file
30use MOM_io_file, only : MOM_axis, MOM_field
31use MOM_string_functions, only : lowercase, slasher
32use MOM_verticalGrid, only : verticalGrid_type
33
34use iso_fortran_env, only : int32, int64, stdout_iso=>output_unit, stderr_iso=>error_unit
35use netcdf, only : NF90_open, NF90_inq_varid, NF90_inq_varids, NF90_inquire, NF90_close
36use netcdf, only : NF90_inquire_variable, NF90_get_var, NF90_get_att, NF90_inquire_attribute
37use netcdf, only : NF90_strerror, NF90_inquire_dimension
38use netcdf, only : NF90_NOWRITE, NF90_NOERR, NF90_GLOBAL, NF90_ENOTATT, NF90_CHAR
39
40! The following are not used in MOM6, but may be used by externals (e.g. SIS2).
41use MOM_io_infra, only : axistype ! still used but soon to be nuked
42use MOM_io_infra, only : fieldtype
43use MOM_io_infra, only : file_type
44use MOM_io_infra, only : get_file_info
45use MOM_io_infra, only : get_file_fields
46use MOM_io_infra, only : get_file_times
47use MOM_io_infra, only : open_file
48use MOM_io_infra, only : write_field
49
50implicit none ; private
51
52! These interfaces are actually implemented in this file.
53public :: create_MOM_file, reopen_MOM_file, cmor_long_std, ensembler, MOM_io_init
54public :: MOM_field
55public :: MOM_write_field, var_desc, modify_vardesc, query_vardesc, position_from_horgrid
56public :: open_namelist_file, check_namelist_error, check_nml_error
57public :: get_var_sizes, verify_variable_units, num_timelevels, read_variable, read_attribute
58public :: open_file_to_read, close_file_to_read
59! The following are simple pass throughs of routines from MOM_io_infra or other modules.
60public :: file_exists, open_ASCII_file, close_file
61public :: MOM_file, MOM_infra_file, MOM_netcdf_file
62public :: field_exists, get_filename_appendix
63public :: fieldtype, field_size, get_field_atts
64public :: axistype, get_axis_data
65public :: MOM_read_data, MOM_read_vector, read_field_chksum
66public :: read_netCDF_data
67public :: slasher, write_version_number
68public :: io_infra_init, io_infra_end
69public :: stdout_if_root
70public :: get_var_axes_info
71public :: get_axis_info
72! This is used to set up information descibing non-domain-decomposed axes.
73public :: axis_info, set_axis_info, delete_axis_info
74! This is used to set up global file attributes
75public :: attribute_info, set_attribute_info, delete_attribute_info
76! This API is here just to support potential use by non-FMS drivers, and should not persist.
77public :: read_data
78!> These encoding constants are used to indicate the file format
79public :: ASCII_FILE, NETCDF_FILE
80!> These encoding constants are used to indicate whether the file is domain decomposed
81public :: MULTIPLE, SINGLE_FILE
82!> These encoding constants are used to indicate the access mode for a file
83public :: APPEND_FILE, OVERWRITE_FILE, READONLY_FILE, WRITEONLY_FILE
84!> These encoding constants are used to indicate the discretization position of a variable
85public :: CENTER, CORNER, NORTH_FACE, EAST_FACE
86
87! The following are not used in MOM6, but may be used by externals (e.g. SIS2).
88public :: create_file
89public :: reopen_file
90public :: file_type
91public :: open_file
92public :: get_file_info
93public :: get_file_fields
94public :: get_file_times
95
96!> Read a field from file using the infrastructure I/O.
97interface MOM_read_data
98 module procedure MOM_read_data_0d
99 module procedure MOM_read_data_0d_int
100 module procedure MOM_read_data_1d
101 module procedure MOM_read_data_1d_int
102 module procedure MOM_read_data_2d
103 module procedure MOM_read_data_2d_region
104 module procedure MOM_read_data_3d
105 module procedure MOM_read_data_3d_region
106 module procedure MOM_read_data_4d
107end interface MOM_read_data
108
109!> Read a vector from file using the infrastructure I/O.
110interface MOM_read_vector
111 module procedure MOM_read_vector_2d
112 module procedure MOM_read_vector_3d
113end interface MOM_read_vector
114
115!> Read a field using native netCDF I/O
116!!
117!! This function is primarily used for unstructured data which may contain
118!! content that cannot be parsed by infrastructure I/O.
119interface read_netCDF_data
120 ! NOTE: Only 2D I/O is currently used; this should be expanded as needed.
121 module procedure read_netCDF_data_2d
122end interface read_netCDF_data
123
124!> Write a registered field to an output file, potentially with rotation
125interface MOM_write_field
126 module procedure MOM_write_field_legacy_4d
127 module procedure MOM_write_field_legacy_3d
128 module procedure MOM_write_field_legacy_2d
129 module procedure MOM_write_field_legacy_1d
130 module procedure MOM_write_field_legacy_0d
131 module procedure MOM_write_field_4d
132 module procedure MOM_write_field_3d
133 module procedure MOM_write_field_2d
134 module procedure MOM_write_field_1d
135 module procedure MOM_write_field_0d
136end interface MOM_write_field
137
138!> Read an entire named variable from a named netCDF file using netCDF calls directly, rather
139!! than any infrastructure routines and broadcast it from the root PE to the other PEs.
140interface read_variable
141 module procedure read_variable_0d, read_variable_0d_int
142 module procedure read_variable_1d, read_variable_1d_int
143 module procedure read_variable_2d, read_variable_3d
144end interface read_variable
145
146!> Read a global or variable attribute from a named netCDF file using netCDF calls
147!! directly, in some cases reading from the root PE before broadcasting to the other PEs.
148interface read_attribute
149 module procedure read_attribute_str, read_attribute_real
150 module procedure read_attribute_int32, read_attribute_int64
151end interface read_attribute
152
153!> Type that stores information that can be used to create a non-decomposed axis.
154type :: axis_info
155 character(len=32) :: name = "" !< The name of this axis for use in files
156 character(len=256) :: longname = "" !< A longer name describing this axis
157 character(len=48) :: units = "" !< The units of the axis labels
158 character(len=8) :: cartesian = "N" !< A variable indicating which direction
159 !! this axis corresponds with. Valid values
160 !! include 'X', 'Y', 'Z', 'T', and 'N' for none.
161 integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1
162 !! if they increase downward. The default, 0, is ignored.
163 integer :: ax_size = 0 !< The number of elements in this axis
164 real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis [arbitrary]
165end type axis_info
166
167!> Type for describing a 3-d variable for output
168type, public :: vardesc
169 character(len=64) :: name !< Variable name in a NetCDF file
170 character(len=48) :: units !< Physical dimensions of the variable
171 character(len=240) :: longname !< Long name of the variable
172 character(len=8) :: hor_grid !< Horizontal grid: u, v, h, q, Cu, Cv, T, Bu, or 1
173 character(len=8) :: z_grid !< Vertical grid: L, i, or 1
174 character(len=8) :: t_grid !< Time description: s, p, or 1
175 character(len=64) :: cmor_field_name !< CMOR name
176 character(len=64) :: cmor_units !< CMOR physical dimensions of the variable
177 character(len=240) :: cmor_longname !< CMOR long name of the variable
178 real :: conversion !< for unit conversions, such as needed to convert
179 !! from intensive to extensive [various] or [a A-1 ~> 1]
180 !! to undo internal dimensional rescaling
181 character(len=32) :: dim_names(5) !< The names in the file of the axes for this variable
182 integer :: position = -1 !< An integer encoding the horizontal position, it may
183 !! CENTER, CORNER, EAST_FACE, NORTH_FACE, or 0.
184 type(axis_info) :: extra_axes(5) !< dimensions other than space-time
185end type vardesc
186
187!> Type that stores for a global file attribute
188type :: attribute_info ; private
189 character(len=:), allocatable :: name !< The name of this attribute
190 character(len=:), allocatable :: att_val !< The values of this attribute
191end type attribute_info
192
193integer, public :: stdout = stdout_iso !< standard output unit
194integer, public :: stderr = stderr_iso !< standard output unit
195
196! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
197! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
198! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
199! vary with the Boussinesq approximation, the Boussinesq variant is given first.
200! The functions in this module work with variables with arbitrary units, in which case the
201! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a].
202
203contains
204
205!> `create_MOM_file` wrapper for the legacy file handle, `file_type`.
206!! NOTE: This function may be removed in a future release.
2070subroutine create_file(IO_handle, filename, vars, novars, fields, threading, &
2080 timeunit, G, dG, GV, checksums, extra_axes, global_atts)
209 type(file_type), intent(inout) :: IO_handle
210 !< Handle for a files or fileset that is to be opened or reopened for
211 !! writing
212 character(len=*), intent(in) :: filename
213 !< full path to the file to create
214 type(vardesc), intent(in) :: vars(:)
215 !< structures describing fields written to filename
216 integer, intent(in) :: novars
217 !< number of fields written to filename
218 type(fieldtype), intent(inout) :: fields(:)
219 !< array of fieldtypes for each variable
220 integer, optional, intent(in) :: threading
221 !< SINGLE_FILE or MULTIPLE
222 real, optional, intent(in) :: timeunit
223 !< length of the units for time [s]. The default value is 86400.0, for 1
224 !! day.
225 type(ocean_grid_type), optional, intent(in) :: G
226 !< ocean horizontal grid structure; G or dG is required if the new file
227 !! uses any horizontal grid axes.
228 type(dyn_horgrid_type), optional, intent(in) :: dG
229 !< dynamic horizontal grid structure; G or dG is required if the new file
230 !! uses any horizontal grid axes.
231 type(verticalGrid_type), optional, intent(in) :: GV
232 !< ocean vertical grid structure, which is ! required if the new file uses
233 !! any vertical grid axes.
234 integer(kind=int64), optional, intent(in) :: checksums(:,:)
235 !< checksums of vars
236 type(axis_info), optional, intent(in) :: extra_axes(:)
237 !< Types with information about some axes that might be used in this file
238 type(attribute_info), optional, intent(in) :: global_atts(:)
239 !< Global attributes to write to this file
240
2410 type(MOM_infra_file) :: new_file
2420 type(MOM_field) :: new_fields(novars)
243
2440 new_file%handle_infra = IO_handle
245
246 call create_MOM_file(new_file, filename, vars, novars, new_fields, &
247 threading=threading, timeunit=timeunit, G=G, dG=dG, GV=GV, &
2480 checksums=checksums, extra_axes=extra_axes, global_atts=global_atts)
249
2500 IO_handle = new_file%handle_infra
2510 call new_file%get_file_fieldtypes(fields(:novars))
2520end subroutine create_file
253
254
255!! Create a new netCDF file and register the MOM_fields to be written.
2568subroutine create_MOM_file(IO_handle, filename, vars, novars, fields, &
25712 threading, timeunit, G, dG, GV, checksums, extra_axes, global_atts)
258 class(MOM_file), intent(inout) :: IO_handle !< Handle for a files or fileset that is to be
259 !! opened or reopened for writing
260 character(len=*), intent(in) :: filename !< full path to the file to create
261 type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename
262 integer, intent(in) :: novars !< number of fields written to filename
263 type(MOM_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable
264 integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE
265 real, optional, intent(in) :: timeunit !< length of the units for time [s]. The
266 !! default value is 86400.0, for 1 day.
267 type(ocean_grid_type), optional, intent(in) :: G !< ocean horizontal grid structure; G or dG
268 !! is required if the new file uses any
269 !! horizontal grid axes.
270 type(dyn_horgrid_type), optional, intent(in) :: dG !< dynamic horizontal grid structure; G or dG
271 !! is required if the new file uses any
272 !! horizontal grid axes.
273 type(verticalGrid_type), optional, intent(in) :: GV !< ocean vertical grid structure, which is
274 !! required if the new file uses any
275 !! vertical grid axes.
276 integer(kind=int64), optional, intent(in) :: checksums(:,:) !< checksums of vars
277 type(axis_info), dimension(:), &
278 optional, intent(in) :: extra_axes !< Types with information about
279 !! some axes that might be used in this file
280 type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to
281 !! write to this file
282
283 logical :: use_lath, use_lonh, use_latq, use_lonq, use_time
284 logical :: use_layer, use_int, use_periodic
285 logical :: one_file, domain_set, dim_found
2864 logical, dimension(:), allocatable :: use_extra_axis
2874 type(MOM_axis) :: axis_lath, axis_latq, axis_lonh, axis_lonq
2884 type(MOM_axis) :: axis_layer, axis_int, axis_time, axis_periodic
2894 type(MOM_axis), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes
29068 type(MOM_axis) :: axes(5) ! The axes of a variable
291 type(MOM_domain_type), pointer :: Domain => NULL()
292 type(domain1d) :: x_domain, y_domain
293 integer :: position, numaxes, pack, thread, k, n, m
294 integer :: num_extra_dims ! The number of extra possible dimensions from extra_axes
295 integer :: isg, ieg, jsg, jeg, IsgB, IegB, JsgB, JegB
296 integer :: var_periods, num_periods=0
2974 real, dimension(:), allocatable :: axis_val ! Axis label values [various]
298 real, pointer, dimension(:) :: &
299 gridLatT => NULL(), & ! The latitude of T or B points for the purpose of labeling
300 gridLatB => NULL(), & ! the output axes, often in units of [degrees_N] or [km] or [m].
301 gridLonT => NULL(), & ! The longitude of T or B points for the purpose of labeling
302 gridLonB => NULL() ! the output axes, often in units of [degrees_E] or [km] or [m].
303 character(len=40) :: time_units, x_axis_units, y_axis_units
304 character(len=8) :: t_grid, t_grid_read
305 character(len=64) :: ax_name(5) ! The axis names of a variable
306
3074 use_lath = .false. ; use_lonh = .false.
3084 use_latq = .false. ; use_lonq = .false.
3094 use_time = .false. ; use_periodic = .false.
3104 use_layer = .false. ; use_int = .false.
3114 num_extra_dims = 0
3124 if (present(extra_axes)) then
3132 num_extra_dims = size(extra_axes)
3142 if (num_extra_dims > 0) then
31512 allocate(use_extra_axis(num_extra_dims)) ; use_extra_axis = .false.
31612 allocate(more_axes(num_extra_dims))
317 endif
318 endif
319
3204 thread = SINGLE_FILE
3214 if (PRESENT(threading)) thread = threading
322
3234 domain_set = .false.
3244 if (present(G)) then
3253 domain_set = .true. ; Domain => G%Domain
3263 gridLatT => G%gridLatT ; gridLatB => G%gridLatB
3273 gridLonT => G%gridLonT ; gridLonB => G%gridLonB
3283 x_axis_units = G%x_axis_units ; y_axis_units = G%y_axis_units
3293 isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg
3303 IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB
3311 elseif (present(dG)) then
3320 domain_set = .true. ; Domain => dG%Domain
3330 gridLatT => dG%gridLatT ; gridLatB => dG%gridLatB
3340 gridLonT => dG%gridLonT ; gridLonB => dG%gridLonB
3350 x_axis_units = dG%x_axis_units ; y_axis_units = dG%y_axis_units
3360 isg = dG%isg ; ieg = dG%ieg ; jsg = dG%jsg ; jeg = dG%jeg
3370 IsgB = dG%IsgB ; IegB = dG%IegB ; JsgB = dG%JsgB ; JegB = dG%JegB
338 endif
339
3404 one_file = .true.
3414 if (domain_set) one_file = (thread == SINGLE_FILE)
342
3434 if (one_file) then
3442 if (domain_set) then
345 call IO_handle%open(filename, action=OVERWRITE_FILE, &
3461 MOM_domain=domain, threading=thread, fileset=SINGLE_FILE)
347 else
348 call IO_handle%open(filename, action=OVERWRITE_FILE, threading=thread, &
3491 fileset=SINGLE_FILE)
350 endif
351 else
352 call IO_handle%open(filename, action=OVERWRITE_FILE, MOM_domain=Domain, &
3532 threading=thread, fileset=thread)
354 endif
355
356! Define the coordinates.
35787 do k=1,novars
35883 position = vars(k)%position
35983 if (position == -1) position = position_from_horgrid(vars(k)%hor_grid)
36037 select case (position)
36137 case (CENTER) ; use_lath = .true. ; use_lonh = .true.
3622 case (CORNER) ; use_latq = .true. ; use_lonq = .true.
36310 case (EAST_FACE) ; use_lath = .true. ; use_lonq = .true.
36434 case (NORTH_FACE) ; use_latq = .true. ; use_lonh = .true.
365 case (0) ! Do nothing.
366 case default
36783 call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//" has an unrecognized value of postion")
368 end select
369110 select case (vars(k)%z_grid)
37027 case ('L') ; use_layer = .true.
37156 case ('i') ; use_int = .true.
372 case ('1') ! Do nothing.
373 case default
374 call MOM_error(FATAL, "MOM_io create_file: "//trim(vars(k)%name)//&
37583 " has unrecognized z_grid "//trim(vars(k)%z_grid))
376 end select
37783 t_grid = adjustl(vars(k)%t_grid)
37881 select case (t_grid(1:1))
37981 case ('s', 'a', 'm') ; use_time = .true.
3800 case ('p') ; use_periodic = .true.
3810 if (len_trim(t_grid(2:8)) <= 0) call MOM_error(FATAL, &
382 "MOM_io create_file: No periodic axis length was specified in "//&
383 trim(vars(k)%t_grid) // " in the periodic axes of variable "//&
3840 trim(vars(k)%name)//" in file "//trim(filename))
3850 var_periods = -9999999
3860 t_grid_read = adjustl(t_grid(2:8))
3870 read(t_grid_read,*) var_periods
3880 if (var_periods == -9999999) call MOM_error(FATAL, &
389 "MOM_io create_file: Failed to read the number of periods from "//&
390 trim(vars(k)%t_grid) // " in the periodic axes of variable "//&
3910 trim(vars(k)%name)//" in file "//trim(filename))
3920 if (var_periods < 1) call MOM_error(FATAL, "MOM_io create_file: "//&
393 "variable "//trim(vars(k)%name)//" in file "//trim(filename)//&
394 " uses a periodic time axis, and must have a positive "//&
3950 "value for the number of periods in "//vars(k)%t_grid )
3960 if ((num_periods > 0) .and. (var_periods /= num_periods)) &
397 call MOM_error(FATAL, "MOM_io create_file: "//&
398 "Only one value of the number of periods can be used in the "//&
399 "create_file call for file "//trim(filename)//". The second is "//&
4000 "variable "//trim(vars(k)%name)//" with t_grid "//vars(k)%t_grid )
401
4022 num_periods = var_periods
403 case ('1') ! Do nothing.
404 case default
405 call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//&
40683 " has unrecognized t_grid "//trim(vars(k)%t_grid))
407 end select
408
409502 do n=1,5 ; if (len_trim(vars(k)%dim_names(n)) > 0) then
4100 dim_found = .false.
4110 do m=1,num_extra_dims
4120 if (lowercase(trim(vars(k)%dim_names(n))) == lowercase(trim(extra_axes(m)%name))) then
4130 use_extra_axis(m) = .true.
4140 dim_found = .true.
4150 exit
416 endif
417 enddo
4180 if (.not.dim_found) call MOM_error(FATAL, "Unable to find a match for dimension "//&
4190 trim(vars(k)%dim_names(n))//" for variable "//trim(vars(k)%name)//" in file "//trim(filename))
420 endif ; enddo
421 enddo
422
4234 if ((use_lath .or. use_lonh .or. use_latq .or. use_lonq)) then
4242 if (.not.domain_set) call MOM_error(FATAL, "create_file: "//&
4250 "An ocean_grid_type or dyn_horgrid_type is required to create a file with a horizontal coordinate.")
426
4272 call get_domain_components(Domain, x_domain, y_domain)
428 endif
4294 if ((use_layer .or. use_int) .and. .not.present(GV)) call MOM_error(FATAL, &
4300 "create_file: A vertical grid type is required to create a file with a vertical coordinate.")
431
4324 if (use_lath) &
433 axis_lath = IO_handle%register_axis("lath", units=y_axis_units, longname="Latitude", &
4342 cartesian='Y', domain=y_domain, data=gridLatT(jsg:jeg))
4354 if (use_lonh) &
436 axis_lonh = IO_handle%register_axis("lonh", units=x_axis_units, longname="Longitude", &
4372 cartesian='X', domain=x_domain, data=gridLonT(isg:ieg))
4384 if (use_latq) &
439 axis_latq = IO_handle%register_axis("latq", units=y_axis_units, longname="Latitude", &
4402 cartesian='Y', domain=y_domain, data=gridLatB(JsgB:JegB), edge_axis=.true.)
4414 if (use_lonq) &
442 axis_lonq = IO_handle%register_axis("lonq", units=x_axis_units, longname="Longitude", &
4432 cartesian='X', domain=x_domain, data=gridLonB(IsgB:IegB), edge_axis=.true.)
4444 if (use_layer) &
445 axis_layer = IO_handle%register_axis("Layer", units=trim(GV%zAxisUnits), &
446 longname="Layer "//trim(GV%zAxisLongName), cartesian='Z', &
4474 sense=1, data=GV%sLayer(1:GV%ke))
4484 if (use_int) &
449 axis_int = IO_handle%register_axis("Interface", units=trim(GV%zAxisUnits), &
450 longname="Interface "//trim(GV%zAxisLongName), cartesian='Z', &
4514 sense=1, data=GV%sInterface(1:GV%ke+1))
452
4534 if (use_time) then ; if (present(timeunit)) then
454 ! Set appropriate units, depending on the value.
4551 if (timeunit < 0.0) then
4560 time_units = "days" ! The default value.
4571 elseif ((timeunit >= 0.99) .and. (timeunit < 1.01)) then
4580 time_units = "seconds"
4591 elseif ((timeunit >= 3599.0) .and. (timeunit < 3601.0)) then
4600 time_units = "hours"
4611 elseif ((timeunit >= 86399.0) .and. (timeunit < 86401.0)) then
4621 time_units = "days"
4630 elseif ((timeunit >= 3.0e7) .and. (timeunit < 3.2e7)) then
4640 time_units = "years"
465 else
4660 write(time_units,'(es8.2," s")') timeunit
467 endif
468
4691 axis_time = IO_handle%register_axis("Time", units=time_units, longname="Time", cartesian='T')
470 else
4712 axis_time = IO_handle%register_axis("Time", units="days", longname="Time", cartesian='T')
472 endif ; endif
473
4744 if (use_periodic) then
4750 if (num_periods <= 1) call MOM_error(FATAL, "MOM_io create_file: "//&
4760 "num_periods for file "//trim(filename)//" must be at least 1.")
477 ! Define a periodic axis with unit labels.
4780 allocate(axis_val(num_periods))
4790 do k=1,num_periods ; axis_val(k) = real(k) ; enddo
480 axis_periodic = IO_handle%register_axis("Period", units="nondimensional", &
4810 longname="Periods for cyclical variables", cartesian='T', data=axis_val)
4820 deallocate(axis_val)
483 endif
484
48514 do m=1,num_extra_dims ; if (use_extra_axis(m)) then
4860 if (allocated(extra_axes(m)%ax_data)) then
487 more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, &
488 longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, &
4890 sense=extra_axes(m)%sense, data=extra_axes(m)%ax_data)
4900 elseif (trim(extra_axes(m)%cartesian) == "T") then
491 more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, &
4920 longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian)
493 else
494 ! FMS requires that non-time axes have variables that label their values, even if they are trivial.
4950 allocate (axis_val(extra_axes(m)%ax_size))
4960 do k=1,extra_axes(m)%ax_size ; axis_val(k) = real(k) ; enddo
497 more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, &
498 longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, &
4990 sense=extra_axes(m)%sense, data=axis_val)
5000 deallocate(axis_val)
501 endif
502 endif ; enddo
503
50487 do k=1,novars
50583 numaxes = 0
50683 position = vars(k)%position
50783 if (position == -1) position = position_from_horgrid(vars(k)%hor_grid)
50837 select case (position)
509 case (CENTER)
51037 numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath ; ax_name(1) = "lonh" ; ax_name(2) = "lath"
511 case (CORNER)
5122 numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq ; ax_name(1) = "lonq" ; ax_name(2) = "latq"
513 case (EAST_FACE)
51410 numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath ; ax_name(1) = "lonq" ; ax_name(2) = "lath"
515 case (NORTH_FACE)
51634 numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq ; ax_name(1) = "lonh" ; ax_name(2) = "latq"
517 case (0) ! Do nothing.
518 case default
519 call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//&
52083 " has unrecognized position, hor_grid = "//trim(vars(k)%hor_grid))
521 end select
522110 select case (vars(k)%z_grid)
52327 case ('L') ; numaxes = numaxes+1 ; axes(numaxes) = axis_layer ; ax_name(numaxes) = "Layer"
52456 case ('i') ; numaxes = numaxes+1 ; axes(numaxes) = axis_int ; ax_name(numaxes) = "Interface"
525 case ('1') ! Do nothing.
526 case default
527 call MOM_error(FATAL, "MOM_io create_file: "//trim(vars(k)%name)//&
52883 " has unrecognized z_grid "//trim(vars(k)%z_grid))
529 end select
530
531238 do n=1,numaxes
532155 if ( (len_trim(vars(k)%dim_names(n)) > 0) .and. (trim(ax_name(n)) /= trim(vars(k)%dim_names(n))) ) &
533 call MOM_error(WARNING, "MOM_io create_file: dimension "//trim(ax_name(n))//&
534 " of variable "//trim(vars(k)%name)//" in "//trim(filename)//&
53583 " is being set inconsistently as "//trim(vars(k)%dim_names(n)))
536 enddo
537343 do n=numaxes+1,5 ; if (len_trim(vars(k)%dim_names(n)) > 0) then
5380 dim_found = .false.
5390 do m=1,num_extra_dims
5400 if (lowercase(trim(vars(k)%dim_names(n))) == lowercase(trim(extra_axes(m)%name))) then
5410 numaxes = numaxes+1 ; axes(numaxes) = more_axes(m)
5420 exit
543 endif
544 enddo
545 endif ; enddo
546
54783 t_grid = adjustl(vars(k)%t_grid)
54881 select case (t_grid(1:1))
54981 case ('s', 'a', 'm') ; numaxes = numaxes+1 ; axes(numaxes) = axis_time
5502 case ('p') ; numaxes = numaxes+1 ; axes(numaxes) = axis_periodic
551 case ('1') ! Do nothing.
552 case default
553 call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//&
55483 " has unrecognized t_grid "//trim(vars(k)%t_grid))
555 end select
556
55783 pack = 1
55887 if (present(checksums)) then
559 fields(k) = IO_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, &
56063 vars(k)%longname, pack=pack, checksum=checksums(k,:), conversion=vars(k)%conversion)
561 else
562 fields(k) = IO_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, &
56320 vars(k)%longname, pack=pack, conversion=vars(k)%conversion)
564 endif
565 enddo
566
5674 if (present(global_atts)) then
5680 do n=1,size(global_atts)
5690 if (allocated(global_atts(n)%name) .and. allocated(global_atts(n)%att_val)) &
5700 call IO_handle%write_attribute(global_atts(n)%name, global_atts(n)%att_val)
571 enddo
572 endif
573
574 ! Now write the variables with the axis label values
5754 if (use_lath) call IO_handle%write_field(axis_lath)
5764 if (use_latq) call IO_handle%write_field(axis_latq)
5774 if (use_lonh) call IO_handle%write_field(axis_lonh)
5784 if (use_lonq) call IO_handle%write_field(axis_lonq)
5794 if (use_layer) call IO_handle%write_field(axis_layer)
5804 if (use_int) call IO_handle%write_field(axis_int)
5814 if (use_periodic) call IO_handle%write_field(axis_periodic)
58214 do m=1,num_extra_dims ; if (use_extra_axis(m)) then
5830 call IO_handle%write_field(more_axes(m))
584 endif ; enddo
585
5864 if (num_extra_dims > 0) then
58714 deallocate(use_extra_axis, more_axes)
588 endif
58912end subroutine create_MOM_file
590
591
592!> `reopen_MOM_file` wrapper for the legacy file handle, `file_type`.
593!! NOTE: This function may be removed in a future release.
5940subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, &
5950 timeunit, G, dG, GV, extra_axes, global_atts)
596 type(file_type), intent(inout) :: IO_handle
597 !< Handle for a file or fileset that is to be opened or reopened for
598 !! writing
599 character(len=*), intent(in) :: filename
600 !< full path to the file to create
601 type(vardesc), intent(in) :: vars(:)
602 !< structures describing fields written to filename
603 integer, intent(in) :: novars
604 !< number of fields written to filename
605 type(fieldtype), intent(inout) :: fields(:)
606 !< array of fieldtypes for each variable
607 integer, optional, intent(in) :: threading
608 !< SINGLE_FILE or MULTIPLE
609 real, optional, intent(in) :: timeunit
610 !< length of the units for time [s]. The default value is 86400.0, for 1
611 !! day.
612 type(ocean_grid_type), optional, intent(in) :: G
613 !< ocean horizontal grid structure; G or dG is required if a new file uses
614 !! any horizontal grid axes.
615 type(dyn_horgrid_type), optional, intent(in) :: dG
616 !< dynamic horizontal grid structure; G or dG is required if a new file
617 !! uses any horizontal grid axes.
618 type(verticalGrid_type), optional, intent(in) :: GV
619 !< ocean vertical grid structure, which is required if a new file uses any
620 !! vertical grid axes.
621 type(axis_info), optional, intent(in) :: extra_axes(:)
622 !< Types with information about some axes that might be used in this file
623 type(attribute_info), optional, intent(in) :: global_atts(:)
624 !< Global attributes to write to this file
625
6260 type(MOM_infra_file) :: mfile
627 !< Wrapper to MOM file
6280 type(MOM_field), allocatable :: mfields(:)
629 !< Wrapper to MOM fields
630 integer :: i
631
6320 mfile%handle_infra = IO_handle
6330 allocate(mfields(size(fields)))
634
635 call reopen_MOM_file(mfile, filename, vars, novars, mfields, &
636 threading=threading, timeunit=timeunit, G=G, dG=dG, GV=GV, &
6370 extra_axes=extra_axes, global_atts=global_atts)
638
6390 IO_handle = mfile%handle_infra
6400 call get_file_fields(IO_handle, fields)
6410end subroutine reopen_file
642
643
644!> This routine opens an existing NetCDF file for output. If it
645!! does not find the file, a new file is created. It also sets up
646!! structures that describe this file and the variables that will
647!! later be written to this file.
6480subroutine reopen_MOM_file(IO_handle, filename, vars, novars, fields, &
6490 threading, timeunit, G, dG, GV, extra_axes, global_atts)
650 class(MOM_file), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be
651 !! opened or reopened for writing
652 character(len=*), intent(in) :: filename !< full path to the file to create
653 type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename
654 integer, intent(in) :: novars !< number of fields written to filename
655 type(MOM_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable
656 integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE
657 real, optional, intent(in) :: timeunit !< length of the units for time [s]. The
658 !! default value is 86400.0, for 1 day.
659 type(ocean_grid_type), optional, intent(in) :: G !< ocean horizontal grid structure; G or dG
660 !! is required if a new file uses any
661 !! horizontal grid axes.
662 type(dyn_horgrid_type), optional, intent(in) :: dG !< dynamic horizontal grid structure; G or dG
663 !! is required if a new file uses any
664 !! horizontal grid axes.
665 type(verticalGrid_type), optional, intent(in) :: GV !< ocean vertical grid structure, which is
666 !! required if a new file uses any
667 !! vertical grid axes.
668 type(axis_info), optional, intent(in) :: extra_axes(:) !< Types with information about
669 !! some axes that might be used in this file
670 type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to
671 !! write to this file
672
673 type(MOM_domain_type), pointer :: Domain => NULL()
674 character(len=200) :: check_name, mesg
675 integer :: length, nvar, thread
676 logical :: exists, one_file, domain_set
677
6780 thread = SINGLE_FILE
6790 if (PRESENT(threading)) thread = threading
680
681 ! For single-file IO, only the root PE is required to set up the fields.
682 ! This permits calls by either the root PE or all PEs
6830 if (.not. is_root_PE() .and. thread == SINGLE_FILE) return
684
685 ! For multiple IO domains, we would need additional functionality:
686 ! * Identify ranks as IO PEs
687 ! * Determine the filename of
688 ! Neither of these tasks should be handed by MOM6, so we cannot safely use
689 ! this function. A framework-specific `inquire()` function is needed.
690 ! Until it exists, we will disable this function.
6910 if (thread == MULTIPLE) &
692 call MOM_error(FATAL, 'reopen_MOM_file does not yet support files with ' &
6930 // 'multiple I/O domains.')
694
6950 check_name = filename
6960 length = len(trim(check_name))
6970 if (check_name(length-2:length) /= ".nc") check_name = trim(check_name)//".nc"
6980 if (thread /= SINGLE_FILE) check_name = trim(check_name)//".0000"
699
7000 inquire(file=check_name,EXIST=exists)
701
7020 if (.not.exists) then
703 call create_MOM_file(IO_handle, filename, vars, novars, fields, &
704 threading, timeunit, G=G, dG=dG, GV=GV, extra_axes=extra_axes, &
7050 global_atts=global_atts)
706 else
707
7080 domain_set = .false.
7090 if (present(G)) then
7100 domain_set = .true. ; Domain => G%Domain
7110 elseif (present(dG)) then
7120 domain_set = .true. ; Domain => dG%Domain
713 endif
714
7150 one_file = .true.
7160 if (domain_set) one_file = (thread == SINGLE_FILE)
717
7180 if (one_file) then
7190 call IO_handle%open(filename, APPEND_FILE, threading=thread)
720 else
7210 call IO_handle%open(filename, APPEND_FILE, MOM_domain=Domain)
722 endif
7230 if (.not. IO_handle%file_is_open()) return
724
7250 call IO_handle%get_file_info(nvar=nvar)
726
7270 if (nvar == -1) then
7280 write (mesg,*) "Reopening file ",trim(filename)," apparently had ",nvar,&
7290 " variables. Clobbering and creating file with ",novars," instead."
7300 call MOM_error(WARNING,"MOM_io: "//mesg)
731 call create_MOM_file(IO_handle, filename, vars, novars, fields, &
732 threading, timeunit, G=G, dG=dG, GV=GV, extra_axes=extra_axes, &
7330 global_atts=global_atts)
7340 elseif (nvar /= novars) then
7350 write (mesg,*) "Reopening file ",trim(filename)," with ",novars,&
7360 " variables instead of ",nvar,"."
7370 call MOM_error(FATAL,"MOM_io: "//mesg)
738 endif
739
7400 if (nvar > 0) call IO_handle%get_file_fields(fields(1:nvar))
741 endif
7420end subroutine reopen_MOM_file
743
744
745!> Return the index of sdtout if called from the root PE, or 0 for other PEs.
7460integer function stdout_if_root()
7470 stdout_if_root = 0
7480 if (is_root_PE()) stdout_if_root = stdout
7490end function stdout_if_root
750
751!> This function determines how many time levels a variable has in a file.
7520function num_timelevels(filename, varname, min_dims) result(n_time)
753 character(len=*), intent(in) :: filename !< name of the file to read
754 character(len=*), intent(in) :: varname !< variable whose number of time levels
755 !! are to be returned
756 integer, optional, intent(in) :: min_dims !< The minimum number of dimensions a variable must have
757 !! if it has a time dimension. If the variable has 1 less
758 !! dimension than this, then 0 is returned.
759 integer :: n_time !< number of time levels varname has in filename
760
761 character(len=256) :: msg
762 integer :: ndims
763 integer :: sizes(8)
764
7650 n_time = -1
766
767 ! To do almost the same via MOM_io_infra calls, we could do the following:
768 ! found = field_exists(filename, varname)
769 ! if (found) then
770 ! call open_file(ncid, filename, action=READONLY_FILE, form=NETCDF_FILE, threading=MULTIPLE)
771 ! call get_file_info(ncid, ntime=n_time)
772 ! endif
773 ! However, this does not handle the case where the time axis for the variable is not the record
774 ! axis and min_dims is not used.
775
7760 call get_var_sizes(filename, varname, ndims, sizes, match_case=.false., caller="num_timelevels")
777
7780 if (ndims > 0) n_time = sizes(ndims)
779
7800 if (present(min_dims)) then
7810 if (ndims < min_dims-1) then
7820 write(msg, '(I0)') min_dims
783 call MOM_error(WARNING, "num_timelevels: variable "//trim(varname)//" in file "//&
7840 trim(filename)//" has fewer than min_dims = "//trim(msg)//" dimensions.")
7850 n_time = -1
7860 elseif (ndims == min_dims - 1) then
7870 n_time = 0
788 endif
789 endif
790
7910end function num_timelevels
792
793
794!> get_var_sizes returns the number and size of dimensions associate with a variable in a file.
795!! Usually only the root PE does the read, and then the information is broadcast
7960subroutine get_var_sizes(filename, varname, ndims, sizes, match_case, caller, all_read, dim_names, ncid_in)
797 character(len=*), intent(in) :: filename !< Name of the file to read, used here in messages
798 character(len=*), intent(in) :: varname !< The variable name, used here for messages
799 integer, intent(out) :: ndims !< The number of dimensions to the variable
800 integer, dimension(:), intent(out) :: sizes !< The dimension sizes, or 0 for extra values
801 logical, optional, intent(in) :: match_case !< If false, allow for variables name matches to be
802 !! case insensitive, but take a perfect match if
803 !! found. The default is true.
804 character(len=*), optional, intent(in) :: caller !< The name of a calling routine for use in error messages
805 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
806 !! routine actually do the read, otherwise only
807 !! root PE reads and then it broadcasts the results.
808 character(len=*), dimension(:), &
809 optional, intent(out) :: dim_names !< The names of the dimensions for this variable
810 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
811 !! file is opened and closed within this routine.
812
813 logical :: do_read, do_broadcast
8140 integer, allocatable :: size_msg(:) ! An array combining the number of dimensions and the sizes.
815 integer :: n, nval
816
8170 do_read = is_root_pe()
8180 if (present(all_read)) do_read = all_read .or. do_read
8190 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
820
8210 if (do_read) call read_var_sizes(filename, varname, ndims, sizes, match_case, caller, dim_names, ncid_in)
822
8230 if (do_broadcast) then
824 ! Distribute the sizes from the root PE.
8250 nval = size(sizes) + 1
826
8270 allocate(size_msg(nval))
8280 size_msg(1) = ndims
8290 do n=2,nval ; size_msg(n) = sizes(n-1) ; enddo
830
8310 call broadcast(size_msg, nval, blocking=.true.)
832
8330 ndims = size_msg(1)
8340 do n=2,nval ; sizes(n-1) = size_msg(n) ; enddo
8350 deallocate(size_msg)
836
8370 if (present(dim_names) .and. (ndims > 0)) then
8380 nval = min(ndims, size(dim_names))
8390 call broadcast(dim_names(1:nval), len(dim_names(1)), blocking=.true.)
840 endif
841 endif
842
8430end subroutine get_var_sizes
844
845!> read_var_sizes returns the number and size of dimensions associated with a variable in a file.
846!! If the variable is not in the file the returned sizes are all 0 and ndims is -1.
847!! Every processor for which this is called does the reading.
8480subroutine read_var_sizes(filename, varname, ndims, sizes, match_case, caller, dim_names, ncid_in)
849 character(len=*), intent(in) :: filename !< Name of the file to read, used here in messages
850 character(len=*), intent(in) :: varname !< The variable name, used here for messages
851 integer, intent(out) :: ndims !< The number of dimensions to the variable
852 integer, dimension(:), intent(out) :: sizes !< The dimension sizes, or 0 for extra values
853 logical, optional, intent(in) :: match_case !< If false, allow for variables name matches to be
854 !! case insensitive, but take a perfect match if
855 !! found. The default is true.
856 character(len=*), &
857 optional, intent(in) :: caller !< The name of a calling routine for use in error messages
858 character(len=*), dimension(:), &
859 optional, intent(out) :: dim_names !< The names of the dimensions for this variable
860 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
861 !! file is opened and closed within this routine.
862
863 character(len=256) :: hdr, dimname
8640 integer, allocatable :: dimids(:)
865 integer :: varid, ncid, n, status
866 logical :: success, found
8670 hdr = "get_var_size: " ; if (present(caller)) hdr = trim(hdr)//": "
8680 sizes(:) = 0 ; ndims = -1
869
8700 if (present(ncid_in)) then
8710 ncid = ncid_in
872 else
8730 call open_file_to_read(filename, ncid, success=success)
8740 if (.not.success) then
8750 call MOM_error(WARNING, "Unsuccessfully attempted to open file "//trim(filename))
8760 return
877 endif
878 endif
879
880 ! Get the dimension sizes of the variable varname.
8810 call get_varid(varname, ncid, filename, varid, match_case=match_case, found=found)
8820 if (.not.found) then
8830 call MOM_error(WARNING, "Could not find variable "//trim(varname)//" in file "//trim(filename))
8840 return
885 endif
886
8870 status = NF90_inquire_variable(ncid, varid, ndims=ndims)
8880 if (status /= NF90_NOERR) then
889 call MOM_error(WARNING, trim(hdr) // trim(NF90_STRERROR(status)) //&
8900 " Getting number of dimensions of "//trim(varname)//" in "//trim(filename))
8910 return
892 endif
8930 if (ndims < 1) return
894
8950 allocate(dimids(ndims))
8960 status = NF90_inquire_variable(ncid, varid, dimids=dimids(1:ndims))
8970 if (status /= NF90_NOERR) then
898 call MOM_error(WARNING, trim(hdr) // trim(NF90_STRERROR(status)) //&
8990 " Getting dimension IDs for "//trim(varname)//" in "//trim(filename))
9000 deallocate(dimids) ; return
901 endif
902
9030 do n = 1, min(ndims,size(sizes))
9040 status = NF90_Inquire_Dimension(ncid, dimids(n), name=dimname, len=sizes(n))
9050 if (status /= NF90_NOERR) call MOM_error(WARNING, trim(hdr) // trim(NF90_STRERROR(status)) //&
9060 " Getting dimension length for "//trim(varname)//" in "//trim(filename))
9070 if (present(dim_names)) then
9080 if (n <= size(dim_names)) dim_names(n) = trim(dimname)
909 endif
910 enddo
9110 deallocate(dimids)
912
9130 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
914
9150end subroutine read_var_sizes
916
917!> Read a real scalar variable from a netCDF file with the root PE, and broadcast the
918!! results to all the other PEs.
9190subroutine read_variable_0d(filename, varname, var, ncid_in, scale)
920 character(len=*), intent(in) :: filename !< The name of the file to read
921 character(len=*), intent(in) :: varname !< The variable name of the data in the file
922 real, intent(inout) :: var !< The scalar into which to read the data in arbitrary units [A ~> a]
923 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
924 !! file is opened and closed within this routine
925 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
926 !! before it is returned to convert from the units in the file
927 !! to the internal units for this variable [A a-1 ~> 1]
928
929 integer :: varid, ncid, rc
930 character(len=256) :: hdr
9310 hdr = "read_variable_0d"
932
9330 if (is_root_pe()) then
9340 if (present(ncid_in)) then
9350 ncid = ncid_in
936 else
9370 call open_file_to_read(filename, ncid)
938 endif
939
9400 call get_varid(varname, ncid, filename, varid, match_case=.false.)
9410 if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//&
9420 " in "//trim(filename))
9430 rc = NF90_get_var(ncid, varid, var)
9440 if (rc /= NF90_NOERR) call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
9450 " Difficulties reading "//trim(varname)//" from "//trim(filename))
946
9470 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
948
9490 if (present(scale)) var = scale * var
950 endif
951
9520 call broadcast(var, blocking=.true.)
9530end subroutine read_variable_0d
954
955!> Read a 1-d real variable from a netCDF file with the root PE, and broadcast the
956!! results to all the other PEs.
9570subroutine read_variable_1d(filename, varname, var, ncid_in, scale)
958 character(len=*), intent(in) :: filename !< The name of the file to read
959 character(len=*), intent(in) :: varname !< The variable name of the data in the file
960 real, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data in arbitrary units [A ~> a]
961 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
962 !! file is opened and closed within this routine
963 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
964 !! before it is returned to convert from the units in the file
965 !! to the internal units for this variable [A a-1 ~> 1]
966
967 integer :: varid, ncid, rc
968 character(len=256) :: hdr
9690 hdr = "read_variable_1d"
970
9710 if (is_root_pe()) then
9720 if (present(ncid_in)) then
9730 ncid = ncid_in
974 else
9750 call open_file_to_read(filename, ncid)
976 endif
977
9780 call get_varid(varname, ncid, filename, varid, match_case=.false.)
9790 if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//&
9800 " in "//trim(filename))
9810 rc = NF90_get_var(ncid, varid, var)
9820 if (rc /= NF90_NOERR) call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
9830 " Difficulties reading "//trim(varname)//" from "//trim(filename))
984
9850 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
986
9870 if (present(scale)) then ; if (scale /= 1.0) then
9880 var(:) = scale * var(:)
989 endif ; endif
990 endif
991
9920 call broadcast(var, size(var), blocking=.true.)
9930end subroutine read_variable_1d
994
995!> Read a integer scalar variable from a netCDF file with the root PE, and broadcast the
996!! results to all the other PEs.
9970subroutine read_variable_0d_int(filename, varname, var, ncid_in)
998 character(len=*), intent(in) :: filename !< The name of the file to read
999 character(len=*), intent(in) :: varname !< The variable name of the data in the file
1000 integer, intent(inout) :: var !< The scalar into which to read the data
1001 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1002 !! file is opened and closed within this routine.
1003
1004 integer :: varid, ncid, rc
1005 character(len=256) :: hdr
10060 hdr = "read_variable_0d_int"
1007
10080 if (is_root_pe()) then
10090 if (present(ncid_in)) then
10100 ncid = ncid_in
1011 else
10120 call open_file_to_read(filename, ncid)
1013 endif
1014
10150 call get_varid(varname, ncid, filename, varid, match_case=.false.)
10160 if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//&
10170 " in "//trim(filename))
10180 rc = NF90_get_var(ncid, varid, var)
10190 if (rc /= NF90_NOERR) call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
10200 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1021
10220 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1023 endif
1024
10250 call broadcast(var, blocking=.true.)
10260end subroutine read_variable_0d_int
1027
1028!> Read a 1-d integer variable from a netCDF file with the root PE, and broadcast the
1029!! results to all the other PEs.
10300subroutine read_variable_1d_int(filename, varname, var, ncid_in)
1031 character(len=*), intent(in) :: filename !< The name of the file to read
1032 character(len=*), intent(in) :: varname !< The variable name of the data in the file
1033 integer, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data
1034 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1035 !! file is opened and closed within this routine.
1036
1037 integer :: varid, ncid, rc
1038 character(len=256) :: hdr
10390 hdr = "read_variable_1d_int"
1040
10410 if (is_root_pe()) then
10420 if (present(ncid_in)) then
10430 ncid = ncid_in
1044 else
10450 call open_file_to_read(filename, ncid)
1046 endif
1047
10480 call get_varid(varname, ncid, filename, varid, match_case=.false.)
10490 if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//&
10500 " in "//trim(filename))
10510 rc = NF90_get_var(ncid, varid, var)
10520 if (rc /= NF90_NOERR) call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
10530 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1054
10550 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1056 endif
1057
10580 call broadcast(var, size(var), blocking=.true.)
10590end subroutine read_variable_1d_int
1060
1061!> Read a 2d array from a netCDF input file and save to a variable.
1062!!
1063!! Start and nread lenths may exceed var rank. This allows for reading slices
1064!! of larger arrays.
1065!!
1066!! Previous versions of the model required a time axis on IO fields. This
1067!! constraint was dropped in later versions. As a result, versions both with
1068!! and without a time axis now exist. In order to support all such versions,
1069!! we use a reshaped version of start and nread in order to read the variable
1070!! as it exists in the file.
1071!!
1072!! Certain constraints are still applied to start and nread in order to ensure
1073!! that varname is a valid 2d array, or contains valid 2d slices.
1074!!
1075!! I/O occurs only on the root PE, and data is broadcast to other ranks.
1076!! Due to potentially large memory communication and storage, this subroutine
1077!! should only be used when domain-decomposition is unavaialable.
10780subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in)
1079 character(len=*), intent(in) :: filename !< Name of file to be read
1080 character(len=*), intent(in) :: varname !< Name of variable to be read
1081 real, intent(out) :: var(:,:) !< Output array of variable [arbitrary]
1082 integer, optional, intent(in) :: start(:) !< Starting index on each axis.
1083 integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis
1084 integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file.
1085 !! If absent, the file is opened and closed within this routine.
1086
1087 integer :: ncid, varid
1088 integer :: field_ndims, dim_len
10890 integer, allocatable :: field_dimids(:), field_shape(:)
10900 integer, allocatable :: field_start(:), field_nread(:)
1091 integer :: i, rc
1092 character(len=*), parameter :: hdr = "read_variable_2d: "
1093
1094 ! Validate shape of start and nread
10950 if (present(start)) then
10960 if (size(start) < 2) &
1097 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
10980 // " start must have at least two dimensions.")
1099 endif
1100
11010 if (present(nread)) then
11020 if (size(nread) < 2) &
1103 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
11040 // " nread must have at least two dimensions.")
1105
11060 if (any(nread(3:) > 1)) &
1107 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
11080 // " nread may only read a single level in higher dimensions.")
1109 endif
1110
1111 ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure
1112 ! that their lengths are equivalent, and must do it here.
11130 if (present(start) .and. present(nread)) then
11140 if (size(start) /= size(nread)) &
1115 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
11160 // " start and nread must have the same length.")
1117 endif
1118
1119 ! Open and read `varname` from `filename`
11200 if (is_root_pe()) then
11210 if (present(ncid_in)) then
11220 ncid = ncid_in
1123 else
11240 call open_file_to_Read(filename, ncid)
1125 endif
1126
11270 call get_varid(varname, ncid, filename, varid, match_case=.false.)
11280 if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//&
11290 " in "//trim(filename))
1130
1131 ! Query for the dimensionality of the input field
11320 rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims)
11330 if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //&
11340 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1135
1136 ! Confirm that field is at least 2d
11370 if (field_ndims < 2) &
1138 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) // " " // &
11390 trim(varname) // " from " // trim(filename) // " is not a 2D field.")
1140
1141 ! If start and nread are present, then reshape them to match field dims
11420 if (present(start) .or. present(nread)) then
11430 allocate(field_shape(field_ndims))
11440 allocate(field_dimids(field_ndims))
1145
11460 rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids)
11470 if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //&
11480 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1149
11500 do i = 1, field_ndims
11510 rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len)
11520 if (rc /= NF90_NOERR) &
1153 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
11540 // ": Difficulties reading dimensions from " // trim(filename))
11550 field_shape(i) = dim_len
1156 enddo
1157
1158 ! Reshape start(:) and nreads(:) in case ranks differ
11590 allocate(field_start(field_ndims))
11600 field_start(:) = 1
11610 if (present(start)) then
11620 dim_len = min(size(start), size(field_start))
11630 field_start(:dim_len) = start(:dim_len)
1164 endif
1165
11660 allocate(field_nread(field_ndims))
11670 field_nread(:2) = field_shape(:2)
11680 field_nread(3:) = 1
11690 if (present(nread)) field_nread(:2) = nread(:2)
1170
11710 rc = nf90_get_var(ncid, varid, var, field_start, field_nread)
1172
11730 deallocate(field_start)
11740 deallocate(field_nread)
11750 deallocate(field_shape)
11760 deallocate(field_dimids)
1177 else
11780 rc = nf90_get_var(ncid, varid, var)
1179 endif
1180
11810 if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //&
11820 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1183
11840 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1185 endif
1186
11870 call broadcast(var, size(var), blocking=.true.)
11880end subroutine read_variable_2d
1189
1190
11910subroutine read_variable_3d(filename, varname, var, start, nread, ncid_in)
1192 character(len=*), intent(in) :: filename !< Name of file to be read
1193 character(len=*), intent(in) :: varname !< Name of variable to be read
1194 real, intent(out) :: var(:,:,:) !< Output array of variable [arbitrary]
1195 integer, optional, intent(in) :: start(:) !< Starting index on each axis.
1196 integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis
1197 integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file.
1198 !! If absent, the file is opened and closed within this routine.
1199
1200 integer :: ncid, varid
1201 integer :: field_ndims, dim_len
12020 integer, allocatable :: field_dimids(:), field_shape(:)
12030 integer, allocatable :: field_start(:), field_nread(:)
1204 integer :: i, rc
1205 character(len=*), parameter :: hdr = "read_variable_3d: "
1206
1207 ! Validate shape of start and nread
12080 if (present(start)) then
12090 if (size(start) < 2) &
1210 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
12110 // " start must have at least two dimensions.")
1212 endif
1213
12140 if (present(nread)) then
12150 if (size(nread) < 2) &
1216 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
12170 // " nread must have at least two dimensions.")
1218
12190 if (any(nread(3:) > 1)) &
1220 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
12210 // " nread may only read a single level in higher dimensions.")
1222 endif
1223
1224 ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure
1225 ! that their lengths are equivalent, and must do it here.
12260 if (present(start) .and. present(nread)) then
12270 if (size(start) /= size(nread)) &
1228 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
12290 // " start and nread must have the same length.")
1230 endif
1231
1232 ! Open and read `varname` from `filename`
12330 if (is_root_pe()) then
12340 if (present(ncid_in)) then
12350 ncid = ncid_in
1236 else
12370 call open_file_to_Read(filename, ncid)
1238 endif
1239
12400 call get_varid(varname, ncid, filename, varid, match_case=.false.)
12410 if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//&
12420 " in "//trim(filename))
1243
1244 ! Query for the dimensionality of the input field
12450 rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims)
12460 if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //&
12470 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1248
1249 ! Confirm that field is at least 2d
12500 if (field_ndims < 2) &
1251 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) // " " // &
12520 trim(varname) // " from " // trim(filename) // " is not a 2D field.")
1253
1254 ! If start and nread are present, then reshape them to match field dims
12550 if (present(start) .or. present(nread)) then
12560 allocate(field_shape(field_ndims))
12570 allocate(field_dimids(field_ndims))
1258
12590 rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids)
12600 if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //&
12610 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1262
12630 do i = 1, field_ndims
12640 rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len)
12650 if (rc /= NF90_NOERR) &
1266 call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) &
12670 // ": Difficulties reading dimensions from " // trim(filename))
12680 field_shape(i) = dim_len
1269 enddo
1270
1271 ! Reshape start(:) and nreads(:) in case ranks differ
12720 allocate(field_start(field_ndims))
12730 field_start(:) = 1
12740 if (present(start)) then
12750 dim_len = min(size(start), size(field_start))
12760 field_start(:dim_len) = start(:dim_len)
1277 endif
1278
12790 allocate(field_nread(field_ndims))
12800 field_nread(:3) = field_shape(:3)
1281 !field_nread(3:) = 1
12820 if (present(nread)) field_nread(:3) = nread(:3)
1283
12840 rc = nf90_get_var(ncid, varid, var, field_start, field_nread)
1285
12860 deallocate(field_start)
12870 deallocate(field_nread)
12880 deallocate(field_shape)
12890 deallocate(field_dimids)
1290 else
12910 rc = nf90_get_var(ncid, varid, var)
1292 endif
1293
12940 if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //&
12950 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1296
12970 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1298 endif
1299
13000 call broadcast(var, size(var), blocking=.true.)
13010end subroutine read_variable_3d
1302
1303!> Read a character-string global or variable attribute
13040subroutine read_attribute_str(filename, attname, att_val, varname, found, all_read, ncid_in)
1305 character(len=*), intent(in) :: filename !< Name of the file to read
1306 character(len=*), intent(in) :: attname !< Name of the attribute to read
1307 character(:), allocatable, intent(out) :: att_val !< The value of the attribute
1308 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1309 !! be read. If missing, read a global attribute.
1310 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1311 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1312 !! routine actually do the read, otherwise only
1313 !! root PE reads and then broadcasts the results.
1314 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1315 !! file is opened and closed within this routine.
1316
1317 logical :: do_read, do_broadcast
1318 integer :: rc, ncid, varid, att_type, att_len, info(2)
1319 character(len=256) :: hdr, att_str
13200 character(len=:), dimension(:), allocatable :: tmp_str
13210 hdr = "read_attribute_str"
13220 att_len = 0
1323
13240 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
13250 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1326
13270 if (do_read) then
13280 if (present(ncid_in)) then
13290 ncid = ncid_in
1330 else
13310 call open_file_to_read(filename, ncid, success=found)
13320 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1333 endif
1334 endif
1335
13360 if (do_read) then
13370 rc = NF90_ENOTATT ; att_len = 0
13380 if (present(varname)) then ! Read a variable attribute
13390 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
13400 att_str = "att "//trim(attname)//" for "//trim(varname)//" from "//trim(filename)
1341 else ! Read a global attribute
13420 varid = NF90_GLOBAL
13430 att_str = "global att "//trim(attname)//" from "//trim(filename)
1344 endif
13450 if ((varid > 0) .or. (varid == NF90_GLOBAL)) then ! The named variable does exist, and found would be true.
13460 rc = NF90_inquire_attribute(ncid, varid, attname, xtype=att_type, len=att_len)
13470 if ((.not. present(found)) .or. (rc /= NF90_ENOTATT)) then
13480 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
13490 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //" Error getting info for "//trim(att_str))
13500 if (att_type /= NF90_CHAR) &
13510 call MOM_error(FATAL, trim(hdr)//": Attribute data type is not a char for "//trim(att_str))
1352 ! if (att_len > len(att_val)) &
1353 ! call MOM_error(FATAL, trim(hdr)//": Insufficiently long string passed in to read "//trim(att_str))
13540 allocate(character(att_len) :: att_val)
1355
13560 if (rc == NF90_NOERR) then
13570 rc = NF90_get_att(ncid, varid, attname, att_val)
13580 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
13590 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //" Difficulties reading "//trim(att_str))
1360 endif
1361 endif
1362 endif
13630 if (present(found)) found = (rc == NF90_NOERR)
1364
13650 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1366 endif
1367
13680 if (do_broadcast) then
1369 ! Communicate the string length
13700 info(1) = att_len ; info(2) = 0 ; if (do_read .and. found) info(2) = 1
13710 call broadcast(info, 2, blocking=.true.)
13720 if (present(found)) then
13730 found = (info(2) /= 0)
13740 if (.not. found) return
1375 endif
13760 att_len = info(1)
1377
13780 if (att_len > 0) then
1379 ! These extra copies are here because broadcast only supports arrays of strings.
13800 allocate(character(att_len) :: tmp_str(1))
13810 if (.not.do_read) allocate(character(att_len) :: att_val)
13820 if (do_read) tmp_str(1) = att_val
13830 call broadcast(tmp_str, att_len, blocking=.true.)
13840 att_val = tmp_str(1)
13850 elseif (.not.allocated(att_val)) then
13860 allocate(character(4) :: att_val) ; att_val = ''
1387 endif
13880 elseif (.not.allocated(att_val)) then
13890 allocate(character(4) :: att_val) ; att_val = ''
1390 endif
13910end subroutine read_attribute_str
1392
1393
1394!> Read a 32-bit integer global or variable attribute
13950subroutine read_attribute_int32(filename, attname, att_val, varname, found, all_read, ncid_in)
1396 character(len=*), intent(in) :: filename !< Name of the file to read
1397 character(len=*), intent(in) :: attname !< Name of the attribute to read
1398 integer(kind=int32), intent(out) :: att_val !< The value of the attribute
1399 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1400 !! be read. If missing, read a global attribute.
1401 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1402 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1403 !! routine actually do the read, otherwise only
1404 !! root PE reads and then broadcasts the results.
1405 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1406 !! file is opened and closed within this routine.
1407
1408 logical :: do_read, do_broadcast
1409 integer :: rc, ncid, varid, is_found
1410 character(len=256) :: hdr
14110 hdr = "read_attribute_int32"
14120 att_val = 0
1413
14140 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
14150 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1416
14170 if (do_read) then
14180 if (present(ncid_in)) then
14190 ncid = ncid_in
1420 else
14210 call open_file_to_read(filename, ncid, success=found)
14220 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1423 endif
1424 endif
1425
14260 if (do_read) then
14270 rc = NF90_ENOTATT
14280 if (present(varname)) then ! Read a variable attribute
14290 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
14300 if (varid >= 0) then ! The named variable does exist, and found would be true.
14310 rc = NF90_get_att(ncid, varid, attname, att_val)
14320 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
1433 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //" Difficulties reading att "//&
14340 trim(attname)//" for "//trim(varname)//" from "//trim(filename))
1435 endif
1436 else ! Read a global attribute
14370 rc = NF90_get_att(ncid, NF90_GLOBAL, attname, att_val)
14380 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
1439 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
14400 " Difficulties reading global att "//trim(attname)//" from "//trim(filename))
1441 endif
14420 if (present(found)) found = (rc == NF90_NOERR)
1443
14440 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1445 endif
1446
14470 if (do_broadcast) then
14480 if (present(found)) then
14490 is_found = 0 ; if (is_root_pe() .and. found) is_found = 1
14500 call broadcast(is_found, blocking=.false.)
1451 endif
14520 call broadcast(att_val, blocking=.true.)
14530 if (present(found)) found = (is_found /= 0)
1454 endif
1455
14560end subroutine read_attribute_int32
1457
1458
1459!> Read a 64-bit integer global or variable attribute
14600subroutine read_attribute_int64(filename, attname, att_val, varname, found, all_read, ncid_in)
1461 character(len=*), intent(in) :: filename !< Name of the file to read
1462 character(len=*), intent(in) :: attname !< Name of the attribute to read
1463 integer(kind=int64), intent(out) :: att_val !< The value of the attribute
1464 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1465 !! be read. If missing, read a global attribute.
1466 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1467 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1468 !! routine actually do the read, otherwise only
1469 !! root PE reads and then broadcasts the results.
1470 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1471 !! file is opened and closed within this routine.
1472
1473 logical :: do_read, do_broadcast
1474 integer :: rc, ncid, varid, is_found
1475 character(len=256) :: hdr
14760 hdr = "read_attribute_int64"
14770 att_val = 0
1478
14790 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
14800 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1481
14820 if (do_read) then
14830 if (present(ncid_in)) then
14840 ncid = ncid_in
1485 else
14860 call open_file_to_read(filename, ncid, success=found)
14870 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1488 endif
1489 endif
1490
14910 if (do_read) then
14920 rc = NF90_ENOTATT
14930 if (present(varname)) then ! Read a variable attribute
14940 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
14950 if (varid >= 0) then ! The named variable does exist, and found would be true.
14960 rc = NF90_get_att(ncid, varid, attname, att_val)
14970 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
1498 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //" Difficulties reading att "//&
14990 trim(attname)//" for "//trim(varname)//" from "//trim(filename))
1500 endif
1501 else ! Read a global attribute
15020 rc = NF90_get_att(ncid, NF90_GLOBAL, attname, att_val)
15030 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
1504 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
15050 " Difficulties reading global att "//trim(attname)//" from "//trim(filename))
1506 endif
15070 if (present(found)) found = (rc == NF90_NOERR)
1508
15090 rc = NF90_close(ncid)
1510 endif
1511
15120 if (do_broadcast) then
15130 if (present(found)) then
15140 is_found = 0 ; if (is_root_pe() .and. found) is_found = 1
15150 call broadcast(is_found, blocking=.false.)
1516 endif
15170 call broadcast(att_val, blocking=.true.)
15180 if (present(found)) found = (is_found /= 0)
1519 endif
1520
15210end subroutine read_attribute_int64
1522
1523!> Read a real global or variable attribute
15240subroutine read_attribute_real(filename, attname, att_val, varname, found, all_read, ncid_in)
1525 character(len=*), intent(in) :: filename !< Name of the file to read
1526 character(len=*), intent(in) :: attname !< Name of the attribute to read
1527 real, intent(out) :: att_val !< The value of the attribute [arbitrary]
1528 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1529 !! be read. If missing, read a global attribute.
1530 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1531 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1532 !! routine actually do the read, otherwise only
1533 !! root PE reads and then broadcasts the results.
1534 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1535 !! file is opened and closed within this routine.
1536
1537 logical :: do_read, do_broadcast
1538 integer :: rc, ncid, varid, is_found
1539 character(len=256) :: hdr
15400 hdr = "read_attribute_real"
15410 att_val = 0.0
1542
15430 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
15440 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1545
15460 if (do_read) then
15470 if (present(ncid_in)) then
15480 ncid = ncid_in
1549 else
15500 call open_file_to_read(filename, ncid, success=found)
15510 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1552 endif
1553 endif
1554
15550 if (do_read) then
15560 rc = NF90_ENOTATT
15570 if (present(varname)) then ! Read a variable attribute
15580 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
15590 if (varid >= 0) then ! The named variable does exist, and found would be true.
15600 rc = NF90_get_att(ncid, varid, attname, att_val)
15610 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
1562 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //" Difficulties reading att "//&
15630 trim(attname)//" for "//trim(varname)//" from "//trim(filename))
1564 endif
1565 else ! Read a global attribute
15660 rc = NF90_get_att(ncid, NF90_GLOBAL, attname, att_val)
15670 if ((rc /= NF90_NOERR) .and. (rc /= NF90_ENOTATT)) &
1568 call MOM_error(FATAL, trim(hdr) // trim(NF90_STRERROR(rc)) //&
15690 " Difficulties reading global att "//trim(attname)//" from "//trim(filename))
1570 endif
15710 if (present(found)) found = (rc == NF90_NOERR)
1572
15730 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1574 endif
1575
15760 if (do_broadcast) then
15770 if (present(found)) then
15780 is_found = 0 ; if (is_root_pe() .and. found) is_found = 1
15790 call broadcast(is_found, blocking=.false.)
1580 endif
15810 call broadcast(att_val, blocking=.true.)
15820 if (present(found)) found = (is_found /= 0)
1583 endif
1584
15850end subroutine read_attribute_real
1586
1587!> Open a netcdf file for reading, with error handling
15880subroutine open_file_to_read(filename, ncid, success)
1589 character(len=*), intent(in) :: filename !< path and name of the file to open for reading
1590 integer, intent(out) :: ncid !< The netcdf handle for the file
1591 logical, optional, intent(out) :: success !< Returns true if the file was opened, or if this
1592 !! argument is not present, failure is fatal error.
1593 ! Local variables
1594 integer rc
1595
15960 rc = NF90_open(trim(filename), NF90_NOWRITE, ncid)
15970 if (present(success)) then
15980 success = (rc == NF90_NOERR)
15990 elseif (rc /= NF90_NOERR) then
16000 call MOM_error(FATAL, "Difficulties opening "//trim(filename)//" - "//trim(NF90_STRERROR(rc)) )
1601 endif
1602
16030end subroutine open_file_to_read
1604
1605!> Close a netcdf file that had been opened for reading, with error handling
16060subroutine close_file_to_read(ncid, filename)
1607 integer, intent(inout) :: ncid !< The netcdf handle for the file to close
1608 character(len=*), optional, intent(in) :: filename !< path and name of the file to close
1609 integer :: rc
16100 if (ncid >= 0) then
16110 rc = NF90_close(ncid)
16120 if (present(filename) .and. (rc /= NF90_NOERR)) then
16130 call MOM_error(WARNING, "Difficulties closing "//trim(filename)//": "//trim(NF90_STRERROR(rc)))
16140 elseif (rc /= NF90_NOERR) then
16150 call MOM_error(WARNING, "Difficulties closing file: "//trim(NF90_STRERROR(rc)))
1616 endif
1617 endif
16180 ncid = -1
16190end subroutine close_file_to_read
1620
1621!> get_varid finds the netcdf handle for the potentially case-insensitive variable name in a file
16220subroutine get_varid(varname, ncid, filename, varid, match_case, found)
1623 character(len=*), intent(in) :: varname !< The name of the variable that is being sought
1624 integer, intent(in) :: ncid !< The open netcdf handle for the file
1625 character(len=*), intent(in) :: filename !< name of the file to read, used here in messages
1626 integer, intent(out) :: varid !< The netcdf handle for the variable
1627 logical, optional, intent(in) :: match_case !< If false, allow for variables name matches to be
1628 !! case insensitive, but take a perfect match if
1629 !! found. The default is true.
1630 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1631
1632 logical :: var_found, insensitive
1633 character(len=256) :: name
16340 integer, allocatable :: varids(:)
1635 integer :: nvars, status, n
1636
16370 varid = -1
16380 var_found = .false.
16390 insensitive = .false. ; if (present(match_case)) insensitive = .not.match_case
1640
16410 if (insensitive) then
1642 ! This code ounddoes a case-insensitive search for a variable in the file.
16430 status = NF90_inquire(ncid, nVariables=nvars)
16440 if (present(found) .and. ((status /= NF90_NOERR) .or. (nvars < 1))) then
16450 found = .false. ; return
16460 elseif (status /= NF90_NOERR) then
1647 call MOM_error(FATAL, "get_varid: Difficulties getting the number of variables in file "//&
16480 trim(filename)//" - "//trim(NF90_STRERROR(status)))
16490 elseif (nvars < 1) then
16500 call MOM_error(FATAL, "get_varid: There appear not to be any variables in "//trim(filename))
1651 endif
1652
16530 allocate(varids(nvars))
1654
16550 status = nf90_inq_varids(ncid, nvars, varids)
16560 if (status /= NF90_NOERR) then
1657 call MOM_error(WARNING, "get_varid: Difficulties getting the variable IDs in file "//&
16580 trim(filename)//" - "//trim(NF90_STRERROR(status)))
16590 nvars = -1 ! Full error handling will occur after the do-loop.
1660 endif
1661
16620 do n = 1,nvars
16630 status = nf90_inquire_variable(ncid, varids(n), name=name)
16640 if (status /= NF90_NOERR) then
1665 call MOM_error(WARNING, "get_varid: Difficulties getting a variable name in file "//&
16660 trim(filename)//" - "//trim(NF90_STRERROR(status)))
1667 endif
1668
16690 if (trim(lowercase(name)) == trim(lowercase(varname))) then
16700 if (var_found) then
1671 call MOM_error(WARNING, "get_varid: Two variables match the case-insensitive name "//&
16720 trim(varname)//" in file "//trim(filename))
1673 ! Replace the first variable if the second one is a case-sensitive match
16740 if (trim(name) == trim(varname)) varid = varids(n)
1675 else
16760 varid = varids(n) ; var_found = .true.
1677 endif
1678 endif
1679 enddo
16800 if (present(found)) found = var_found
16810 if ((.not.var_found) .and. .not.present(found)) call MOM_error(FATAL, &
16820 "get_varid: variable "//trim(varname)//" was not found in file "//trim(filename))
1683
16840 deallocate(varids)
1685 else
16860 status = NF90_INQ_VARID(ncid, trim(varname), varid)
16870 if (present(found)) found = (status == NF90_NOERR)
16880 if ((status /= NF90_NOERR) .and. .not.present(found)) then
1689 call MOM_error(FATAL, "get_varid: Difficulties getting a variable id for "//&
16900 trim(varname)//" in file "//trim(filename)//" - "//trim(NF90_STRERROR(status)))
1691 endif
1692 endif
1693
16940end subroutine get_varid
1695
1696!> Verify that a file contains a named variable with the expected units.
16970subroutine verify_variable_units(filename, varname, expected_units, msg, ierr, alt_units)
1698 character(len=*), intent(in) :: filename !< File name
1699 character(len=*), intent(in) :: varname !< Variable name
1700 character(len=*), intent(in) :: expected_units !< Expected units of variable
1701 character(len=*), intent(inout) :: msg !< Message to use for errors
1702 logical, intent(out) :: ierr !< True if an error occurs
1703 character(len=*), optional, intent(in) :: alt_units !< Alterate acceptable units of variable
1704
1705 ! Local variables
1706 character (len=200) :: units
1707 logical :: units_correct, success
1708 integer :: i, ncid, status, vid
1709
17100 if (.not.is_root_pe()) then ! Only the root PE should do the verification.
17110 ierr = .false. ; msg = '' ; return
1712 endif
1713
17140 ierr = .true.
17150 call open_file_to_read(filename, ncid, success)
17160 if (.not.success) then
17170 msg = 'File not found: '//trim(filename)
17180 return
1719 endif
1720
17210 status = NF90_INQ_VARID(ncid, trim(varname), vid)
17220 if (status /= NF90_NOERR) then
17230 msg = 'Var not found: '//trim(varname)
1724 else
17250 status = NF90_GET_ATT(ncid, vid, "units", units)
17260 if (status /= NF90_NOERR) then
17270 msg = 'Attribute not found: units'
1728 else
1729 ! NF90_GET_ATT can return attributes with null characters, which TRIM will not truncate.
1730 ! This loop replaces any null characters with a space so that the subsequent check
1731 ! between the read units and the expected units will pass
17320 do i=1,LEN_TRIM(units)
17330 if (units(i:i) == CHAR(0)) units(i:i) = " "
1734 enddo
1735
17360 units_correct = (trim(units) == trim(expected_units))
17370 if (present(alt_units)) then
17380 units_correct = units_correct .or. (trim(units) == trim(alt_units))
1739 endif
17400 if (units_correct) then
17410 ierr = .false.
17420 msg = ''
1743 else
17440 msg = 'Units incorrect: '//trim(units)//' /= '//trim(expected_units)
1745 endif
1746 endif
1747 endif
1748
17490 status = NF90_close(ncid)
1750
17510end subroutine verify_variable_units
1752
1753!> Returns a vardesc type whose elements have been filled with the provided
1754!! fields. The argument name is required, while the others are optional and
1755!! have default values that are empty strings or are appropriate for a 3-d
1756!! tracer field at the tracer cell centers.
175791function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, &
175891 cmor_units, cmor_longname, conversion, caller, position, dim_names, &
175991 extra_axes, fixed) result(vd)
1760 character(len=*), intent(in) :: name !< variable name
1761 character(len=*), optional, intent(in) :: units !< variable units
1762 character(len=*), optional, intent(in) :: longname !< variable long name
1763 character(len=*), optional, intent(in) :: hor_grid !< A character string indicating the horizontal
1764 !! position of this variable
1765 character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering
1766 character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1
1767 character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name
1768 character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable
1769 character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name
1770 real , optional, intent(in) :: conversion !< for unit conversions, such as needed to
1771 !! convert from intensive to extensive
1772 !! [various] or [a A-1 ~> 1]
1773 character(len=*), optional, intent(in) :: caller !< The calling routine for error messages
1774 integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position
1775 !! of this variable if it has such dimensions.
1776 !! Valid values include CORNER, CENTER, EAST_FACE
1777 !! NORTH_FACE, and 0 for no horizontal dimensions.
1778 character(len=*), dimension(:), &
1779 optional, intent(in) :: dim_names !< The names of the dimensions of this variable
1780 type(axis_info), dimension(:), &
1781 optional, intent(in) :: extra_axes !< dimensions other than space-time
1782 logical, optional, intent(in) :: fixed !< If true, this does not evolve with time
1783 type(vardesc) :: vd !< vardesc type that is created
1784
1785 character(len=120) :: cllr
178691 cllr = "var_desc"
178791 if (present(caller)) cllr = trim(caller)
1788
178991 call safe_string_copy(name, vd%name, "vd%name", cllr)
1790
179191 vd%longname = "" ; vd%units = ""
179291 vd%hor_grid = 'h' ; vd%position = CENTER ; vd%z_grid = 'L' ; vd%t_grid = 's'
179391 if (present(dim_names)) vd%z_grid = '1' ! In this case the names are used to set the non-horizontal axes
179491 if (present(fixed)) then ; if (fixed) vd%t_grid = '1' ; endif
1795
179691 vd%cmor_field_name = ""
179791 vd%cmor_units = ""
179891 vd%cmor_longname = ""
179991 vd%conversion = 1.0
1800546 vd%dim_names(:) = ""
1801
1802 call modify_vardesc(vd, units=units, longname=longname, hor_grid=hor_grid, &
1803 z_grid=z_grid, t_grid=t_grid, position=position, dim_names=dim_names, &
1804 cmor_field_name=cmor_field_name, cmor_units=cmor_units, &
1805 cmor_longname=cmor_longname, conversion=conversion, caller=cllr, &
180691 extra_axes=extra_axes)
1807
1808637end function var_desc
1809
1810
1811!> This routine modifies the named elements of a vardesc type.
1812!! All arguments are optional, except the vardesc type to be modified.
181393subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
181493 cmor_field_name, cmor_units, cmor_longname, conversion, caller, position, dim_names, &
181593 extra_axes)
1816 type(vardesc), intent(inout) :: vd !< vardesc type that is modified
1817 character(len=*), optional, intent(in) :: name !< name of variable
1818 character(len=*), optional, intent(in) :: units !< units of variable
1819 character(len=*), optional, intent(in) :: longname !< long name of variable
1820 character(len=*), optional, intent(in) :: hor_grid !< horizontal staggering of variable
1821 character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable
1822 character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1
1823 character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name
1824 character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable
1825 character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name
1826 real , optional, intent(in) :: conversion !< A multiplicative factor for unit conversions,
1827 !! such as needed to convert from intensive to
1828 !! extensive or dimensional consistency testing
1829 !! [various] or [a A-1 ~> 1]
1830 character(len=*), optional, intent(in) :: caller !< The calling routine for error messages
1831 integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position
1832 !! of this variable if it has such dimensions.
1833 !! Valid values include CORNER, CENTER, EAST_FACE
1834 !! NORTH_FACE, and 0 for no horizontal dimensions.
1835 character(len=*), dimension(:), &
1836 optional, intent(in) :: dim_names !< The names of the dimensions of this variable
1837 type(axis_info), dimension(:), &
1838 optional, intent(in) :: extra_axes !< dimensions other than space-time
1839
1840 character(len=120) :: cllr
1841 integer :: n
1842
184393 cllr = "mod_vardesc" ; if (present(caller)) cllr = trim(caller)
1844
184593 if (present(name)) call safe_string_copy(name, vd%name, "vd%name", cllr)
1846
184793 if (present(longname)) call safe_string_copy(longname, vd%longname, &
184891 "vd%longname of "//trim(vd%name), cllr)
184993 if (present(units)) call safe_string_copy(units, vd%units, &
185091 "vd%units of "//trim(vd%name), cllr)
185193 if (present(position)) then
18520 vd%position = position
18530 select case (position)
18540 case (CENTER) ; vd%hor_grid = 'T'
18550 case (CORNER) ; vd%hor_grid = 'Bu'
18560 case (EAST_FACE) ; vd%hor_grid = 'Cu'
18570 case (NORTH_FACE) ; vd%hor_grid = 'Cv'
18580 case (0) ; vd%hor_grid = '1'
1859 case default
18600 call MOM_error(FATAL, "modify_vardesc: "//trim(vd%name)//" has unrecognized position argument")
1861 end select
1862 endif
186393 if (present(hor_grid)) then
186469 call safe_string_copy(hor_grid, vd%hor_grid, "vd%hor_grid of "//trim(vd%name), cllr)
186569 vd%position = position_from_horgrid(vd%hor_grid)
186669 if (present(caller) .and. (vd%position == -1)) then
1867 call MOM_error(FATAL, "modify_vardesc called by "//trim(caller)//": "//trim(vd%name)//&
18680 " has an unrecognized hor_grid argument "//trim(vd%hor_grid))
186969 elseif (vd%position == -1) then
18700 call MOM_error(FATAL, "modify_vardesc called with bad hor_grid argument "//trim(vd%hor_grid))
1871 endif
1872 endif
187393 if (present(z_grid)) call safe_string_copy(z_grid, vd%z_grid, &
187482 "vd%z_grid of "//trim(vd%name), cllr)
187593 if (present(t_grid)) call safe_string_copy(t_grid, vd%t_grid, &
18764 "vd%t_grid of "//trim(vd%name), cllr)
1877
187893 if (present(cmor_field_name)) call safe_string_copy(cmor_field_name, vd%cmor_field_name, &
18793 "vd%cmor_field_name of "//trim(vd%name), cllr)
188093 if (present(cmor_units)) call safe_string_copy(cmor_units, vd%cmor_units, &
18810 "vd%cmor_units of "//trim(vd%name), cllr)
188293 if (present(cmor_longname)) call safe_string_copy(cmor_longname, vd%cmor_longname, &
18832 "vd%cmor_longname of "//trim(vd%name), cllr)
1884
188593 if (present(conversion)) vd%conversion = conversion
1886
188793 if (present(dim_names)) then
18880 do n=1,min(5,size(dim_names)) ; if (len_trim(dim_names(n)) > 0) then
18890 call safe_string_copy(dim_names(n), vd%dim_names(n), "vd%dim_names of "//trim(vd%name), cllr)
1890 endif ; enddo
1891 endif
1892
189393 if (present(extra_axes)) then
18940 do n=1,size(extra_axes) ; if (len_trim(extra_axes(n)%name) > 0) then
18950 vd%extra_axes(n) = extra_axes(n)
1896 endif ; enddo
1897 endif
1898
189993end subroutine modify_vardesc
1900
190169integer function position_from_horgrid(hor_grid)
1902 character(len=*), intent(in) :: hor_grid !< horizontal staggering of variable
1903
190469 select case (trim(hor_grid))
19050 case ('h') ; position_from_horgrid = CENTER
19060 case ('q') ; position_from_horgrid = CORNER
19074 case ('u') ; position_from_horgrid = EAST_FACE
19084 case ('v') ; position_from_horgrid = NORTH_FACE
19090 case ('T') ; position_from_horgrid = CENTER
19101 case ('Bu') ; position_from_horgrid = CORNER
19111 case ('Cu') ; position_from_horgrid = EAST_FACE
19121 case ('Cv') ; position_from_horgrid = NORTH_FACE
191358 case ('1') ; position_from_horgrid = 0
1914138 case default ; position_from_horgrid = -1 ! This is a bad-value flag.
1915 end select
1916138end function position_from_horgrid
1917
1918!> Store information that can be used to create an axis in a subsequent call to create_file.
1919315subroutine set_axis_info(axis, name, units, longname, ax_size, ax_data, cartesian, sense)
1920 type(axis_info), intent(inout) :: axis !< A type with information about a named axis
1921 character(len=*), intent(in) :: name !< The name of this axis for use in files
1922 character(len=*), optional, intent(in) :: units !< The units of the axis labels
1923 character(len=*), optional, intent(in) :: longname !< Long name of the axis variable
1924 integer, optional, intent(in) :: ax_size !< The number of elements in this axis
1925 real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis [arbitrary]
1926 character(len=*), optional, intent(in) :: cartesian !< A variable indicating which direction this axis
1927 !! axis corresponds with. Valid values
1928 !! include 'X', 'Y', 'Z', 'T', and 'N' (the default) for none.
1929 integer, optional, intent(in) :: sense !< This is 1 for axes whose values increase upward, or -1
1930 !! if they increase downward. The default, 0, is ignored.
1931
1932315 call safe_string_copy(name, axis%name, "axis%name of "//trim(name), "set_axis_info")
1933 ! Set the default values.
1934315 axis%longname = trim(axis%name) ; axis%units = "" ; axis%cartesian = "N" ; axis%sense = 0
1935
1936315 if (present(longname)) call safe_string_copy(longname, axis%longname, &
19370 "axis%longname of "//trim(name), "set_axis_info")
1938315 if (present(units)) call safe_string_copy(units, axis%units, &
19390 "axis%units of "//trim(name), "set_axis_info")
1940315 if (present(cartesian)) call safe_string_copy(cartesian, axis%cartesian, &
19410 "axis%cartesian of "//trim(name), "set_axis_info")
1942315 if (present(sense)) axis%sense = sense
1943
1944315 if (.not.(present(ax_size) .or. present(ax_data)) ) then
1945 call MOM_error(FATAL, "set_axis_info called for "//trim(name)//&
19460 "without either an ax_size or an ax_data argument.")
1947315 elseif (present(ax_size) .and. present(ax_data)) then
19480 if (size(ax_data) /= ax_size) call MOM_error(FATAL, "set_axis_info called for "//trim(name)//&
19490 "with an inconsistent value of ax_size and size of ax_data.")
1950 endif
1951
1952315 if (present(ax_size)) then
1953315 axis%ax_size = ax_size
1954 else
19550 axis%ax_size = size(ax_data)
1956 endif
1957315 if (present(ax_data)) then
19580 allocate(axis%ax_data(axis%ax_size)) ; axis%ax_data(:) = ax_data(:)
1959 endif
1960
1961315end subroutine set_axis_info
1962
1963!> Delete the information in an array of axis_info types and deallocate memory in them.
19640subroutine delete_axis_info(axes)
1965 type(axis_info), dimension(:), intent(inout) :: axes !< An array with information about named axes
1966
1967 integer :: n
19680 do n=1,size(axes)
19690 axes(n)%name = "" ; axes(n)%longname = "" ; axes(n)%units = "" ; axes(n)%cartesian = "N"
19700 axes(n)%sense = 0 ; axes(n)%ax_size = 0
19710 if (allocated(axes(n)%ax_data)) deallocate(axes(n)%ax_data)
1972 enddo
19730end subroutine delete_axis_info
1974
1975
1976!> Retrieve the information from an axis_info type.
19770subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data)
1978 type(axis_info), intent(in) :: axis !< An axis type
1979 character(len=*), intent(out), optional :: name !< The axis name.
1980 character(len=*), intent(out), optional :: longname !< The axis longname.
1981 character(len=*), intent(out), optional :: units !< The axis units.
1982 character(len=*), intent(out), optional :: cartesian !< The cartesian attribute
1983 !! of the axis [X,Y,Z,T].
1984 integer, intent(out), optional :: ax_size !< The size of the axis.
1985 real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data [arbitrary]
1986
19870 if (present(ax_data)) then
19880 if (allocated(ax_data)) deallocate(ax_data)
19890 allocate(ax_data(axis%ax_size))
19900 ax_data(:) = axis%ax_data
1991 endif
1992
19930 if (present(name)) name = axis%name
19940 if (present(longname)) longname = axis%longname
19950 if (present(units)) units = axis%units
19960 if (present(cartesian)) cartesian = axis%cartesian
19970 if (present(ax_size)) ax_size = axis%ax_size
1998
19990end subroutine get_axis_info
2000
2001!> Store information that can be used to create an attribute in a subsequent call to create_file.
20020subroutine set_attribute_info(attribute, name, str_value)
2003 type(attribute_info), intent(inout) :: attribute !< A type with information about a named attribute
2004 character(len=*), intent(in) :: name !< The name of this attribute for use in files
2005 character(len=*), intent(in) :: str_value !< The value of this attribute
2006
20070 attribute%name = trim(name)
20080 attribute%att_val = trim(str_value)
20090end subroutine set_attribute_info
2010
2011!> Delete the information in an array of attribute_info types and deallocate memory in them.
20120subroutine delete_attribute_info(atts)
2013 type(attribute_info), dimension(:), intent(inout) :: atts !< An array of global attributes
2014
2015 integer :: n
20160 do n=1,size(atts)
20170 if (allocated(atts(n)%name)) deallocate(atts(n)%name)
20180 if (allocated(atts(n)%att_val)) deallocate(atts(n)%att_val)
2019 enddo
20200end subroutine delete_attribute_info
2021
2022
2023!> This function returns the CMOR standard name given a CMOR longname, based on
2024!! the standard pattern of character conversions.
202511function cmor_long_std(longname) result(std_name)
2026 character(len=*), intent(in) :: longname !< The CMOR longname being converted
2027 character(len=len(longname)) :: std_name !< The CMOR standard name generated from longname
2028
2029 integer :: k
2030
203111 std_name = lowercase(longname)
2032
2033798 do k=1, len_trim(std_name)
2034798 if (std_name(k:k) == ' ') std_name(k:k) = '_'
2035 enddo
2036
203711end function cmor_long_std
2038
2039!> This routine queries vardesc
2040861subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
2041 cmor_field_name, cmor_units, cmor_longname, conversion, caller, &
2042168 extra_axes, position, dim_names)
2043 type(vardesc), intent(in) :: vd !< vardesc type that is queried
2044 character(len=*), optional, intent(out) :: name !< name of variable
2045 character(len=*), optional, intent(out) :: units !< units of variable
2046 character(len=*), optional, intent(out) :: longname !< long name of variable
2047 character(len=*), optional, intent(out) :: hor_grid !< horizontal staggering of variable
2048 character(len=*), optional, intent(out) :: z_grid !< verticle staggering of variable
2049 character(len=*), optional, intent(out) :: t_grid !< time description: s, p, or 1
2050 character(len=*), optional, intent(out) :: cmor_field_name !< CMOR name
2051 character(len=*), optional, intent(out) :: cmor_units !< CMOR physical dimensions of variable
2052 character(len=*), optional, intent(out) :: cmor_longname !< CMOR long name
2053 real , optional, intent(out) :: conversion !< for unit conversions, such as needed to
2054 !! convert from intensive to extensive
2055 !! [various] or [a A-1 ~> 1]
2056 character(len=*), optional, intent(in) :: caller !< calling routine?
2057 type(axis_info), dimension(5), &
2058 optional, intent(out) :: extra_axes !< dimensions other than space-time
2059 integer, optional, intent(out) :: position !< A coded integer indicating the horizontal position
2060 !! of this variable if it has such dimensions.
2061 !! Valid values include CORNER, CENTER, EAST_FACE
2062 !! NORTH_FACE, and 0 for no horizontal dimensions.
2063 character(len=*), dimension(:), &
2064 optional, intent(out) :: dim_names !< The names of the dimensions of this variable
2065
2066 integer :: n
2067 integer, parameter :: nmax_extraaxes = 5
2068 character(len=120) :: cllr, varname
2069168 cllr = "mod_vardesc"
2070168 if (present(caller)) cllr = trim(caller)
2071
2072168 if (present(name)) call safe_string_copy(vd%name, name, &
2073103 "vd%name of "//trim(vd%name), cllr)
2074168 if (present(longname)) call safe_string_copy(vd%longname, longname, &
20753 "vd%longname of "//trim(vd%name), cllr)
2076168 if (present(units)) call safe_string_copy(vd%units, units, &
20776 "vd%units of "//trim(vd%name), cllr)
2078168 if (present(hor_grid)) call safe_string_copy(vd%hor_grid, hor_grid, &
20790 "vd%hor_grid of "//trim(vd%name), cllr)
2080168 if (present(z_grid)) call safe_string_copy(vd%z_grid, z_grid, &
208163 "vd%z_grid of "//trim(vd%name), cllr)
2082168 if (present(t_grid)) call safe_string_copy(vd%t_grid, t_grid, &
208365 "vd%t_grid of "//trim(vd%name), cllr)
2084
2085168 if (present(cmor_field_name)) call safe_string_copy(vd%cmor_field_name, cmor_field_name, &
20863 "vd%cmor_field_name of "//trim(vd%name), cllr)
2087168 if (present(cmor_units)) call safe_string_copy(vd%cmor_units, cmor_units, &
20880 "vd%cmor_units of "//trim(vd%name), cllr)
2089168 if (present(cmor_longname)) call safe_string_copy(vd%cmor_longname, cmor_longname, &
20903 "vd%cmor_longname of "//trim(vd%name), cllr)
2091
2092168 if (present(conversion)) conversion = vd%conversion
2093
2094168 if (present(position)) then
2095128 position = vd%position
2096128 if (position == -1) position = position_from_horgrid(vd%hor_grid)
2097 endif
2098168 if (present(dim_names)) then
20990 do n=1,min(5,size(dim_names))
21000 call safe_string_copy(vd%dim_names(n), dim_names(n), "vd%dim_names of "//trim(vd%name), cllr)
2101 enddo
2102 endif
2103
2104168 if (present(extra_axes)) then
2105 ! save_restart expects 5 extra axes (can be empty)
2106378 do n=1, nmax_extraaxes
2107378 if (vd%extra_axes(n)%ax_size>=1) then
21080 extra_axes(n) = vd%extra_axes(n)
2109 else
2110 ! return an empty axis
2111315 write(varname,"('dummy',i1.1)") n
2112315 call set_axis_info(extra_axes(n), name=trim(varname), ax_size=1)
2113 endif
2114 enddo
2115 endif
2116
2117168end subroutine query_vardesc
2118
2119
2120!> Read a scalar from file using infrastructure I/O.
21210subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, &
2122 global_file, file_may_be_4d)
2123 character(len=*), intent(in) :: filename !< Input filename
2124 character(len=*), intent(in) :: fieldname !< Field variable name
2125 real, intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2126 integer, optional, intent(in) :: timelevel !< Time level to read in file
2127 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2128 !! before it is returned to convert from the units in the file
2129 !! to the internal units for this variable [A a-1 ~> 1]
2130 type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2131 logical, optional, intent(in) :: global_file !< If true, read from a single file
2132 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2133 !! as 4d arrays in the file.
2134
2135 call read_field(filename, fieldname, data, &
2136 timelevel=timelevel, scale=scale, MOM_Domain=MOM_Domain, &
21370 global_file=global_file, file_may_be_4d=file_may_be_4d)
21380end subroutine MOM_read_data_0d
2139
2140
2141!> Read a scalar integer from file using infrastructure I/O.
21420subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel)
2143 character(len=*), intent(in) :: filename !< Input filename
2144 character(len=*), intent(in) :: fieldname !< Field variable name
2145 integer, intent(inout) :: data !< Field value
2146 integer, optional, intent(in) :: timelevel !< Time level to read in file
2147
21480 call read_field(filename, fieldname, data, timelevel=timelevel)
21490end subroutine MOM_read_data_0d_int
2150
2151
2152!> Read a 1d array from file using infrastructure I/O.
21530subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, &
2154 global_file, file_may_be_4d)
2155 character(len=*), intent(in) :: filename !< Input filename
2156 character(len=*), intent(in) :: fieldname !< Field variable name
2157 real, dimension(:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2158 integer, optional, intent(in) :: timelevel !< Time level to read in file
2159 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2160 !! before it is returned to convert from the units in the file
2161 !! to the internal units for this variable [A a-1 ~> 1]
2162 type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2163 logical, optional, intent(in) :: global_file !< If true, read from a single file
2164 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2165 !! as 4d arrays in the file.
2166
2167 call read_field(filename, fieldname, data, &
2168 timelevel=timelevel, scale=scale, MOM_Domain=MOM_Domain, &
21690 global_file=global_file, file_may_be_4d=file_may_be_4d)
2170
21710end subroutine MOM_read_data_1d
2172
2173
2174!> Read a 1d integer array from file using infrastructure I/O.
21750subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel)
2176 character(len=*), intent(in) :: filename !< Input filename
2177 character(len=*), intent(in) :: fieldname !< Field variable name
2178 integer, dimension(:), intent(inout) :: data !< Field value
2179 integer, optional, intent(in) :: timelevel !< Time level to read in file
2180
21810 call read_field(filename, fieldname, data, timelevel=timelevel)
21820end subroutine MOM_read_data_1d_int
2183
2184
2185!> Read a 2d array from file using infrastructure I/O.
21860subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, timelevel, position, &
2187 scale, global_file, file_may_be_4d, turns)
2188 character(len=*), intent(in) :: filename !< Input filename
2189 character(len=*), intent(in) :: fieldname !< Field variable name
2190 real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2191 type(MOM_domain_type), target, &
2192 intent(in) :: MOM_Domain !< Model domain decomposition
2193 integer, optional, intent(in) :: timelevel !< Time level to read in file
2194 integer, optional, intent(in) :: position !< Grid positioning flag
2195 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2196 !! before it is returned to convert from the units in the file
2197 !! to the internal units for this variable [A a-1 ~> 1]
2198 logical, optional, intent(in) :: global_file !< If true, read from a single file
2199 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2200 !! as 4d arrays in the file.
2201 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2202 !! the number of turns is taken from MOM_Domain.
2203
2204 ! Local variables
2205 integer :: qturns ! Number of quarter-turns from input to model grid
22060 real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2207 type(MOM_domain_type), pointer :: domain_ptr => NULL() ! Pointer to the unrotated domain for reading
2208
22090 qturns = MOM_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2210
22110 domain_ptr => MOM_Domain
22120 if (associated(MOM_Domain%domain_in) .and. (qturns /= 0)) domain_ptr => MOM_Domain%domain_in
2213
22140 if (qturns == 0) then
2215 call read_field(filename, fieldname, data, MOM_Domain, &
2216 timelevel=timelevel, position=position, scale=scale, &
22170 global_file=global_file, file_may_be_4d=file_may_be_4d)
2218 else
22190 call allocate_rotated_array(data, [1,1], -qturns, data_in)
22200 call rotate_array(data, -qturns, data_in)
2221 call read_field(filename, fieldname, data_in, domain_ptr, &
2222 timelevel=timelevel, position=position, scale=scale, &
22230 global_file=global_file, file_may_be_4d=file_may_be_4d)
22240 call rotate_array(data_in, qturns, data)
22250 deallocate(data_in)
2226 endif
2227
22280end subroutine MOM_read_data_2d
2229
2230
2231!> Read a 2d array (which might have halos) from a file using native netCDF I/O.
22320subroutine read_netCDF_data_2d(filename, fieldname, values, MOM_Domain, &
2233 timelevel, position, rescale, turns)
2234 character(len=*), intent(in) :: filename
2235 !< Input filename
2236 character(len=*), intent(in) :: fieldname
2237 !< Field variable name
2238 real, intent(inout) :: values(:,:)
2239 !< Field values read from the file. It would be intent(out) but for the
2240 !! need to preserve any initialized values in the halo regions.
2241 type(MOM_domain_type), intent(in) :: MOM_Domain
2242 !< Model domain decomposition
2243 integer, optional, intent(in) :: timelevel
2244 !< Time level to read in file
2245 integer, optional, intent(in) :: position
2246 !< Grid positioning flag
2247 real, optional, intent(in) :: rescale
2248 !< Rescale factor, omitting this is the same as setting it to 1.
2249 integer, optional, intent(in) :: turns
2250 !< Number of quarter-turns to rotate the data. If absent the number of turns is taken
2251 !! from MOM_Domain.
2252
2253 integer :: qturns
2254 ! Number of quarter-turns from input to model grid
22550 real, allocatable :: values_in(:,:)
2256 ! Field array on the unrotated input grid
22570 type(MOM_netcdf_file) :: handle
2258 ! netCDF file handle
2259
2260 ! General-purpose IO will require the following arguments, but they are not
2261 ! yet implemented, so we raise an error if they are present.
2262
2263 ! Fields are currently assumed on cell centers, and position is unsupported
22640 if (present(position)) &
22650 call MOM_error(FATAL, 'read_netCDF_data: position is not yet supported.')
2266
2267 ! Timelevels are not yet supported
22680 if (present(timelevel)) &
22690 call MOM_error(FATAL, 'read_netCDF_data: timelevel is not yet supported.')
2270
22710 call handle%open(filename, action=READONLY_FILE, MOM_domain=MOM_domain)
22720 call handle%update()
2273
22740 qturns = MOM_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2275
22760 if (qturns == 0) then
22770 call handle%read(fieldname, values, rescale=rescale)
2278 else
22790 call allocate_rotated_array(values, [1,1], -qturns, values_in)
22800 call rotate_array(values, -qturns, values_in)
22810 call handle%read(fieldname, values_in, rescale=rescale)
22820 call rotate_array(values_in, qturns, values)
22830 deallocate(values_in)
2284 endif
2285
22860 call handle%close()
22870end subroutine read_netCDF_data_2d
2288
2289
2290!> Read a 2d region array from file using infrastructure I/O.
22910subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, &
2292 no_domain, scale, turns)
2293 character(len=*), intent(in) :: filename !< Input filename
2294 character(len=*), intent(in) :: fieldname !< Field variable name
2295 real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2296 integer, dimension(:), intent(in) :: start !< Starting index for each axis.
2297 !! In 2d, start(3:4) must be 1.
2298 integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis.
2299 !! In 2d, nread(3:4) must be 1.
2300 type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2301 logical, optional, intent(in) :: no_domain !< If true, field does not use
2302 !! domain decomposion.
2303 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2304 !! before it is returned to convert from the units in the file
2305 !! to the internal units for this variable [A a-1 ~> 1]
2306 integer, optional, intent(in) :: turns !< Number of quarter turns from
2307 !! input to model grid
2308
2309 integer :: qturns ! Number of quarter turns
23100 real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2311
23120 qturns = 0
23130 if (present(turns)) qturns = modulo(turns, 4)
2314
23150 if (qturns == 0) then
2316 call read_field(filename, fieldname, data, start, nread, &
23170 MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale)
2318 else
23190 call allocate_rotated_array(data, [1,1], -qturns, data_in)
23200 call rotate_array(data, -qturns, data_in)
23210 if (associated(MOM_Domain%domain_in)) then
2322 call read_field(filename, fieldname, data_in, start, nread, &
23230 MOM_Domain=MOM_Domain%domain_in, no_domain=no_domain, scale=scale)
2324 else
2325 call read_field(filename, fieldname, data_in, start, nread, &
23260 MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale)
2327 endif
23280 call rotate_array(data_in, qturns, data)
23290 deallocate(data_in)
2330 endif
23310end subroutine MOM_read_data_2d_region
2332
2333
2334!> Read a 3d array from file using infrastructure I/O.
23350subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, timelevel, position, &
2336 scale, global_file, file_may_be_4d, turns)
2337 character(len=*), intent(in) :: filename !< Input filename
2338 character(len=*), intent(in) :: fieldname !< Field variable name
2339 real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2340 type(MOM_domain_type), target, &
2341 intent(in) :: MOM_Domain !< Model domain decomposition
2342 integer, optional, intent(in) :: timelevel !< Time level to read in file
2343 integer, optional, intent(in) :: position !< Grid positioning flag
2344 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2345 !! before it is returned to convert from the units in the file
2346 !! to the internal units for this variable [A a-1 ~> 1]
2347 logical, optional, intent(in) :: global_file !< If true, read from a single file
2348 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2349 !! as 4d arrays in the file.
2350 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2351 !! the number of turns is taken from MOM_Domain.
2352
2353 ! Local variables
2354 integer :: qturns ! Number of quarter-turns from input to model grid
23550 real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2356 type(MOM_domain_type), pointer :: domain_ptr => NULL() ! Pointer to the unrotated domain for reading
2357
23580 domain_ptr => MOM_Domain
23590 if (associated(MOM_Domain%domain_in) .and. (qturns /= 0)) domain_ptr => MOM_Domain%domain_in
2360
23610 qturns = MOM_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
23620 if (qturns == 0) then
2363 call read_field(filename, fieldname, data, MOM_Domain, &
2364 timelevel=timelevel, position=position, scale=scale, &
23650 global_file=global_file, file_may_be_4d=file_may_be_4d)
2366 else
23670 call allocate_rotated_array(data, [1,1,1], -qturns, data_in)
23680 call rotate_array(data, -qturns, data_in)
2369 call read_field(filename, fieldname, data_in, domain_ptr, &
2370 timelevel=timelevel, position=position, scale=scale, &
23710 global_file=global_file, file_may_be_4d=file_may_be_4d)
23720 call rotate_array(data_in, qturns, data)
23730 deallocate(data_in)
2374 endif
2375
23760end subroutine MOM_read_data_3d
2377
2378!> Read a 3d region array from file using infrastructure I/O.
23790subroutine MOM_read_data_3d_region(filename, fieldname, data, start, nread, MOM_domain, &
2380 no_domain, scale, turns)
2381 character(len=*), intent(in) :: filename !< Input filename
2382 character(len=*), intent(in) :: fieldname !< Field variable name
2383 real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2384 integer, dimension(:), intent(in) :: start !< Starting index for each axis.
2385 integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis.
2386 type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2387 logical, optional, intent(in) :: no_domain !< If true, field does not use
2388 !! domain decomposion.
2389 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2390 !! before it is returned to convert from the units in the file
2391 !! to the internal units for this variable [A a-1 ~> 1]
2392 integer, optional, intent(in) :: turns !< Number of quarter turns from
2393 !! input to model grid
2394
2395 integer :: qturns ! Number of quarter turns
23960 real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2397
23980 qturns = 0
23990 if (present(turns)) qturns = modulo(turns, 4)
2400
24010 if (qturns == 0) then
2402 call read_field(filename, fieldname, data, start, nread, &
24030 MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale)
2404 else
24050 call allocate_rotated_array(data, [1,1,1], -qturns, data_in)
24060 call rotate_array(data, -qturns, data_in)
24070 if (associated(MOM_Domain%domain_in)) then
2408 call read_field(filename, fieldname, data_in, start, nread, &
24090 MOM_Domain=MOM_Domain%domain_in, no_domain=no_domain, scale=scale)
2410 else
2411 call read_field(filename, fieldname, data_in, start, nread, &
24120 MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale)
2413 endif
24140 call rotate_array(data_in, qturns, data)
24150 deallocate(data_in)
2416 endif
24170end subroutine MOM_read_data_3d_region
2418
2419!> Read a 4d array from file using infrastructure I/O.
24200subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, &
2421 timelevel, position, scale, global_file, turns)
2422 character(len=*), intent(in) :: filename !< Input filename
2423 character(len=*), intent(in) :: fieldname !< Field variable name
2424 real, dimension(:,:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2425 type(MOM_domain_type), target, &
2426 intent(in) :: MOM_Domain !< Model domain decomposition
2427 integer, optional, intent(in) :: timelevel !< Time level to read in file
2428 integer, optional, intent(in) :: position !< Grid positioning flag
2429 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2430 !! before it is returned to convert from the units in the file
2431 !! to the internal units for this variable [A a-1 ~> 1]
2432 logical, optional, intent(in) :: global_file !< If true, read from a single file
2433 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2434 !! the number of turns is taken from MOM_Domain.
2435
2436 ! Local variables
2437 integer :: qturns ! Number of quarter-turns from input to model grid
24380 real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2439 type(MOM_domain_type), pointer :: domain_ptr => NULL() ! Pointer to the unrotated domain for reading
2440
24410 qturns = MOM_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2442
24430 domain_ptr => MOM_Domain
24440 if (associated(MOM_Domain%domain_in) .and. (qturns /= 0)) domain_ptr => MOM_Domain%domain_in
2445
24460 if (qturns == 0) then
2447 call read_field(filename, fieldname, data, MOM_Domain, &
2448 timelevel=timelevel, position=position, scale=scale, &
24490 global_file=global_file)
2450 else
2451 ! Read field along the input grid and rotate to the model grid
24520 call allocate_rotated_array(data, [1,1,1,1], -qturns, data_in)
24530 call rotate_array(data, -qturns, data_in)
2454 call read_field(filename, fieldname, data_in, domain_ptr, timelevel=timelevel, &
24550 position=position, scale=scale, global_file=global_file)
24560 call rotate_array(data_in, qturns, data)
24570 deallocate(data_in)
2458 endif
2459
24600end subroutine MOM_read_data_4d
2461
2462
2463!> Read a 2d vector tuple from file using infrastructure I/O.
24640subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
2465 timelevel, stagger, scalar_pair, scale, turns)
2466 character(len=*), intent(in) :: filename !< Input filename
2467 character(len=*), intent(in) :: u_fieldname !< Field variable name in u
2468 character(len=*), intent(in) :: v_fieldname !< Field variable name in v
2469 real, dimension(:,:), intent(inout) :: u_data !< Field value at u points in arbitrary units [A ~> a]
2470 real, dimension(:,:), intent(inout) :: v_data !< Field value at v points in arbitrary units [A ~> a]
2471 type(MOM_domain_type), target, &
2472 intent(in) :: MOM_Domain !< Model domain decomposition
2473 integer, optional, intent(in) :: timelevel !< Time level to read in file
2474 integer, optional, intent(in) :: stagger !< Grid staggering flag
2475 logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector
2476 real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by
2477 !! before it is returned to convert from the units in the file
2478 !! to the internal units for this variable [A a-1 ~> 1]
2479 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2480 !! the number of turns is taken from MOM_Domain.
2481
2482 ! Local variables
2483 integer :: qturns ! Number of quarter-turns from input to model grid
24840 real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid in arbitrary units [A ~> a]
2485 type(MOM_domain_type), pointer :: domain_ptr => NULL() ! Pointer to the unrotated domain for reading
2486
24870 qturns = MOM_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2488
24890 domain_ptr => MOM_Domain
24900 if (associated(MOM_Domain%domain_in) .and. (qturns /= 0)) domain_ptr => MOM_Domain%domain_in
2491
24920 if (qturns == 0) then
2493 call read_vector(filename, u_fieldname, v_fieldname, &
2494 u_data, v_data, MOM_domain, timelevel=timelevel, stagger=stagger, &
24950 scalar_pair=scalar_pair, scale=scale)
2496 else
24970 call allocate_rotated_array(u_data, [1,1], -qturns, u_data_in)
24980 call allocate_rotated_array(v_data, [1,1], -qturns, v_data_in)
24990 if (scalar_pair) then
25000 call rotate_array_pair(u_data, v_data, -qturns, u_data_in, v_data_in)
2501 else
25020 call rotate_vector(u_data, v_data, -qturns, u_data_in, v_data_in)
2503 endif
2504 call read_vector(filename, u_fieldname, v_fieldname, u_data_in, v_data_in, &
2505 domain_ptr, timelevel=timelevel, &
25060 stagger=stagger, scalar_pair=scalar_pair, scale=scale)
25070 if (scalar_pair) then
25080 call rotate_array_pair(u_data_in, v_data_in, qturns, u_data, v_data)
2509 else
25100 call rotate_vector(u_data_in, v_data_in, qturns, u_data, v_data)
2511 endif
25120 deallocate(v_data_in)
25130 deallocate(u_data_in)
2514 endif
2515
25160end subroutine MOM_read_vector_2d
2517
2518
2519!> Read a 3d vector tuple from file using infrastructure I/O.
25200subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
2521 timelevel, stagger, scalar_pair, scale, turns)
2522 character(len=*), intent(in) :: filename !< Input filename
2523 character(len=*), intent(in) :: u_fieldname !< Field variable name in u
2524 character(len=*), intent(in) :: v_fieldname !< Field variable name in v
2525 real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u in arbitrary units [A ~> a]
2526 real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v in arbitrary units [A ~> a]
2527 type(MOM_domain_type), target, &
2528 intent(in) :: MOM_Domain !< Model domain decomposition
2529 integer, optional, intent(in) :: timelevel !< Time level to read in file
2530 integer, optional, intent(in) :: stagger !< Grid staggering flag
2531 logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector
2532 real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by
2533 !! before it is returned to convert from the units in the file
2534 !! to the internal units for this variable [A a-1 ~> 1]
2535 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2536 !! the number of turns is taken from MOM_Domain.
2537
2538 ! Local variables
2539 integer :: qturns ! Number of quarter-turns from input to model grid
25400 real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid in arbitrary units [A ~> a]
2541 type(MOM_domain_type), pointer :: domain_ptr => NULL() ! Pointer to the unrotated domain for reading
2542
25430 qturns = MOM_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2544
25450 domain_ptr => MOM_Domain
25460 if (associated(MOM_Domain%domain_in) .and. (qturns /= 0)) domain_ptr => MOM_Domain%domain_in
2547
25480 if (qturns == 0) then
2549 call read_vector(filename, u_fieldname, v_fieldname, &
2550 u_data, v_data, MOM_domain, timelevel=timelevel, stagger=stagger, &
25510 scalar_pair=scalar_pair, scale=scale)
2552 else
25530 call allocate_rotated_array(u_data, [1,1,1], -qturns, u_data_in)
25540 call allocate_rotated_array(v_data, [1,1,1], -qturns, v_data_in)
25550 if (scalar_pair) then
25560 call rotate_array_pair(u_data, v_data, -qturns, u_data_in, v_data_in)
2557 else
25580 call rotate_vector(u_data, v_data, -qturns, u_data_in, v_data_in)
2559 endif
2560 call read_vector(filename, u_fieldname, v_fieldname, u_data_in, v_data_in, &
2561 domain_ptr, timelevel=timelevel, &
25620 stagger=stagger, scalar_pair=scalar_pair, scale=scale)
25630 if (scalar_pair) then
25640 call rotate_array_pair(u_data_in, v_data_in, qturns, u_data, v_data)
2565 else
25660 call rotate_vector(u_data_in, v_data_in, qturns, u_data, v_data)
2567 endif
25680 deallocate(v_data_in)
25690 deallocate(u_data_in)
2570 endif
2571
25720end subroutine MOM_read_vector_3d
2573
2574!> Write a 4d field to an output file, potentially with rotation
25750subroutine MOM_write_field_legacy_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2576 fill_value, turns, scale, unscale, zero_zeros)
2577 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2578 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2579 type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2580 real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2581 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2582 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2583 real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a]
2584 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2585 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2586 !! it is written [a A-1 ~> 1], for example to convert it
2587 !! from its internal units to the desired units for output
2588 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2589 !! it is written [a A-1 ~> 1], for example to convert it
2590 !! from its internal units to the desired units for output.
2591 !! Here scale and unscale are synonymous, but unscale
2592 !! takes precedence if both are present.
2593 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2594 !! into ordinary signless zeros.
2595
2596 ! Local variables
25970 real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [a] or
2598 ! rescaled [A ~> a] then [a]
2599 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2600 integer :: qturns ! The number of quarter turns through which to rotate field
2601
26020 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
26030 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
26040 if (present(unscale)) scale_fac = unscale
2605
26060 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2607 call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, &
26080 tile_count=tile_count, fill_value=fill_value)
2609 else
26100 call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot)
26110 call rotate_array(field, qturns, field_rot)
26120 call rescale_comp_data(MOM_Domain, field_rot, scale_fac, zero_zeros)
2613 call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, &
26140 tile_count=tile_count, fill_value=fill_value)
26150 deallocate(field_rot)
2616 endif
26170end subroutine MOM_write_field_legacy_4d
2618
2619
2620!> Write a 3d field to an output file, potentially with rotation
26210subroutine MOM_write_field_legacy_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2622 fill_value, turns, scale, unscale, zero_zeros)
2623 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2624 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2625 type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2626 real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2627 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2628 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2629 real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a]
2630 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2631 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2632 !! it is written [a A-1 ~> 1], for example to convert it
2633 !! from its internal units to the desired units for output
2634 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2635 !! it is written [a A-1 ~> 1], for example to convert it
2636 !! from its internal units to the desired units for output.
2637 !! Here scale and unscale are synonymous, but unscale
2638 !! takes precedence if both are present.
2639 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2640 !! into ordinary signless zeros.
2641
2642 ! Local variables
26430 real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [a] or
2644 ! rescaled [A ~> a] then [a]
2645 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2646 integer :: qturns ! The number of quarter turns through which to rotate field
2647
26480 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
26490 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
26500 if (present(unscale)) scale_fac = unscale
2651
26520 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2653 call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, &
26540 tile_count=tile_count, fill_value=fill_value)
2655 else
26560 call allocate_rotated_array(field, [1,1,1], qturns, field_rot)
26570 call rotate_array(field, qturns, field_rot)
26580 call rescale_comp_data(MOM_Domain, field_rot, scale_fac, zero_zeros)
2659 call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, &
26600 tile_count=tile_count, fill_value=fill_value)
26610 deallocate(field_rot)
2662 endif
26630end subroutine MOM_write_field_legacy_3d
2664
2665
2666!> Write a 2d field to an output file, potentially with rotation
26670subroutine MOM_write_field_legacy_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2668 fill_value, turns, scale, unscale, zero_zeros)
2669 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2670 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2671 type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2672 real, dimension(:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2673 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2674 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2675 real, optional, intent(in) :: fill_value !< Missing data fill value
2676 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2677 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2678 !! it is written [a A-1 ~> 1], for example to convert it
2679 !! from its internal units to the desired units for output
2680 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2681 !! it is written [a A-1 ~> 1], for example to convert it
2682 !! from its internal units to the desired units for output.
2683 !! Here scale and unscale are synonymous, but unscale
2684 !! takes precedence if both are present.
2685 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2686 !! into ordinary signless zeros.
2687
2688 ! Local variables
26890 real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [a] or
2690 ! rescaled [A ~> a] then [a]
2691 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2692 integer :: qturns ! The number of quarter turns through which to rotate field
2693
26940 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
26950 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
26960 if (present(unscale)) scale_fac = unscale
2697
26980 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2699 call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, &
27000 tile_count=tile_count, fill_value=fill_value)
2701 else
27020 call allocate_rotated_array(field, [1,1], qturns, field_rot)
27030 call rotate_array(field, qturns, field_rot)
27040 call rescale_comp_data(MOM_Domain, field_rot, scale_fac, zero_zeros)
2705 call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, &
27060 tile_count=tile_count, fill_value=fill_value)
27070 deallocate(field_rot)
2708 endif
27090end subroutine MOM_write_field_legacy_2d
2710
2711
2712!> Write a 1d field to an output file
27130subroutine MOM_write_field_legacy_1d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2714 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2715 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2716 real, dimension(:), intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2717 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2718 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2719 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2720 !! it is written [a A-1 ~> 1], for example to convert it
2721 !! from its internal units to the desired units for output
2722 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2723 !! it is written [a A-1 ~> 1], for example to convert it
2724 !! from its internal units to the desired units for output.
2725 !! Here scale and unscale are synonymous, but unscale
2726 !! takes precedence if both are present.
2727 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2728 !! into ordinary signless zeros.
2729
2730 ! Local variables
27310 real, dimension(:), allocatable :: array ! A rescaled copy of field [a]
2732 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2733 logical :: design_zeros ! If true, convert negative zeros into ordinary signless zeros.
2734 integer :: i
2735
27360 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
27370 if (present(unscale)) scale_fac = unscale
2738
27390 design_zeros = .false. ; if (present(zero_zeros)) design_zeros = zero_zeros
2740
27410 if ((scale_fac == 1.0) .and. (.not.design_zeros)) then
27420 call write_field(IO_handle, field_md, field, tstamp=tstamp)
2743 else
27440 allocate(array(size(field)))
27450 array(:) = scale_fac * field(:)
27460 if (present(fill_value)) then
27470 do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo
2748 endif
27490 if (design_zeros) then ! Convert negative zeros into zeros
27500 do i=1,size(field) ; if (array(i) == 0.0) array(i) = 0.0 ; enddo
2751 endif
27520 call write_field(IO_handle, field_md, array, tstamp=tstamp)
27530 deallocate(array)
2754 endif
27550end subroutine MOM_write_field_legacy_1d
2756
2757
2758!> Write a 0d field to an output file
27590subroutine MOM_write_field_legacy_0d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2760 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2761 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2762 real, intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2763 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2764 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2765 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2766 !! it is written [a A-1 ~> 1], for example to convert it
2767 !! from its internal units to the desired units for output
2768 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2769 !! it is written [a A-1 ~> 1], for example to convert it
2770 !! from its internal units to the desired units for output.
2771 !! Here scale and unscale are synonymous, but unscale
2772 !! takes precedence if both are present.
2773 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2774 !! into ordinary signless zeros.
2775
2776 ! Local variables
2777 real :: scale_fac ! A scaling factor to use before writing the field [a A-1 ~> 1]
2778 real :: scaled_val ! A rescaled copy of field [a]
2779
27800 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
27810 if (present(unscale)) scale_fac = unscale
2782
27830 scaled_val = field * scale_fac
2784
27850 if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif
27860 if (present(zero_zeros)) then ; if (zero_zeros .and. (scaled_val == 0.0)) scaled_val = 0.0 ; endif
2787
27880 call write_field(IO_handle, field_md, scaled_val, tstamp=tstamp)
27890end subroutine MOM_write_field_legacy_0d
2790
2791
2792!> Write a 4d field to an output file, potentially with rotation
27930subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2794 fill_value, turns, scale, unscale, zero_zeros)
2795 class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2796 type(MOM_field), intent(in) :: field_md !< Field type with metadata
2797 type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2798 real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2799 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2800 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2801 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2802 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2803 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2804 !! it is written [a A-1 ~> 1], for example to convert it
2805 !! from its internal units to the desired units for output
2806 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2807 !! it is written [a A-1 ~> 1], for example to convert it
2808 !! from its internal units to the desired units for output.
2809 !! Here scale and unscale are synonymous, but unscale
2810 !! takes precedence if both are present.
2811 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2812 !! into ordinary signless zeros.
2813
2814 ! Local variables
28150 real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units or rescaled [a]
2816 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2817 integer :: qturns ! The number of quarter turns through which to rotate field
2818
28190 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
28200 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
28210 if (present(unscale)) scale_fac = unscale
2822
28230 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2824 call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, &
28250 tile_count=tile_count, fill_value=fill_value)
2826 else
28270 call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot)
28280 call rotate_array(field, qturns, field_rot)
28290 call rescale_comp_data(MOM_Domain, field_rot, scale_fac, zero_zeros)
2830 call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, &
28310 tile_count=tile_count, fill_value=fill_value)
28320 deallocate(field_rot)
2833 endif
28340end subroutine MOM_write_field_4d
2835
2836!> Write a 3d field to an output file, potentially with rotation
283731subroutine MOM_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2838 fill_value, turns, scale, unscale, zero_zeros)
2839 class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2840 type(MOM_field), intent(in) :: field_md !< Field type with metadata
2841 type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2842 real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2843 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2844 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2845 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2846 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2847 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2848 !! it is written [a A-1 ~> 1], for example to convert it
2849 !! from its internal units to the desired units for output
2850 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2851 !! it is written [a A-1 ~> 1], for example to convert it
2852 !! from its internal units to the desired units for output.
2853 !! Here scale and unscale are synonymous, but unscale
2854 !! takes precedence if both are present.
2855 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2856 !! into ordinary signless zeros.
2857
2858 ! Local variables
285931 real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units or rescaled [a]
2860 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2861 integer :: qturns ! The number of quarter turns through which to rotate field
2862
286331 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
286431 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
286531 if (present(unscale)) scale_fac = unscale
2866
286731 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2868 call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, &
28690 tile_count=tile_count, fill_value=fill_value)
2870 else
287131 call allocate_rotated_array(field, [1,1,1], qturns, field_rot)
287231 call rotate_array(field, qturns, field_rot)
287331 call rescale_comp_data(MOM_Domain, field_rot, scale_fac, zero_zeros)
2874 call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, &
287531 tile_count=tile_count, fill_value=fill_value)
287631 deallocate(field_rot)
2877 endif
287831end subroutine MOM_write_field_3d
2879
2880!> Write a 2d field to an output file, potentially with rotation
288128subroutine MOM_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2882 fill_value, turns, scale, unscale, zero_zeros)
2883 class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2884 type(MOM_field), intent(in) :: field_md !< Field type with metadata
2885 type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2886 real, dimension(:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2887 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2888 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2889 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2890 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2891 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2892 !! it is written [a A-1 ~> 1], for example to convert it
2893 !! from its internal units to the desired units for output
2894 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2895 !! it is written [a A-1 ~> 1], for example to convert it
2896 !! from its internal units to the desired units for output.
2897 !! Here scale and unscale are synonymous, but unscale
2898 !! takes precedence if both are present.
2899 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2900 !! into ordinary signless zeros.
2901
2902 ! Local variables
290328 real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units or rescaled [a]
2904 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2905 integer :: qturns ! The number of quarter turns through which to rotate field
2906
290728 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
290828 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
290928 if (present(unscale)) scale_fac = unscale
2910
291128 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2912 call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, &
29130 tile_count=tile_count, fill_value=fill_value)
2914 else
291528 call allocate_rotated_array(field, [1,1], qturns, field_rot)
291628 call rotate_array(field, qturns, field_rot)
291728 call rescale_comp_data(MOM_Domain, field_rot, scale_fac, zero_zeros)
2918 call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, &
291928 tile_count=tile_count, fill_value=fill_value)
292028 deallocate(field_rot)
2921 endif
292228end subroutine MOM_write_field_2d
2923
2924!> Write a 1d field to an output file
29252subroutine MOM_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2926 class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2927 type(MOM_field), intent(in) :: field_md !< Field type with metadata
2928 real, dimension(:), intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2929 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2930 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2931 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2932 !! it is written [a A-1 ~> 1], for example to convert it
2933 !! from its internal units to the desired units for output
2934 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2935 !! it is written [a A-1 ~> 1], for example to convert it
2936 !! from its internal units to the desired units for output.
2937 !! Here scale and unscale are synonymous, but unscale
2938 !! takes precedence if both are present.
2939 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2940 !! into ordinary signless zeros.
2941
2942 ! Local variables
29432 real, dimension(:), allocatable :: array ! A rescaled copy of field in arbtrary unscaled units [a]
2944 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2945 logical :: design_zeros ! If true, convert negative zeros into ordinary signless zeros.
2946 integer :: i
2947
29482 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
29492 if (present(unscale)) scale_fac = unscale
2950
29512 design_zeros = .false. ; if (present(zero_zeros)) design_zeros = zero_zeros
2952
29532 if ((scale_fac == 1.0) .and. (.not.design_zeros)) then
29542 call IO_handle%write_field(field_md, field, tstamp=tstamp)
2955 else
29560 allocate(array(size(field)))
29570 array(:) = scale_fac * field(:)
29580 if (present(fill_value)) then
29590 do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo
2960 endif
29610 if (design_zeros) then ! Convert negative zeros into zeros
29620 do i=1,size(field) ; if (array(i) == 0.0) array(i) = 0.0 ; enddo
2963 endif
29640 call IO_handle%write_field(field_md, array, tstamp=tstamp)
29650 deallocate(array)
2966 endif
29672end subroutine MOM_write_field_1d
2968
2969!> Write a 0d field to an output file
29704subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2971 class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2972 type(MOM_field), intent(in) :: field_md !< Field type with metadata
2973 real, intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2974 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2975 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2976 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2977 !! it is written [a A-1 ~> 1], for example to convert it
2978 !! from its internal units to the desired units for output
2979 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2980 !! it is written [a A-1 ~> 1], for example to convert it
2981 !! from its internal units to the desired units for output.
2982 !! Here scale and unscale are synonymous, but unscale
2983 !! takes precedence if both are present.
2984 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2985 !! into ordinary signless zeros.
2986
2987 ! Local variables
2988 real :: scale_fac ! A scaling factor to use before writing the field [a A-1 ~> 1]
2989 real :: scaled_val ! A rescaled copy of field in arbtrary unscaled units [a]
2990
29914 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
29924 if (present(unscale)) scale_fac = unscale
2993
29944 scaled_val = field * scale_fac
2995
29964 if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif
29974 if (present(zero_zeros)) then ; if (zero_zeros .and. (scaled_val == 0.0)) scaled_val = 0.0 ; endif
2998
29994 call IO_handle%write_field(field_md, scaled_val, tstamp=tstamp)
30004end subroutine MOM_write_field_0d
3001
3002!> Given filename and fieldname, this subroutine returns the size of the field in the file
30030subroutine field_size(filename, fieldname, sizes, field_found, no_domain, ndims, ncid_in)
3004 character(len=*), intent(in) :: filename !< The name of the file to read
3005 character(len=*), intent(in) :: fieldname !< The name of the variable whose sizes are returned
3006 integer, dimension(:), intent(inout) :: sizes !< The sizes of the variable in each dimension
3007 logical, optional, intent(out) :: field_found !< This indicates whether the field was found in
3008 !! the input file. Without this argument, there
3009 !! is a fatal error if the field is not found.
3010 logical, optional, intent(in) :: no_domain !< If present and true, do not check for file
3011 !! names with an appended tile number. If
3012 !! ndims is present, the default changes to true.
3013 integer, optional, intent(out) :: ndims !< The number of dimensions to the variable
3014 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
3015 !! file is opened and closed within this routine.
3016
30170 if (present(ndims)) then
30180 if (present(no_domain)) then ; if (.not.no_domain) call MOM_error(FATAL, &
30190 "field_size does not support the ndims argument when no_domain is present and false.")
3020 endif
30210 call get_var_sizes(filename, fieldname, ndims, sizes, match_case=.false., ncid_in=ncid_in)
30220 if (present(field_found)) field_found = (ndims >= 0)
30230 if ((ndims < 0) .and. .not.present(field_found)) then
30240 call MOM_error(FATAL, "Variable "//trim(fieldname)//" not found in "//trim(filename) )
3025 endif
3026 else
30270 call get_field_size(filename, fieldname, sizes, field_found=field_found, no_domain=no_domain)
3028 endif
3029
30300end subroutine field_size
3031
3032
3033!> Copies a string
3034994subroutine safe_string_copy(str1, str2, fieldnm, caller)
3035 character(len=*), intent(in) :: str1 !< The string being copied
3036 character(len=*), intent(out) :: str2 !< The string being copied into
3037 character(len=*), optional, intent(in) :: fieldnm !< The name of the field for error messages
3038 character(len=*), optional, intent(in) :: caller !< The calling routine for error messages
3039
3040994 if (len(trim(str1)) > len(str2)) then
30410 if (present(fieldnm) .and. present(caller)) then
3042 call MOM_error(FATAL, trim(caller)//" attempted to copy the overly long string "//&
30430 trim(str1)//" into "//trim(fieldnm))
3044 else
3045 call MOM_error(FATAL, "safe_string_copy: The string "//trim(str1)//&
30460 " is longer than its intended target.")
3047 endif
3048 endif
3049994 str2 = trim(str1)
3050994end subroutine safe_string_copy
3051
3052!> Returns a name with "%#E" or "%E" replaced with the ensemble member number.
305311function ensembler(name, ens_no_in) result(en_nm)
3054 character(len=*), intent(in) :: name !< The name to be modified
3055 integer, optional, intent(in) :: ens_no_in !< The number of the current ensemble member
3056 character(len=len(name)) :: en_nm !< The name encoded with the ensemble number
3057
3058 ! This function replaces "%#E" or "%E" with the ensemble number anywhere it
3059 ! occurs in name, with %E using 4 or 6 digits (depending on the ensemble size)
3060 ! and %#E using # digits, where # is a number from 1 to 9.
3061
306211 character(len=len(name)) :: tmp
3063 character(10) :: ens_num_char
3064 character(3) :: code_str
3065 integer :: ens_no
3066 integer :: n, is
3067
306811 en_nm = trim(name)
306911 if (index(name,"%") == 0) return
3070
30710 if (present(ens_no_in)) then
30720 ens_no = ens_no_in
3073 else
30740 ens_no = get_ensemble_id()
3075 endif
3076
30770 write(ens_num_char, '(I0)') ens_no
30780 do
30790 is = index(en_nm,"%E")
30800 if (is == 0) exit
30810 if (len(en_nm) < len(trim(en_nm)) + len(trim(ens_num_char)) - 2) &
3082 call MOM_error(FATAL, "MOM_io ensembler: name "//trim(name)// &
30830 " is not long enough for %E expansion for ens_no "//trim(ens_num_char))
30840 tmp = en_nm(1:is-1)//trim(ens_num_char)//trim(en_nm(is+2:))
30850 en_nm = tmp
3086 enddo
3087
30880 if (index(name,"%") == 0) return
3089
30900 write(ens_num_char, '(I10.10)') ens_no
30910 do n=1,9 ; do
30920 write(code_str, '("%",I1,"E")') n
3093
30940 is = index(en_nm,code_str)
30950 if (is == 0) exit
30960 if (ens_no < 10**n) then
30970 if (len(en_nm) < len(trim(en_nm)) + n-3) call MOM_error(FATAL, &
30980 "MOM_io ensembler: name "//trim(name)//" is not long enough for %E expansion.")
30990 tmp = en_nm(1:is-1)//trim(ens_num_char(11-n:10))//trim(en_nm(is+3:))
3100 else
3101 call MOM_error(FATAL, "MOM_io ensembler: Ensemble number is too large "//&
31020 "to be encoded with "//code_str//" in "//trim(name))
3103 endif
31040 en_nm = tmp
3105 enddo ; enddo
3106
310711end function ensembler
3108
3109!> Provide a string to append to filenames, to differentiate ensemble members, for example.
31107subroutine get_filename_appendix(suffix)
3111 character(len=*), intent(out) :: suffix !< A string to append to filenames
3112
31137 call get_filename_suffix(suffix)
31147end subroutine get_filename_appendix
3115
3116!> Write a file version number to the log file or other output file
31170subroutine write_version_number(version, tag, unit)
3118 character(len=*), intent(in) :: version !< A string that contains the routine name and version
3119 character(len=*), optional, intent(in) :: tag !< A tag name to add to the message
3120 integer, optional, intent(in) :: unit !< An alternate unit number for output
3121
31220 call write_version(version, tag, unit)
31230end subroutine write_version_number
3124
3125
3126!> Open a single namelist file that is potentially readable by all PEs.
31272function open_namelist_file(file) result(unit)
3128 character(len=*), optional, intent(in) :: file !< The file to open, by default "input.nml"
3129 integer :: unit !< The opened unit number of the namelist file
31302 unit = MOM_namelist_file(file)
31314end function open_namelist_file
3132
3133!> Checks the iostat argument that is returned after reading a namelist variable and writes a
3134!! message if there is an error.
31353function check_nml_error(IOstat, nml_name) result(ierr)
3136 integer, intent(in) :: IOstat !< An I/O status field from a namelist read call
3137 character(len=*), intent(in) :: nml_name !< The name of the namelist
3138 integer :: ierr !< A copy of IOstat that is returned to preserve legacy function behavior
31393 call check_namelist_error(IOstat, nml_name)
31403 ierr = IOstat
31413end function check_nml_error
3142
3143!> Initialize the MOM_io module
31441subroutine MOM_io_init(param_file)
3145 type(param_file_type), intent(in) :: param_file !< structure indicating the open file to
3146 !! parse for model parameter values.
3147
3148 ! This include declares and sets the variable "version".
3149# include "version_variable.h"
3150 character(len=40) :: mdl = "MOM_io" ! This module's name.
3151
31521 call log_version(param_file, mdl, version)
3153
31541end subroutine MOM_io_init
3155!> Returns the dimension variable information for a netCDF variable
31560subroutine get_var_axes_info(filename, fieldname, axes_info)
3157 character(len=*), intent(in) :: filename !< A filename from which to read
3158 character(len=*), intent(in) :: fieldname !< The name of the field to read
3159 type(axis_info), dimension(4), intent(inout) :: axes_info !< A returned array of field axis information
3160
3161 !! local variables
3162 integer :: rcode
3163 logical :: success
3164 integer :: ncid, varid, ndims
3165 integer :: id, jd, kd
3166 integer, dimension(4) :: dims, dim_id
3167 character(len=128) :: dim_name(4)
3168 integer, dimension(1) :: start, count
3169 !! cartesian axis data
31700 real, allocatable, dimension(:) :: x ! x-axis labels, often [degrees_E] or [km] or [m]
31710 real, allocatable, dimension(:) :: y ! y-axis labels, often [degrees_N] or [km] or [m]
31720 real, allocatable, dimension(:) :: z ! vertical axis labels [various], often [m] or [kg m-3]
3173
3174
31750 call open_file_to_read(filename, ncid, success=success)
3176
31770 rcode = NF90_INQ_VARID(ncid, trim(fieldname), varid)
31780 if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(fieldname)//&
31790 " in file "//trim(filename)//" in hinterp_extrap")
3180
31810 rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims)
31820 if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(fieldname)//&
31830 " in file "//trim(filename)//" in hinterp_extrap")
31840 if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(fieldname)//" in file "//trim(filename)// &
31850 " has too few dimensions to be read as a 3-d array.")
31860 rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id)
31870 if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// &
31880 trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap")
31890 rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1))
31900 if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//&
31910 " in file "//trim(filename)//" in hinterp_extrap")
31920 rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd)
31930 if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// &
31940 trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap")
31950 rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2))
31960 if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//&
31970 " in file "//trim(filename)//" in hinterp_extrap")
31980 rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd)
31990 if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// &
32000 trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap")
32010 rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3))
32020 if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//&
32030 " in file "//trim(filename)//" in hinterp_extrap")
32040 allocate(x(id), y(jd), z(kd))
3205
32060 start = 1 ; count = 1 ; count(1) = id
32070 rcode = NF90_GET_VAR(ncid, dim_id(1), x, start, count)
32080 if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// &
32090 trim(fieldname)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap")
32100 start = 1 ; count = 1 ; count(1) = jd
32110 rcode = NF90_GET_VAR(ncid, dim_id(2), y, start, count)
32120 if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// &
32130 trim(fieldname)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap")
32140 start = 1 ; count = 1 ; count(1) = kd
32150 rcode = NF90_GET_VAR(ncid, dim_id(3), z, start, count)
32160 if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// &
32170 trim(fieldname//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap")
3218
32190 call set_axis_info(axes_info(1), name=trim(dim_name(1)), ax_size=id, ax_data=x,cartesian='X')
32200 call set_axis_info(axes_info(2), name=trim(dim_name(2)), ax_size=jd, ax_data=y,cartesian='Y')
32210 call set_axis_info(axes_info(3), name=trim(dim_name(3)), ax_size=kd, ax_data=z,cartesian='Z')
3222
32230 call close_file_to_read(ncid, filename)
3224
32250 deallocate(x,y,z)
3226
32270end subroutine get_var_axes_info
3228!> \namespace mom_io
3229!!
3230!! This file contains a number of subroutines that manipulate
3231!! NetCDF files and handle input and output of fields. These
3232!! subroutines, along with their purpose, are:
3233!!
3234!! * create_file: create a new file and set up structures that are
3235!! needed for subsequent output and write out the coordinates.
3236!! * reopen_file: reopen an existing file for writing and set up
3237!! structures that are needed for subsequent output.
3238!! * open_input_file: open the indicated file for reading only.
3239!! * close_file: close an open file.
3240!! * synch_file: flush the buffers, completing all pending output.
3241!!
3242!! * write_field: write a field to an open file.
3243!! * write_time: write a value of the time axis to an open file.
3244!! * read_data: read a variable from an open file.
3245!! * read_time: read a time from an open file.
3246!!
3247!! * name_output_file: provide a name for an output file based on a
3248!! name root and the time of the output.
3249!! * find_input_file: find a file that has been previously written by
3250!! MOM and named by name_output_file and open it for reading.
3251!!
3252!! * handle_error: write an error code and quit.
3253
32540end module MOM_io