MOM_io.F90

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
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
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.
54public :: mom_field
56public :: open_namelist_file, check_namelist_error, check_nml_error
57public :: get_var_sizes, verify_variable_units, num_timelevels, read_variable, read_attribute
59! The following are simple pass throughs of routines from MOM_io_infra or other modules.
60public :: file_exists, open_ascii_file, close_file
62public :: field_exists, get_filename_appendix
64public :: fieldtype, field_size, get_field_atts
65public :: axistype, get_axis_data
66public :: mom_read_data, mom_read_vector, read_field_chksum
67public :: read_netcdf_data
69public :: io_infra_init, io_infra_end
70public :: stdout_if_root
71public :: get_var_axes_info
72public :: get_axis_info
73! This is used to set up information descibing non-domain-decomposed axes.
75! This is used to set up global file attributes
77! This API is here just to support potential use by non-FMS drivers, and should not persist.
78public :: read_data
79!> These encoding constants are used to indicate the file format
80public :: ascii_file, netcdf_file
81!> These encoding constants are used to indicate whether the file is domain decomposed
82public :: multiple, single_file
83!> These encoding constants are used to indicate the access mode for a file
84public :: append_file, overwrite_file, readonly_file, writeonly_file
85!> These encoding constants are used to indicate the discretization position of a variable
86public :: center, corner, north_face, east_face
87
88! The following are not used in MOM6, but may be used by externals (e.g. SIS2).
89public :: create_file
90public :: reopen_file
91public :: file_type
92public :: open_file
93public :: get_file_info
94public :: get_file_fields
95public :: get_file_times
96
97!> Read a field from file using the infrastructure I/O.
98interface mom_read_data
99 module procedure mom_read_data_0d
100 module procedure mom_read_data_0d_int
101 module procedure mom_read_data_1d
102 module procedure mom_read_data_1d_int
103 module procedure mom_read_data_2d
104 module procedure mom_read_data_2d_region
105 module procedure mom_read_data_3d
106 module procedure mom_read_data_3d_region
107 module procedure mom_read_data_4d
108end interface mom_read_data
109
110!> Read a vector from file using the infrastructure I/O.
111interface mom_read_vector
112 module procedure mom_read_vector_2d
113 module procedure mom_read_vector_3d
114end interface mom_read_vector
115
116!> Read a field using native netCDF I/O
117!!
118!! This function is primarily used for unstructured data which may contain
119!! content that cannot be parsed by infrastructure I/O.
120interface read_netcdf_data
121 ! NOTE: Only 2D I/O is currently used; this should be expanded as needed.
122 module procedure read_netcdf_data_2d
123end interface read_netcdf_data
124
125!> Write a registered field to an output file, potentially with rotation
126interface mom_write_field
127 module procedure mom_write_field_legacy_4d
128 module procedure mom_write_field_legacy_3d
129 module procedure mom_write_field_legacy_2d
130 module procedure mom_write_field_legacy_1d
131 module procedure mom_write_field_legacy_0d
132 module procedure mom_write_field_4d
133 module procedure mom_write_field_3d
134 module procedure mom_write_field_2d
135 module procedure mom_write_field_1d
136 module procedure mom_write_field_0d
137end interface mom_write_field
138
139!> Read an entire named variable from a named netCDF file using netCDF calls directly, rather
140!! than any infrastructure routines and broadcast it from the root PE to the other PEs.
141interface read_variable
142 module procedure read_variable_0d, read_variable_0d_int
143 module procedure read_variable_1d, read_variable_1d_int
144 module procedure read_variable_2d, read_variable_3d
145end interface read_variable
146
147!> Read a global or variable attribute from a named netCDF file using netCDF calls
148!! directly, in some cases reading from the root PE before broadcasting to the other PEs.
149interface read_attribute
152end interface read_attribute
153
154!> Type that stores information that can be used to create a non-decomposed axis.
155type :: axis_info
156 character(len=32) :: name = "" !< The name of this axis for use in files
157 character(len=256) :: longname = "" !< A longer name describing this axis
158 character(len=48) :: units = "" !< The units of the axis labels
159 character(len=8) :: cartesian = "N" !< A variable indicating which direction
160 !! this axis corresponds with. Valid values
161 !! include 'X', 'Y', 'Z', 'T', and 'N' for none.
162 integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1
163 !! if they increase downward. The default, 0, is ignored.
164 integer :: ax_size = 0 !< The number of elements in this axis
165 real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis [arbitrary]
166end type axis_info
167
168!> Type for describing a 3-d variable for output
169type, public :: vardesc
170 character(len=64) :: name !< Variable name in a NetCDF file
171 character(len=48) :: units !< Physical dimensions of the variable
172 character(len=240) :: longname !< Long name of the variable
173 character(len=8) :: hor_grid !< Horizontal grid: u, v, h, q, Cu, Cv, T, Bu, or 1
174 character(len=8) :: z_grid !< Vertical grid: L, i, or 1
175 character(len=8) :: t_grid !< Time description: s, p, or 1
176 character(len=64) :: cmor_field_name !< CMOR name
177 character(len=64) :: cmor_units !< CMOR physical dimensions of the variable
178 character(len=240) :: cmor_longname !< CMOR long name of the variable
179 real :: conversion !< for unit conversions, such as needed to convert
180 !! from intensive to extensive [various] or [a A-1 ~> 1]
181 !! to undo internal dimensional rescaling
182 character(len=32) :: dim_names(5) !< The names in the file of the axes for this variable
183 integer :: position = -1 !< An integer encoding the horizontal position, it may
184 !! CENTER, CORNER, EAST_FACE, NORTH_FACE, or 0.
185 type(axis_info) :: extra_axes(5) !< dimensions other than space-time
186end type vardesc
187
188!> Type that stores for a global file attribute
189type :: attribute_info ; private
190 character(len=:), allocatable :: name !< The name of this attribute
191 character(len=:), allocatable :: att_val !< The values of this attribute
192end type attribute_info
193
194integer, public :: stdout = stdout_iso !< standard output unit
195integer, public :: stderr = stderr_iso !< standard output unit
196
197! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
198! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
199! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
200! vary with the Boussinesq approximation, the Boussinesq variant is given first.
201! The functions in this module work with variables with arbitrary units, in which case the
202! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a].
203
204contains
205
206!> `create_MOM_file` wrapper for the legacy file handle, `file_type`.
207!! NOTE: This function may be removed in a future release.
208subroutine create_file(IO_handle, filename, vars, novars, fields, threading, &
209 timeunit, G, dG, GV, checksums, extra_axes, global_atts)
210 type(file_type), intent(inout) :: io_handle
211 !< Handle for a files or fileset that is to be opened or reopened for
212 !! writing
213 character(len=*), intent(in) :: filename
214 !< full path to the file to create
215 type(vardesc), intent(in) :: vars(:)
216 !< structures describing fields written to filename
217 integer, intent(in) :: novars
218 !< number of fields written to filename
219 type(fieldtype), intent(inout) :: fields(:)
220 !< array of fieldtypes for each variable
221 integer, optional, intent(in) :: threading
222 !< SINGLE_FILE or MULTIPLE
223 real, optional, intent(in) :: timeunit
224 !< length of the units for time [s]. The default value is 86400.0, for 1
225 !! day.
226 type(ocean_grid_type), optional, intent(in) :: g
227 !< ocean horizontal grid structure; G or dG is required if the new file
228 !! uses any horizontal grid axes.
229 type(dyn_horgrid_type), optional, intent(in) :: dg
230 !< dynamic horizontal grid structure; G or dG is required if the new file
231 !! uses any horizontal grid axes.
232 type(verticalgrid_type), optional, intent(in) :: gv
233 !< ocean vertical grid structure, which is ! required if the new file uses
234 !! any vertical grid axes.
235 integer(kind=int64), optional, intent(in) :: checksums(:,:)
236 !< checksums of vars
237 type(axis_info), optional, intent(in) :: extra_axes(:)
238 !< Types with information about some axes that might be used in this file
239 type(attribute_info), optional, intent(in) :: global_atts(:)
240 !< Global attributes to write to this file
241
242 type(mom_infra_file) :: new_file
243 type(mom_field) :: new_fields(novars)
244
245 new_file%handle_infra = io_handle
246
247 call create_mom_file(new_file, filename, vars, novars, new_fields, &
248 threading=threading, timeunit=timeunit, g=g, dg=dg, gv=gv, &
249 checksums=checksums, extra_axes=extra_axes, global_atts=global_atts)
250
251 io_handle = new_file%handle_infra
252 call new_file%get_file_fieldtypes(fields(:novars))
253end subroutine create_file
254
255
256!! Create a new netCDF file and register the MOM_fields to be written.
257subroutine create_mom_file(IO_handle, filename, vars, novars, fields, &
258 threading, timeunit, G, dG, GV, checksums, extra_axes, global_atts)
259 class(mom_file), intent(inout) :: io_handle !< Handle for a files or fileset that is to be
260 !! opened or reopened for writing
261 character(len=*), intent(in) :: filename !< full path to the file to create
262 type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename
263 integer, intent(in) :: novars !< number of fields written to filename
264 type(mom_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable
265 integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE
266 real, optional, intent(in) :: timeunit !< length of the units for time [s]. The
267 !! default value is 86400.0, for 1 day.
268 type(ocean_grid_type), optional, intent(in) :: g !< ocean horizontal grid structure; G or dG
269 !! is required if the new file uses any
270 !! horizontal grid axes.
271 type(dyn_horgrid_type), optional, intent(in) :: dg !< dynamic horizontal grid structure; G or dG
272 !! is required if the new file uses any
273 !! horizontal grid axes.
274 type(verticalgrid_type), optional, intent(in) :: gv !< ocean vertical grid structure, which is
275 !! required if the new file uses any
276 !! vertical grid axes.
277 integer(kind=int64), optional, intent(in) :: checksums(:,:) !< checksums of vars
278 type(axis_info), dimension(:), &
279 optional, intent(in) :: extra_axes !< Types with information about
280 !! some axes that might be used in this file
281 type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to
282 !! write to this file
283
284 logical :: use_lath, use_lonh, use_latq, use_lonq, use_time
285 logical :: use_layer, use_int, use_periodic
286 logical :: one_file, domain_set, dim_found
287 logical, dimension(:), allocatable :: use_extra_axis
288 type(mom_axis) :: axis_lath, axis_latq, axis_lonh, axis_lonq
289 type(mom_axis) :: axis_layer, axis_int, axis_time, axis_periodic
290 type(mom_axis), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes
291 type(mom_axis) :: axes(5) ! The axes of a variable
292 type(mom_domain_type), pointer :: domain => null()
293 type(domain1d) :: x_domain, y_domain
294 integer :: position, numaxes, pack, thread, k, n, m
295 integer :: num_extra_dims ! The number of extra possible dimensions from extra_axes
296 integer :: isg, ieg, jsg, jeg, isgb, iegb, jsgb, jegb
297 integer :: var_periods, num_periods=0
298 real, dimension(:), allocatable :: axis_val ! Axis label values [various]
299 real, pointer, dimension(:) :: &
300 gridlatt => null(), & ! The latitude of T or B points for the purpose of labeling
301 gridlatb => null(), & ! the output axes, often in units of [degrees_N] or [km] or [m].
302 gridlont => null(), & ! The longitude of T or B points for the purpose of labeling
303 gridlonb => null() ! the output axes, often in units of [degrees_E] or [km] or [m].
304 character(len=40) :: time_units, x_axis_units, y_axis_units
305 character(len=8) :: t_grid, t_grid_read
306 character(len=64) :: ax_name(5) ! The axis names of a variable
307
308 use_lath = .false. ; use_lonh = .false.
309 use_latq = .false. ; use_lonq = .false.
310 use_time = .false. ; use_periodic = .false.
311 use_layer = .false. ; use_int = .false.
312 num_extra_dims = 0
313 if (present(extra_axes)) then
314 num_extra_dims = size(extra_axes)
315 if (num_extra_dims > 0) then
316 allocate(use_extra_axis(num_extra_dims)) ; use_extra_axis = .false.
317 allocate(more_axes(num_extra_dims))
318 endif
319 endif
320
321 thread = single_file
322 if (PRESENT(threading)) thread = threading
323
324 domain_set = .false.
325 if (present(g)) then
326 domain_set = .true. ; domain => g%Domain
327 gridlatt => g%gridLatT ; gridlatb => g%gridLatB
328 gridlont => g%gridLonT ; gridlonb => g%gridLonB
329 x_axis_units = g%x_axis_units ; y_axis_units = g%y_axis_units
330 isg = g%isg ; ieg = g%ieg ; jsg = g%jsg ; jeg = g%jeg
331 isgb = g%IsgB ; iegb = g%IegB ; jsgb = g%JsgB ; jegb = g%JegB
332 elseif (present(dg)) then
333 domain_set = .true. ; domain => dg%Domain
334 gridlatt => dg%gridLatT ; gridlatb => dg%gridLatB
335 gridlont => dg%gridLonT ; gridlonb => dg%gridLonB
336 x_axis_units = dg%x_axis_units ; y_axis_units = dg%y_axis_units
337 isg = dg%isg ; ieg = dg%ieg ; jsg = dg%jsg ; jeg = dg%jeg
338 isgb = dg%IsgB ; iegb = dg%IegB ; jsgb = dg%JsgB ; jegb = dg%JegB
339 endif
340
341 one_file = .true.
342 if (domain_set) one_file = (thread == single_file)
343
344 if (one_file) then
345 if (domain_set) then
346 call io_handle%open(filename, action=overwrite_file, &
347 mom_domain=domain, threading=thread, fileset=single_file)
348 else
349 call io_handle%open(filename, action=overwrite_file, threading=thread, &
350 fileset=single_file)
351 endif
352 else
353 call io_handle%open(filename, action=overwrite_file, mom_domain=domain, &
354 threading=thread, fileset=thread)
355 endif
356
357! Define the coordinates.
358 do k=1,novars
359 position = vars(k)%position
360 if (position == -1) position = position_from_horgrid(vars(k)%hor_grid)
361 select case (position)
362 case (center) ; use_lath = .true. ; use_lonh = .true.
363 case (corner) ; use_latq = .true. ; use_lonq = .true.
364 case (east_face) ; use_lath = .true. ; use_lonq = .true.
365 case (north_face) ; use_latq = .true. ; use_lonh = .true.
366 case (0) ! Do nothing.
367 case default
368 call mom_error(warning, "MOM_io create_file: "//trim(vars(k)%name)//" has an unrecognized value of postion")
369 end select
370 select case (vars(k)%z_grid)
371 case ('L') ; use_layer = .true.
372 case ('i') ; use_int = .true.
373 case ('1') ! Do nothing.
374 case default
375 call mom_error(fatal, "MOM_io create_file: "//trim(vars(k)%name)//&
376 " has unrecognized z_grid "//trim(vars(k)%z_grid))
377 end select
378 t_grid = adjustl(vars(k)%t_grid)
379 select case (t_grid(1:1))
380 case ('s', 'a', 'm') ; use_time = .true.
381 case ('p') ; use_periodic = .true.
382 if (len_trim(t_grid(2:8)) <= 0) call mom_error(fatal, &
383 "MOM_io create_file: No periodic axis length was specified in "//&
384 trim(vars(k)%t_grid) // " in the periodic axes of variable "//&
385 trim(vars(k)%name)//" in file "//trim(filename))
386 var_periods = -9999999
387 t_grid_read = adjustl(t_grid(2:8))
388 read(t_grid_read,*) var_periods
389 if (var_periods == -9999999) call mom_error(fatal, &
390 "MOM_io create_file: Failed to read the number of periods from "//&
391 trim(vars(k)%t_grid) // " in the periodic axes of variable "//&
392 trim(vars(k)%name)//" in file "//trim(filename))
393 if (var_periods < 1) call mom_error(fatal, "MOM_io create_file: "//&
394 "variable "//trim(vars(k)%name)//" in file "//trim(filename)//&
395 " uses a periodic time axis, and must have a positive "//&
396 "value for the number of periods in "//vars(k)%t_grid )
397 if ((num_periods > 0) .and. (var_periods /= num_periods)) &
398 call mom_error(fatal, "MOM_io create_file: "//&
399 "Only one value of the number of periods can be used in the "//&
400 "create_file call for file "//trim(filename)//". The second is "//&
401 "variable "//trim(vars(k)%name)//" with t_grid "//vars(k)%t_grid )
402
403 num_periods = var_periods
404 case ('1') ! Do nothing.
405 case default
406 call mom_error(warning, "MOM_io create_file: "//trim(vars(k)%name)//&
407 " has unrecognized t_grid "//trim(vars(k)%t_grid))
408 end select
409
410 do n=1,5 ; if (len_trim(vars(k)%dim_names(n)) > 0) then
411 dim_found = .false.
412 do m=1,num_extra_dims
413 if (lowercase(trim(vars(k)%dim_names(n))) == lowercase(trim(extra_axes(m)%name))) then
414 use_extra_axis(m) = .true.
415 dim_found = .true.
416 exit
417 endif
418 enddo
419 if (.not.dim_found) call mom_error(fatal, "Unable to find a match for dimension "//&
420 trim(vars(k)%dim_names(n))//" for variable "//trim(vars(k)%name)//" in file "//trim(filename))
421 endif ; enddo
422 enddo
423
424 if ((use_lath .or. use_lonh .or. use_latq .or. use_lonq)) then
425 if (.not.domain_set) call mom_error(fatal, "create_file: "//&
426 "An ocean_grid_type or dyn_horgrid_type is required to create a file with a horizontal coordinate.")
427
428 call get_domain_components(domain, x_domain, y_domain)
429 endif
430 if ((use_layer .or. use_int) .and. .not.present(gv)) call mom_error(fatal, &
431 "create_file: A vertical grid type is required to create a file with a vertical coordinate.")
432
433 if (use_lath) &
434 axis_lath = io_handle%register_axis("lath", units=y_axis_units, longname="Latitude", &
435 cartesian='Y', domain=y_domain, data=gridlatt(jsg:jeg))
436 if (use_lonh) &
437 axis_lonh = io_handle%register_axis("lonh", units=x_axis_units, longname="Longitude", &
438 cartesian='X', domain=x_domain, data=gridlont(isg:ieg))
439 if (use_latq) &
440 axis_latq = io_handle%register_axis("latq", units=y_axis_units, longname="Latitude", &
441 cartesian='Y', domain=y_domain, data=gridlatb(jsgb:jegb), edge_axis=.true.)
442 if (use_lonq) &
443 axis_lonq = io_handle%register_axis("lonq", units=x_axis_units, longname="Longitude", &
444 cartesian='X', domain=x_domain, data=gridlonb(isgb:iegb), edge_axis=.true.)
445 if (use_layer) &
446 axis_layer = io_handle%register_axis("Layer", units=trim(gv%zAxisUnits), &
447 longname="Layer "//trim(gv%zAxisLongName), cartesian='Z', &
448 sense=1, data=gv%sLayer(1:gv%ke))
449 if (use_int) &
450 axis_int = io_handle%register_axis("Interface", units=trim(gv%zAxisUnits), &
451 longname="Interface "//trim(gv%zAxisLongName), cartesian='Z', &
452 sense=1, data=gv%sInterface(1:gv%ke+1))
453
454 if (use_time) then ; if (present(timeunit)) then
455 ! Set appropriate units, depending on the value.
456 if (timeunit < 0.0) then
457 time_units = "days" ! The default value.
458 elseif ((timeunit >= 0.99) .and. (timeunit < 1.01)) then
459 time_units = "seconds"
460 elseif ((timeunit >= 3599.0) .and. (timeunit < 3601.0)) then
461 time_units = "hours"
462 elseif ((timeunit >= 86399.0) .and. (timeunit < 86401.0)) then
463 time_units = "days"
464 elseif ((timeunit >= 3.0e7) .and. (timeunit < 3.2e7)) then
465 time_units = "years"
466 else
467 write(time_units,'(es8.2," s")') timeunit
468 endif
469
470 axis_time = io_handle%register_axis("Time", units=time_units, longname="Time", cartesian='T')
471 else
472 axis_time = io_handle%register_axis("Time", units="days", longname="Time", cartesian='T')
473 endif ; endif
474
475 if (use_periodic) then
476 if (num_periods <= 1) call mom_error(fatal, "MOM_io create_file: "//&
477 "num_periods for file "//trim(filename)//" must be at least 1.")
478 ! Define a periodic axis with unit labels.
479 allocate(axis_val(num_periods))
480 do k=1,num_periods ; axis_val(k) = real(k) ; enddo
481 axis_periodic = io_handle%register_axis("Period", units="nondimensional", &
482 longname="Periods for cyclical variables", cartesian='T', data=axis_val)
483 deallocate(axis_val)
484 endif
485
486 do m=1,num_extra_dims ; if (use_extra_axis(m)) then
487 if (allocated(extra_axes(m)%ax_data)) then
488 more_axes(m) = io_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, &
489 longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, &
490 sense=extra_axes(m)%sense, data=extra_axes(m)%ax_data)
491 elseif (trim(extra_axes(m)%cartesian) == "T") then
492 more_axes(m) = io_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, &
493 longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian)
494 else
495 ! FMS requires that non-time axes have variables that label their values, even if they are trivial.
496 allocate (axis_val(extra_axes(m)%ax_size))
497 do k=1,extra_axes(m)%ax_size ; axis_val(k) = real(k) ; enddo
498 more_axes(m) = io_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, &
499 longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, &
500 sense=extra_axes(m)%sense, data=axis_val)
501 deallocate(axis_val)
502 endif
503 endif ; enddo
504
505 do k=1,novars
506 numaxes = 0
507 position = vars(k)%position
508 if (position == -1) position = position_from_horgrid(vars(k)%hor_grid)
509 select case (position)
510 case (center)
511 numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath ; ax_name(1) = "lonh" ; ax_name(2) = "lath"
512 case (corner)
513 numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq ; ax_name(1) = "lonq" ; ax_name(2) = "latq"
514 case (east_face)
515 numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath ; ax_name(1) = "lonq" ; ax_name(2) = "lath"
516 case (north_face)
517 numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq ; ax_name(1) = "lonh" ; ax_name(2) = "latq"
518 case (0) ! Do nothing.
519 case default
520 call mom_error(warning, "MOM_io create_file: "//trim(vars(k)%name)//&
521 " has unrecognized position, hor_grid = "//trim(vars(k)%hor_grid))
522 end select
523 select case (vars(k)%z_grid)
524 case ('L') ; numaxes = numaxes+1 ; axes(numaxes) = axis_layer ; ax_name(numaxes) = "Layer"
525 case ('i') ; numaxes = numaxes+1 ; axes(numaxes) = axis_int ; ax_name(numaxes) = "Interface"
526 case ('1') ! Do nothing.
527 case default
528 call mom_error(fatal, "MOM_io create_file: "//trim(vars(k)%name)//&
529 " has unrecognized z_grid "//trim(vars(k)%z_grid))
530 end select
531
532 do n=1,numaxes
533 if ( (len_trim(vars(k)%dim_names(n)) > 0) .and. (trim(ax_name(n)) /= trim(vars(k)%dim_names(n))) ) &
534 call mom_error(warning, "MOM_io create_file: dimension "//trim(ax_name(n))//&
535 " of variable "//trim(vars(k)%name)//" in "//trim(filename)//&
536 " is being set inconsistently as "//trim(vars(k)%dim_names(n)))
537 enddo
538 do n=numaxes+1,5 ; if (len_trim(vars(k)%dim_names(n)) > 0) then
539 dim_found = .false.
540 do m=1,num_extra_dims
541 if (lowercase(trim(vars(k)%dim_names(n))) == lowercase(trim(extra_axes(m)%name))) then
542 numaxes = numaxes+1 ; axes(numaxes) = more_axes(m)
543 exit
544 endif
545 enddo
546 endif ; enddo
547
548 t_grid = adjustl(vars(k)%t_grid)
549 select case (t_grid(1:1))
550 case ('s', 'a', 'm') ; numaxes = numaxes+1 ; axes(numaxes) = axis_time
551 case ('p') ; numaxes = numaxes+1 ; axes(numaxes) = axis_periodic
552 case ('1') ! Do nothing.
553 case default
554 call mom_error(warning, "MOM_io create_file: "//trim(vars(k)%name)//&
555 " has unrecognized t_grid "//trim(vars(k)%t_grid))
556 end select
557
558 pack = 1
559 if (present(checksums)) then
560 fields(k) = io_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, &
561 vars(k)%longname, pack=pack, checksum=checksums(k,:), conversion=vars(k)%conversion)
562 else
563 fields(k) = io_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, &
564 vars(k)%longname, pack=pack, conversion=vars(k)%conversion)
565 endif
566 enddo
567
568 if (present(global_atts)) then
569 do n=1,size(global_atts)
570 if (allocated(global_atts(n)%name) .and. allocated(global_atts(n)%att_val)) &
571 call io_handle%write_attribute(global_atts(n)%name, global_atts(n)%att_val)
572 enddo
573 endif
574
575 ! Now write the variables with the axis label values
576 if (use_lath) call io_handle%write_field(axis_lath)
577 if (use_latq) call io_handle%write_field(axis_latq)
578 if (use_lonh) call io_handle%write_field(axis_lonh)
579 if (use_lonq) call io_handle%write_field(axis_lonq)
580 if (use_layer) call io_handle%write_field(axis_layer)
581 if (use_int) call io_handle%write_field(axis_int)
582 if (use_periodic) call io_handle%write_field(axis_periodic)
583 do m=1,num_extra_dims ; if (use_extra_axis(m)) then
584 call io_handle%write_field(more_axes(m))
585 endif ; enddo
586
587 if (num_extra_dims > 0) then
588 deallocate(use_extra_axis, more_axes)
589 endif
590end subroutine create_mom_file
591
592
593!> `reopen_MOM_file` wrapper for the legacy file handle, `file_type`.
594!! NOTE: This function may be removed in a future release.
595subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, &
596 timeunit, G, dG, GV, extra_axes, global_atts)
597 type(file_type), intent(inout) :: io_handle
598 !< Handle for a file or fileset that is to be opened or reopened for
599 !! writing
600 character(len=*), intent(in) :: filename
601 !< full path to the file to create
602 type(vardesc), intent(in) :: vars(:)
603 !< structures describing fields written to filename
604 integer, intent(in) :: novars
605 !< number of fields written to filename
606 type(fieldtype), intent(inout) :: fields(:)
607 !< array of fieldtypes for each variable
608 integer, optional, intent(in) :: threading
609 !< SINGLE_FILE or MULTIPLE
610 real, optional, intent(in) :: timeunit
611 !< length of the units for time [s]. The default value is 86400.0, for 1
612 !! day.
613 type(ocean_grid_type), optional, intent(in) :: g
614 !< ocean horizontal grid structure; G or dG is required if a new file uses
615 !! any horizontal grid axes.
616 type(dyn_horgrid_type), optional, intent(in) :: dg
617 !< dynamic horizontal grid structure; G or dG is required if a new file
618 !! uses any horizontal grid axes.
619 type(verticalgrid_type), optional, intent(in) :: gv
620 !< ocean vertical grid structure, which is required if a new file uses any
621 !! vertical grid axes.
622 type(axis_info), optional, intent(in) :: extra_axes(:)
623 !< Types with information about some axes that might be used in this file
624 type(attribute_info), optional, intent(in) :: global_atts(:)
625 !< Global attributes to write to this file
626
627 type(mom_infra_file) :: mfile
628 !< Wrapper to MOM file
629 type(mom_field), allocatable :: mfields(:)
630 !< Wrapper to MOM fields
631 integer :: i
632
633 mfile%handle_infra = io_handle
634 allocate(mfields(size(fields)))
635
636 call reopen_mom_file(mfile, filename, vars, novars, mfields, &
637 threading=threading, timeunit=timeunit, g=g, dg=dg, gv=gv, &
638 extra_axes=extra_axes, global_atts=global_atts)
639
640 io_handle = mfile%handle_infra
641 call get_file_fields(io_handle, fields)
642end subroutine reopen_file
643
644
645!> This routine opens an existing NetCDF file for output. If it
646!! does not find the file, a new file is created. It also sets up
647!! structures that describe this file and the variables that will
648!! later be written to this file.
649subroutine reopen_mom_file(IO_handle, filename, vars, novars, fields, &
650 threading, timeunit, G, dG, GV, extra_axes, global_atts)
651 class(mom_file), intent(inout) :: io_handle !< Handle for a file or fileset that is to be
652 !! opened or reopened for writing
653 character(len=*), intent(in) :: filename !< full path to the file to create
654 type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename
655 integer, intent(in) :: novars !< number of fields written to filename
656 type(mom_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable
657 integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE
658 real, optional, intent(in) :: timeunit !< length of the units for time [s]. The
659 !! default value is 86400.0, for 1 day.
660 type(ocean_grid_type), optional, intent(in) :: g !< ocean horizontal grid structure; G or dG
661 !! is required if a new file uses any
662 !! horizontal grid axes.
663 type(dyn_horgrid_type), optional, intent(in) :: dg !< dynamic horizontal grid structure; G or dG
664 !! is required if a new file uses any
665 !! horizontal grid axes.
666 type(verticalgrid_type), optional, intent(in) :: gv !< ocean vertical grid structure, which is
667 !! required if a new file uses any
668 !! vertical grid axes.
669 type(axis_info), optional, intent(in) :: extra_axes(:) !< Types with information about
670 !! some axes that might be used in this file
671 type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to
672 !! write to this file
673
674 type(mom_domain_type), pointer :: domain => null()
675 character(len=200) :: check_name, mesg
676 integer :: length, nvar, thread
677 logical :: exists, one_file, domain_set
678
679 thread = single_file
680 if (PRESENT(threading)) thread = threading
681
682 ! For single-file IO, only the root PE is required to set up the fields.
683 ! This permits calls by either the root PE or all PEs
684 if (.not. is_root_pe() .and. thread == single_file) return
685
686 ! For multiple IO domains, we would need additional functionality:
687 ! * Identify ranks as IO PEs
688 ! * Determine the filename of
689 ! Neither of these tasks should be handed by MOM6, so we cannot safely use
690 ! this function. A framework-specific `inquire()` function is needed.
691 ! Until it exists, we will disable this function.
692 if (thread == multiple) &
693 call mom_error(fatal, 'reopen_MOM_file does not yet support files with ' &
694 // 'multiple I/O domains.')
695
696 check_name = filename
697 length = len(trim(check_name))
698 if (check_name(length-2:length) /= ".nc") check_name = trim(check_name)//".nc"
699 if (thread /= single_file) check_name = trim(check_name)//".0000"
700
701 inquire(file=check_name,exist=exists)
702
703 if (.not.exists) then
704 call create_mom_file(io_handle, filename, vars, novars, fields, &
705 threading, timeunit, g=g, dg=dg, gv=gv, extra_axes=extra_axes, &
706 global_atts=global_atts)
707 else
708
709 domain_set = .false.
710 if (present(g)) then
711 domain_set = .true. ; domain => g%Domain
712 elseif (present(dg)) then
713 domain_set = .true. ; domain => dg%Domain
714 endif
715
716 one_file = .true.
717 if (domain_set) one_file = (thread == single_file)
718
719 if (one_file) then
720 call io_handle%open(filename, append_file, threading=thread)
721 else
722 call io_handle%open(filename, append_file, mom_domain=domain)
723 endif
724 if (.not. io_handle%file_is_open()) return
725
726 call io_handle%get_file_info(nvar=nvar)
727
728 if (nvar == -1) then
729 write (mesg,*) "Reopening file ",trim(filename)," apparently had ",nvar,&
730 " variables. Clobbering and creating file with ",novars," instead."
731 call mom_error(warning,"MOM_io: "//mesg)
732 call create_mom_file(io_handle, filename, vars, novars, fields, &
733 threading, timeunit, g=g, dg=dg, gv=gv, extra_axes=extra_axes, &
734 global_atts=global_atts)
735 elseif (nvar /= novars) then
736 write (mesg,*) "Reopening file ",trim(filename)," with ",novars,&
737 " variables instead of ",nvar,"."
738 call mom_error(fatal,"MOM_io: "//mesg)
739 endif
740
741 if (nvar > 0) call io_handle%get_file_fields(fields(1:nvar))
742 endif
743end subroutine reopen_mom_file
744
745
746!> Return the index of sdtout if called from the root PE, or 0 for other PEs.
747integer function stdout_if_root()
749 if (is_root_pe()) stdout_if_root = stdout
750end function stdout_if_root
751
752!> This function determines how many time levels a variable has in a file.
753function num_timelevels(filename, varname, min_dims) result(n_time)
754 character(len=*), intent(in) :: filename !< name of the file to read
755 character(len=*), intent(in) :: varname !< variable whose number of time levels
756 !! are to be returned
757 integer, optional, intent(in) :: min_dims !< The minimum number of dimensions a variable must have
758 !! if it has a time dimension. If the variable has 1 less
759 !! dimension than this, then 0 is returned.
760 integer :: n_time !< number of time levels varname has in filename
761
762 character(len=256) :: msg
763 integer :: ndims
764 integer :: sizes(8)
765
766 n_time = -1
767
768 ! To do almost the same via MOM_io_infra calls, we could do the following:
769 ! found = field_exists(filename, varname)
770 ! if (found) then
771 ! call open_file(ncid, filename, action=READONLY_FILE, form=NETCDF_FILE, threading=MULTIPLE)
772 ! call get_file_info(ncid, ntime=n_time)
773 ! endif
774 ! However, this does not handle the case where the time axis for the variable is not the record
775 ! axis and min_dims is not used.
776
777 call get_var_sizes(filename, varname, ndims, sizes, match_case=.false., caller="num_timelevels")
778
779 if (ndims > 0) n_time = sizes(ndims)
780
781 if (present(min_dims)) then
782 if (ndims < min_dims-1) then
783 write(msg, '(I0)') min_dims
784 call mom_error(warning, "num_timelevels: variable "//trim(varname)//" in file "//&
785 trim(filename)//" has fewer than min_dims = "//trim(msg)//" dimensions.")
786 n_time = -1
787 elseif (ndims == min_dims - 1) then
788 n_time = 0
789 endif
790 endif
791
792end function num_timelevels
793
794
795!> get_var_sizes returns the number and size of dimensions associate with a variable in a file.
796!! Usually only the root PE does the read, and then the information is broadcast
797subroutine get_var_sizes(filename, varname, ndims, sizes, match_case, caller, all_read, dim_names, ncid_in)
798 character(len=*), intent(in) :: filename !< Name of the file to read, used here in messages
799 character(len=*), intent(in) :: varname !< The variable name, used here for messages
800 integer, intent(out) :: ndims !< The number of dimensions to the variable
801 integer, dimension(:), intent(out) :: sizes !< The dimension sizes, or 0 for extra values
802 logical, optional, intent(in) :: match_case !< If false, allow for variables name matches to be
803 !! case insensitive, but take a perfect match if
804 !! found. The default is true.
805 character(len=*), optional, intent(in) :: caller !< The name of a calling routine for use in error messages
806 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
807 !! routine actually do the read, otherwise only
808 !! root PE reads and then it broadcasts the results.
809 character(len=*), dimension(:), &
810 optional, intent(out) :: dim_names !< The names of the dimensions for this variable
811 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
812 !! file is opened and closed within this routine.
813
814 logical :: do_read, do_broadcast
815 integer, allocatable :: size_msg(:) ! An array combining the number of dimensions and the sizes.
816 integer :: n, nval
817
818 do_read = is_root_pe()
819 if (present(all_read)) do_read = all_read .or. do_read
820 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
821
822 if (do_read) call read_var_sizes(filename, varname, ndims, sizes, match_case, caller, dim_names, ncid_in)
823
824 if (do_broadcast) then
825 ! Distribute the sizes from the root PE.
826 nval = size(sizes) + 1
827
828 allocate(size_msg(nval))
829 size_msg(1) = ndims
830 do n=2,nval ; size_msg(n) = sizes(n-1) ; enddo
831
832 call broadcast(size_msg, nval, blocking=.true.)
833
834 ndims = size_msg(1)
835 do n=2,nval ; sizes(n-1) = size_msg(n) ; enddo
836 deallocate(size_msg)
837
838 if (present(dim_names) .and. (ndims > 0)) then
839 nval = min(ndims, size(dim_names))
840 call broadcast(dim_names(1:nval), len(dim_names(1)), blocking=.true.)
841 endif
842 endif
843
844end subroutine get_var_sizes
845
846!> read_var_sizes returns the number and size of dimensions associated with a variable in a file.
847!! If the variable is not in the file the returned sizes are all 0 and ndims is -1.
848!! Every processor for which this is called does the reading.
849subroutine read_var_sizes(filename, varname, ndims, sizes, match_case, caller, dim_names, ncid_in)
850 character(len=*), intent(in) :: filename !< Name of the file to read, used here in messages
851 character(len=*), intent(in) :: varname !< The variable name, used here for messages
852 integer, intent(out) :: ndims !< The number of dimensions to the variable
853 integer, dimension(:), intent(out) :: sizes !< The dimension sizes, or 0 for extra values
854 logical, optional, intent(in) :: match_case !< If false, allow for variables name matches to be
855 !! case insensitive, but take a perfect match if
856 !! found. The default is true.
857 character(len=*), &
858 optional, intent(in) :: caller !< The name of a calling routine for use in error messages
859 character(len=*), dimension(:), &
860 optional, intent(out) :: dim_names !< The names of the dimensions for this variable
861 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
862 !! file is opened and closed within this routine.
863
864 character(len=256) :: hdr, dimname
865 integer, allocatable :: dimids(:)
866 integer :: varid, ncid, n, status
867 logical :: success, found
868 hdr = "get_var_size: " ; if (present(caller)) hdr = trim(hdr)//": "
869 sizes(:) = 0 ; ndims = -1
870
871 if (present(ncid_in)) then
872 ncid = ncid_in
873 else
874 call open_file_to_read(filename, ncid, success=success)
875 if (.not.success) then
876 call mom_error(warning, "Unsuccessfully attempted to open file "//trim(filename))
877 return
878 endif
879 endif
880
881 ! Get the dimension sizes of the variable varname.
882 call get_varid(varname, ncid, filename, varid, match_case=match_case, found=found)
883 if (.not.found) then
884 call mom_error(warning, "Could not find variable "//trim(varname)//" in file "//trim(filename))
885 return
886 endif
887
888 status = nf90_inquire_variable(ncid, varid, ndims=ndims)
889 if (status /= nf90_noerr) then
890 call mom_error(warning, trim(hdr) // trim(nf90_strerror(status)) //&
891 " Getting number of dimensions of "//trim(varname)//" in "//trim(filename))
892 return
893 endif
894 if (ndims < 1) return
895
896 allocate(dimids(ndims))
897 status = nf90_inquire_variable(ncid, varid, dimids=dimids(1:ndims))
898 if (status /= nf90_noerr) then
899 call mom_error(warning, trim(hdr) // trim(nf90_strerror(status)) //&
900 " Getting dimension IDs for "//trim(varname)//" in "//trim(filename))
901 deallocate(dimids) ; return
902 endif
903
904 do n = 1, min(ndims,size(sizes))
905 status = nf90_inquire_dimension(ncid, dimids(n), name=dimname, len=sizes(n))
906 if (status /= nf90_noerr) call mom_error(warning, trim(hdr) // trim(nf90_strerror(status)) //&
907 " Getting dimension length for "//trim(varname)//" in "//trim(filename))
908 if (present(dim_names)) then
909 if (n <= size(dim_names)) dim_names(n) = trim(dimname)
910 endif
911 enddo
912 deallocate(dimids)
913
914 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
915
916end subroutine read_var_sizes
917
918!> Read a real scalar variable from a netCDF file with the root PE, and broadcast the
919!! results to all the other PEs.
920subroutine read_variable_0d(filename, varname, var, ncid_in, scale)
921 character(len=*), intent(in) :: filename !< The name of the file to read
922 character(len=*), intent(in) :: varname !< The variable name of the data in the file
923 real, intent(inout) :: var !< The scalar into which to read the data in arbitrary units [A ~> a]
924 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
925 !! file is opened and closed within this routine
926 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
927 !! before it is returned to convert from the units in the file
928 !! to the internal units for this variable [A a-1 ~> 1]
929
930 integer :: varid, ncid, rc
931 character(len=256) :: hdr
932 hdr = "read_variable_0d"
933
934 if (is_root_pe()) then
935 if (present(ncid_in)) then
936 ncid = ncid_in
937 else
938 call open_file_to_read(filename, ncid)
939 endif
940
941 call get_varid(varname, ncid, filename, varid, match_case=.false.)
942 if (varid < 0) call mom_error(fatal, "Unable to get netCDF varid for "//trim(varname)//&
943 " in "//trim(filename))
944 rc = nf90_get_var(ncid, varid, var)
945 if (rc /= nf90_noerr) call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
946 " Difficulties reading "//trim(varname)//" from "//trim(filename))
947
948 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
949
950 if (present(scale)) var = scale * var
951 endif
952
953 call broadcast(var, blocking=.true.)
954end subroutine read_variable_0d
955
956!> Read a 1-d real variable from a netCDF file with the root PE, and broadcast the
957!! results to all the other PEs.
958subroutine read_variable_1d(filename, varname, var, ncid_in, scale)
959 character(len=*), intent(in) :: filename !< The name of the file to read
960 character(len=*), intent(in) :: varname !< The variable name of the data in the file
961 real, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data in arbitrary units [A ~> a]
962 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
963 !! file is opened and closed within this routine
964 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
965 !! before it is returned to convert from the units in the file
966 !! to the internal units for this variable [A a-1 ~> 1]
967
968 integer :: varid, ncid, rc
969 character(len=256) :: hdr
970 hdr = "read_variable_1d"
971
972 if (is_root_pe()) then
973 if (present(ncid_in)) then
974 ncid = ncid_in
975 else
976 call open_file_to_read(filename, ncid)
977 endif
978
979 call get_varid(varname, ncid, filename, varid, match_case=.false.)
980 if (varid < 0) call mom_error(fatal, "Unable to get netCDF varid for "//trim(varname)//&
981 " in "//trim(filename))
982 rc = nf90_get_var(ncid, varid, var)
983 if (rc /= nf90_noerr) call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
984 " Difficulties reading "//trim(varname)//" from "//trim(filename))
985
986 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
987
988 if (present(scale)) then ; if (scale /= 1.0) then
989 var(:) = scale * var(:)
990 endif ; endif
991 endif
992
993 call broadcast(var, size(var), blocking=.true.)
994end subroutine read_variable_1d
995
996!> Read a integer scalar variable from a netCDF file with the root PE, and broadcast the
997!! results to all the other PEs.
998subroutine read_variable_0d_int(filename, varname, var, ncid_in)
999 character(len=*), intent(in) :: filename !< The name of the file to read
1000 character(len=*), intent(in) :: varname !< The variable name of the data in the file
1001 integer, intent(inout) :: var !< The scalar into which to read the data
1002 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1003 !! file is opened and closed within this routine.
1004
1005 integer :: varid, ncid, rc
1006 character(len=256) :: hdr
1007 hdr = "read_variable_0d_int"
1008
1009 if (is_root_pe()) then
1010 if (present(ncid_in)) then
1011 ncid = ncid_in
1012 else
1013 call open_file_to_read(filename, ncid)
1014 endif
1015
1016 call get_varid(varname, ncid, filename, varid, match_case=.false.)
1017 if (varid < 0) call mom_error(fatal, "Unable to get netCDF varid for "//trim(varname)//&
1018 " in "//trim(filename))
1019 rc = nf90_get_var(ncid, varid, var)
1020 if (rc /= nf90_noerr) call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
1021 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1022
1023 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1024 endif
1025
1026 call broadcast(var, blocking=.true.)
1027end subroutine read_variable_0d_int
1028
1029!> Read a 1-d integer variable from a netCDF file with the root PE, and broadcast the
1030!! results to all the other PEs.
1031subroutine read_variable_1d_int(filename, varname, var, ncid_in)
1032 character(len=*), intent(in) :: filename !< The name of the file to read
1033 character(len=*), intent(in) :: varname !< The variable name of the data in the file
1034 integer, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data
1035 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1036 !! file is opened and closed within this routine.
1037
1038 integer :: varid, ncid, rc
1039 character(len=256) :: hdr
1040 hdr = "read_variable_1d_int"
1041
1042 if (is_root_pe()) then
1043 if (present(ncid_in)) then
1044 ncid = ncid_in
1045 else
1046 call open_file_to_read(filename, ncid)
1047 endif
1048
1049 call get_varid(varname, ncid, filename, varid, match_case=.false.)
1050 if (varid < 0) call mom_error(fatal, "Unable to get netCDF varid for "//trim(varname)//&
1051 " in "//trim(filename))
1052 rc = nf90_get_var(ncid, varid, var)
1053 if (rc /= nf90_noerr) call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
1054 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1055
1056 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1057 endif
1058
1059 call broadcast(var, size(var), blocking=.true.)
1060end subroutine read_variable_1d_int
1061
1062!> Read a 2d array from a netCDF input file and save to a variable.
1063!!
1064!! Start and nread lenths may exceed var rank. This allows for reading slices
1065!! of larger arrays.
1066!!
1067!! Previous versions of the model required a time axis on IO fields. This
1068!! constraint was dropped in later versions. As a result, versions both with
1069!! and without a time axis now exist. In order to support all such versions,
1070!! we use a reshaped version of start and nread in order to read the variable
1071!! as it exists in the file.
1072!!
1073!! Certain constraints are still applied to start and nread in order to ensure
1074!! that varname is a valid 2d array, or contains valid 2d slices.
1075!!
1076!! I/O occurs only on the root PE, and data is broadcast to other ranks.
1077!! Due to potentially large memory communication and storage, this subroutine
1078!! should only be used when domain-decomposition is unavaialable.
1079subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in)
1080 character(len=*), intent(in) :: filename !< Name of file to be read
1081 character(len=*), intent(in) :: varname !< Name of variable to be read
1082 real, intent(out) :: var(:,:) !< Output array of variable [arbitrary]
1083 integer, optional, intent(in) :: start(:) !< Starting index on each axis.
1084 integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis
1085 integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file.
1086 !! If absent, the file is opened and closed within this routine.
1087
1088 integer :: ncid, varid
1089 integer :: field_ndims, dim_len
1090 integer, allocatable :: field_dimids(:), field_shape(:)
1091 integer, allocatable :: field_start(:), field_nread(:)
1092 integer :: i, rc
1093 character(len=*), parameter :: hdr = "read_variable_2d: "
1094
1095 ! Validate shape of start and nread
1096 if (present(start)) then
1097 if (size(start) < 2) &
1098 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1099 // " start must have at least two dimensions.")
1100 endif
1101
1102 if (present(nread)) then
1103 if (size(nread) < 2) &
1104 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1105 // " nread must have at least two dimensions.")
1106
1107 if (any(nread(3:) > 1)) &
1108 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1109 // " nread may only read a single level in higher dimensions.")
1110 endif
1111
1112 ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure
1113 ! that their lengths are equivalent, and must do it here.
1114 if (present(start) .and. present(nread)) then
1115 if (size(start) /= size(nread)) &
1116 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1117 // " start and nread must have the same length.")
1118 endif
1119
1120 ! Open and read `varname` from `filename`
1121 if (is_root_pe()) then
1122 if (present(ncid_in)) then
1123 ncid = ncid_in
1124 else
1125 call open_file_to_read(filename, ncid)
1126 endif
1127
1128 call get_varid(varname, ncid, filename, varid, match_case=.false.)
1129 if (varid < 0) call mom_error(fatal, "Unable to get netCDF varid for "//trim(varname)//&
1130 " in "//trim(filename))
1131
1132 ! Query for the dimensionality of the input field
1133 rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims)
1134 if (rc /= nf90_noerr) call mom_error(fatal, hdr // trim(nf90_strerror(rc)) //&
1135 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1136
1137 ! Confirm that field is at least 2d
1138 if (field_ndims < 2) &
1139 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) // " " // &
1140 trim(varname) // " from " // trim(filename) // " is not a 2D field.")
1141
1142 ! If start and nread are present, then reshape them to match field dims
1143 if (present(start) .or. present(nread)) then
1144 allocate(field_shape(field_ndims))
1145 allocate(field_dimids(field_ndims))
1146
1147 rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids)
1148 if (rc /= nf90_noerr) call mom_error(fatal, hdr // trim(nf90_strerror(rc)) //&
1149 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1150
1151 do i = 1, field_ndims
1152 rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len)
1153 if (rc /= nf90_noerr) &
1154 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1155 // ": Difficulties reading dimensions from " // trim(filename))
1156 field_shape(i) = dim_len
1157 enddo
1158
1159 ! Reshape start(:) and nreads(:) in case ranks differ
1160 allocate(field_start(field_ndims))
1161 field_start(:) = 1
1162 if (present(start)) then
1163 dim_len = min(size(start), size(field_start))
1164 field_start(:dim_len) = start(:dim_len)
1165 endif
1166
1167 allocate(field_nread(field_ndims))
1168 field_nread(:2) = field_shape(:2)
1169 field_nread(3:) = 1
1170 if (present(nread)) field_nread(:2) = nread(:2)
1171
1172 rc = nf90_get_var(ncid, varid, var, field_start, field_nread)
1173
1174 deallocate(field_start)
1175 deallocate(field_nread)
1176 deallocate(field_shape)
1177 deallocate(field_dimids)
1178 else
1179 rc = nf90_get_var(ncid, varid, var)
1180 endif
1181
1182 if (rc /= nf90_noerr) call mom_error(fatal, hdr // trim(nf90_strerror(rc)) //&
1183 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1184
1185 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1186 endif
1187
1188 call broadcast(var, size(var), blocking=.true.)
1189end subroutine read_variable_2d
1190
1191
1192subroutine read_variable_3d(filename, varname, var, start, nread, ncid_in)
1193 character(len=*), intent(in) :: filename !< Name of file to be read
1194 character(len=*), intent(in) :: varname !< Name of variable to be read
1195 real, intent(out) :: var(:,:,:) !< Output array of variable [arbitrary]
1196 integer, optional, intent(in) :: start(:) !< Starting index on each axis.
1197 integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis
1198 integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file.
1199 !! If absent, the file is opened and closed within this routine.
1200
1201 integer :: ncid, varid
1202 integer :: field_ndims, dim_len
1203 integer, allocatable :: field_dimids(:), field_shape(:)
1204 integer, allocatable :: field_start(:), field_nread(:)
1205 integer :: i, rc
1206 character(len=*), parameter :: hdr = "read_variable_3d: "
1207
1208 ! Validate shape of start and nread
1209 if (present(start)) then
1210 if (size(start) < 2) &
1211 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1212 // " start must have at least two dimensions.")
1213 endif
1214
1215 if (present(nread)) then
1216 if (size(nread) < 2) &
1217 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1218 // " nread must have at least two dimensions.")
1219
1220 if (any(nread(3:) > 1)) &
1221 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1222 // " nread may only read a single level in higher dimensions.")
1223 endif
1224
1225 ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure
1226 ! that their lengths are equivalent, and must do it here.
1227 if (present(start) .and. present(nread)) then
1228 if (size(start) /= size(nread)) &
1229 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1230 // " start and nread must have the same length.")
1231 endif
1232
1233 ! Open and read `varname` from `filename`
1234 if (is_root_pe()) then
1235 if (present(ncid_in)) then
1236 ncid = ncid_in
1237 else
1238 call open_file_to_read(filename, ncid)
1239 endif
1240
1241 call get_varid(varname, ncid, filename, varid, match_case=.false.)
1242 if (varid < 0) call mom_error(fatal, "Unable to get netCDF varid for "//trim(varname)//&
1243 " in "//trim(filename))
1244
1245 ! Query for the dimensionality of the input field
1246 rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims)
1247 if (rc /= nf90_noerr) call mom_error(fatal, hdr // trim(nf90_strerror(rc)) //&
1248 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1249
1250 ! Confirm that field is at least 2d
1251 if (field_ndims < 2) &
1252 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) // " " // &
1253 trim(varname) // " from " // trim(filename) // " is not a 2D field.")
1254
1255 ! If start and nread are present, then reshape them to match field dims
1256 if (present(start) .or. present(nread)) then
1257 allocate(field_shape(field_ndims))
1258 allocate(field_dimids(field_ndims))
1259
1260 rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids)
1261 if (rc /= nf90_noerr) call mom_error(fatal, hdr // trim(nf90_strerror(rc)) //&
1262 ": Difficulties reading "//trim(varname)//" from "//trim(filename))
1263
1264 do i = 1, field_ndims
1265 rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len)
1266 if (rc /= nf90_noerr) &
1267 call mom_error(fatal, hdr // trim(nf90_strerror(rc)) &
1268 // ": Difficulties reading dimensions from " // trim(filename))
1269 field_shape(i) = dim_len
1270 enddo
1271
1272 ! Reshape start(:) and nreads(:) in case ranks differ
1273 allocate(field_start(field_ndims))
1274 field_start(:) = 1
1275 if (present(start)) then
1276 dim_len = min(size(start), size(field_start))
1277 field_start(:dim_len) = start(:dim_len)
1278 endif
1279
1280 allocate(field_nread(field_ndims))
1281 field_nread(:3) = field_shape(:3)
1282 !field_nread(3:) = 1
1283 if (present(nread)) field_nread(:3) = nread(:3)
1284
1285 rc = nf90_get_var(ncid, varid, var, field_start, field_nread)
1286
1287 deallocate(field_start)
1288 deallocate(field_nread)
1289 deallocate(field_shape)
1290 deallocate(field_dimids)
1291 else
1292 rc = nf90_get_var(ncid, varid, var)
1293 endif
1294
1295 if (rc /= nf90_noerr) call mom_error(fatal, hdr // trim(nf90_strerror(rc)) //&
1296 " Difficulties reading "//trim(varname)//" from "//trim(filename))
1297
1298 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1299 endif
1300
1301 call broadcast(var, size(var), blocking=.true.)
1302end subroutine read_variable_3d
1303
1304!> Read a character-string global or variable attribute
1305subroutine read_attribute_str(filename, attname, att_val, varname, found, all_read, ncid_in)
1306 character(len=*), intent(in) :: filename !< Name of the file to read
1307 character(len=*), intent(in) :: attname !< Name of the attribute to read
1308 character(:), allocatable, intent(out) :: att_val !< The value of the attribute
1309 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1310 !! be read. If missing, read a global attribute.
1311 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1312 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1313 !! routine actually do the read, otherwise only
1314 !! root PE reads and then broadcasts the results.
1315 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1316 !! file is opened and closed within this routine.
1317
1318 logical :: do_read, do_broadcast
1319 integer :: rc, ncid, varid, att_type, att_len, info(2)
1320 character(len=256) :: hdr, att_str
1321 character(len=:), dimension(:), allocatable :: tmp_str
1322 hdr = "read_attribute_str"
1323 att_len = 0
1324
1325 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
1326 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1327
1328 if (do_read) then
1329 if (present(ncid_in)) then
1330 ncid = ncid_in
1331 else
1332 call open_file_to_read(filename, ncid, success=found)
1333 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1334 endif
1335 endif
1336
1337 if (do_read) then
1338 rc = nf90_enotatt ; att_len = 0
1339 if (present(varname)) then ! Read a variable attribute
1340 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
1341 att_str = "att "//trim(attname)//" for "//trim(varname)//" from "//trim(filename)
1342 else ! Read a global attribute
1343 varid = nf90_global
1344 att_str = "global att "//trim(attname)//" from "//trim(filename)
1345 endif
1346 if ((varid > 0) .or. (varid == nf90_global)) then ! The named variable does exist, and found would be true.
1347 rc = nf90_inquire_attribute(ncid, varid, attname, xtype=att_type, len=att_len)
1348 if ((.not. present(found)) .or. (rc /= nf90_enotatt)) then
1349 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1350 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //" Error getting info for "//trim(att_str))
1351 if (att_type /= nf90_char) &
1352 call mom_error(fatal, trim(hdr)//": Attribute data type is not a char for "//trim(att_str))
1353 ! if (att_len > len(att_val)) &
1354 ! call MOM_error(FATAL, trim(hdr)//": Insufficiently long string passed in to read "//trim(att_str))
1355 allocate(character(att_len) :: att_val)
1356
1357 if (rc == nf90_noerr) then
1358 rc = nf90_get_att(ncid, varid, attname, att_val)
1359 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1360 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //" Difficulties reading "//trim(att_str))
1361 endif
1362 endif
1363 endif
1364 if (present(found)) found = (rc == nf90_noerr)
1365
1366 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1367 endif
1368
1369 if (do_broadcast) then
1370 ! Communicate the string length
1371 info(1) = att_len ; info(2) = 0 ; if (do_read .and. found) info(2) = 1
1372 call broadcast(info, 2, blocking=.true.)
1373 if (present(found)) then
1374 found = (info(2) /= 0)
1375 if (.not. found) return
1376 endif
1377 att_len = info(1)
1378
1379 if (att_len > 0) then
1380 ! These extra copies are here because broadcast only supports arrays of strings.
1381 allocate(character(att_len) :: tmp_str(1))
1382 if (.not.do_read) allocate(character(att_len) :: att_val)
1383 if (do_read) tmp_str(1) = att_val
1384 call broadcast(tmp_str, att_len, blocking=.true.)
1385 att_val = tmp_str(1)
1386 elseif (.not.allocated(att_val)) then
1387 allocate(character(4) :: att_val) ; att_val = ''
1388 endif
1389 elseif (.not.allocated(att_val)) then
1390 allocate(character(4) :: att_val) ; att_val = ''
1391 endif
1392end subroutine read_attribute_str
1393
1394
1395!> Read a 32-bit integer global or variable attribute
1396subroutine read_attribute_int32(filename, attname, att_val, varname, found, all_read, ncid_in)
1397 character(len=*), intent(in) :: filename !< Name of the file to read
1398 character(len=*), intent(in) :: attname !< Name of the attribute to read
1399 integer(kind=int32), intent(out) :: att_val !< The value of the attribute
1400 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1401 !! be read. If missing, read a global attribute.
1402 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1403 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1404 !! routine actually do the read, otherwise only
1405 !! root PE reads and then broadcasts the results.
1406 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1407 !! file is opened and closed within this routine.
1408
1409 logical :: do_read, do_broadcast
1410 integer :: rc, ncid, varid, is_found
1411 character(len=256) :: hdr
1412 hdr = "read_attribute_int32"
1413 att_val = 0
1414
1415 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
1416 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1417
1418 if (do_read) then
1419 if (present(ncid_in)) then
1420 ncid = ncid_in
1421 else
1422 call open_file_to_read(filename, ncid, success=found)
1423 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1424 endif
1425 endif
1426
1427 if (do_read) then
1428 rc = nf90_enotatt
1429 if (present(varname)) then ! Read a variable attribute
1430 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
1431 if (varid >= 0) then ! The named variable does exist, and found would be true.
1432 rc = nf90_get_att(ncid, varid, attname, att_val)
1433 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1434 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //" Difficulties reading att "//&
1435 trim(attname)//" for "//trim(varname)//" from "//trim(filename))
1436 endif
1437 else ! Read a global attribute
1438 rc = nf90_get_att(ncid, nf90_global, attname, att_val)
1439 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1440 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
1441 " Difficulties reading global att "//trim(attname)//" from "//trim(filename))
1442 endif
1443 if (present(found)) found = (rc == nf90_noerr)
1444
1445 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1446 endif
1447
1448 if (do_broadcast) then
1449 if (present(found)) then
1450 is_found = 0 ; if (is_root_pe() .and. found) is_found = 1
1451 call broadcast(is_found, blocking=.false.)
1452 endif
1453 call broadcast(att_val, blocking=.true.)
1454 if (present(found)) found = (is_found /= 0)
1455 endif
1456
1457end subroutine read_attribute_int32
1458
1459
1460!> Read a 64-bit integer global or variable attribute
1461subroutine read_attribute_int64(filename, attname, att_val, varname, found, all_read, ncid_in)
1462 character(len=*), intent(in) :: filename !< Name of the file to read
1463 character(len=*), intent(in) :: attname !< Name of the attribute to read
1464 integer(kind=int64), intent(out) :: att_val !< The value of the attribute
1465 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1466 !! be read. If missing, read a global attribute.
1467 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1468 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1469 !! routine actually do the read, otherwise only
1470 !! root PE reads and then broadcasts the results.
1471 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1472 !! file is opened and closed within this routine.
1473
1474 logical :: do_read, do_broadcast
1475 integer :: rc, ncid, varid, is_found
1476 character(len=256) :: hdr
1477 hdr = "read_attribute_int64"
1478 att_val = 0
1479
1480 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
1481 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1482
1483 if (do_read) then
1484 if (present(ncid_in)) then
1485 ncid = ncid_in
1486 else
1487 call open_file_to_read(filename, ncid, success=found)
1488 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1489 endif
1490 endif
1491
1492 if (do_read) then
1493 rc = nf90_enotatt
1494 if (present(varname)) then ! Read a variable attribute
1495 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
1496 if (varid >= 0) then ! The named variable does exist, and found would be true.
1497 rc = nf90_get_att(ncid, varid, attname, att_val)
1498 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1499 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //" Difficulties reading att "//&
1500 trim(attname)//" for "//trim(varname)//" from "//trim(filename))
1501 endif
1502 else ! Read a global attribute
1503 rc = nf90_get_att(ncid, nf90_global, attname, att_val)
1504 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1505 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
1506 " Difficulties reading global att "//trim(attname)//" from "//trim(filename))
1507 endif
1508 if (present(found)) found = (rc == nf90_noerr)
1509
1510 rc = nf90_close(ncid)
1511 endif
1512
1513 if (do_broadcast) then
1514 if (present(found)) then
1515 is_found = 0 ; if (is_root_pe() .and. found) is_found = 1
1516 call broadcast(is_found, blocking=.false.)
1517 endif
1518 call broadcast(att_val, blocking=.true.)
1519 if (present(found)) found = (is_found /= 0)
1520 endif
1521
1522end subroutine read_attribute_int64
1523
1524!> Read a real global or variable attribute
1525subroutine read_attribute_real(filename, attname, att_val, varname, found, all_read, ncid_in)
1526 character(len=*), intent(in) :: filename !< Name of the file to read
1527 character(len=*), intent(in) :: attname !< Name of the attribute to read
1528 real, intent(out) :: att_val !< The value of the attribute [arbitrary]
1529 character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will
1530 !! be read. If missing, read a global attribute.
1531 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1532 logical, optional, intent(in) :: all_read !< If present and true, all PEs that call this
1533 !! routine actually do the read, otherwise only
1534 !! root PE reads and then broadcasts the results.
1535 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
1536 !! file is opened and closed within this routine.
1537
1538 logical :: do_read, do_broadcast
1539 integer :: rc, ncid, varid, is_found
1540 character(len=256) :: hdr
1541 hdr = "read_attribute_real"
1542 att_val = 0.0
1543
1544 do_read = is_root_pe() ; if (present(all_read)) do_read = all_read .or. do_read
1545 do_broadcast = .true. ; if (present(all_read)) do_broadcast = .not.all_read
1546
1547 if (do_read) then
1548 if (present(ncid_in)) then
1549 ncid = ncid_in
1550 else
1551 call open_file_to_read(filename, ncid, success=found)
1552 if (present(found)) then ; if (.not.found) do_read = .false. ; endif
1553 endif
1554 endif
1555
1556 if (do_read) then
1557 rc = nf90_enotatt
1558 if (present(varname)) then ! Read a variable attribute
1559 call get_varid(varname, ncid, filename, varid, match_case=.false., found=found)
1560 if (varid >= 0) then ! The named variable does exist, and found would be true.
1561 rc = nf90_get_att(ncid, varid, attname, att_val)
1562 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1563 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //" Difficulties reading att "//&
1564 trim(attname)//" for "//trim(varname)//" from "//trim(filename))
1565 endif
1566 else ! Read a global attribute
1567 rc = nf90_get_att(ncid, nf90_global, attname, att_val)
1568 if ((rc /= nf90_noerr) .and. (rc /= nf90_enotatt)) &
1569 call mom_error(fatal, trim(hdr) // trim(nf90_strerror(rc)) //&
1570 " Difficulties reading global att "//trim(attname)//" from "//trim(filename))
1571 endif
1572 if (present(found)) found = (rc == nf90_noerr)
1573
1574 if (.not.present(ncid_in)) call close_file_to_read(ncid, filename)
1575 endif
1576
1577 if (do_broadcast) then
1578 if (present(found)) then
1579 is_found = 0 ; if (is_root_pe() .and. found) is_found = 1
1580 call broadcast(is_found, blocking=.false.)
1581 endif
1582 call broadcast(att_val, blocking=.true.)
1583 if (present(found)) found = (is_found /= 0)
1584 endif
1585
1586end subroutine read_attribute_real
1587
1588!> Open a netcdf file for reading, with error handling
1589subroutine open_file_to_read(filename, ncid, success)
1590 character(len=*), intent(in) :: filename !< path and name of the file to open for reading
1591 integer, intent(out) :: ncid !< The netcdf handle for the file
1592 logical, optional, intent(out) :: success !< Returns true if the file was opened, or if this
1593 !! argument is not present, failure is fatal error.
1594 ! Local variables
1595 integer rc
1596
1597 rc = nf90_open(trim(filename), nf90_nowrite, ncid)
1598 if (present(success)) then
1599 success = (rc == nf90_noerr)
1600 elseif (rc /= nf90_noerr) then
1601 call mom_error(fatal, "Difficulties opening "//trim(filename)//" - "//trim(nf90_strerror(rc)) )
1602 endif
1603
1604end subroutine open_file_to_read
1605
1606!> Close a netcdf file that had been opened for reading, with error handling
1607subroutine close_file_to_read(ncid, filename)
1608 integer, intent(inout) :: ncid !< The netcdf handle for the file to close
1609 character(len=*), optional, intent(in) :: filename !< path and name of the file to close
1610 integer :: rc
1611 if (ncid >= 0) then
1612 rc = nf90_close(ncid)
1613 if (present(filename) .and. (rc /= nf90_noerr)) then
1614 call mom_error(warning, "Difficulties closing "//trim(filename)//": "//trim(nf90_strerror(rc)))
1615 elseif (rc /= nf90_noerr) then
1616 call mom_error(warning, "Difficulties closing file: "//trim(nf90_strerror(rc)))
1617 endif
1618 endif
1619 ncid = -1
1620end subroutine close_file_to_read
1621
1622!> get_varid finds the netcdf handle for the potentially case-insensitive variable name in a file
1623subroutine get_varid(varname, ncid, filename, varid, match_case, found)
1624 character(len=*), intent(in) :: varname !< The name of the variable that is being sought
1625 integer, intent(in) :: ncid !< The open netcdf handle for the file
1626 character(len=*), intent(in) :: filename !< name of the file to read, used here in messages
1627 integer, intent(out) :: varid !< The netcdf handle for the variable
1628 logical, optional, intent(in) :: match_case !< If false, allow for variables name matches to be
1629 !! case insensitive, but take a perfect match if
1630 !! found. The default is true.
1631 logical, optional, intent(out) :: found !< Returns true if the attribute is found
1632
1633 logical :: var_found, insensitive
1634 character(len=256) :: name
1635 integer, allocatable :: varids(:)
1636 integer :: nvars, status, n
1637
1638 varid = -1
1639 var_found = .false.
1640 insensitive = .false. ; if (present(match_case)) insensitive = .not.match_case
1641
1642 if (insensitive) then
1643 ! This code ounddoes a case-insensitive search for a variable in the file.
1644 status = nf90_inquire(ncid, nvariables=nvars)
1645 if (present(found) .and. ((status /= nf90_noerr) .or. (nvars < 1))) then
1646 found = .false. ; return
1647 elseif (status /= nf90_noerr) then
1648 call mom_error(fatal, "get_varid: Difficulties getting the number of variables in file "//&
1649 trim(filename)//" - "//trim(nf90_strerror(status)))
1650 elseif (nvars < 1) then
1651 call mom_error(fatal, "get_varid: There appear not to be any variables in "//trim(filename))
1652 endif
1653
1654 allocate(varids(nvars))
1655
1656 status = nf90_inq_varids(ncid, nvars, varids)
1657 if (status /= nf90_noerr) then
1658 call mom_error(warning, "get_varid: Difficulties getting the variable IDs in file "//&
1659 trim(filename)//" - "//trim(nf90_strerror(status)))
1660 nvars = -1 ! Full error handling will occur after the do-loop.
1661 endif
1662
1663 do n = 1,nvars
1664 status = nf90_inquire_variable(ncid, varids(n), name=name)
1665 if (status /= nf90_noerr) then
1666 call mom_error(warning, "get_varid: Difficulties getting a variable name in file "//&
1667 trim(filename)//" - "//trim(nf90_strerror(status)))
1668 endif
1669
1670 if (trim(lowercase(name)) == trim(lowercase(varname))) then
1671 if (var_found) then
1672 call mom_error(warning, "get_varid: Two variables match the case-insensitive name "//&
1673 trim(varname)//" in file "//trim(filename))
1674 ! Replace the first variable if the second one is a case-sensitive match
1675 if (trim(name) == trim(varname)) varid = varids(n)
1676 else
1677 varid = varids(n) ; var_found = .true.
1678 endif
1679 endif
1680 enddo
1681 if (present(found)) found = var_found
1682 if ((.not.var_found) .and. .not.present(found)) call mom_error(fatal, &
1683 "get_varid: variable "//trim(varname)//" was not found in file "//trim(filename))
1684
1685 deallocate(varids)
1686 else
1687 status = nf90_inq_varid(ncid, trim(varname), varid)
1688 if (present(found)) found = (status == nf90_noerr)
1689 if ((status /= nf90_noerr) .and. .not.present(found)) then
1690 call mom_error(fatal, "get_varid: Difficulties getting a variable id for "//&
1691 trim(varname)//" in file "//trim(filename)//" - "//trim(nf90_strerror(status)))
1692 endif
1693 endif
1694
1695end subroutine get_varid
1696
1697!> Verify that a file contains a named variable with the expected units.
1698subroutine verify_variable_units(filename, varname, expected_units, msg, ierr, alt_units)
1699 character(len=*), intent(in) :: filename !< File name
1700 character(len=*), intent(in) :: varname !< Variable name
1701 character(len=*), intent(in) :: expected_units !< Expected units of variable
1702 character(len=*), intent(inout) :: msg !< Message to use for errors
1703 logical, intent(out) :: ierr !< True if an error occurs
1704 character(len=*), optional, intent(in) :: alt_units !< Alterate acceptable units of variable
1705
1706 ! Local variables
1707 character (len=200) :: units
1708 logical :: units_correct, success
1709 integer :: i, ncid, status, vid
1710
1711 if (.not.is_root_pe()) then ! Only the root PE should do the verification.
1712 ierr = .false. ; msg = '' ; return
1713 endif
1714
1715 ierr = .true.
1716 call open_file_to_read(filename, ncid, success)
1717 if (.not.success) then
1718 msg = 'File not found: '//trim(filename)
1719 return
1720 endif
1721
1722 status = nf90_inq_varid(ncid, trim(varname), vid)
1723 if (status /= nf90_noerr) then
1724 msg = 'Var not found: '//trim(varname)
1725 else
1726 status = nf90_get_att(ncid, vid, "units", units)
1727 if (status /= nf90_noerr) then
1728 msg = 'Attribute not found: units'
1729 else
1730 ! NF90_GET_ATT can return attributes with null characters, which TRIM will not truncate.
1731 ! This loop replaces any null characters with a space so that the subsequent check
1732 ! between the read units and the expected units will pass
1733 do i=1,len_trim(units)
1734 if (units(i:i) == char(0)) units(i:i) = " "
1735 enddo
1736
1737 units_correct = (trim(units) == trim(expected_units))
1738 if (present(alt_units)) then
1739 units_correct = units_correct .or. (trim(units) == trim(alt_units))
1740 endif
1741 if (units_correct) then
1742 ierr = .false.
1743 msg = ''
1744 else
1745 msg = 'Units incorrect: '//trim(units)//' /= '//trim(expected_units)
1746 endif
1747 endif
1748 endif
1749
1750 status = nf90_close(ncid)
1751
1752end subroutine verify_variable_units
1753
1754!> Returns a vardesc type whose elements have been filled with the provided
1755!! fields. The argument name is required, while the others are optional and
1756!! have default values that are empty strings or are appropriate for a 3-d
1757!! tracer field at the tracer cell centers.
1758function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, &
1759 cmor_units, cmor_longname, conversion, caller, position, dim_names, &
1760 extra_axes, fixed) result(vd)
1761 character(len=*), intent(in) :: name !< variable name
1762 character(len=*), optional, intent(in) :: units !< variable units
1763 character(len=*), optional, intent(in) :: longname !< variable long name
1764 character(len=*), optional, intent(in) :: hor_grid !< A character string indicating the horizontal
1765 !! position of this variable
1766 character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering
1767 character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1
1768 character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name
1769 character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable
1770 character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name
1771 real , optional, intent(in) :: conversion !< for unit conversions, such as needed to
1772 !! convert from intensive to extensive
1773 !! [various] or [a A-1 ~> 1]
1774 character(len=*), optional, intent(in) :: caller !< The calling routine for error messages
1775 integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position
1776 !! of this variable if it has such dimensions.
1777 !! Valid values include CORNER, CENTER, EAST_FACE
1778 !! NORTH_FACE, and 0 for no horizontal dimensions.
1779 character(len=*), dimension(:), &
1780 optional, intent(in) :: dim_names !< The names of the dimensions of this variable
1781 type(axis_info), dimension(:), &
1782 optional, intent(in) :: extra_axes !< dimensions other than space-time
1783 logical, optional, intent(in) :: fixed !< If true, this does not evolve with time
1784 type(vardesc) :: vd !< vardesc type that is created
1785
1786 character(len=120) :: cllr
1787 cllr = "var_desc"
1788 if (present(caller)) cllr = trim(caller)
1789
1790 call safe_string_copy(name, vd%name, "vd%name", cllr)
1791
1792 vd%longname = "" ; vd%units = ""
1793 vd%hor_grid = 'h' ; vd%position = center ; vd%z_grid = 'L' ; vd%t_grid = 's'
1794 if (present(dim_names)) vd%z_grid = '1' ! In this case the names are used to set the non-horizontal axes
1795 if (present(fixed)) then ; if (fixed) vd%t_grid = '1' ; endif
1796
1797 vd%cmor_field_name = ""
1798 vd%cmor_units = ""
1799 vd%cmor_longname = ""
1800 vd%conversion = 1.0
1801 vd%dim_names(:) = ""
1802
1803 call modify_vardesc(vd, units=units, longname=longname, hor_grid=hor_grid, &
1804 z_grid=z_grid, t_grid=t_grid, position=position, dim_names=dim_names, &
1805 cmor_field_name=cmor_field_name, cmor_units=cmor_units, &
1806 cmor_longname=cmor_longname, conversion=conversion, caller=cllr, &
1807 extra_axes=extra_axes)
1808
1809end function var_desc
1810
1811
1812!> This routine modifies the named elements of a vardesc type.
1813!! All arguments are optional, except the vardesc type to be modified.
1814subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
1815 cmor_field_name, cmor_units, cmor_longname, conversion, caller, position, dim_names, &
1816 extra_axes)
1817 type(vardesc), intent(inout) :: vd !< vardesc type that is modified
1818 character(len=*), optional, intent(in) :: name !< name of variable
1819 character(len=*), optional, intent(in) :: units !< units of variable
1820 character(len=*), optional, intent(in) :: longname !< long name of variable
1821 character(len=*), optional, intent(in) :: hor_grid !< horizontal staggering of variable
1822 character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable
1823 character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1
1824 character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name
1825 character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable
1826 character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name
1827 real , optional, intent(in) :: conversion !< A multiplicative factor for unit conversions,
1828 !! such as needed to convert from intensive to
1829 !! extensive or dimensional consistency testing
1830 !! [various] or [a A-1 ~> 1]
1831 character(len=*), optional, intent(in) :: caller !< The calling routine for error messages
1832 integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position
1833 !! of this variable if it has such dimensions.
1834 !! Valid values include CORNER, CENTER, EAST_FACE
1835 !! NORTH_FACE, and 0 for no horizontal dimensions.
1836 character(len=*), dimension(:), &
1837 optional, intent(in) :: dim_names !< The names of the dimensions of this variable
1838 type(axis_info), dimension(:), &
1839 optional, intent(in) :: extra_axes !< dimensions other than space-time
1840
1841 character(len=120) :: cllr
1842 integer :: n
1843
1844 cllr = "mod_vardesc" ; if (present(caller)) cllr = trim(caller)
1845
1846 if (present(name)) call safe_string_copy(name, vd%name, "vd%name", cllr)
1847
1848 if (present(longname)) call safe_string_copy(longname, vd%longname, &
1849 "vd%longname of "//trim(vd%name), cllr)
1850 if (present(units)) call safe_string_copy(units, vd%units, &
1851 "vd%units of "//trim(vd%name), cllr)
1852 if (present(position)) then
1853 vd%position = position
1854 select case (position)
1855 case (center) ; vd%hor_grid = 'T'
1856 case (corner) ; vd%hor_grid = 'Bu'
1857 case (east_face) ; vd%hor_grid = 'Cu'
1858 case (north_face) ; vd%hor_grid = 'Cv'
1859 case (0) ; vd%hor_grid = '1'
1860 case default
1861 call mom_error(fatal, "modify_vardesc: "//trim(vd%name)//" has unrecognized position argument")
1862 end select
1863 endif
1864 if (present(hor_grid)) then
1865 call safe_string_copy(hor_grid, vd%hor_grid, "vd%hor_grid of "//trim(vd%name), cllr)
1866 vd%position = position_from_horgrid(vd%hor_grid)
1867 if (present(caller) .and. (vd%position == -1)) then
1868 call mom_error(fatal, "modify_vardesc called by "//trim(caller)//": "//trim(vd%name)//&
1869 " has an unrecognized hor_grid argument "//trim(vd%hor_grid))
1870 elseif (vd%position == -1) then
1871 call mom_error(fatal, "modify_vardesc called with bad hor_grid argument "//trim(vd%hor_grid))
1872 endif
1873 endif
1874 if (present(z_grid)) call safe_string_copy(z_grid, vd%z_grid, &
1875 "vd%z_grid of "//trim(vd%name), cllr)
1876 if (present(t_grid)) call safe_string_copy(t_grid, vd%t_grid, &
1877 "vd%t_grid of "//trim(vd%name), cllr)
1878
1879 if (present(cmor_field_name)) call safe_string_copy(cmor_field_name, vd%cmor_field_name, &
1880 "vd%cmor_field_name of "//trim(vd%name), cllr)
1881 if (present(cmor_units)) call safe_string_copy(cmor_units, vd%cmor_units, &
1882 "vd%cmor_units of "//trim(vd%name), cllr)
1883 if (present(cmor_longname)) call safe_string_copy(cmor_longname, vd%cmor_longname, &
1884 "vd%cmor_longname of "//trim(vd%name), cllr)
1885
1886 if (present(conversion)) vd%conversion = conversion
1887
1888 if (present(dim_names)) then
1889 do n=1,min(5,size(dim_names)) ; if (len_trim(dim_names(n)) > 0) then
1890 call safe_string_copy(dim_names(n), vd%dim_names(n), "vd%dim_names of "//trim(vd%name), cllr)
1891 endif ; enddo
1892 endif
1893
1894 if (present(extra_axes)) then
1895 do n=1,size(extra_axes) ; if (len_trim(extra_axes(n)%name) > 0) then
1896 vd%extra_axes(n) = extra_axes(n)
1897 endif ; enddo
1898 endif
1899
1900end subroutine modify_vardesc
1901
1902integer function position_from_horgrid(hor_grid)
1903 character(len=*), intent(in) :: hor_grid !< horizontal staggering of variable
1904
1905 select case (trim(hor_grid))
1906 case ('h') ; position_from_horgrid = center
1907 case ('q') ; position_from_horgrid = corner
1908 case ('u') ; position_from_horgrid = east_face
1909 case ('v') ; position_from_horgrid = north_face
1910 case ('T') ; position_from_horgrid = center
1911 case ('Bu') ; position_from_horgrid = corner
1912 case ('Cu') ; position_from_horgrid = east_face
1913 case ('Cv') ; position_from_horgrid = north_face
1914 case ('1') ; position_from_horgrid = 0
1915 case default ; position_from_horgrid = -1 ! This is a bad-value flag.
1916 end select
1917end function position_from_horgrid
1918
1919!> Store information that can be used to create an axis in a subsequent call to create_file.
1920subroutine set_axis_info(axis, name, units, longname, ax_size, ax_data, cartesian, sense)
1921 type(axis_info), intent(inout) :: axis !< A type with information about a named axis
1922 character(len=*), intent(in) :: name !< The name of this axis for use in files
1923 character(len=*), optional, intent(in) :: units !< The units of the axis labels
1924 character(len=*), optional, intent(in) :: longname !< Long name of the axis variable
1925 integer, optional, intent(in) :: ax_size !< The number of elements in this axis
1926 real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis [arbitrary]
1927 character(len=*), optional, intent(in) :: cartesian !< A variable indicating which direction this axis
1928 !! axis corresponds with. Valid values
1929 !! include 'X', 'Y', 'Z', 'T', and 'N' (the default) for none.
1930 integer, optional, intent(in) :: sense !< This is 1 for axes whose values increase upward, or -1
1931 !! if they increase downward. The default, 0, is ignored.
1932
1933 call safe_string_copy(name, axis%name, "axis%name of "//trim(name), "set_axis_info")
1934 ! Set the default values.
1935 axis%longname = trim(axis%name) ; axis%units = "" ; axis%cartesian = "N" ; axis%sense = 0
1936
1937 if (present(longname)) call safe_string_copy(longname, axis%longname, &
1938 "axis%longname of "//trim(name), "set_axis_info")
1939 if (present(units)) call safe_string_copy(units, axis%units, &
1940 "axis%units of "//trim(name), "set_axis_info")
1941 if (present(cartesian)) call safe_string_copy(cartesian, axis%cartesian, &
1942 "axis%cartesian of "//trim(name), "set_axis_info")
1943 if (present(sense)) axis%sense = sense
1944
1945 if (.not.(present(ax_size) .or. present(ax_data)) ) then
1946 call mom_error(fatal, "set_axis_info called for "//trim(name)//&
1947 "without either an ax_size or an ax_data argument.")
1948 elseif (present(ax_size) .and. present(ax_data)) then
1949 if (size(ax_data) /= ax_size) call mom_error(fatal, "set_axis_info called for "//trim(name)//&
1950 "with an inconsistent value of ax_size and size of ax_data.")
1951 endif
1952
1953 if (present(ax_size)) then
1954 axis%ax_size = ax_size
1955 else
1956 axis%ax_size = size(ax_data)
1957 endif
1958 if (present(ax_data)) then
1959 allocate(axis%ax_data(axis%ax_size)) ; axis%ax_data(:) = ax_data(:)
1960 endif
1961
1962end subroutine set_axis_info
1963
1964!> Delete the information in an array of axis_info types and deallocate memory in them.
1965subroutine delete_axis_info(axes)
1966 type(axis_info), dimension(:), intent(inout) :: axes !< An array with information about named axes
1967
1968 integer :: n
1969 do n=1,size(axes)
1970 axes(n)%name = "" ; axes(n)%longname = "" ; axes(n)%units = "" ; axes(n)%cartesian = "N"
1971 axes(n)%sense = 0 ; axes(n)%ax_size = 0
1972 if (allocated(axes(n)%ax_data)) deallocate(axes(n)%ax_data)
1973 enddo
1974end subroutine delete_axis_info
1975
1976
1977!> Retrieve the information from an axis_info type.
1978subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data)
1979 type(axis_info), intent(in) :: axis !< An axis type
1980 character(len=*), intent(out), optional :: name !< The axis name.
1981 character(len=*), intent(out), optional :: longname !< The axis longname.
1982 character(len=*), intent(out), optional :: units !< The axis units.
1983 character(len=*), intent(out), optional :: cartesian !< The cartesian attribute
1984 !! of the axis [X,Y,Z,T].
1985 integer, intent(out), optional :: ax_size !< The size of the axis.
1986 real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data [arbitrary]
1987
1988 if (present(ax_data)) then
1989 if (allocated(ax_data)) deallocate(ax_data)
1990 allocate(ax_data(axis%ax_size))
1991 ax_data(:) = axis%ax_data
1992 endif
1993
1994 if (present(name)) name = axis%name
1995 if (present(longname)) longname = axis%longname
1996 if (present(units)) units = axis%units
1997 if (present(cartesian)) cartesian = axis%cartesian
1998 if (present(ax_size)) ax_size = axis%ax_size
1999
2000end subroutine get_axis_info
2001
2002!> Store information that can be used to create an attribute in a subsequent call to create_file.
2003subroutine set_attribute_info(attribute, name, str_value)
2004 type(attribute_info), intent(inout) :: attribute !< A type with information about a named attribute
2005 character(len=*), intent(in) :: name !< The name of this attribute for use in files
2006 character(len=*), intent(in) :: str_value !< The value of this attribute
2007
2008 attribute%name = trim(name)
2009 attribute%att_val = trim(str_value)
2010end subroutine set_attribute_info
2011
2012!> Delete the information in an array of attribute_info types and deallocate memory in them.
2013subroutine delete_attribute_info(atts)
2014 type(attribute_info), dimension(:), intent(inout) :: atts !< An array of global attributes
2015
2016 integer :: n
2017 do n=1,size(atts)
2018 if (allocated(atts(n)%name)) deallocate(atts(n)%name)
2019 if (allocated(atts(n)%att_val)) deallocate(atts(n)%att_val)
2020 enddo
2021end subroutine delete_attribute_info
2022
2023
2024!> This function returns the CMOR standard name given a CMOR longname, based on
2025!! the standard pattern of character conversions.
2026function cmor_long_std(longname) result(std_name)
2027 character(len=*), intent(in) :: longname !< The CMOR longname being converted
2028 character(len=len(longname)) :: std_name !< The CMOR standard name generated from longname
2029
2030 integer :: k
2031
2032 std_name = lowercase(longname)
2033
2034 do k=1, len_trim(std_name)
2035 if (std_name(k:k) == ' ') std_name(k:k) = '_'
2036 enddo
2037
2038end function cmor_long_std
2039
2040!> This routine queries vardesc
2041subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
2042 cmor_field_name, cmor_units, cmor_longname, conversion, caller, &
2043 extra_axes, position, dim_names)
2044 type(vardesc), intent(in) :: vd !< vardesc type that is queried
2045 character(len=*), optional, intent(out) :: name !< name of variable
2046 character(len=*), optional, intent(out) :: units !< units of variable
2047 character(len=*), optional, intent(out) :: longname !< long name of variable
2048 character(len=*), optional, intent(out) :: hor_grid !< horizontal staggering of variable
2049 character(len=*), optional, intent(out) :: z_grid !< verticle staggering of variable
2050 character(len=*), optional, intent(out) :: t_grid !< time description: s, p, or 1
2051 character(len=*), optional, intent(out) :: cmor_field_name !< CMOR name
2052 character(len=*), optional, intent(out) :: cmor_units !< CMOR physical dimensions of variable
2053 character(len=*), optional, intent(out) :: cmor_longname !< CMOR long name
2054 real , optional, intent(out) :: conversion !< for unit conversions, such as needed to
2055 !! convert from intensive to extensive
2056 !! [various] or [a A-1 ~> 1]
2057 character(len=*), optional, intent(in) :: caller !< calling routine?
2058 type(axis_info), dimension(5), &
2059 optional, intent(out) :: extra_axes !< dimensions other than space-time
2060 integer, optional, intent(out) :: position !< A coded integer indicating the horizontal position
2061 !! of this variable if it has such dimensions.
2062 !! Valid values include CORNER, CENTER, EAST_FACE
2063 !! NORTH_FACE, and 0 for no horizontal dimensions.
2064 character(len=*), dimension(:), &
2065 optional, intent(out) :: dim_names !< The names of the dimensions of this variable
2066
2067 integer :: n
2068 integer, parameter :: nmax_extraaxes = 5
2069 character(len=120) :: cllr, varname
2070 cllr = "mod_vardesc"
2071 if (present(caller)) cllr = trim(caller)
2072
2073 if (present(name)) call safe_string_copy(vd%name, name, &
2074 "vd%name of "//trim(vd%name), cllr)
2075 if (present(longname)) call safe_string_copy(vd%longname, longname, &
2076 "vd%longname of "//trim(vd%name), cllr)
2077 if (present(units)) call safe_string_copy(vd%units, units, &
2078 "vd%units of "//trim(vd%name), cllr)
2079 if (present(hor_grid)) call safe_string_copy(vd%hor_grid, hor_grid, &
2080 "vd%hor_grid of "//trim(vd%name), cllr)
2081 if (present(z_grid)) call safe_string_copy(vd%z_grid, z_grid, &
2082 "vd%z_grid of "//trim(vd%name), cllr)
2083 if (present(t_grid)) call safe_string_copy(vd%t_grid, t_grid, &
2084 "vd%t_grid of "//trim(vd%name), cllr)
2085
2086 if (present(cmor_field_name)) call safe_string_copy(vd%cmor_field_name, cmor_field_name, &
2087 "vd%cmor_field_name of "//trim(vd%name), cllr)
2088 if (present(cmor_units)) call safe_string_copy(vd%cmor_units, cmor_units, &
2089 "vd%cmor_units of "//trim(vd%name), cllr)
2090 if (present(cmor_longname)) call safe_string_copy(vd%cmor_longname, cmor_longname, &
2091 "vd%cmor_longname of "//trim(vd%name), cllr)
2092
2093 if (present(conversion)) conversion = vd%conversion
2094
2095 if (present(position)) then
2096 position = vd%position
2097 if (position == -1) position = position_from_horgrid(vd%hor_grid)
2098 endif
2099 if (present(dim_names)) then
2100 do n=1,min(5,size(dim_names))
2101 call safe_string_copy(vd%dim_names(n), dim_names(n), "vd%dim_names of "//trim(vd%name), cllr)
2102 enddo
2103 endif
2104
2105 if (present(extra_axes)) then
2106 ! save_restart expects 5 extra axes (can be empty)
2107 do n=1, nmax_extraaxes
2108 if (vd%extra_axes(n)%ax_size>=1) then
2109 extra_axes(n) = vd%extra_axes(n)
2110 else
2111 ! return an empty axis
2112 write(varname,"('dummy',i1.1)") n
2113 call set_axis_info(extra_axes(n), name=trim(varname), ax_size=1)
2114 endif
2115 enddo
2116 endif
2117
2118end subroutine query_vardesc
2119
2120
2121!> Read a scalar from file using infrastructure I/O.
2122subroutine mom_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, &
2123 global_file, file_may_be_4d)
2124 character(len=*), intent(in) :: filename !< Input filename
2125 character(len=*), intent(in) :: fieldname !< Field variable name
2126 real, intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2127 integer, optional, intent(in) :: timelevel !< Time level to read in file
2128 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2129 !! before it is returned to convert from the units in the file
2130 !! to the internal units for this variable [A a-1 ~> 1]
2131 type(mom_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2132 logical, optional, intent(in) :: global_file !< If true, read from a single file
2133 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2134 !! as 4d arrays in the file.
2135
2136 call read_field(filename, fieldname, data, &
2137 timelevel=timelevel, scale=scale, mom_domain=mom_domain, &
2138 global_file=global_file, file_may_be_4d=file_may_be_4d)
2139end subroutine mom_read_data_0d
2140
2141
2142!> Read a scalar integer from file using infrastructure I/O.
2143subroutine mom_read_data_0d_int(filename, fieldname, data, timelevel)
2144 character(len=*), intent(in) :: filename !< Input filename
2145 character(len=*), intent(in) :: fieldname !< Field variable name
2146 integer, intent(inout) :: data !< Field value
2147 integer, optional, intent(in) :: timelevel !< Time level to read in file
2148
2149 call read_field(filename, fieldname, data, timelevel=timelevel)
2150end subroutine mom_read_data_0d_int
2151
2152
2153!> Read a 1d array from file using infrastructure I/O.
2154subroutine mom_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, &
2155 global_file, file_may_be_4d)
2156 character(len=*), intent(in) :: filename !< Input filename
2157 character(len=*), intent(in) :: fieldname !< Field variable name
2158 real, dimension(:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2159 integer, optional, intent(in) :: timelevel !< Time level to read in file
2160 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2161 !! before it is returned to convert from the units in the file
2162 !! to the internal units for this variable [A a-1 ~> 1]
2163 type(mom_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2164 logical, optional, intent(in) :: global_file !< If true, read from a single file
2165 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2166 !! as 4d arrays in the file.
2167
2168 call read_field(filename, fieldname, data, &
2169 timelevel=timelevel, scale=scale, mom_domain=mom_domain, &
2170 global_file=global_file, file_may_be_4d=file_may_be_4d)
2171
2172end subroutine mom_read_data_1d
2173
2174
2175!> Read a 1d integer array from file using infrastructure I/O.
2176subroutine mom_read_data_1d_int(filename, fieldname, data, timelevel)
2177 character(len=*), intent(in) :: filename !< Input filename
2178 character(len=*), intent(in) :: fieldname !< Field variable name
2179 integer, dimension(:), intent(inout) :: data !< Field value
2180 integer, optional, intent(in) :: timelevel !< Time level to read in file
2181
2182 call read_field(filename, fieldname, data, timelevel=timelevel)
2183end subroutine mom_read_data_1d_int
2184
2185
2186!> Read a 2d array from file using infrastructure I/O.
2187subroutine mom_read_data_2d(filename, fieldname, data, MOM_Domain, timelevel, position, &
2188 scale, global_file, file_may_be_4d, turns)
2189 character(len=*), intent(in) :: filename !< Input filename
2190 character(len=*), intent(in) :: fieldname !< Field variable name
2191 real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2192 type(mom_domain_type), target, &
2193 intent(in) :: MOM_Domain !< Model domain decomposition
2194 integer, optional, intent(in) :: timelevel !< Time level to read in file
2195 integer, optional, intent(in) :: position !< Grid positioning flag
2196 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2197 !! before it is returned to convert from the units in the file
2198 !! to the internal units for this variable [A a-1 ~> 1]
2199 logical, optional, intent(in) :: global_file !< If true, read from a single file
2200 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2201 !! as 4d arrays in the file.
2202 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2203 !! the number of turns is taken from MOM_Domain.
2204
2205 ! Local variables
2206 integer :: qturns ! Number of quarter-turns from input to model grid
2207 real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2208 type(mom_domain_type), pointer :: domain_ptr => null() ! Pointer to the unrotated domain for reading
2209
2210 qturns = mom_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2211
2212 domain_ptr => mom_domain
2213 if (associated(mom_domain%domain_in) .and. (qturns /= 0)) domain_ptr => mom_domain%domain_in
2214
2215 if (qturns == 0) then
2216 call read_field(filename, fieldname, data, mom_domain, &
2217 timelevel=timelevel, position=position, scale=scale, &
2218 global_file=global_file, file_may_be_4d=file_may_be_4d)
2219 else
2220 call allocate_rotated_array(data, [1,1], -qturns, data_in)
2221 call rotate_array(data, -qturns, data_in)
2222 call read_field(filename, fieldname, data_in, domain_ptr, &
2223 timelevel=timelevel, position=position, scale=scale, &
2224 global_file=global_file, file_may_be_4d=file_may_be_4d)
2225 call rotate_array(data_in, qturns, data)
2226 deallocate(data_in)
2227 endif
2228
2229end subroutine mom_read_data_2d
2230
2231
2232!> Read a 2d array (which might have halos) from a file using native netCDF I/O.
2233subroutine read_netcdf_data_2d(filename, fieldname, values, MOM_Domain, &
2234 timelevel, position, rescale, turns)
2235 character(len=*), intent(in) :: filename
2236 !< Input filename
2237 character(len=*), intent(in) :: fieldname
2238 !< Field variable name
2239 real, intent(inout) :: values(:,:)
2240 !< Field values read from the file. It would be intent(out) but for the
2241 !! need to preserve any initialized values in the halo regions.
2242 type(mom_domain_type), intent(in) :: MOM_Domain
2243 !< Model domain decomposition
2244 integer, optional, intent(in) :: timelevel
2245 !< Time level to read in file
2246 integer, optional, intent(in) :: position
2247 !< Grid positioning flag
2248 real, optional, intent(in) :: rescale
2249 !< Rescale factor, omitting this is the same as setting it to 1.
2250 integer, optional, intent(in) :: turns
2251 !< Number of quarter-turns to rotate the data. If absent the number of turns is taken
2252 !! from MOM_Domain.
2253
2254 integer :: qturns
2255 ! Number of quarter-turns from input to model grid
2256 real, allocatable :: values_in(:,:)
2257 ! Field array on the unrotated input grid
2258 type(mom_netcdf_file) :: handle
2259 ! netCDF file handle
2260
2261 ! General-purpose IO will require the following arguments, but they are not
2262 ! yet implemented, so we raise an error if they are present.
2263
2264 ! Fields are currently assumed on cell centers, and position is unsupported
2265 if (present(position)) &
2266 call mom_error(fatal, 'read_netCDF_data: position is not yet supported.')
2267
2268 ! Timelevels are not yet supported
2269 if (present(timelevel)) &
2270 call mom_error(fatal, 'read_netCDF_data: timelevel is not yet supported.')
2271
2272 call handle%open(filename, action=readonly_file, mom_domain=mom_domain)
2273 call handle%update()
2274
2275 qturns = mom_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2276
2277 if (qturns == 0) then
2278 call handle%read(fieldname, values, rescale=rescale)
2279 else
2280 call allocate_rotated_array(values, [1,1], -qturns, values_in)
2281 call rotate_array(values, -qturns, values_in)
2282 call handle%read(fieldname, values_in, rescale=rescale)
2283 call rotate_array(values_in, qturns, values)
2284 deallocate(values_in)
2285 endif
2286
2287 call handle%close()
2288end subroutine read_netcdf_data_2d
2289
2290
2291!> Read a 2d region array from file using infrastructure I/O.
2292subroutine mom_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, &
2293 no_domain, scale, turns)
2294 character(len=*), intent(in) :: filename !< Input filename
2295 character(len=*), intent(in) :: fieldname !< Field variable name
2296 real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2297 integer, dimension(:), intent(in) :: start !< Starting index for each axis.
2298 !! In 2d, start(3:4) must be 1.
2299 integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis.
2300 !! In 2d, nread(3:4) must be 1.
2301 type(mom_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2302 logical, optional, intent(in) :: no_domain !< If true, field does not use
2303 !! domain decomposion.
2304 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2305 !! before it is returned to convert from the units in the file
2306 !! to the internal units for this variable [A a-1 ~> 1]
2307 integer, optional, intent(in) :: turns !< Number of quarter turns from
2308 !! input to model grid
2309
2310 integer :: qturns ! Number of quarter turns
2311 real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2312
2313 qturns = 0
2314 if (present(turns)) qturns = modulo(turns, 4)
2315
2316 if (qturns == 0) then
2317 call read_field(filename, fieldname, data, start, nread, &
2318 mom_domain=mom_domain, no_domain=no_domain, scale=scale)
2319 else
2320 call allocate_rotated_array(data, [1,1], -qturns, data_in)
2321 call rotate_array(data, -qturns, data_in)
2322 if (associated(mom_domain%domain_in)) then
2323 call read_field(filename, fieldname, data_in, start, nread, &
2324 mom_domain=mom_domain%domain_in, no_domain=no_domain, scale=scale)
2325 else
2326 call read_field(filename, fieldname, data_in, start, nread, &
2327 mom_domain=mom_domain, no_domain=no_domain, scale=scale)
2328 endif
2329 call rotate_array(data_in, qturns, data)
2330 deallocate(data_in)
2331 endif
2332end subroutine mom_read_data_2d_region
2333
2334
2335!> Read a 3d array from file using infrastructure I/O.
2336subroutine mom_read_data_3d(filename, fieldname, data, MOM_Domain, timelevel, position, &
2337 scale, global_file, file_may_be_4d, turns)
2338 character(len=*), intent(in) :: filename !< Input filename
2339 character(len=*), intent(in) :: fieldname !< Field variable name
2340 real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2341 type(mom_domain_type), target, &
2342 intent(in) :: MOM_Domain !< Model domain decomposition
2343 integer, optional, intent(in) :: timelevel !< Time level to read in file
2344 integer, optional, intent(in) :: position !< Grid positioning flag
2345 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2346 !! before it is returned to convert from the units in the file
2347 !! to the internal units for this variable [A a-1 ~> 1]
2348 logical, optional, intent(in) :: global_file !< If true, read from a single file
2349 logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored
2350 !! as 4d arrays in the file.
2351 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2352 !! the number of turns is taken from MOM_Domain.
2353
2354 ! Local variables
2355 integer :: qturns ! Number of quarter-turns from input to model grid
2356 real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2357 type(mom_domain_type), pointer :: domain_ptr => null() ! Pointer to the unrotated domain for reading
2358
2359 domain_ptr => mom_domain
2360 if (associated(mom_domain%domain_in) .and. (qturns /= 0)) domain_ptr => mom_domain%domain_in
2361
2362 qturns = mom_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2363 if (qturns == 0) then
2364 call read_field(filename, fieldname, data, mom_domain, &
2365 timelevel=timelevel, position=position, scale=scale, &
2366 global_file=global_file, file_may_be_4d=file_may_be_4d)
2367 else
2368 call allocate_rotated_array(data, [1,1,1], -qturns, data_in)
2369 call rotate_array(data, -qturns, data_in)
2370 call read_field(filename, fieldname, data_in, domain_ptr, &
2371 timelevel=timelevel, position=position, scale=scale, &
2372 global_file=global_file, file_may_be_4d=file_may_be_4d)
2373 call rotate_array(data_in, qturns, data)
2374 deallocate(data_in)
2375 endif
2376
2377end subroutine mom_read_data_3d
2378
2379!> Read a 3d region array from file using infrastructure I/O.
2380subroutine mom_read_data_3d_region(filename, fieldname, data, start, nread, MOM_domain, &
2381 no_domain, scale, turns)
2382 character(len=*), intent(in) :: filename !< Input filename
2383 character(len=*), intent(in) :: fieldname !< Field variable name
2384 real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2385 integer, dimension(:), intent(in) :: start !< Starting index for each axis.
2386 integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis.
2387 type(mom_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition
2388 logical, optional, intent(in) :: no_domain !< If true, field does not use
2389 !! domain decomposion.
2390 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2391 !! before it is returned to convert from the units in the file
2392 !! to the internal units for this variable [A a-1 ~> 1]
2393 integer, optional, intent(in) :: turns !< Number of quarter turns from
2394 !! input to model grid
2395
2396 integer :: qturns ! Number of quarter turns
2397 real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2398
2399 qturns = 0
2400 if (present(turns)) qturns = modulo(turns, 4)
2401
2402 if (qturns == 0) then
2403 call read_field(filename, fieldname, data, start, nread, &
2404 mom_domain=mom_domain, no_domain=no_domain, scale=scale)
2405 else
2406 call allocate_rotated_array(data, [1,1,1], -qturns, data_in)
2407 call rotate_array(data, -qturns, data_in)
2408 if (associated(mom_domain%domain_in)) then
2409 call read_field(filename, fieldname, data_in, start, nread, &
2410 mom_domain=mom_domain%domain_in, no_domain=no_domain, scale=scale)
2411 else
2412 call read_field(filename, fieldname, data_in, start, nread, &
2413 mom_domain=mom_domain, no_domain=no_domain, scale=scale)
2414 endif
2415 call rotate_array(data_in, qturns, data)
2416 deallocate(data_in)
2417 endif
2418end subroutine mom_read_data_3d_region
2419
2420!> Read a 4d array from file using infrastructure I/O.
2421subroutine mom_read_data_4d(filename, fieldname, data, MOM_Domain, &
2422 timelevel, position, scale, global_file, turns)
2423 character(len=*), intent(in) :: filename !< Input filename
2424 character(len=*), intent(in) :: fieldname !< Field variable name
2425 real, dimension(:,:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a]
2426 type(mom_domain_type), target, &
2427 intent(in) :: MOM_Domain !< Model domain decomposition
2428 integer, optional, intent(in) :: timelevel !< Time level to read in file
2429 integer, optional, intent(in) :: position !< Grid positioning flag
2430 real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by
2431 !! before it is returned to convert from the units in the file
2432 !! to the internal units for this variable [A a-1 ~> 1]
2433 logical, optional, intent(in) :: global_file !< If true, read from a single file
2434 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2435 !! the number of turns is taken from MOM_Domain.
2436
2437 ! Local variables
2438 integer :: qturns ! Number of quarter-turns from input to model grid
2439 real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid in arbitrary units [A ~> a]
2440 type(mom_domain_type), pointer :: domain_ptr => null() ! Pointer to the unrotated domain for reading
2441
2442 qturns = mom_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2443
2444 domain_ptr => mom_domain
2445 if (associated(mom_domain%domain_in) .and. (qturns /= 0)) domain_ptr => mom_domain%domain_in
2446
2447 if (qturns == 0) then
2448 call read_field(filename, fieldname, data, mom_domain, &
2449 timelevel=timelevel, position=position, scale=scale, &
2450 global_file=global_file)
2451 else
2452 ! Read field along the input grid and rotate to the model grid
2453 call allocate_rotated_array(data, [1,1,1,1], -qturns, data_in)
2454 call rotate_array(data, -qturns, data_in)
2455 call read_field(filename, fieldname, data_in, domain_ptr, timelevel=timelevel, &
2456 position=position, scale=scale, global_file=global_file)
2457 call rotate_array(data_in, qturns, data)
2458 deallocate(data_in)
2459 endif
2460
2461end subroutine mom_read_data_4d
2462
2463
2464!> Read a 2d vector tuple from file using infrastructure I/O.
2465subroutine mom_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
2466 timelevel, stagger, scalar_pair, scale, turns)
2467 character(len=*), intent(in) :: filename !< Input filename
2468 character(len=*), intent(in) :: u_fieldname !< Field variable name in u
2469 character(len=*), intent(in) :: v_fieldname !< Field variable name in v
2470 real, dimension(:,:), intent(inout) :: u_data !< Field value at u points in arbitrary units [A ~> a]
2471 real, dimension(:,:), intent(inout) :: v_data !< Field value at v points in arbitrary units [A ~> a]
2472 type(mom_domain_type), target, &
2473 intent(in) :: MOM_Domain !< Model domain decomposition
2474 integer, optional, intent(in) :: timelevel !< Time level to read in file
2475 integer, optional, intent(in) :: stagger !< Grid staggering flag
2476 logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector
2477 real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by
2478 !! before it is returned to convert from the units in the file
2479 !! to the internal units for this variable [A a-1 ~> 1]
2480 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2481 !! the number of turns is taken from MOM_Domain.
2482
2483 ! Local variables
2484 integer :: qturns ! Number of quarter-turns from input to model grid
2485 real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid in arbitrary units [A ~> a]
2486 type(mom_domain_type), pointer :: domain_ptr => null() ! Pointer to the unrotated domain for reading
2487
2488 qturns = mom_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2489
2490 domain_ptr => mom_domain
2491 if (associated(mom_domain%domain_in) .and. (qturns /= 0)) domain_ptr => mom_domain%domain_in
2492
2493 if (qturns == 0) then
2494 call read_vector(filename, u_fieldname, v_fieldname, &
2495 u_data, v_data, mom_domain, timelevel=timelevel, stagger=stagger, &
2496 scalar_pair=scalar_pair, scale=scale)
2497 else
2498 call allocate_rotated_array(u_data, [1,1], -qturns, u_data_in)
2499 call allocate_rotated_array(v_data, [1,1], -qturns, v_data_in)
2500 if (scalar_pair) then
2501 call rotate_array_pair(u_data, v_data, -qturns, u_data_in, v_data_in)
2502 else
2503 call rotate_vector(u_data, v_data, -qturns, u_data_in, v_data_in)
2504 endif
2505 call read_vector(filename, u_fieldname, v_fieldname, u_data_in, v_data_in, &
2506 domain_ptr, timelevel=timelevel, &
2507 stagger=stagger, scalar_pair=scalar_pair, scale=scale)
2508 if (scalar_pair) then
2509 call rotate_array_pair(u_data_in, v_data_in, qturns, u_data, v_data)
2510 else
2511 call rotate_vector(u_data_in, v_data_in, qturns, u_data, v_data)
2512 endif
2513 deallocate(v_data_in)
2514 deallocate(u_data_in)
2515 endif
2516
2517end subroutine mom_read_vector_2d
2518
2519
2520!> Read a 3d vector tuple from file using infrastructure I/O.
2521subroutine mom_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
2522 timelevel, stagger, scalar_pair, scale, turns)
2523 character(len=*), intent(in) :: filename !< Input filename
2524 character(len=*), intent(in) :: u_fieldname !< Field variable name in u
2525 character(len=*), intent(in) :: v_fieldname !< Field variable name in v
2526 real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u in arbitrary units [A ~> a]
2527 real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v in arbitrary units [A ~> a]
2528 type(mom_domain_type), target, &
2529 intent(in) :: MOM_Domain !< Model domain decomposition
2530 integer, optional, intent(in) :: timelevel !< Time level to read in file
2531 integer, optional, intent(in) :: stagger !< Grid staggering flag
2532 logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector
2533 real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by
2534 !! before it is returned to convert from the units in the file
2535 !! to the internal units for this variable [A a-1 ~> 1]
2536 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data. If absent
2537 !! the number of turns is taken from MOM_Domain.
2538
2539 ! Local variables
2540 integer :: qturns ! Number of quarter-turns from input to model grid
2541 real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid in arbitrary units [A ~> a]
2542 type(mom_domain_type), pointer :: domain_ptr => null() ! Pointer to the unrotated domain for reading
2543
2544 qturns = mom_domain%turns ; if (present(turns)) qturns = modulo(turns, 4)
2545
2546 domain_ptr => mom_domain
2547 if (associated(mom_domain%domain_in) .and. (qturns /= 0)) domain_ptr => mom_domain%domain_in
2548
2549 if (qturns == 0) then
2550 call read_vector(filename, u_fieldname, v_fieldname, &
2551 u_data, v_data, mom_domain, timelevel=timelevel, stagger=stagger, &
2552 scalar_pair=scalar_pair, scale=scale)
2553 else
2554 call allocate_rotated_array(u_data, [1,1,1], -qturns, u_data_in)
2555 call allocate_rotated_array(v_data, [1,1,1], -qturns, v_data_in)
2556 if (scalar_pair) then
2557 call rotate_array_pair(u_data, v_data, -qturns, u_data_in, v_data_in)
2558 else
2559 call rotate_vector(u_data, v_data, -qturns, u_data_in, v_data_in)
2560 endif
2561 call read_vector(filename, u_fieldname, v_fieldname, u_data_in, v_data_in, &
2562 domain_ptr, timelevel=timelevel, &
2563 stagger=stagger, scalar_pair=scalar_pair, scale=scale)
2564 if (scalar_pair) then
2565 call rotate_array_pair(u_data_in, v_data_in, qturns, u_data, v_data)
2566 else
2567 call rotate_vector(u_data_in, v_data_in, qturns, u_data, v_data)
2568 endif
2569 deallocate(v_data_in)
2570 deallocate(u_data_in)
2571 endif
2572
2573end subroutine mom_read_vector_3d
2574
2575!> Write a 4d field to an output file, potentially with rotation
2576subroutine mom_write_field_legacy_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2577 fill_value, turns, scale, unscale, zero_zeros)
2578 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2579 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2580 type(mom_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2581 real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2582 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2583 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2584 real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a]
2585 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2586 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2587 !! it is written [a A-1 ~> 1], for example to convert it
2588 !! from its internal units to the desired units for output
2589 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2590 !! it is written [a A-1 ~> 1], for example to convert it
2591 !! from its internal units to the desired units for output.
2592 !! Here scale and unscale are synonymous, but unscale
2593 !! takes precedence if both are present.
2594 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2595 !! into ordinary signless zeros.
2596
2597 ! Local variables
2598 real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [a] or
2599 ! rescaled [A ~> a] then [a]
2600 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2601 integer :: qturns ! The number of quarter turns through which to rotate field
2602
2603 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
2604 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2605 if (present(unscale)) scale_fac = unscale
2606
2607 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2608 call write_field(io_handle, field_md, mom_domain, field, tstamp=tstamp, &
2609 tile_count=tile_count, fill_value=fill_value)
2610 else
2611 call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot)
2612 call rotate_array(field, qturns, field_rot)
2613 call rescale_comp_data(mom_domain, field_rot, scale_fac, zero_zeros)
2614 call write_field(io_handle, field_md, mom_domain, field_rot, tstamp=tstamp, &
2615 tile_count=tile_count, fill_value=fill_value)
2616 deallocate(field_rot)
2617 endif
2618end subroutine mom_write_field_legacy_4d
2619
2620
2621!> Write a 3d field to an output file, potentially with rotation
2622subroutine mom_write_field_legacy_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2623 fill_value, turns, scale, unscale, zero_zeros)
2624 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2625 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2626 type(mom_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2627 real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2628 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2629 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2630 real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a]
2631 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2632 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2633 !! it is written [a A-1 ~> 1], for example to convert it
2634 !! from its internal units to the desired units for output
2635 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2636 !! it is written [a A-1 ~> 1], for example to convert it
2637 !! from its internal units to the desired units for output.
2638 !! Here scale and unscale are synonymous, but unscale
2639 !! takes precedence if both are present.
2640 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2641 !! into ordinary signless zeros.
2642
2643 ! Local variables
2644 real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [a] or
2645 ! rescaled [A ~> a] then [a]
2646 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2647 integer :: qturns ! The number of quarter turns through which to rotate field
2648
2649 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
2650 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2651 if (present(unscale)) scale_fac = unscale
2652
2653 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2654 call write_field(io_handle, field_md, mom_domain, field, tstamp=tstamp, &
2655 tile_count=tile_count, fill_value=fill_value)
2656 else
2657 call allocate_rotated_array(field, [1,1,1], qturns, field_rot)
2658 call rotate_array(field, qturns, field_rot)
2659 call rescale_comp_data(mom_domain, field_rot, scale_fac, zero_zeros)
2660 call write_field(io_handle, field_md, mom_domain, field_rot, tstamp=tstamp, &
2661 tile_count=tile_count, fill_value=fill_value)
2662 deallocate(field_rot)
2663 endif
2664end subroutine mom_write_field_legacy_3d
2665
2666
2667!> Write a 2d field to an output file, potentially with rotation
2668subroutine mom_write_field_legacy_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2669 fill_value, turns, scale, unscale, zero_zeros)
2670 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2671 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2672 type(mom_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2673 real, dimension(:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2674 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2675 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2676 real, optional, intent(in) :: fill_value !< Missing data fill value
2677 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2678 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2679 !! it is written [a A-1 ~> 1], for example to convert it
2680 !! from its internal units to the desired units for output
2681 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2682 !! it is written [a A-1 ~> 1], for example to convert it
2683 !! from its internal units to the desired units for output.
2684 !! Here scale and unscale are synonymous, but unscale
2685 !! takes precedence if both are present.
2686 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2687 !! into ordinary signless zeros.
2688
2689 ! Local variables
2690 real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [a] or
2691 ! rescaled [A ~> a] then [a]
2692 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2693 integer :: qturns ! The number of quarter turns through which to rotate field
2694
2695 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
2696 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2697 if (present(unscale)) scale_fac = unscale
2698
2699 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2700 call write_field(io_handle, field_md, mom_domain, field, tstamp=tstamp, &
2701 tile_count=tile_count, fill_value=fill_value)
2702 else
2703 call allocate_rotated_array(field, [1,1], qturns, field_rot)
2704 call rotate_array(field, qturns, field_rot)
2705 call rescale_comp_data(mom_domain, field_rot, scale_fac, zero_zeros)
2706 call write_field(io_handle, field_md, mom_domain, field_rot, tstamp=tstamp, &
2707 tile_count=tile_count, fill_value=fill_value)
2708 deallocate(field_rot)
2709 endif
2710end subroutine mom_write_field_legacy_2d
2711
2712
2713!> Write a 1d field to an output file
2714subroutine mom_write_field_legacy_1d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2715 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2716 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2717 real, dimension(:), intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2718 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2719 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2720 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2721 !! it is written [a A-1 ~> 1], for example to convert it
2722 !! from its internal units to the desired units for output
2723 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2724 !! it is written [a A-1 ~> 1], for example to convert it
2725 !! from its internal units to the desired units for output.
2726 !! Here scale and unscale are synonymous, but unscale
2727 !! takes precedence if both are present.
2728 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2729 !! into ordinary signless zeros.
2730
2731 ! Local variables
2732 real, dimension(:), allocatable :: array ! A rescaled copy of field [a]
2733 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2734 logical :: design_zeros ! If true, convert negative zeros into ordinary signless zeros.
2735 integer :: i
2736
2737 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2738 if (present(unscale)) scale_fac = unscale
2739
2740 design_zeros = .false. ; if (present(zero_zeros)) design_zeros = zero_zeros
2741
2742 if ((scale_fac == 1.0) .and. (.not.design_zeros)) then
2743 call write_field(io_handle, field_md, field, tstamp=tstamp)
2744 else
2745 allocate(array(size(field)))
2746 array(:) = scale_fac * field(:)
2747 if (present(fill_value)) then
2748 do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo
2749 endif
2750 if (design_zeros) then ! Convert negative zeros into zeros
2751 do i=1,size(field) ; if (array(i) == 0.0) array(i) = 0.0 ; enddo
2752 endif
2753 call write_field(io_handle, field_md, array, tstamp=tstamp)
2754 deallocate(array)
2755 endif
2756end subroutine mom_write_field_legacy_1d
2757
2758
2759!> Write a 0d field to an output file
2760subroutine mom_write_field_legacy_0d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2761 type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2762 type(fieldtype), intent(in) :: field_md !< Field type with metadata
2763 real, intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2764 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2765 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2766 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2767 !! it is written [a A-1 ~> 1], for example to convert it
2768 !! from its internal units to the desired units for output
2769 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2770 !! it is written [a A-1 ~> 1], for example to convert it
2771 !! from its internal units to the desired units for output.
2772 !! Here scale and unscale are synonymous, but unscale
2773 !! takes precedence if both are present.
2774 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2775 !! into ordinary signless zeros.
2776
2777 ! Local variables
2778 real :: scale_fac ! A scaling factor to use before writing the field [a A-1 ~> 1]
2779 real :: scaled_val ! A rescaled copy of field [a]
2780
2781 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2782 if (present(unscale)) scale_fac = unscale
2783
2784 scaled_val = field * scale_fac
2785
2786 if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif
2787 if (present(zero_zeros)) then ; if (zero_zeros .and. (scaled_val == 0.0)) scaled_val = 0.0 ; endif
2788
2789 call write_field(io_handle, field_md, scaled_val, tstamp=tstamp)
2790end subroutine mom_write_field_legacy_0d
2791
2792
2793!> Write a 4d field to an output file, potentially with rotation
2794subroutine mom_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2795 fill_value, turns, scale, unscale, zero_zeros)
2796 class(mom_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2797 type(mom_field), intent(in) :: field_md !< Field type with metadata
2798 type(mom_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2799 real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2800 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2801 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2802 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2803 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2804 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2805 !! it is written [a A-1 ~> 1], for example to convert it
2806 !! from its internal units to the desired units for output
2807 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2808 !! it is written [a A-1 ~> 1], for example to convert it
2809 !! from its internal units to the desired units for output.
2810 !! Here scale and unscale are synonymous, but unscale
2811 !! takes precedence if both are present.
2812 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2813 !! into ordinary signless zeros.
2814
2815 ! Local variables
2816 real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units or rescaled [a]
2817 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2818 integer :: qturns ! The number of quarter turns through which to rotate field
2819
2820 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
2821 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2822 if (present(unscale)) scale_fac = unscale
2823
2824 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2825 call io_handle%write_field(field_md, mom_domain, field, tstamp=tstamp, &
2826 tile_count=tile_count, fill_value=fill_value)
2827 else
2828 call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot)
2829 call rotate_array(field, qturns, field_rot)
2830 call rescale_comp_data(mom_domain, field_rot, scale_fac, zero_zeros)
2831 call io_handle%write_field(field_md, mom_domain, field_rot, tstamp=tstamp, &
2832 tile_count=tile_count, fill_value=fill_value)
2833 deallocate(field_rot)
2834 endif
2835end subroutine mom_write_field_4d
2836
2837!> Write a 3d field to an output file, potentially with rotation
2838subroutine mom_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2839 fill_value, turns, scale, unscale, zero_zeros)
2840 class(mom_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2841 type(mom_field), intent(in) :: field_md !< Field type with metadata
2842 type(mom_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2843 real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2844 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2845 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2846 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2847 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2848 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2849 !! it is written [a A-1 ~> 1], for example to convert it
2850 !! from its internal units to the desired units for output
2851 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2852 !! it is written [a A-1 ~> 1], for example to convert it
2853 !! from its internal units to the desired units for output.
2854 !! Here scale and unscale are synonymous, but unscale
2855 !! takes precedence if both are present.
2856 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2857 !! into ordinary signless zeros.
2858
2859 ! Local variables
2860 real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units or rescaled [a]
2861 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2862 integer :: qturns ! The number of quarter turns through which to rotate field
2863
2864 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
2865 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2866 if (present(unscale)) scale_fac = unscale
2867
2868 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2869 call io_handle%write_field(field_md, mom_domain, field, tstamp=tstamp, &
2870 tile_count=tile_count, fill_value=fill_value)
2871 else
2872 call allocate_rotated_array(field, [1,1,1], qturns, field_rot)
2873 call rotate_array(field, qturns, field_rot)
2874 call rescale_comp_data(mom_domain, field_rot, scale_fac, zero_zeros)
2875 call io_handle%write_field(field_md, mom_domain, field_rot, tstamp=tstamp, &
2876 tile_count=tile_count, fill_value=fill_value)
2877 deallocate(field_rot)
2878 endif
2879end subroutine mom_write_field_3d
2880
2881!> Write a 2d field to an output file, potentially with rotation
2882subroutine mom_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, &
2883 fill_value, turns, scale, unscale, zero_zeros)
2884 class(mom_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2885 type(mom_field), intent(in) :: field_md !< Field type with metadata
2886 type(mom_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition
2887 real, dimension(:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a]
2888 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2889 integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1)
2890 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2891 integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data
2892 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2893 !! it is written [a A-1 ~> 1], for example to convert it
2894 !! from its internal units to the desired units for output
2895 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2896 !! it is written [a A-1 ~> 1], for example to convert it
2897 !! from its internal units to the desired units for output.
2898 !! Here scale and unscale are synonymous, but unscale
2899 !! takes precedence if both are present.
2900 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2901 !! into ordinary signless zeros.
2902
2903 ! Local variables
2904 real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units or rescaled [a]
2905 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2906 integer :: qturns ! The number of quarter turns through which to rotate field
2907
2908 qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4)
2909 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2910 if (present(unscale)) scale_fac = unscale
2911
2912 if ((qturns == 0) .and. (scale_fac == 1.0) .and. .not.present(zero_zeros)) then
2913 call io_handle%write_field(field_md, mom_domain, field, tstamp=tstamp, &
2914 tile_count=tile_count, fill_value=fill_value)
2915 else
2916 call allocate_rotated_array(field, [1,1], qturns, field_rot)
2917 call rotate_array(field, qturns, field_rot)
2918 call rescale_comp_data(mom_domain, field_rot, scale_fac, zero_zeros)
2919 call io_handle%write_field(field_md, mom_domain, field_rot, tstamp=tstamp, &
2920 tile_count=tile_count, fill_value=fill_value)
2921 deallocate(field_rot)
2922 endif
2923end subroutine mom_write_field_2d
2924
2925!> Write a 1d field to an output file
2926subroutine mom_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2927 class(mom_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2928 type(mom_field), intent(in) :: field_md !< Field type with metadata
2929 real, dimension(:), intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2930 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2931 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2932 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2933 !! it is written [a A-1 ~> 1], for example to convert it
2934 !! from its internal units to the desired units for output
2935 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2936 !! it is written [a A-1 ~> 1], for example to convert it
2937 !! from its internal units to the desired units for output.
2938 !! Here scale and unscale are synonymous, but unscale
2939 !! takes precedence if both are present.
2940 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2941 !! into ordinary signless zeros.
2942
2943 ! Local variables
2944 real, dimension(:), allocatable :: array ! A rescaled copy of field in arbtrary unscaled units [a]
2945 real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1]
2946 logical :: design_zeros ! If true, convert negative zeros into ordinary signless zeros.
2947 integer :: i
2948
2949 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2950 if (present(unscale)) scale_fac = unscale
2951
2952 design_zeros = .false. ; if (present(zero_zeros)) design_zeros = zero_zeros
2953
2954 if ((scale_fac == 1.0) .and. (.not.design_zeros)) then
2955 call io_handle%write_field(field_md, field, tstamp=tstamp)
2956 else
2957 allocate(array(size(field)))
2958 array(:) = scale_fac * field(:)
2959 if (present(fill_value)) then
2960 do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo
2961 endif
2962 if (design_zeros) then ! Convert negative zeros into zeros
2963 do i=1,size(field) ; if (array(i) == 0.0) array(i) = 0.0 ; enddo
2964 endif
2965 call io_handle%write_field(field_md, array, tstamp=tstamp)
2966 deallocate(array)
2967 endif
2968end subroutine mom_write_field_1d
2969
2970!> Write a 0d field to an output file
2971subroutine mom_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, scale, unscale, zero_zeros)
2972 class(mom_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing
2973 type(mom_field), intent(in) :: field_md !< Field type with metadata
2974 real, intent(in) :: field !< Field to write in arbitrary units [A ~> a]
2975 real, optional, intent(in) :: tstamp !< Model timestamp, often in [days]
2976 real, optional, intent(in) :: fill_value !< Missing data fill value [a]
2977 real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before
2978 !! it is written [a A-1 ~> 1], for example to convert it
2979 !! from its internal units to the desired units for output
2980 real, optional, intent(in) :: unscale !< A scaling factor that the field is multiplied by before
2981 !! it is written [a A-1 ~> 1], for example to convert it
2982 !! from its internal units to the desired units for output.
2983 !! Here scale and unscale are synonymous, but unscale
2984 !! takes precedence if both are present.
2985 logical, optional, intent(in) :: zero_zeros !< If present and true, convert negative zeros
2986 !! into ordinary signless zeros.
2987
2988 ! Local variables
2989 real :: scale_fac ! A scaling factor to use before writing the field [a A-1 ~> 1]
2990 real :: scaled_val ! A rescaled copy of field in arbtrary unscaled units [a]
2991
2992 scale_fac = 1.0 ; if (present(scale)) scale_fac = scale
2993 if (present(unscale)) scale_fac = unscale
2994
2995 scaled_val = field * scale_fac
2996
2997 if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif
2998 if (present(zero_zeros)) then ; if (zero_zeros .and. (scaled_val == 0.0)) scaled_val = 0.0 ; endif
2999
3000 call io_handle%write_field(field_md, scaled_val, tstamp=tstamp)
3001end subroutine mom_write_field_0d
3002
3003!> Insert the ensemble appendix into a filename. If provided, the appendix is inserted after
3004!! the last occurrence of the insert_after substring in the filename.
3005subroutine insert_ensemble_appendix(filename, insert_after)
3006 character(len=*), intent(inout) :: filename !< The filename to which the appendix is inserted
3007 character(len=*), optional, intent(in) :: insert_after !< The string after which the appendix is inserted.
3008 !! If not provided or found, the appendix is inserted
3009 !! at the end of the filename.
3010 ! Local variables
3011 character(len=32) :: filename_appendix ! ensemble appendix to be inserted into the filename
3012 character(len=:), allocatable :: filename_tr ! trimmed filename
3013 character(len=:), allocatable :: insert_after_tr ! trimmed insert_after
3014 integer :: pos ! The filename string index after which the appendix is to be inserted
3015
3016 call get_filename_appendix(filename_appendix)
3017 if (len_trim(filename_appendix) == 0) return
3018
3019 filename_tr = trim(adjustl(filename))
3020 pos = len(filename_tr)
3021
3022 ! If insert_after is provided, find the last occurrence of insert_after in the filename and set pos accordingly.
3023 if (present(insert_after)) then
3024 insert_after_tr = trim(adjustl(insert_after))
3025 pos = index(filename_tr, insert_after_tr, back=.true.)
3026 if (pos == 0) then
3027 call mom_error(fatal, "insert_ensemble_appendix: The string " // insert_after_tr // &
3028 " was not found in the filename " // filename_tr)
3029 endif
3030 pos = pos + len(insert_after_tr) - 1
3031 endif
3032
3033 ! Insert the ensemble appendix into the filename. If the appendix is to be added to
3034 ! the end of the filename, do so before the .nc extension if it exists.
3035 if (pos>3 .and. pos == len(filename_tr)) then
3036 if (filename_tr(pos-2:pos) == ".nc") then
3037 pos = pos - 3 ! Position before the .nc extension
3038 endif
3039 endif
3040 filename = filename_tr(1:pos) // trim(filename_appendix) // filename_tr(pos+1:)
3041
3042end subroutine insert_ensemble_appendix
3043
3044!> Given filename and fieldname, this subroutine returns the size of the field in the file
3045subroutine field_size(filename, fieldname, sizes, field_found, no_domain, ndims, ncid_in)
3046 character(len=*), intent(in) :: filename !< The name of the file to read
3047 character(len=*), intent(in) :: fieldname !< The name of the variable whose sizes are returned
3048 integer, dimension(:), intent(inout) :: sizes !< The sizes of the variable in each dimension
3049 logical, optional, intent(out) :: field_found !< This indicates whether the field was found in
3050 !! the input file. Without this argument, there
3051 !! is a fatal error if the field is not found.
3052 logical, optional, intent(in) :: no_domain !< If present and true, do not check for file
3053 !! names with an appended tile number. If
3054 !! ndims is present, the default changes to true.
3055 integer, optional, intent(out) :: ndims !< The number of dimensions to the variable
3056 integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the
3057 !! file is opened and closed within this routine.
3058
3059 if (present(ndims)) then
3060 if (present(no_domain)) then ; if (.not.no_domain) call mom_error(fatal, &
3061 "field_size does not support the ndims argument when no_domain is present and false.")
3062 endif
3063 call get_var_sizes(filename, fieldname, ndims, sizes, match_case=.false., ncid_in=ncid_in)
3064 if (present(field_found)) field_found = (ndims >= 0)
3065 if ((ndims < 0) .and. .not.present(field_found)) then
3066 call mom_error(fatal, "Variable "//trim(fieldname)//" not found in "//trim(filename) )
3067 endif
3068 else
3069 call get_field_size(filename, fieldname, sizes, field_found=field_found, no_domain=no_domain)
3070 endif
3071
3072end subroutine field_size
3073
3074
3075!> Copies a string
3076subroutine safe_string_copy(str1, str2, fieldnm, caller)
3077 character(len=*), intent(in) :: str1 !< The string being copied
3078 character(len=*), intent(out) :: str2 !< The string being copied into
3079 character(len=*), optional, intent(in) :: fieldnm !< The name of the field for error messages
3080 character(len=*), optional, intent(in) :: caller !< The calling routine for error messages
3081
3082 if (len(trim(str1)) > len(str2)) then
3083 if (present(fieldnm) .and. present(caller)) then
3084 call mom_error(fatal, trim(caller)//" attempted to copy the overly long string "//&
3085 trim(str1)//" into "//trim(fieldnm))
3086 else
3087 call mom_error(fatal, "safe_string_copy: The string "//trim(str1)//&
3088 " is longer than its intended target.")
3089 endif
3090 endif
3091 str2 = trim(str1)
3092end subroutine safe_string_copy
3093
3094!> Returns a name with "%#E" or "%E" replaced with the ensemble member number.
3095function ensembler(name, ens_no_in) result(en_nm)
3096 character(len=*), intent(in) :: name !< The name to be modified
3097 integer, optional, intent(in) :: ens_no_in !< The number of the current ensemble member
3098 character(len=len(name)) :: en_nm !< The name encoded with the ensemble number
3099
3100 ! This function replaces "%#E" or "%E" with the ensemble number anywhere it
3101 ! occurs in name, with %E using 4 or 6 digits (depending on the ensemble size)
3102 ! and %#E using # digits, where # is a number from 1 to 9.
3103
3104 character(len=len(name)) :: tmp
3105 character(10) :: ens_num_char
3106 character(3) :: code_str
3107 integer :: ens_no
3108 integer :: n, is
3109
3110 en_nm = trim(name)
3111 if (index(name,"%") == 0) return
3112
3113 if (present(ens_no_in)) then
3114 ens_no = ens_no_in
3115 else
3116 ens_no = get_ensemble_id()
3117 endif
3118
3119 write(ens_num_char, '(I0)') ens_no
3120 do
3121 is = index(en_nm,"%E")
3122 if (is == 0) exit
3123 if (len(en_nm) < len(trim(en_nm)) + len(trim(ens_num_char)) - 2) &
3124 call mom_error(fatal, "MOM_io ensembler: name "//trim(name)// &
3125 " is not long enough for %E expansion for ens_no "//trim(ens_num_char))
3126 tmp = en_nm(1:is-1)//trim(ens_num_char)//trim(en_nm(is+2:))
3127 en_nm = tmp
3128 enddo
3129
3130 if (index(name,"%") == 0) return
3131
3132 write(ens_num_char, '(I10.10)') ens_no
3133 do n=1,9 ; do
3134 write(code_str, '("%",I1,"E")') n
3135
3136 is = index(en_nm,code_str)
3137 if (is == 0) exit
3138 if (ens_no < 10**n) then
3139 if (len(en_nm) < len(trim(en_nm)) + n-3) call mom_error(fatal, &
3140 "MOM_io ensembler: name "//trim(name)//" is not long enough for %E expansion.")
3141 tmp = en_nm(1:is-1)//trim(ens_num_char(11-n:10))//trim(en_nm(is+3:))
3142 else
3143 call mom_error(fatal, "MOM_io ensembler: Ensemble number is too large "//&
3144 "to be encoded with "//code_str//" in "//trim(name))
3145 endif
3146 en_nm = tmp
3147 enddo ; enddo
3148
3149end function ensembler
3150
3151!> Provide a string to append to filenames, to differentiate ensemble members, for example.
3152subroutine get_filename_appendix(suffix)
3153 character(len=*), intent(out) :: suffix !< A string to append to filenames
3154
3155 call get_filename_suffix(suffix)
3156end subroutine get_filename_appendix
3157
3158!> Write a file version number to the log file or other output file
3159subroutine write_version_number(version, tag, unit)
3160 character(len=*), intent(in) :: version !< A string that contains the routine name and version
3161 character(len=*), optional, intent(in) :: tag !< A tag name to add to the message
3162 integer, optional, intent(in) :: unit !< An alternate unit number for output
3163
3164 call write_version(version, tag, unit)
3165end subroutine write_version_number
3166
3167
3168!> Open a single namelist file that is potentially readable by all PEs.
3169function open_namelist_file(file) result(unit)
3170 character(len=*), optional, intent(in) :: file !< The file to open, by default "input.nml"
3171 integer :: unit !< The opened unit number of the namelist file
3172 unit = mom_namelist_file(file)
3173end function open_namelist_file
3174
3175!> Checks the iostat argument that is returned after reading a namelist variable and writes a
3176!! message if there is an error.
3177function check_nml_error(IOstat, nml_name) result(ierr)
3178 integer, intent(in) :: iostat !< An I/O status field from a namelist read call
3179 character(len=*), intent(in) :: nml_name !< The name of the namelist
3180 integer :: ierr !< A copy of IOstat that is returned to preserve legacy function behavior
3181 call check_namelist_error(iostat, nml_name)
3182 ierr = iostat
3183end function check_nml_error
3184
3185!> Initialize the MOM_io module
3186subroutine mom_io_init(param_file)
3187 type(param_file_type), intent(in) :: param_file !< structure indicating the open file to
3188 !! parse for model parameter values.
3189
3190 ! This include declares and sets the variable "version".
3191# include "version_variable.h"
3192 character(len=40) :: mdl = "MOM_io" ! This module's name.
3193
3194 call log_version(param_file, mdl, version)
3195
3196end subroutine mom_io_init
3197!> Returns the dimension variable information for a netCDF variable
3198subroutine get_var_axes_info(filename, fieldname, axes_info)
3199 character(len=*), intent(in) :: filename !< A filename from which to read
3200 character(len=*), intent(in) :: fieldname !< The name of the field to read
3201 type(axis_info), dimension(4), intent(inout) :: axes_info !< A returned array of field axis information
3202
3203 !! local variables
3204 integer :: rcode
3205 logical :: success
3206 integer :: ncid, varid, ndims
3207 integer :: id, jd, kd
3208 integer, dimension(4) :: dims, dim_id
3209 character(len=128) :: dim_name(4)
3210 integer, dimension(1) :: start, count
3211 !! cartesian axis data
3212 real, allocatable, dimension(:) :: x ! x-axis labels, often [degrees_E] or [km] or [m]
3213 real, allocatable, dimension(:) :: y ! y-axis labels, often [degrees_N] or [km] or [m]
3214 real, allocatable, dimension(:) :: z ! vertical axis labels [various], often [m] or [kg m-3]
3215
3216
3217 call open_file_to_read(filename, ncid, success=success)
3218
3219 rcode = nf90_inq_varid(ncid, trim(fieldname), varid)
3220 if (rcode /= 0) call mom_error(fatal,"error finding variable "//trim(fieldname)//&
3221 " in file "//trim(filename)//" in hinterp_extrap")
3222
3223 rcode = nf90_inquire_variable(ncid, varid, ndims=ndims, dimids=dims)
3224 if (rcode /= 0) call mom_error(fatal, "Error inquiring about the dimensions of "//trim(fieldname)//&
3225 " in file "//trim(filename)//" in hinterp_extrap")
3226 if (ndims < 3) call mom_error(fatal,"Variable "//trim(fieldname)//" in file "//trim(filename)// &
3227 " has too few dimensions to be read as a 3-d array.")
3228 rcode = nf90_inquire_dimension(ncid, dims(1), dim_name(1), len=id)
3229 if (rcode /= 0) call mom_error(fatal,"error reading dimension 1 data for "// &
3230 trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap")
3231 rcode = nf90_inq_varid(ncid, dim_name(1), dim_id(1))
3232 if (rcode /= 0) call mom_error(fatal,"error finding variable "//trim(dim_name(1))//&
3233 " in file "//trim(filename)//" in hinterp_extrap")
3234 rcode = nf90_inquire_dimension(ncid, dims(2), dim_name(2), len=jd)
3235 if (rcode /= 0) call mom_error(fatal,"error reading dimension 2 data for "// &
3236 trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap")
3237 rcode = nf90_inq_varid(ncid, dim_name(2), dim_id(2))
3238 if (rcode /= 0) call mom_error(fatal,"error finding variable "//trim(dim_name(2))//&
3239 " in file "//trim(filename)//" in hinterp_extrap")
3240 rcode = nf90_inquire_dimension(ncid, dims(3), dim_name(3), len=kd)
3241 if (rcode /= 0) call mom_error(fatal,"error reading dimension 3 data for "// &
3242 trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap")
3243 rcode = nf90_inq_varid(ncid, dim_name(3), dim_id(3))
3244 if (rcode /= 0) call mom_error(fatal,"error finding variable "//trim(dim_name(3))//&
3245 " in file "//trim(filename)//" in hinterp_extrap")
3246 allocate(x(id), y(jd), z(kd))
3247
3248 start = 1 ; count = 1 ; count(1) = id
3249 rcode = nf90_get_var(ncid, dim_id(1), x, start, count)
3250 if (rcode /= 0) call mom_error(fatal,"error reading dimension 1 values for var_name "// &
3251 trim(fieldname)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap")
3252 start = 1 ; count = 1 ; count(1) = jd
3253 rcode = nf90_get_var(ncid, dim_id(2), y, start, count)
3254 if (rcode /= 0) call mom_error(fatal,"error reading dimension 2 values for var_name "// &
3255 trim(fieldname)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap")
3256 start = 1 ; count = 1 ; count(1) = kd
3257 rcode = nf90_get_var(ncid, dim_id(3), z, start, count)
3258 if (rcode /= 0) call mom_error(fatal,"error reading dimension 3 values for var_name "// &
3259 trim(fieldname//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap")
3260
3261 call set_axis_info(axes_info(1), name=trim(dim_name(1)), ax_size=id, ax_data=x,cartesian='X')
3262 call set_axis_info(axes_info(2), name=trim(dim_name(2)), ax_size=jd, ax_data=y,cartesian='Y')
3263 call set_axis_info(axes_info(3), name=trim(dim_name(3)), ax_size=kd, ax_data=z,cartesian='Z')
3264
3265 call close_file_to_read(ncid, filename)
3266
3267 deallocate(x,y,z)
3268
3269end subroutine get_var_axes_info
3270!> \namespace mom_io
3271!!
3272!! This file contains a number of subroutines that manipulate
3273!! NetCDF files and handle input and output of fields. These
3274!! subroutines, along with their purpose, are:
3275!!
3276!! * create_file: create a new file and set up structures that are
3277!! needed for subsequent output and write out the coordinates.
3278!! * reopen_file: reopen an existing file for writing and set up
3279!! structures that are needed for subsequent output.
3280!! * open_input_file: open the indicated file for reading only.
3281!! * close_file: close an open file.
3282!! * synch_file: flush the buffers, completing all pending output.
3283!!
3284!! * write_field: write a field to an open file.
3285!! * write_time: write a value of the time axis to an open file.
3286!! * read_data: read a variable from an open file.
3287!! * read_time: read a time from an open file.
3288!!
3289!! * name_output_file: provide a name for an output file based on a
3290!! name root and the time of the output.
3291!! * find_input_file: find a file that has been previously written by
3292!! MOM and named by name_output_file and open it for reading.
3293!!
3294!! * handle_error: write an error code and quit.
3295
3296end module mom_io