MOM6
MOM_restart.F90
1 !> The MOM6 facility for reading and writing restart files, and querying what has been read.
2 module mom_restart
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_domains, only : pe_here, num_pes
7 use mom_error_handler, only : mom_error, fatal, warning, note, is_root_pe
9 use mom_string_functions, only : lowercase
10 use mom_grid, only : ocean_grid_type
11 use mom_io, only : create_file, fieldtype, file_exists, open_file, close_file
12 use mom_io, only : mom_read_data, read_data, get_filename_appendix
13 use mom_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times
14 use mom_io, only : vardesc, var_desc, query_vardesc, modify_vardesc
15 use mom_io, only : multiple, netcdf_file, readonly_file, single_file
16 use mom_io, only : center, corner, north_face, east_face
17 use mom_time_manager, only : time_type, time_type_to_real, real_to_time
18 use mom_time_manager, only : days_in_month, get_date, set_date
19 use mom_transform_fms, only : mpp_chksum => rotated_mpp_chksum
20 use mom_transform_fms, only : write_field => rotated_write_field
22 use mpp_io_mod, only : mpp_attribute_exist, mpp_get_atts
23 use mpp_mod, only : mpp_pe
24 
25 implicit none ; private
26 
27 public restart_init, restart_end, restore_state, register_restart_field
28 public save_restart, query_initialized, restart_init_end, vardesc
29 public restart_files_exist, determine_is_new_run, is_new_run
30 public register_restart_field_as_obsolete
32 
33 !> A type for making arrays of pointers to 4-d arrays
34 type p4d
35  real, dimension(:,:,:,:), pointer :: p => null() !< A pointer to a 4d array
36 end type p4d
37 
38 !> A type for making arrays of pointers to 3-d arrays
39 type p3d
40  real, dimension(:,:,:), pointer :: p => null() !< A pointer to a 3d array
41 end type p3d
42 
43 !> A type for making arrays of pointers to 2-d arrays
44 type p2d
45  real, dimension(:,:), pointer :: p => null() !< A pointer to a 2d array
46 end type p2d
47 
48 !> A type for making arrays of pointers to 1-d arrays
49 type p1d
50  real, dimension(:), pointer :: p => null() !< A pointer to a 1d array
51 end type p1d
52 
53 !> A type for making arrays of pointers to scalars
54 type p0d
55  real, pointer :: p => null() !< A pointer to a scalar
56 end type p0d
57 
58 !> A structure with information about a single restart field
60  type(vardesc) :: vars !< Description of a field that is to be read from or written
61  !! to the restart file.
62  logical :: mand_var !< If .true. the run will abort if this field is not successfully
63  !! read from the restart file.
64  logical :: initialized !< .true. if this field has been read from the restart file.
65  character(len=32) :: var_name !< A name by which a variable may be queried.
66 end type field_restart
67 
68 !> A structure to store information about restart fields that are no longer used
70  character(len=32) :: field_name !< Name of restart field that is no longer in use
71  character(len=32) :: replacement_name !< Name of replacement restart field, if applicable
72 end type obsolete_restart
73 
74 !> A restart registry and the control structure for restarts
75 type, public :: mom_restart_cs ; private
76  logical :: restart !< restart is set to .true. if the run has been started from a full restart
77  !! file. Otherwise some fields must be initialized approximately.
78  integer :: novars = 0 !< The number of restart fields that have been registered.
79  integer :: num_obsolete_vars = 0 !< The number of obsolete restart fields that have been registered.
80  logical :: parallel_restartfiles !< If true, each PE writes its own restart file,
81  !! otherwise they are combined internally.
82  logical :: large_file_support !< If true, NetCDF 3.6 or later is being used
83  !! and large-file-support is enabled.
84  logical :: new_run !< If true, the input filenames and restart file existence will
85  !! result in a new run that is not initialized from restart files.
86  logical :: new_run_set = .false. !< If true, new_run has been determined for this restart_CS.
87  logical :: checksum_required !< If true, require the restart checksums to match and error out otherwise.
88  !! Users may want to avoid this comparison if for example the restarts are
89  !! made from a run with a different mask_table than the current run,
90  !! in which case the checksums will not match and cause crash.
91  character(len=240) :: restartfile !< The name or name root for MOM restart files.
92  integer :: turns !< Number of quarter turns from input to model domain
93 
94  !> An array of descriptions of the registered fields
95  type(field_restart), pointer :: restart_field(:) => null()
96 
97  !> An array of obsolete restart fields
98  type(obsolete_restart), pointer :: restart_obsolete(:) => null()
99 
100  !>@{ Pointers to the fields that have been registered for restarts
101  type(p0d), pointer :: var_ptr0d(:) => null()
102  type(p1d), pointer :: var_ptr1d(:) => null()
103  type(p2d), pointer :: var_ptr2d(:) => null()
104  type(p3d), pointer :: var_ptr3d(:) => null()
105  type(p4d), pointer :: var_ptr4d(:) => null()
106  !>@}
107  integer :: max_fields !< The maximum number of restart fields
108 end type mom_restart_cs
109 
110 !> Register fields for restarts
112  module procedure register_restart_field_ptr4d, register_restart_field_4d
113  module procedure register_restart_field_ptr3d, register_restart_field_3d
114  module procedure register_restart_field_ptr2d, register_restart_field_2d
115  module procedure register_restart_field_ptr1d, register_restart_field_1d
116  module procedure register_restart_field_ptr0d, register_restart_field_0d
117 end interface
118 
119 !> Register a pair of restart fieilds whose rotations map onto each other
121  module procedure register_restart_pair_ptr2d
122  module procedure register_restart_pair_ptr3d
123  module procedure register_restart_pair_ptr4d
124 end interface register_restart_pair
125 
126 !> Indicate whether a field has been read from a restart file
128  module procedure query_initialized_name
129  module procedure query_initialized_0d, query_initialized_0d_name
130  module procedure query_initialized_1d, query_initialized_1d_name
131  module procedure query_initialized_2d, query_initialized_2d_name
132  module procedure query_initialized_3d, query_initialized_3d_name
133  module procedure query_initialized_4d, query_initialized_4d_name
134 end interface
135 
136 contains
137 !!> Register a restart field as obsolete
138 subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS)
139  character(*), intent(in) :: field_name !< Name of restart field that is no longer in use
140  character(*), intent(in) :: replacement_name !< Name of replacement restart field, if applicable
141  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in/out)
142 
143  cs%num_obsolete_vars = cs%num_obsolete_vars+1
144  cs%restart_obsolete(cs%num_obsolete_vars)%field_name = field_name
145  cs%restart_obsolete(cs%num_obsolete_vars)%replacement_name = replacement_name
146 end subroutine register_restart_field_as_obsolete
147 
148 !> Register a 3-d field for restarts, providing the metadata in a structure
149 subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS)
150  real, dimension(:,:,:), &
151  target, intent(in) :: f_ptr !< A pointer to the field to be read or written
152  type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable
153  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
154  !! successfully read from the restart file.
155  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
156 
157  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
158  "register_restart_field: Module must be initialized before it is used.")
159 
160  cs%novars = cs%novars+1
161  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
162  ! once the total number of fields is known.
163 
164  cs%restart_field(cs%novars)%vars = var_desc
165  cs%restart_field(cs%novars)%mand_var = mandatory
166  cs%restart_field(cs%novars)%initialized = .false.
167  call query_vardesc(cs%restart_field(cs%novars)%vars, &
168  name=cs%restart_field(cs%novars)%var_name, &
169  caller="register_restart_field_ptr3d")
170 
171  cs%var_ptr3d(cs%novars)%p => f_ptr
172  cs%var_ptr4d(cs%novars)%p => null()
173  cs%var_ptr2d(cs%novars)%p => null()
174  cs%var_ptr1d(cs%novars)%p => null()
175  cs%var_ptr0d(cs%novars)%p => null()
176 
177 end subroutine register_restart_field_ptr3d
178 
179 !> Register a 4-d field for restarts, providing the metadata in a structure
180 subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS)
181  real, dimension(:,:,:,:), &
182  target, intent(in) :: f_ptr !< A pointer to the field to be read or written
183  type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable
184  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
185  !! successfully read from the restart file.
186  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
187 
188  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
189  "register_restart_field: Module must be initialized before it is used.")
190 
191  cs%novars = cs%novars+1
192  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
193  ! once the total number of fields is known.
194 
195  cs%restart_field(cs%novars)%vars = var_desc
196  cs%restart_field(cs%novars)%mand_var = mandatory
197  cs%restart_field(cs%novars)%initialized = .false.
198  call query_vardesc(cs%restart_field(cs%novars)%vars, &
199  name=cs%restart_field(cs%novars)%var_name, &
200  caller="register_restart_field_ptr4d")
201 
202  cs%var_ptr4d(cs%novars)%p => f_ptr
203  cs%var_ptr3d(cs%novars)%p => null()
204  cs%var_ptr2d(cs%novars)%p => null()
205  cs%var_ptr1d(cs%novars)%p => null()
206  cs%var_ptr0d(cs%novars)%p => null()
207 
208 end subroutine register_restart_field_ptr4d
209 
210 !> Register a 2-d field for restarts, providing the metadata in a structure
211 subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS)
212  real, dimension(:,:), &
213  target, intent(in) :: f_ptr !< A pointer to the field to be read or written
214  type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable
215  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
216  !! successfully read from the restart file.
217  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
218 
219  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
220  "register_restart_field: Module must be initialized before it is used.")
221 
222  cs%novars = cs%novars+1
223  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
224  ! once the total number of fields is known.
225 
226  cs%restart_field(cs%novars)%vars = var_desc
227  cs%restart_field(cs%novars)%mand_var = mandatory
228  cs%restart_field(cs%novars)%initialized = .false.
229  call query_vardesc(cs%restart_field(cs%novars)%vars, &
230  name=cs%restart_field(cs%novars)%var_name, &
231  caller="register_restart_field_ptr2d")
232 
233  cs%var_ptr2d(cs%novars)%p => f_ptr
234  cs%var_ptr4d(cs%novars)%p => null()
235  cs%var_ptr3d(cs%novars)%p => null()
236  cs%var_ptr1d(cs%novars)%p => null()
237  cs%var_ptr0d(cs%novars)%p => null()
238 
239 end subroutine register_restart_field_ptr2d
240 
241 !> Register a 1-d field for restarts, providing the metadata in a structure
242 subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS)
243  real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written
244  type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable
245  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
246  !! successfully read from the restart file.
247  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
248 
249  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
250  "register_restart_field: Module must be initialized before it is used.")
251 
252  cs%novars = cs%novars+1
253  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
254  ! once the total number of fields is known.
255 
256  cs%restart_field(cs%novars)%vars = var_desc
257  cs%restart_field(cs%novars)%mand_var = mandatory
258  cs%restart_field(cs%novars)%initialized = .false.
259  call query_vardesc(cs%restart_field(cs%novars)%vars, &
260  name=cs%restart_field(cs%novars)%var_name, &
261  caller="register_restart_field_ptr1d")
262 
263  cs%var_ptr1d(cs%novars)%p => f_ptr
264  cs%var_ptr4d(cs%novars)%p => null()
265  cs%var_ptr3d(cs%novars)%p => null()
266  cs%var_ptr2d(cs%novars)%p => null()
267  cs%var_ptr0d(cs%novars)%p => null()
268 
269 end subroutine register_restart_field_ptr1d
270 
271 !> Register a 0-d field for restarts, providing the metadata in a structure
272 subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS)
273  real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written
274  type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable
275  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
276  !! successfully read from the restart file.
277  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
278 
279  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
280  "register_restart_field: Module must be initialized before it is used.")
281 
282  cs%novars = cs%novars+1
283  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
284  ! once the total number of fields is known.
285 
286  cs%restart_field(cs%novars)%vars = var_desc
287  cs%restart_field(cs%novars)%mand_var = mandatory
288  cs%restart_field(cs%novars)%initialized = .false.
289  call query_vardesc(cs%restart_field(cs%novars)%vars, &
290  name=cs%restart_field(cs%novars)%var_name, &
291  caller="register_restart_field_ptr0d")
292 
293  cs%var_ptr0d(cs%novars)%p => f_ptr
294  cs%var_ptr4d(cs%novars)%p => null()
295  cs%var_ptr3d(cs%novars)%p => null()
296  cs%var_ptr2d(cs%novars)%p => null()
297  cs%var_ptr1d(cs%novars)%p => null()
298 
299 end subroutine register_restart_field_ptr0d
300 
301 
302 !> Register a pair of rotationally equivalent 2d restart fields
303 subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, &
304  mandatory, CS)
305  real, dimension(:,:), target, intent(in) :: a_ptr !< First field pointer
306  real, dimension(:,:), target, intent(in) :: b_ptr !< Second field pointer
307  type(vardesc), intent(in) :: a_desc !< First field descriptor
308  type(vardesc), intent(in) :: b_desc !< Second field descriptor
309  logical, intent(in) :: mandatory !< If true, abort if field is missing
310  type(mom_restart_cs), pointer :: CS !< MOM restart control structure
311 
312  if (modulo(cs%turns, 2) /= 0) then
313  call register_restart_field(b_ptr, a_desc, mandatory, cs)
314  call register_restart_field(a_ptr, b_desc, mandatory, cs)
315  else
316  call register_restart_field(a_ptr, a_desc, mandatory, cs)
317  call register_restart_field(b_ptr, b_desc, mandatory, cs)
318  endif
319 end subroutine register_restart_pair_ptr2d
320 
321 
322 !> Register a pair of rotationally equivalent 3d restart fields
323 subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, &
324  mandatory, CS)
325  real, dimension(:,:,:), target, intent(in) :: a_ptr !< First field pointer
326  real, dimension(:,:,:), target, intent(in) :: b_ptr !< Second field pointer
327  type(vardesc), intent(in) :: a_desc !< First field descriptor
328  type(vardesc), intent(in) :: b_desc !< Second field descriptor
329  logical, intent(in) :: mandatory !< If true, abort if field is missing
330  type(mom_restart_cs), pointer :: CS !< MOM restart control structure
331 
332  if (modulo(cs%turns, 2) /= 0) then
333  call register_restart_field(b_ptr, a_desc, mandatory, cs)
334  call register_restart_field(a_ptr, b_desc, mandatory, cs)
335  else
336  call register_restart_field(a_ptr, a_desc, mandatory, cs)
337  call register_restart_field(b_ptr, b_desc, mandatory, cs)
338  endif
339 end subroutine register_restart_pair_ptr3d
340 
341 
342 !> Register a pair of rotationally equivalent 2d restart fields
343 subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, &
344  mandatory, CS)
345  real, dimension(:,:,:,:), target, intent(in) :: a_ptr !< First field pointer
346  real, dimension(:,:,:,:), target, intent(in) :: b_ptr !< Second field pointer
347  type(vardesc), intent(in) :: a_desc !< First field descriptor
348  type(vardesc), intent(in) :: b_desc !< Second field descriptor
349  logical, intent(in) :: mandatory !< If true, abort if field is missing
350  type(mom_restart_cs), pointer :: CS !< MOM restart control structure
351 
352  if (modulo(cs%turns, 2) /= 0) then
353  call register_restart_field(b_ptr, a_desc, mandatory, cs)
354  call register_restart_field(a_ptr, b_desc, mandatory, cs)
355  else
356  call register_restart_field(a_ptr, a_desc, mandatory, cs)
357  call register_restart_field(b_ptr, b_desc, mandatory, cs)
358  endif
359 end subroutine register_restart_pair_ptr4d
360 
361 
362 ! The following provide alternate interfaces to register restarts.
363 
364 !> Register a 4-d field for restarts, providing the metadata as individual arguments
365 subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units, &
366  hor_grid, z_grid, t_grid)
367  real, dimension(:,:,:,:), &
368  target, intent(in) :: f_ptr !< A pointer to the field to be read or written
369  character(len=*), intent(in) :: name !< variable name to be used in the restart file
370  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
371  !! successfully read from the restart file.
372  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
373  character(len=*), optional, intent(in) :: longname !< variable long name
374  character(len=*), optional, intent(in) :: units !< variable units
375  character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, 'h' if absent
376  character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent
377  character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
378 
379  type(vardesc) :: vd
380 
381  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart: " // &
382  "register_restart_field_4d: Module must be initialized before "//&
383  "it is used to register "//trim(name))
384  vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
385  z_grid=z_grid, t_grid=t_grid)
386 
387  call register_restart_field_ptr4d(f_ptr, vd, mandatory, cs)
388 
389 end subroutine register_restart_field_4d
390 
391 !> Register a 3-d field for restarts, providing the metadata as individual arguments
392 subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units, &
393  hor_grid, z_grid, t_grid)
394  real, dimension(:,:,:), &
395  target, intent(in) :: f_ptr !< A pointer to the field to be read or written
396  character(len=*), intent(in) :: name !< variable name to be used in the restart file
397  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
398  !! successfully read from the restart file.
399  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
400  character(len=*), optional, intent(in) :: longname !< variable long name
401  character(len=*), optional, intent(in) :: units !< variable units
402  character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, 'h' if absent
403  character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent
404  character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
405 
406  type(vardesc) :: vd
407 
408  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart: " // &
409  "register_restart_field_3d: Module must be initialized before "//&
410  "it is used to register "//trim(name))
411  vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
412  z_grid=z_grid, t_grid=t_grid)
413 
414  call register_restart_field_ptr3d(f_ptr, vd, mandatory, cs)
415 
416 end subroutine register_restart_field_3d
417 
418 !> Register a 2-d field for restarts, providing the metadata as individual arguments
419 subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units, &
420  hor_grid, z_grid, t_grid)
421  real, dimension(:,:), &
422  target, intent(in) :: f_ptr !< A pointer to the field to be read or written
423  character(len=*), intent(in) :: name !< variable name to be used in the restart file
424  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
425  !! successfully read from the restart file.
426  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
427  character(len=*), optional, intent(in) :: longname !< variable long name
428  character(len=*), optional, intent(in) :: units !< variable units
429  character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, 'h' if absent
430  character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, '1' if absent
431  character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
432 
433  type(vardesc) :: vd
434  character(len=8) :: Zgrid
435 
436  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart: " // &
437  "register_restart_field_2d: Module must be initialized before "//&
438  "it is used to register "//trim(name))
439  zgrid = '1' ; if (present(z_grid)) zgrid = z_grid
440  vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
441  z_grid=zgrid, t_grid=t_grid)
442 
443  call register_restart_field_ptr2d(f_ptr, vd, mandatory, cs)
444 
445 end subroutine register_restart_field_2d
446 
447 !> Register a 1-d field for restarts, providing the metadata as individual arguments
448 subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units, &
449  hor_grid, z_grid, t_grid)
450  real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written
451  character(len=*), intent(in) :: name !< variable name to be used in the restart file
452  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
453  !! successfully read from the restart file.
454  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
455  character(len=*), optional, intent(in) :: longname !< variable long name
456  character(len=*), optional, intent(in) :: units !< variable units
457  character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, '1' if absent
458  character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent
459  character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
460 
461  type(vardesc) :: vd
462  character(len=8) :: hgrid
463 
464  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart: " // &
465  "register_restart_field_3d: Module must be initialized before "//&
466  "it is used to register "//trim(name))
467  hgrid = '1' ; if (present(hor_grid)) hgrid = hor_grid
468  vd = var_desc(name, units=units, longname=longname, hor_grid=hgrid, &
469  z_grid=z_grid, t_grid=t_grid)
470 
471  call register_restart_field_ptr1d(f_ptr, vd, mandatory, cs)
472 
473 end subroutine register_restart_field_1d
474 
475 !> Register a 0-d field for restarts, providing the metadata as individual arguments
476 subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units, &
477  t_grid)
478  real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written
479  character(len=*), intent(in) :: name !< variable name to be used in the restart file
480  logical, intent(in) :: mandatory !< If true, the run will abort if this field is not
481  !! successfully read from the restart file.
482  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out)
483  character(len=*), optional, intent(in) :: longname !< variable long name
484  character(len=*), optional, intent(in) :: units !< variable units
485  character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
486 
487  type(vardesc) :: vd
488  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart: " // &
489  "register_restart_field_0d: Module must be initialized before "//&
490  "it is used to register "//trim(name))
491  vd = var_desc(name, units=units, longname=longname, hor_grid='1', &
492  z_grid='1', t_grid=t_grid)
493 
494  call register_restart_field_ptr0d(f_ptr, vd, mandatory, cs)
495 
496 end subroutine register_restart_field_0d
497 
498 
499 !> query_initialized_name determines whether a named field has been successfully
500 !! read from a restart file yet.
501 function query_initialized_name(name, CS) result(query_initialized)
502  character(len=*), intent(in) :: name !< The name of the field that is being queried
503  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
504  logical :: query_initialized
505 ! This subroutine returns .true. if the field referred to by name has
506 ! initialized from a restart file, and .false. otherwise.
507 
508  integer :: m,n
509  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
510  "query_initialized: Module must be initialized before it is used.")
511  if (cs%novars > cs%max_fields) call restart_error(cs)
512 
513  query_initialized = .false.
514  n = cs%novars+1
515  do m=1,cs%novars
516  if (trim(name) == cs%restart_field(m)%var_name) then
517  if (cs%restart_field(m)%initialized) query_initialized = .true.
518  n = m ; exit
519  endif
520  enddo
521 ! Assume that you are going to initialize it now, so set flag to initialized if
522 ! queried again.
523  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
524  if ((n==cs%novars+1) .and. (is_root_pe())) &
525  call mom_error(note,"MOM_restart: Unknown restart variable "//name// &
526  " queried for initialization.")
527 
528  if ((is_root_pe()) .and. query_initialized) &
529  call mom_error(note,"MOM_restart: "//name// &
530  " initialization confirmed by name.")
531 
532 end function query_initialized_name
533 
534 !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file.
535 function query_initialized_0d(f_ptr, CS) result(query_initialized)
536  real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried
537  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
538  logical :: query_initialized
539 ! This subroutine tests whether the field pointed to by f_ptr has
540 ! been initialized from a restart file.
541 
542  integer :: m,n
543  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
544  "query_initialized: Module must be initialized before it is used.")
545  if (cs%novars > cs%max_fields) call restart_error(cs)
546 
547  query_initialized = .false.
548  n = cs%novars+1
549  do m=1,cs%novars
550  if (associated(cs%var_ptr0d(m)%p,f_ptr)) then
551  if (cs%restart_field(m)%initialized) query_initialized = .true.
552  n = m ; exit
553  endif
554  enddo
555 ! Assume that you are going to initialize it now, so set flag to initialized if
556 ! queried again.
557  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
558 
559 end function query_initialized_0d
560 
561 !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file.
562 function query_initialized_1d(f_ptr, CS) result(query_initialized)
563  real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried
564  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
565  logical :: query_initialized
566 ! This subroutine tests whether the field pointed to by f_ptr has
567 ! been initialized from a restart file.
568 
569  integer :: m,n
570  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
571  "query_initialized: Module must be initialized before it is used.")
572  if (cs%novars > cs%max_fields) call restart_error(cs)
573 
574  query_initialized = .false.
575  n = cs%novars+1
576  do m=1,cs%novars
577  if (associated(cs%var_ptr1d(m)%p,f_ptr)) then
578  if (cs%restart_field(m)%initialized) query_initialized = .true.
579  n = m ; exit
580  endif
581  enddo
582 ! Assume that you are going to initialize it now, so set flag to initialized if
583 ! queried again.
584  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
585 
586 end function query_initialized_1d
587 
588 !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file.
589 function query_initialized_2d(f_ptr, CS) result(query_initialized)
590  real, dimension(:,:), &
591  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
592  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
593  logical :: query_initialized
594 ! This subroutine tests whether the field pointed to by f_ptr has
595 ! been initialized from a restart file.
596 
597  integer :: m,n
598  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
599  "query_initialized: Module must be initialized before it is used.")
600  if (cs%novars > cs%max_fields) call restart_error(cs)
601 
602  query_initialized = .false.
603  n = cs%novars+1
604  do m=1,cs%novars
605  if (associated(cs%var_ptr2d(m)%p,f_ptr)) then
606  if (cs%restart_field(m)%initialized) query_initialized = .true.
607  n = m ; exit
608  endif
609  enddo
610 ! Assume that you are going to initialize it now, so set flag to initialized if
611 ! queried again.
612  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
613 
614 end function query_initialized_2d
615 
616 !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file.
617 function query_initialized_3d(f_ptr, CS) result(query_initialized)
618  real, dimension(:,:,:), &
619  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
620  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
621  logical :: query_initialized
622 ! This subroutine tests whether the field pointed to by f_ptr has
623 ! been initialized from a restart file.
624 
625  integer :: m,n
626  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
627  "query_initialized: Module must be initialized before it is used.")
628  if (cs%novars > cs%max_fields) call restart_error(cs)
629 
630  query_initialized = .false.
631  n = cs%novars+1
632  do m=1,cs%novars
633  if (associated(cs%var_ptr3d(m)%p,f_ptr)) then
634  if (cs%restart_field(m)%initialized) query_initialized = .true.
635  n = m ; exit
636  endif
637  enddo
638 ! Assume that you are going to initialize it now, so set flag to initialized if
639 ! queried again.
640  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
641 
642 end function query_initialized_3d
643 
644 !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file.
645 function query_initialized_4d(f_ptr, CS) result(query_initialized)
646  real, dimension(:,:,:,:), &
647  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
648  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
649  logical :: query_initialized
650 ! This subroutine tests whether the field pointed to by f_ptr has
651 ! been initialized from a restart file.
652 
653  integer :: m,n
654  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
655  "query_initialized: Module must be initialized before it is used.")
656  if (cs%novars > cs%max_fields) call restart_error(cs)
657 
658  query_initialized = .false.
659  n = cs%novars+1
660  do m=1,cs%novars
661  if (associated(cs%var_ptr4d(m)%p,f_ptr)) then
662  if (cs%restart_field(m)%initialized) query_initialized = .true.
663  n = m ; exit
664  endif
665  enddo
666 ! Assume that you are going to initialize it now, so set flag to initialized if
667 ! queried again.
668  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
669 
670 end function query_initialized_4d
671 
672 !> Indicate whether the field pointed to by f_ptr or with the specified variable
673 !! name has been initialized from a restart file.
674 function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized)
675  real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried
676  character(len=*), intent(in) :: name !< The name of the field that is being queried
677  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
678  logical :: query_initialized
679 ! This subroutine tests whether the field pointed to by f_ptr or with the
680 ! specified variable name has been initialized from a restart file.
681 
682  integer :: m,n
683  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
684  "query_initialized: Module must be initialized before it is used.")
685  if (cs%novars > cs%max_fields) call restart_error(cs)
686 
687  query_initialized = .false.
688  n = cs%novars+1
689  do m=1,cs%novars
690  if (associated(cs%var_ptr0d(m)%p,f_ptr)) then
691  if (cs%restart_field(m)%initialized) query_initialized = .true.
692  n = m ; exit
693  endif
694  enddo
695 ! Assume that you are going to initialize it now, so set flag to initialized if
696 ! queried again.
697  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
698  if (n==cs%novars+1) then
699  if (is_root_pe()) &
700  call mom_error(note,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
701  "probably because of the suspect comparison of pointers by ASSOCIATED.")
702  query_initialized = query_initialized_name(name, cs)
703  endif
704 
705 end function query_initialized_0d_name
706 
707 !> Indicate whether the field pointed to by f_ptr or with the specified variable
708 !! name has been initialized from a restart file.
709 function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized)
710  real, dimension(:), &
711  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
712  character(len=*), intent(in) :: name !< The name of the field that is being queried
713  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
714  logical :: query_initialized
715 ! This subroutine tests whether the field pointed to by f_ptr or with the
716 ! specified variable name has been initialized from a restart file.
717 
718  integer :: m,n
719  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
720  "query_initialized: Module must be initialized before it is used.")
721  if (cs%novars > cs%max_fields) call restart_error(cs)
722 
723  query_initialized = .false.
724  n = cs%novars+1
725  do m=1,cs%novars
726  if (associated(cs%var_ptr1d(m)%p,f_ptr)) then
727  if (cs%restart_field(m)%initialized) query_initialized = .true.
728  n = m ; exit
729  endif
730  enddo
731 ! Assume that you are going to initialize it now, so set flag to initialized if
732 ! queried again.
733  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
734  if (n==cs%novars+1) then
735  if (is_root_pe()) &
736  call mom_error(note,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
737  "probably because of the suspect comparison of pointers by ASSOCIATED.")
738  query_initialized = query_initialized_name(name, cs)
739  endif
740 
741 end function query_initialized_1d_name
742 
743 !> Indicate whether the field pointed to by f_ptr or with the specified variable
744 !! name has been initialized from a restart file.
745 function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized)
746  real, dimension(:,:), &
747  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
748  character(len=*), intent(in) :: name !< The name of the field that is being queried
749  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
750  logical :: query_initialized
751 ! This subroutine tests whether the field pointed to by f_ptr or with the
752 ! specified variable name has been initialized from a restart file.
753 
754  integer :: m,n
755  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
756  "query_initialized: Module must be initialized before it is used.")
757  if (cs%novars > cs%max_fields) call restart_error(cs)
758 
759  query_initialized = .false.
760  n = cs%novars+1
761  do m=1,cs%novars
762  if (associated(cs%var_ptr2d(m)%p,f_ptr)) then
763  if (cs%restart_field(m)%initialized) query_initialized = .true.
764  n = m ; exit
765  endif
766  enddo
767 ! Assume that you are going to initialize it now, so set flag to initialized if
768 ! queried again.
769  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
770  if (n==cs%novars+1) then
771  if (is_root_pe()) &
772  call mom_error(note,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
773  "probably because of the suspect comparison of pointers by ASSOCIATED.")
774  query_initialized = query_initialized_name(name, cs)
775  endif
776 
777 end function query_initialized_2d_name
778 
779 !> Indicate whether the field pointed to by f_ptr or with the specified variable
780 !! name has been initialized from a restart file.
781 function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized)
782  real, dimension(:,:,:), &
783  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
784  character(len=*), intent(in) :: name !< The name of the field that is being queried
785  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
786  logical :: query_initialized
787 ! This subroutine tests whether the field pointed to by f_ptr or with the
788 ! specified variable name has been initialized from a restart file.
789 
790  integer :: m, n
791  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
792  "query_initialized: Module must be initialized before it is used.")
793  if (cs%novars > cs%max_fields) call restart_error(cs)
794 
795  query_initialized = .false.
796  n = cs%novars+1
797  do m=1,cs%novars
798  if (associated(cs%var_ptr3d(m)%p,f_ptr)) then
799  if (cs%restart_field(m)%initialized) query_initialized = .true.
800  n = m ; exit
801  endif
802  enddo
803 ! Assume that you are going to initialize it now, so set flag to initialized if
804 ! queried again.
805  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
806  if (n==cs%novars+1) then
807  if (is_root_pe()) &
808  call mom_error(note, "MOM_restart: Unable to find "//name//" queried by pointer, "//&
809  "possibly because of the suspect comparison of pointers by ASSOCIATED.")
810  query_initialized = query_initialized_name(name, cs)
811  endif
812 
813 end function query_initialized_3d_name
814 
815 !> Indicate whether the field pointed to by f_ptr or with the specified variable
816 !! name has been initialized from a restart file.
817 function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized)
818  real, dimension(:,:,:,:), &
819  target, intent(in) :: f_ptr !< A pointer to the field that is being queried
820  character(len=*), intent(in) :: name !< The name of the field that is being queried
821  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object (intent in)
822  logical :: query_initialized
823 ! This subroutine tests whether the field pointed to by f_ptr or with the
824 ! specified variable name has been initialized from a restart file.
825 
826  integer :: m, n
827  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
828  "query_initialized: Module must be initialized before it is used.")
829  if (cs%novars > cs%max_fields) call restart_error(cs)
830 
831  query_initialized = .false.
832  n = cs%novars+1
833  do m=1,cs%novars
834  if (associated(cs%var_ptr4d(m)%p,f_ptr)) then
835  if (cs%restart_field(m)%initialized) query_initialized = .true.
836  n = m ; exit
837  endif
838  enddo
839 ! Assume that you are going to initialize it now, so set flag to initialized if
840 ! queried again.
841  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
842  if (n==cs%novars+1) then
843  if (is_root_pe()) &
844  call mom_error(note, "MOM_restart: Unable to find "//name//" queried by pointer, "//&
845  "possibly because of the suspect comparison of pointers by ASSOCIATED.")
846  query_initialized = query_initialized_name(name, cs)
847  endif
848 
849 end function query_initialized_4d_name
850 
851 !> save_restart saves all registered variables to restart files.
852 subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_rest_files)
853  character(len=*), intent(in) :: directory !< The directory where the restart files
854  !! are to be written
855  type(time_type), intent(in) :: time !< The current model time
856  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure
857  type(mom_restart_cs), pointer :: cs !< The control structure returned by a previous
858  !! call to restart_init.
859  logical, optional, intent(in) :: time_stamped !< If present and true, add time-stamp
860  !! to the restart file names.
861  character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile.
862  type(verticalgrid_type), optional, intent(in) :: gv !< The ocean's vertical grid structure
863  integer, optional, intent(out) :: num_rest_files !< number of restart files written
864 
865  ! Local variables
866  type(vardesc) :: vars(cs%max_fields) ! Descriptions of the fields that
867  ! are to be read from the restart file.
868  type(fieldtype) :: fields(cs%max_fields) !
869  character(len=512) :: restartpath ! The restart file path (dir/file).
870  character(len=256) :: restartname ! The restart file name (no dir).
871  character(len=8) :: suffix ! A suffix (like _2) that is appended
872  ! to the name of files after the first.
873  integer(kind=8) :: var_sz, size_in_file ! The size in bytes of each variable
874  ! and the variables already in a file.
875  integer(kind=8) :: max_file_size = 2147483647_8 ! The maximum size in bytes
876  ! for any one file. With NetCDF3,
877  ! this should be 2 Gb or less.
878  integer :: start_var, next_var ! The starting variables of the
879  ! current and next files.
880  integer :: unit ! The mpp unit of the open file.
881  integer :: m, nz, num_files, var_periods
882  integer :: seconds, days, year, month, hour, minute
883  character(len=8) :: hor_grid, z_grid, t_grid ! Variable grid info.
884  character(len=8) :: t_grid_read
885  character(len=64) :: var_name ! A variable's name.
886  real :: restart_time
887  character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs
888  integer :: length
889  integer(kind=8) :: check_val(cs%max_fields,1)
890  integer :: isl, iel, jsl, jel, pos
891  integer :: turns
892 
893  turns = cs%turns
894 
895  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
896  "save_restart: Module must be initialized before it is used.")
897  if (cs%novars > cs%max_fields) call restart_error(cs)
898 
899  ! With parallel read & write, it is possible to disable the following...
900 
901  ! The maximum file size is 4294967292, according to the NetCDF documentation.
902  if (cs%large_file_support) max_file_size = 4294967292_8
903 
904  num_files = 0
905  next_var = 0
906  nz = 1 ; if (present(gv)) nz = gv%ke
907 
908  restart_time = time_type_to_real(time) / 86400.0
909 
910  restartname = trim(cs%restartfile)
911  if (present(filename)) restartname = trim(filename)
912  if (PRESENT(time_stamped)) then ; if (time_stamped) then
913  call get_date(time,year,month,days,hour,minute,seconds)
914  ! Compute the year-day, because I don't like months. - RWH
915  do m=1,month-1
916  days = days + days_in_month(set_date(year,m,2,0,0,0))
917  enddo
918  seconds = seconds + 60*minute + 3600*hour
919  if (year <= 9999) then
920  write(restartname,'("_Y",I4.4,"_D",I3.3,"_S",I5.5)') year, days, seconds
921  elseif (year <= 99999) then
922  write(restartname,'("_Y",I5.5,"_D",I3.3,"_S",I5.5)') year, days, seconds
923  else
924  write(restartname,'("_Y",I10.10,"_D",I3.3,"_S",I5.5)') year, days, seconds
925  endif
926  restartname = trim(cs%restartfile)//trim(restartname)
927  endif ; endif
928 
929  next_var = 1
930  do while (next_var <= cs%novars )
931  start_var = next_var
932  size_in_file = 8*(2*g%Domain%niglobal+2*g%Domain%njglobal+2*nz+1000)
933 
934  do m=start_var,cs%novars
935  call query_vardesc(cs%restart_field(m)%vars, hor_grid=hor_grid, &
936  z_grid=z_grid, t_grid=t_grid, caller="save_restart")
937  if (hor_grid == '1') then
938  var_sz = 8
939  else
940  var_sz = 8*(g%Domain%niglobal+1)*(g%Domain%njglobal+1)
941  endif
942  select case (z_grid)
943  case ('L') ; var_sz = var_sz * nz
944  case ('i') ; var_sz = var_sz * (nz+1)
945  end select
946  t_grid = adjustl(t_grid)
947  if (t_grid(1:1) == 'p') then
948  if (len_trim(t_grid(2:8)) > 0) then
949  var_periods = -1
950  t_grid_read = adjustl(t_grid(2:8))
951  read(t_grid_read,*) var_periods
952  if (var_periods > 1) var_sz = var_sz * var_periods
953  endif
954  endif
955 
956  if ((m==start_var) .OR. (size_in_file < max_file_size-var_sz)) then
957  size_in_file = size_in_file + var_sz
958  else ; exit
959  endif
960 
961  enddo
962  next_var = m
963 
964  !query fms_io if there is a filename_appendix (for ensemble runs)
965  call get_filename_appendix(filename_appendix)
966  if (len_trim(filename_appendix) > 0) then
967  length = len_trim(restartname)
968  if (restartname(length-2:length) == '.nc') then
969  restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc'
970  else
971  restartname = restartname(1:length) //'.'//trim(filename_appendix)
972  endif
973  endif
974 
975  restartpath = trim(directory)// trim(restartname)
976 
977  if (num_files < 10) then
978  write(suffix,'("_",I1)') num_files
979  else
980  write(suffix,'("_",I2)') num_files
981  endif
982 
983  if (num_files > 0) restartpath = trim(restartpath) // trim(suffix)
984 
985  do m=start_var,next_var-1
986  vars(m-start_var+1) = cs%restart_field(m)%vars
987  enddo
988  call query_vardesc(vars(1), t_grid=t_grid, hor_grid=hor_grid, caller="save_restart")
989  t_grid = adjustl(t_grid)
990  if (t_grid(1:1) /= 'p') &
991  call modify_vardesc(vars(1), t_grid='s', caller="save_restart")
992  select case (hor_grid)
993  case ('q') ; pos = corner
994  case ('h') ; pos = center
995  case ('u') ; pos = east_face
996  case ('v') ; pos = north_face
997  case ('Bu') ; pos = corner
998  case ('T') ; pos = center
999  case ('Cu') ; pos = east_face
1000  case ('Cv') ; pos = north_face
1001  case ('1') ; pos = 0
1002  case default ; pos = 0
1003  end select
1004 
1005  !Prepare the checksum of the restart fields to be written to restart files
1006  if (modulo(turns, 2) /= 0) then
1007  call get_checksum_loop_ranges(g, pos, jsl, jel, isl, iel)
1008  else
1009  call get_checksum_loop_ranges(g, pos, isl, iel, jsl, jel)
1010  endif
1011  do m=start_var,next_var-1
1012  if (associated(cs%var_ptr3d(m)%p)) then
1013  check_val(m-start_var+1,1) = &
1014  mpp_chksum(cs%var_ptr3d(m)%p(isl:iel,jsl:jel,:), turns=-turns)
1015  elseif (associated(cs%var_ptr2d(m)%p)) then
1016  check_val(m-start_var+1,1) = &
1017  mpp_chksum(cs%var_ptr2d(m)%p(isl:iel,jsl:jel), turns=-turns)
1018  elseif (associated(cs%var_ptr4d(m)%p)) then
1019  check_val(m-start_var+1,1) = &
1020  mpp_chksum(cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:), turns=-turns)
1021  elseif (associated(cs%var_ptr1d(m)%p)) then
1022  check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr1d(m)%p)
1023  elseif (associated(cs%var_ptr0d(m)%p)) then
1024  check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr0d(m)%p,pelist=(/mpp_pe()/))
1025  endif
1026  enddo
1027 
1028  if (cs%parallel_restartfiles) then
1029  call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
1030  fields, multiple, g=g, gv=gv, checksums=check_val)
1031  else
1032  call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
1033  fields, single_file, g=g, gv=gv, checksums=check_val)
1034  endif
1035 
1036  do m=start_var,next_var-1
1037  if (associated(cs%var_ptr3d(m)%p)) then
1038  call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
1039  cs%var_ptr3d(m)%p, restart_time, turns=-turns)
1040  elseif (associated(cs%var_ptr2d(m)%p)) then
1041  call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
1042  cs%var_ptr2d(m)%p, restart_time, turns=-turns)
1043  elseif (associated(cs%var_ptr4d(m)%p)) then
1044  call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
1045  cs%var_ptr4d(m)%p, restart_time, turns=-turns)
1046  elseif (associated(cs%var_ptr1d(m)%p)) then
1047  call write_field(unit, fields(m-start_var+1), cs%var_ptr1d(m)%p, &
1048  restart_time)
1049  elseif (associated(cs%var_ptr0d(m)%p)) then
1050  call write_field(unit, fields(m-start_var+1), cs%var_ptr0d(m)%p, &
1051  restart_time)
1052  endif
1053  enddo
1054 
1055  call close_file(unit)
1056 
1057  num_files = num_files+1
1058 
1059  enddo
1060 
1061  if (present(num_rest_files)) num_rest_files = num_files
1062 
1063 end subroutine save_restart
1064 
1065 !> restore_state reads the model state from previously generated files. All
1066 !! restart variables are read from the first file in the input filename list
1067 !! in which they are found.
1068 subroutine restore_state(filename, directory, day, G, CS)
1069  character(len=*), intent(in) :: filename !< The list of restart file names or a single
1070  !! character 'r' to read automatically named files.
1071  character(len=*), intent(in) :: directory !< The directory in which to find restart files
1072  type(time_type), intent(out) :: day !< The time of the restarted run
1073  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
1074  type(mom_restart_cs), pointer :: cs !< The control structure returned by a previous
1075  !! call to restart_init.
1076 
1077 ! This subroutine reads the model state from previously
1078 ! generated files. All restart variables are read from the first
1079 ! file in the input filename list in which they are found.
1080 
1081  ! Local variables
1082  character(len=200) :: filepath ! The path (dir/file) to the file being opened.
1083  character(len=80) :: fname ! The name of the current file.
1084  character(len=8) :: suffix ! A suffix (like "_2") that is added to any
1085  ! additional restart files.
1086  character(len=512) :: mesg ! A message for warnings.
1087  character(len=80) :: varname ! A variable's name.
1088  integer :: num_file ! The number of files (restart files and others
1089  ! explicitly in filename) that are open.
1090  integer :: i, n, m, missing_fields
1091  integer :: isl, iel, jsl, jel, is0, js0
1092  integer :: sizes(7)
1093  integer :: ndim, nvar, natt, ntime, pos
1094 
1095  integer :: unit(cs%max_fields) ! The mpp unit of all open files.
1096  character(len=200) :: unit_path(cs%max_fields) ! The file names.
1097  logical :: unit_is_global(cs%max_fields) ! True if the file is global.
1098 
1099  character(len=8) :: hor_grid ! Variable grid info.
1100  real :: t1, t2 ! Two times.
1101  real, allocatable :: time_vals(:)
1102  type(fieldtype), allocatable :: fields(:)
1103  logical :: check_exist, is_there_a_checksum
1104  integer(kind=8),dimension(3) :: checksum_file
1105  integer(kind=8) :: checksum_data
1106 
1107  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
1108  "restore_state: Module must be initialized before it is used.")
1109  if (cs%novars > cs%max_fields) call restart_error(cs)
1110 
1111 ! Get NetCDF ids for all of the restart files.
1112  if ((len_trim(filename) == 1) .and. (filename(1:1) == 'F')) then
1113  num_file = open_restart_units('r', directory, g, cs, units=unit, &
1114  file_paths=unit_path, global_files=unit_is_global)
1115  else
1116  num_file = open_restart_units(filename, directory, g, cs, units=unit, &
1117  file_paths=unit_path, global_files=unit_is_global)
1118  endif
1119 
1120  if (num_file == 0) then
1121  write(mesg,'("Unable to find any restart files specified by ",A," in directory ",A,".")') &
1122  trim(filename), trim(directory)
1123  call mom_error(fatal,"MOM_restart: "//mesg)
1124  endif
1125 
1126 ! Get the time from the first file in the list that has one.
1127  do n=1,num_file
1128  call get_file_info(unit(n), ndim, nvar, natt, ntime)
1129  if (ntime < 1) cycle
1130 
1131  allocate(time_vals(ntime))
1132  call get_file_times(unit(n), time_vals)
1133  t1 = time_vals(1)
1134  deallocate(time_vals)
1135 
1136  day = real_to_time(t1*86400.0)
1137  exit
1138  enddo
1139 
1140  if (n>num_file) call mom_error(warning,"MOM_restart: " // &
1141  "No times found in restart files.")
1142 
1143 ! Check the remaining files for different times and issue a warning
1144 ! if they differ from the first time.
1145  if (is_root_pe()) then
1146  do m = n+1,num_file
1147  call get_file_info(unit(n), ndim, nvar, natt, ntime)
1148  if (ntime < 1) cycle
1149 
1150  allocate(time_vals(ntime))
1151  call get_file_times(unit(n), time_vals)
1152  t2 = time_vals(1)
1153  deallocate(time_vals)
1154 
1155  if (t1 /= t2) then
1156  write(mesg,'("WARNING: Restart file ",I2," has time ",F10.4,"whereas &
1157  &simulation is restarted at ",F10.4," (differing by ",F10.4,").")')&
1158  m,t1,t2,t1-t2
1159  call mom_error(warning, "MOM_restart: "//mesg)
1160  endif
1161  enddo
1162  endif
1163 
1164 ! Read each variable from the first file in which it is found.
1165  do n=1,num_file
1166  call get_file_info(unit(n), ndim, nvar, natt, ntime)
1167 
1168  allocate(fields(nvar))
1169  call get_file_fields(unit(n),fields(1:nvar))
1170 
1171  do m=1, nvar
1172  call get_file_atts(fields(m),name=varname)
1173  do i=1,cs%num_obsolete_vars
1174  if (adjustl(lowercase(trim(varname))) == adjustl(lowercase(trim(cs%restart_obsolete(i)%field_name)))) then
1175  call mom_error(fatal, "MOM_restart restore_state: Attempting to use obsolete restart field "//&
1176  trim(varname)//" - the new corresponding restart field is "//&
1177  trim(cs%restart_obsolete(i)%replacement_name))
1178  endif
1179  enddo
1180  enddo
1181 
1182  missing_fields = 0
1183 
1184  do m=1,cs%novars
1185  if (cs%restart_field(m)%initialized) cycle
1186  call query_vardesc(cs%restart_field(m)%vars, hor_grid=hor_grid, &
1187  caller="restore_state")
1188  select case (hor_grid)
1189  case ('q') ; pos = corner
1190  case ('h') ; pos = center
1191  case ('u') ; pos = east_face
1192  case ('v') ; pos = north_face
1193  case ('Bu') ; pos = corner
1194  case ('T') ; pos = center
1195  case ('Cu') ; pos = east_face
1196  case ('Cv') ; pos = north_face
1197  case ('1') ; pos = 0
1198  case default ; pos = 0
1199  end select
1200 
1201  call get_checksum_loop_ranges(g, pos, isl, iel, jsl, jel)
1202  do i=1, nvar
1203  call get_file_atts(fields(i),name=varname)
1204  if (lowercase(trim(varname)) == lowercase(trim(cs%restart_field(m)%var_name))) then
1205  check_exist = mpp_attribute_exist(fields(i),"checksum")
1206  checksum_file(:) = -1
1207  checksum_data = -1
1208  is_there_a_checksum = .false.
1209  if ( check_exist ) then
1210  call mpp_get_atts(fields(i),checksum=checksum_file)
1211  is_there_a_checksum = .true.
1212  endif
1213  if (.NOT. cs%checksum_required) is_there_a_checksum = .false. ! Do not need to do data checksumming.
1214 
1215  if (associated(cs%var_ptr1d(m)%p)) then
1216  ! Read a 1d array, which should be invariant to domain decomposition.
1217  call read_data(unit_path(n), varname, cs%var_ptr1d(m)%p, &
1218  g%Domain%mpp_domain, timelevel=1)
1219  if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr1d(m)%p)
1220  elseif (associated(cs%var_ptr0d(m)%p)) then ! Read a scalar...
1221  call read_data(unit_path(n), varname, cs%var_ptr0d(m)%p, &
1222  g%Domain%mpp_domain, timelevel=1)
1223  if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr0d(m)%p,pelist=(/mpp_pe()/))
1224  elseif (associated(cs%var_ptr2d(m)%p)) then ! Read a 2d array.
1225  if (pos /= 0) then
1226  call mom_read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1227  g%Domain, timelevel=1, position=pos)
1228  else ! This array is not domain-decomposed. This variant may be under-tested.
1229  call read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1230  no_domain=.true., timelevel=1)
1231  endif
1232  if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr2d(m)%p(isl:iel,jsl:jel))
1233  elseif (associated(cs%var_ptr3d(m)%p)) then ! Read a 3d array.
1234  if (pos /= 0) then
1235  call mom_read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1236  g%Domain, timelevel=1, position=pos)
1237  else ! This array is not domain-decomposed. This variant may be under-tested.
1238  call read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1239  no_domain=.true., timelevel=1)
1240  endif
1241  if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr3d(m)%p(isl:iel,jsl:jel,:))
1242  elseif (associated(cs%var_ptr4d(m)%p)) then ! Read a 4d array.
1243  if (pos /= 0) then
1244  call mom_read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1245  g%Domain, timelevel=1, position=pos)
1246  else ! This array is not domain-decomposed. This variant may be under-tested.
1247  call read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1248  no_domain=.true., timelevel=1)
1249  endif
1250  if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:))
1251  else
1252  call mom_error(fatal, "MOM_restart restore_state: No pointers set for "//trim(varname))
1253  endif
1254 
1255  if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then
1256  write (mesg,'(a,Z16,a,Z16,a)') "Checksum of input field "// trim(varname)//" ",checksum_data,&
1257  " does not match value ", checksum_file(1), &
1258  " stored in "//trim(unit_path(n)//"." )
1259  call mom_error(fatal, "MOM_restart(restore_state): "//trim(mesg) )
1260  endif
1261 
1262  cs%restart_field(m)%initialized = .true.
1263  exit ! Start search for next restart variable.
1264  endif
1265  enddo
1266  if (i>nvar) missing_fields = missing_fields+1
1267  enddo
1268 
1269  deallocate(fields)
1270  if (missing_fields == 0) exit
1271  enddo
1272 
1273  do n=1,num_file
1274  call close_file(unit(n))
1275  enddo
1276 
1277 ! Check whether any mandatory fields have not been found.
1278  cs%restart = .true.
1279  do m=1,cs%novars
1280  if (.not.(cs%restart_field(m)%initialized)) then
1281  cs%restart = .false.
1282  if (cs%restart_field(m)%mand_var) then
1283  call mom_error(fatal,"MOM_restart: Unable to find mandatory variable " &
1284  //trim(cs%restart_field(m)%var_name)//" in restart files.")
1285  endif
1286  endif
1287  enddo
1288 
1289 end subroutine restore_state
1290 
1291 !> restart_files_exist determines whether any restart files exist.
1292 function restart_files_exist(filename, directory, G, CS)
1293  character(len=*), intent(in) :: filename !< The list of restart file names or a single
1294  !! character 'r' to read automatically named files.
1295  character(len=*), intent(in) :: directory !< The directory in which to find restart files
1296  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
1297  type(mom_restart_cs), pointer :: cs !< The control structure returned by a previous
1298  !! call to restart_init.
1299  logical :: restart_files_exist !< The function result, which indicates whether
1300  !! any of the explicitly or automatically named
1301  !! restart files exist in directory.
1302  integer :: num_files
1303 
1304  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
1305  "restart_files_exist: Module must be initialized before it is used.")
1306 
1307  if ((len_trim(filename) == 1) .and. (filename(1:1) == 'F')) then
1308  num_files = open_restart_units('r', directory, g, cs)
1309  else
1310  num_files = open_restart_units(filename, directory, g, cs)
1311  endif
1312  restart_files_exist = (num_files > 0)
1313 
1314 end function restart_files_exist
1315 
1316 !> determine_is_new_run determines from the value of filename and the existence
1317 !! automatically named restart files in directory whether this would be a new,
1318 !! and as a side effect stores this information in CS.
1319 function determine_is_new_run(filename, directory, G, CS) result(is_new_run)
1320  character(len=*), intent(in) :: filename !< The list of restart file names or a single
1321  !! character 'r' to read automatically named files.
1322  character(len=*), intent(in) :: directory !< The directory in which to find restart files
1323  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
1324  type(mom_restart_cs), pointer :: cs !< The control structure returned by a previous
1325  !! call to restart_init.
1326  logical :: is_new_run !< The function result, which indicates whether
1327  !! this is a new run, based on the value of
1328  !! filename and whether restart files exist.
1329 
1330  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
1331  "determine_is_new_run: Module must be initialized before it is used.")
1332  if (len_trim(filename) > 1) then
1333  cs%new_run = .false.
1334  elseif (len_trim(filename) == 0) then
1335  cs%new_run = .true.
1336  elseif (filename(1:1) == 'n') then
1337  cs%new_run = .true.
1338  elseif (filename(1:1) == 'F') then
1339  cs%new_run = (open_restart_units('r', directory, g, cs) == 0)
1340  else
1341  cs%new_run = .false.
1342  endif
1343 
1344  cs%new_run_set = .true.
1345  is_new_run = cs%new_run
1346 end function determine_is_new_run
1347 
1348 !> is_new_run returns whether this is going to be a new run based on the
1349 !! information stored in CS by a previous call to determine_is_new_run.
1350 function is_new_run(CS)
1351  type(mom_restart_cs), pointer :: cs !< The control structure returned by a previous
1352  !! call to restart_init.
1353  logical :: is_new_run !< The function result, which indicates whether
1354  !! this is a new run, based on the value of
1355  !! filename and whether restart files exist.
1356 
1357  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
1358  "is_new_run: Module must be initialized before it is used.")
1359  if (.not.cs%new_run_set) call mom_error(fatal, "MOM_restart " // &
1360  "determine_is_new_run must be called for a restart file before is_new_run.")
1361 
1362  is_new_run = cs%new_run
1363 end function is_new_run
1364 
1365 !> open_restart_units determines the number of existing restart files and optionally opens
1366 !! them and returns unit ids, paths and whether the files are global or spatially decomposed.
1367 function open_restart_units(filename, directory, G, CS, units, file_paths, &
1368  global_files) result(num_files)
1369  character(len=*), intent(in) :: filename !< The list of restart file names or a single
1370  !! character 'r' to read automatically named files.
1371  character(len=*), intent(in) :: directory !< The directory in which to find restart files
1372  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
1373  type(mom_restart_cs), pointer :: cs !< The control structure returned by a previous
1374  !! call to restart_init.
1375  integer, dimension(:), &
1376  optional, intent(out) :: units !< The mpp units of all opened files.
1377  character(len=*), dimension(:), &
1378  optional, intent(out) :: file_paths !< The full paths to open files.
1379  logical, dimension(:), &
1380  optional, intent(out) :: global_files !< True if a file is global.
1381 
1382  integer :: num_files !< The number of files (both automatically named restart
1383  !! files and others explicitly in filename) that have been opened.
1384 
1385 ! This subroutine reads the model state from previously
1386 ! generated files. All restart variables are read from the first
1387 ! file in the input filename list in which they are found.
1388 
1389  ! Local variables
1390  character(len=256) :: filepath ! The path (dir/file) to the file being opened.
1391  character(len=256) :: fname ! The name of the current file.
1392  character(len=8) :: suffix ! A suffix (like "_2") that is added to any
1393  ! additional restart files.
1394 ! character(len=256) :: mesg ! A message for warnings.
1395  integer :: num_restart ! The number of restart files that have already
1396  ! been opened.
1397  integer :: start_char ! The location of the starting character in the
1398  ! current file name.
1399  integer :: n, m, err, length
1400 
1401 
1402  logical :: fexists
1403  character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs
1404  character(len=80) :: restartname
1405 
1406  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
1407  "open_restart_units: Module must be initialized before it is used.")
1408 
1409 ! Get NetCDF ids for all of the restart files.
1410  num_restart = 0 ; n = 1 ; start_char = 1
1411  do while (start_char <= len_trim(filename) )
1412  do m=start_char,len_trim(filename)
1413  if (filename(m:m) == ' ') exit
1414  enddo
1415  fname = filename(start_char:m-1)
1416  start_char = m
1417  do while (start_char <= len_trim(filename))
1418  if (filename(start_char:start_char) == ' ') then
1419  start_char = start_char + 1
1420  else
1421  exit
1422  endif
1423  enddo
1424 
1425  if ((fname(1:1)=='r') .and. ( len_trim(fname) == 1)) then
1426  err = 0
1427  if (num_restart > 0) err = 1 ! Avoid going through the file list twice.
1428  do while (err == 0)
1429  restartname = trim(cs%restartfile)
1430 
1431  !query fms_io if there is a filename_appendix (for ensemble runs)
1432  call get_filename_appendix(filename_appendix)
1433  if (len_trim(filename_appendix) > 0) then
1434  length = len_trim(restartname)
1435  if (restartname(length-2:length) == '.nc') then
1436  restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc'
1437  else
1438  restartname = restartname(1:length) //'.'//trim(filename_appendix)
1439  endif
1440  endif
1441  filepath = trim(directory) // trim(restartname)
1442 
1443  if (num_restart < 10) then
1444  write(suffix,'("_",I1)') num_restart
1445  else
1446  write(suffix,'("_",I2)') num_restart
1447  endif
1448  if (num_restart > 0) filepath = trim(filepath) // suffix
1449 
1450  ! if (.not.file_exists(filepath)) &
1451  filepath = trim(filepath)//".nc"
1452 
1453  num_restart = num_restart + 1
1454  inquire(file=filepath, exist=fexists)
1455  if (fexists) then
1456  if (present(units)) &
1457  call open_file(units(n), trim(filepath), readonly_file, netcdf_file, &
1458  threading = multiple, fileset = single_file)
1459  if (present(global_files)) global_files(n) = .true.
1460  elseif (cs%parallel_restartfiles) then
1461  ! Look for decomposed files using the I/O Layout.
1462  fexists = file_exists(filepath, g%Domain)
1463  if (fexists .and. (present(units))) &
1464  call open_file(units(n), trim(filepath), readonly_file, netcdf_file, &
1465  domain=g%Domain%mpp_domain)
1466  if (fexists .and. present(global_files)) global_files(n) = .false.
1467  endif
1468 
1469  if (fexists) then
1470  if (present(file_paths)) file_paths(n) = filepath
1471  n = n + 1
1472  if (is_root_pe() .and. (present(units))) &
1473  call mom_error(note, "MOM_restart: MOM run restarted using : "//trim(filepath))
1474  else
1475  err = 1 ; exit
1476  endif
1477  enddo ! while (err == 0) loop
1478  else
1479  filepath = trim(directory)//trim(fname)
1480  inquire(file=filepath, exist=fexists)
1481  if (.not. fexists) filepath = trim(filepath)//".nc"
1482 
1483  inquire(file=filepath, exist=fexists)
1484  if (fexists) then
1485  if (present(units)) &
1486  call open_file(units(n), trim(filepath), readonly_file, netcdf_file, &
1487  threading = multiple, fileset = single_file)
1488  if (present(global_files)) global_files(n) = .true.
1489  if (present(file_paths)) file_paths(n) = filepath
1490  n = n + 1
1491  if (is_root_pe() .and. (present(units))) &
1492  call mom_error(note,"MOM_restart: MOM run restarted using : "//trim(filepath))
1493  else
1494  if (present(units)) &
1495  call mom_error(warning,"MOM_restart: Unable to find restart file : "//trim(filepath))
1496  endif
1497 
1498  endif
1499  enddo ! while (start_char < strlen(filename)) loop
1500  num_files = n-1
1501 
1502 end function open_restart_units
1503 
1504 !> Initialize this module and set up a restart control structure.
1505 subroutine restart_init(param_file, CS, restart_root)
1506  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
1507  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object that is allocated here
1508  character(len=*), optional, &
1509  intent(in) :: restart_root !< A filename root that overrides the value
1510  !! set by RESTARTFILE to enable the use of this module by
1511  !! other components than MOM.
1512 
1513  logical :: rotate_index
1514 
1515 ! This include declares and sets the variable "version".
1516 #include "version_variable.h"
1517  character(len=40) :: mdl = "MOM_restart" ! This module's name.
1518  logical :: all_default ! If true, all parameters are using their default values.
1519 
1520  if (associated(cs)) then
1521  call mom_error(warning, "restart_init called with an associated control structure.")
1522  return
1523  endif
1524  allocate(cs)
1525 
1526  ! Determine whether all paramters are set to their default values.
1527  call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", cs%parallel_restartfiles, &
1528  default=.false., do_not_log=.true.)
1529  call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", cs%large_file_support, &
1530  default=.true., do_not_log=.true.)
1531  call get_param(param_file, mdl, "MAX_FIELDS", cs%max_fields, default=100, do_not_log=.true.)
1532  call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", cs%checksum_required, &
1533  default=.true., do_not_log=.true.)
1534  all_default = ((.not.cs%parallel_restartfiles) .and. (cs%large_file_support) .and. &
1535  (cs%max_fields == 100) .and. (cs%checksum_required))
1536  if (.not.present(restart_root)) then
1537  call get_param(param_file, mdl, "RESTARTFILE", cs%restartfile, &
1538  default="MOM.res", do_not_log=.true.)
1539  all_default = (all_default .and. (trim(cs%restartfile) == trim("MOM.res")))
1540  endif
1541 
1542  ! Read all relevant parameters and write them to the model log.
1543  call log_version(param_file, mdl, version, "", all_default=all_default)
1544  call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", cs%parallel_restartfiles, &
1545  "If true, each processor writes its own restart file, "//&
1546  "otherwise a single restart file is generated", &
1547  default=.false.)
1548 
1549  if (present(restart_root)) then
1550  cs%restartfile = restart_root
1551  call log_param(param_file, mdl, "RESTARTFILE from argument", cs%restartfile)
1552  else
1553  call get_param(param_file, mdl, "RESTARTFILE", cs%restartfile, &
1554  "The name-root of the restart file.", default="MOM.res")
1555  endif
1556  call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", cs%large_file_support, &
1557  "If true, use the file-size limits with NetCDF large "//&
1558  "file support (4Gb), otherwise the limit is 2Gb.", &
1559  default=.true.)
1560  call get_param(param_file, mdl, "MAX_FIELDS", cs%max_fields, &
1561  "The maximum number of restart fields that can be used.", &
1562  default=100)
1563  call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", cs%checksum_required, &
1564  "If true, require the restart checksums to match and error out otherwise. "//&
1565  "Users may want to avoid this comparison if for example the restarts are "//&
1566  "made from a run with a different mask_table than the current run, "//&
1567  "in which case the checksums will not match and cause crash.",&
1568  default=.true.)
1569 
1570  ! Maybe not the best place to do this?
1571  call get_param(param_file, mdl, "ROTATE_INDEX", rotate_index, &
1572  default=.false., do_not_log=.true.)
1573 
1574  cs%turns = 0
1575  if (rotate_index) then
1576  call get_param(param_file, mdl, "INDEX_TURNS", cs%turns, &
1577  default=1, do_not_log=.true.)
1578  endif
1579 
1580  allocate(cs%restart_field(cs%max_fields))
1581  allocate(cs%restart_obsolete(cs%max_fields))
1582  allocate(cs%var_ptr0d(cs%max_fields))
1583  allocate(cs%var_ptr1d(cs%max_fields))
1584  allocate(cs%var_ptr2d(cs%max_fields))
1585  allocate(cs%var_ptr3d(cs%max_fields))
1586  allocate(cs%var_ptr4d(cs%max_fields))
1587 
1588 end subroutine restart_init
1589 
1590 !> Indicate that all variables have now been registered.
1591 subroutine restart_init_end(CS)
1592  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object
1593 
1594  if (associated(cs)) then
1595  if (cs%novars == 0) call restart_end(cs)
1596  endif
1597 
1598 end subroutine restart_init_end
1599 
1600 !> Deallocate memory associated with a MOM_restart_CS variable.
1601 subroutine restart_end(CS)
1602  type(mom_restart_cs), pointer :: cs !< A pointer to a MOM_restart_CS object
1603 
1604  if (associated(cs%restart_field)) deallocate(cs%restart_field)
1605  if (associated(cs%restart_obsolete)) deallocate(cs%restart_obsolete)
1606  if (associated(cs%var_ptr0d)) deallocate(cs%var_ptr0d)
1607  if (associated(cs%var_ptr1d)) deallocate(cs%var_ptr1d)
1608  if (associated(cs%var_ptr2d)) deallocate(cs%var_ptr2d)
1609  if (associated(cs%var_ptr3d)) deallocate(cs%var_ptr3d)
1610  if (associated(cs%var_ptr4d)) deallocate(cs%var_ptr4d)
1611  deallocate(cs)
1612 
1613 end subroutine restart_end
1614 
1615 subroutine restart_error(CS)
1616  type(mom_restart_cs), pointer :: CS !< A pointer to a MOM_restart_CS object
1617 
1618  character(len=16) :: num ! String for error messages
1619 
1620  if (cs%novars > cs%max_fields) then
1621  write(num,'(I0)') cs%novars
1622  call mom_error(fatal,"MOM_restart: Too many fields registered for " // &
1623  "restart. Set MAX_FIELDS to be at least " // &
1624  trim(adjustl(num)) // " in the MOM input file.")
1625  else
1626  call mom_error(fatal,"MOM_restart: Unspecified fatal error.")
1627  endif
1628 end subroutine restart_error
1629 
1630 !> Return bounds for computing checksums to store in restart files
1631 subroutine get_checksum_loop_ranges(G, pos, isL, ieL, jsL, jeL)
1632  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
1633  integer, intent(in) :: pos !< An integer indicating staggering of variable
1634  integer, intent(out) :: isL !< i-start for checksum
1635  integer, intent(out) :: ieL !< i-end for checksum
1636  integer, intent(out) :: jsL !< j-start for checksum
1637  integer, intent(out) :: jeL !< j-end for checksum
1638 
1639  ! Regular non-symmetric compute domain
1640  isl = g%isc-g%isd+1
1641  iel = g%iec-g%isd+1
1642  jsl = g%jsc-g%jsd+1
1643  jel = g%jec-g%jsd+1
1644 
1645  ! Expand range east or south for symmetric arrays
1646  if (g%symmetric) then
1647  if ((pos == east_face) .or. (pos == corner)) then ! For u-, q-points only
1648  if (g%idg_offset == 0) isl = isl - 1 ! include western edge in checksums only for western PEs
1649  endif
1650  if ((pos == north_face) .or. (pos == corner)) then ! For v-, q-points only
1651  if (g%jdg_offset == 0) jsl = jsl - 1 ! include western edge in checksums only for southern PEs
1652  endif
1653  endif
1654 
1655 end subroutine get_checksum_loop_ranges
1656 
1657 end module mom_restart
Support functions and interfaces to permit transformed model domains to interact with FMS operations ...
Wraps the FMS time manager functions.
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26
A type for making arrays of pointers to scalars.
Definition: MOM_restart.F90:54
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Definition: MOM_grid.F90:2
Register fields for restarts.
A type for making arrays of pointers to 2-d arrays.
Definition: MOM_restart.F90:44
A structure with information about a single restart field.
Definition: MOM_restart.F90:59
This module contains I/O framework code.
Definition: MOM_io.F90:2
The MOM6 facility to parse input files for runtime parameters.
Register a pair of restart fieilds whose rotations map onto each other.
An overloaded interface to log the values of various types of parameters.
A type for making arrays of pointers to 4-d arrays.
Definition: MOM_restart.F90:34
A restart registry and the control structure for restarts.
Definition: MOM_restart.F90:75
Describes the decomposed MOM domain and has routines for communications across PEs.
Definition: MOM_domains.F90:2
Routines for error handling and I/O management.
A structure to store information about restart fields that are no longer used.
Definition: MOM_restart.F90:69
The MOM6 facility for reading and writing restart files, and querying what has been read.
Definition: MOM_restart.F90:2
Type for describing a variable, typically a tracer.
Definition: MOM_io.F90:53
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
Indicate whether a file exists, perhaps with domain decomposition.
Definition: MOM_io.F90:68
Rotate and compute the FMS (mpp) checksum of a field.
A type for making arrays of pointers to 1-d arrays.
Definition: MOM_restart.F90:49
Rotate and write a registered field to an FMS output file.
Indicate whether a field has been read from a restart file.
A type for making arrays of pointers to 3-d arrays.
Definition: MOM_restart.F90:39
Handy functions for manipulating strings.
Provides a transparent vertical ocean grid type and supporting routines.
Read a data field from a file.
Definition: MOM_io.F90:74
An overloaded interface to read and log the values of various types of parameters.