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
22 use mpp_io_mod,
only : mpp_attribute_exist, mpp_get_atts
23 use mpp_mod,
only : mpp_pe
25 implicit none ;
private 29 public restart_files_exist, determine_is_new_run, is_new_run
30 public register_restart_field_as_obsolete
35 real,
dimension(:,:,:,:),
pointer :: p => null()
40 real,
dimension(:,:,:),
pointer :: p => null()
45 real,
dimension(:,:),
pointer :: p => null()
50 real,
dimension(:),
pointer :: p => null()
55 real,
pointer :: p => null()
64 logical :: initialized
65 character(len=32) :: var_name
70 character(len=32) :: field_name
71 character(len=32) :: replacement_name
79 integer :: num_obsolete_vars = 0
80 logical :: parallel_restartfiles
82 logical :: large_file_support
86 logical :: new_run_set = .false.
87 logical :: checksum_required
91 character(len=240) :: restartfile
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()
107 integer :: max_fields
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
121 module procedure register_restart_pair_ptr2d
122 module procedure register_restart_pair_ptr3d
123 module procedure register_restart_pair_ptr4d
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
138 subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS)
139 character(*),
intent(in) :: field_name
140 character(*),
intent(in) :: replacement_name
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
149 subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS)
150 real,
dimension(:,:,:), &
151 target,
intent(in) :: f_ptr
152 type(
vardesc),
intent(in) :: var_desc
153 logical,
intent(in) :: mandatory
157 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
158 "register_restart_field: Module must be initialized before it is used.")
160 cs%novars = cs%novars+1
161 if (cs%novars > cs%max_fields)
return 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")
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()
177 end subroutine register_restart_field_ptr3d
180 subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS)
181 real,
dimension(:,:,:,:), &
182 target,
intent(in) :: f_ptr
183 type(
vardesc),
intent(in) :: var_desc
184 logical,
intent(in) :: mandatory
188 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
189 "register_restart_field: Module must be initialized before it is used.")
191 cs%novars = cs%novars+1
192 if (cs%novars > cs%max_fields)
return 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")
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()
208 end subroutine register_restart_field_ptr4d
211 subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS)
212 real,
dimension(:,:), &
213 target,
intent(in) :: f_ptr
214 type(
vardesc),
intent(in) :: var_desc
215 logical,
intent(in) :: mandatory
219 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
220 "register_restart_field: Module must be initialized before it is used.")
222 cs%novars = cs%novars+1
223 if (cs%novars > cs%max_fields)
return 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")
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()
239 end subroutine register_restart_field_ptr2d
242 subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS)
243 real,
dimension(:),
target,
intent(in) :: f_ptr
244 type(
vardesc),
intent(in) :: var_desc
245 logical,
intent(in) :: mandatory
249 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
250 "register_restart_field: Module must be initialized before it is used.")
252 cs%novars = cs%novars+1
253 if (cs%novars > cs%max_fields)
return 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")
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()
269 end subroutine register_restart_field_ptr1d
272 subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS)
273 real,
target,
intent(in) :: f_ptr
274 type(
vardesc),
intent(in) :: var_desc
275 logical,
intent(in) :: mandatory
279 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
280 "register_restart_field: Module must be initialized before it is used.")
282 cs%novars = cs%novars+1
283 if (cs%novars > cs%max_fields)
return 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")
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()
299 end subroutine register_restart_field_ptr0d
303 subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, &
305 real,
dimension(:,:),
target,
intent(in) :: a_ptr
306 real,
dimension(:,:),
target,
intent(in) :: b_ptr
307 type(
vardesc),
intent(in) :: a_desc
308 type(
vardesc),
intent(in) :: b_desc
309 logical,
intent(in) :: mandatory
312 if (modulo(cs%turns, 2) /= 0)
then 319 end subroutine register_restart_pair_ptr2d
323 subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, &
325 real,
dimension(:,:,:),
target,
intent(in) :: a_ptr
326 real,
dimension(:,:,:),
target,
intent(in) :: b_ptr
327 type(
vardesc),
intent(in) :: a_desc
328 type(
vardesc),
intent(in) :: b_desc
329 logical,
intent(in) :: mandatory
332 if (modulo(cs%turns, 2) /= 0)
then 339 end subroutine register_restart_pair_ptr3d
343 subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, &
345 real,
dimension(:,:,:,:),
target,
intent(in) :: a_ptr
346 real,
dimension(:,:,:,:),
target,
intent(in) :: b_ptr
347 type(
vardesc),
intent(in) :: a_desc
348 type(
vardesc),
intent(in) :: b_desc
349 logical,
intent(in) :: mandatory
352 if (modulo(cs%turns, 2) /= 0)
then 359 end subroutine register_restart_pair_ptr4d
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
369 character(len=*),
intent(in) :: name
370 logical,
intent(in) :: mandatory
373 character(len=*),
optional,
intent(in) :: longname
374 character(len=*),
optional,
intent(in) :: units
375 character(len=*),
optional,
intent(in) :: hor_grid
376 character(len=*),
optional,
intent(in) :: z_grid
377 character(len=*),
optional,
intent(in) :: t_grid
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)
387 call register_restart_field_ptr4d(f_ptr, vd, mandatory, cs)
389 end subroutine register_restart_field_4d
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
396 character(len=*),
intent(in) :: name
397 logical,
intent(in) :: mandatory
400 character(len=*),
optional,
intent(in) :: longname
401 character(len=*),
optional,
intent(in) :: units
402 character(len=*),
optional,
intent(in) :: hor_grid
403 character(len=*),
optional,
intent(in) :: z_grid
404 character(len=*),
optional,
intent(in) :: t_grid
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)
414 call register_restart_field_ptr3d(f_ptr, vd, mandatory, cs)
416 end subroutine register_restart_field_3d
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
423 character(len=*),
intent(in) :: name
424 logical,
intent(in) :: mandatory
427 character(len=*),
optional,
intent(in) :: longname
428 character(len=*),
optional,
intent(in) :: units
429 character(len=*),
optional,
intent(in) :: hor_grid
430 character(len=*),
optional,
intent(in) :: z_grid
431 character(len=*),
optional,
intent(in) :: t_grid
434 character(len=8) :: Zgrid
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)
443 call register_restart_field_ptr2d(f_ptr, vd, mandatory, cs)
445 end subroutine register_restart_field_2d
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
451 character(len=*),
intent(in) :: name
452 logical,
intent(in) :: mandatory
455 character(len=*),
optional,
intent(in) :: longname
456 character(len=*),
optional,
intent(in) :: units
457 character(len=*),
optional,
intent(in) :: hor_grid
458 character(len=*),
optional,
intent(in) :: z_grid
459 character(len=*),
optional,
intent(in) :: t_grid
462 character(len=8) :: hgrid
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)
471 call register_restart_field_ptr1d(f_ptr, vd, mandatory, cs)
473 end subroutine register_restart_field_1d
476 subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units, &
478 real,
target,
intent(in) :: f_ptr
479 character(len=*),
intent(in) :: name
480 logical,
intent(in) :: mandatory
483 character(len=*),
optional,
intent(in) :: longname
484 character(len=*),
optional,
intent(in) :: units
485 character(len=*),
optional,
intent(in) :: t_grid
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)
494 call register_restart_field_ptr0d(f_ptr, vd, mandatory, cs)
496 end subroutine register_restart_field_0d
501 function query_initialized_name(name, CS)
result(query_initialized)
502 character(len=*),
intent(in) :: name
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)
516 if (trim(name) == cs%restart_field(m)%var_name)
then 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.")
529 call mom_error(note,
"MOM_restart: "//name// &
530 " initialization confirmed by name.")
532 end function query_initialized_name
535 function query_initialized_0d(f_ptr, CS)
result(query_initialized)
536 real,
target,
intent(in) :: f_ptr
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)
550 if (
associated(cs%var_ptr0d(m)%p,f_ptr))
then 557 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
559 end function query_initialized_0d
562 function query_initialized_1d(f_ptr, CS)
result(query_initialized)
563 real,
dimension(:),
target,
intent(in) :: f_ptr
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)
577 if (
associated(cs%var_ptr1d(m)%p,f_ptr))
then 584 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
586 end function query_initialized_1d
589 function query_initialized_2d(f_ptr, CS)
result(query_initialized)
590 real,
dimension(:,:), &
591 target,
intent(in) :: f_ptr
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)
605 if (
associated(cs%var_ptr2d(m)%p,f_ptr))
then 612 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
614 end function query_initialized_2d
617 function query_initialized_3d(f_ptr, CS)
result(query_initialized)
618 real,
dimension(:,:,:), &
619 target,
intent(in) :: f_ptr
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)
633 if (
associated(cs%var_ptr3d(m)%p,f_ptr))
then 640 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
642 end function query_initialized_3d
645 function query_initialized_4d(f_ptr, CS)
result(query_initialized)
646 real,
dimension(:,:,:,:), &
647 target,
intent(in) :: f_ptr
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)
661 if (
associated(cs%var_ptr4d(m)%p,f_ptr))
then 668 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
670 end function query_initialized_4d
674 function query_initialized_0d_name(f_ptr, name, CS)
result(query_initialized)
675 real,
target,
intent(in) :: f_ptr
676 character(len=*),
intent(in) :: name
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)
690 if (
associated(cs%var_ptr0d(m)%p,f_ptr))
then 697 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
698 if (n==cs%novars+1)
then 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.")
705 end function query_initialized_0d_name
709 function query_initialized_1d_name(f_ptr, name, CS)
result(query_initialized)
710 real,
dimension(:), &
711 target,
intent(in) :: f_ptr
712 character(len=*),
intent(in) :: name
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)
726 if (
associated(cs%var_ptr1d(m)%p,f_ptr))
then 733 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
734 if (n==cs%novars+1)
then 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.")
741 end function query_initialized_1d_name
745 function query_initialized_2d_name(f_ptr, name, CS)
result(query_initialized)
746 real,
dimension(:,:), &
747 target,
intent(in) :: f_ptr
748 character(len=*),
intent(in) :: name
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)
762 if (
associated(cs%var_ptr2d(m)%p,f_ptr))
then 769 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
770 if (n==cs%novars+1)
then 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.")
777 end function query_initialized_2d_name
781 function query_initialized_3d_name(f_ptr, name, CS)
result(query_initialized)
782 real,
dimension(:,:,:), &
783 target,
intent(in) :: f_ptr
784 character(len=*),
intent(in) :: name
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)
798 if (
associated(cs%var_ptr3d(m)%p,f_ptr))
then 805 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
806 if (n==cs%novars+1)
then 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.")
813 end function query_initialized_3d_name
817 function query_initialized_4d_name(f_ptr, name, CS)
result(query_initialized)
818 real,
dimension(:,:,:,:), &
819 target,
intent(in) :: f_ptr
820 character(len=*),
intent(in) :: name
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)
834 if (
associated(cs%var_ptr4d(m)%p,f_ptr))
then 841 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
842 if (n==cs%novars+1)
then 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.")
849 end function query_initialized_4d_name
852 subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_rest_files)
853 character(len=*),
intent(in) :: directory
855 type(time_type),
intent(in) :: time
859 logical,
optional,
intent(in) :: time_stamped
861 character(len=*),
optional,
intent(in) :: filename
863 integer,
optional,
intent(out) :: num_rest_files
866 type(
vardesc) :: vars(cs%max_fields)
868 type(fieldtype) :: fields(cs%max_fields)
869 character(len=512) :: restartpath
870 character(len=256) :: restartname
871 character(len=8) :: suffix
873 integer(kind=8) :: var_sz, size_in_file
875 integer(kind=8) :: max_file_size = 2147483647_8
878 integer :: start_var, next_var
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
884 character(len=8) :: t_grid_read
885 character(len=64) :: var_name
887 character(len=32) :: filename_appendix =
'' 889 integer(kind=8) :: check_val(cs%max_fields,1)
890 integer :: isl, iel, jsl, jel, pos
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)
902 if (cs%large_file_support) max_file_size = 4294967292_8
906 nz = 1 ;
if (
present(gv)) nz = gv%ke
908 restart_time = time_type_to_real(time) / 86400.0
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)
916 days = days + days_in_month(set_date(year,m,2,0,0,0))
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
924 write(restartname,
'("_Y",I10.10,"_D",I3.3,"_S",I5.5)') year, days, seconds
926 restartname = trim(cs%restartfile)//trim(restartname)
930 do while (next_var <= cs%novars )
932 size_in_file = 8*(2*g%Domain%niglobal+2*g%Domain%njglobal+2*nz+1000)
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 940 var_sz = 8*(g%Domain%niglobal+1)*(g%Domain%njglobal+1)
943 case (
'L') ; var_sz = var_sz * nz
944 case (
'i') ; var_sz = var_sz * (nz+1)
946 t_grid = adjustl(t_grid)
947 if (t_grid(1:1) ==
'p')
then 948 if (len_trim(t_grid(2:8)) > 0)
then 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
956 if ((m==start_var) .OR. (size_in_file < max_file_size-var_sz))
then 957 size_in_file = size_in_file + var_sz
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' 971 restartname = restartname(1:length) //
'.'//trim(filename_appendix)
975 restartpath = trim(directory)// trim(restartname)
977 if (num_files < 10)
then 978 write(suffix,
'("_",I1)') num_files
980 write(suffix,
'("_",I2)') num_files
983 if (num_files > 0) restartpath = trim(restartpath) // trim(suffix)
985 do m=start_var,next_var-1
986 vars(m-start_var+1) = cs%restart_field(m)%vars
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
1006 if (modulo(turns, 2) /= 0)
then 1007 call get_checksum_loop_ranges(g, pos, jsl, jel, isl, iel)
1009 call get_checksum_loop_ranges(g, pos, isl, iel, jsl, jel)
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()/))
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)
1032 call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
1033 fields, single_file, g=g, gv=gv, checksums=check_val)
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, &
1049 elseif (
associated(cs%var_ptr0d(m)%p))
then 1050 call write_field(unit, fields(m-start_var+1), cs%var_ptr0d(m)%p, &
1055 call close_file(unit)
1057 num_files = num_files+1
1061 if (
present(num_rest_files)) num_rest_files = num_files
1063 end subroutine save_restart
1068 subroutine restore_state(filename, directory, day, G, CS)
1069 character(len=*),
intent(in) :: filename
1071 character(len=*),
intent(in) :: directory
1072 type(time_type),
intent(out) :: day
1082 character(len=200) :: filepath
1083 character(len=80) :: fname
1084 character(len=8) :: suffix
1086 character(len=512) :: mesg
1087 character(len=80) :: varname
1090 integer :: i, n, m, missing_fields
1091 integer :: isl, iel, jsl, jel, is0, js0
1093 integer :: ndim, nvar, natt, ntime, pos
1095 integer :: unit(cs%max_fields)
1096 character(len=200) :: unit_path(cs%max_fields)
1097 logical :: unit_is_global(cs%max_fields)
1099 character(len=8) :: hor_grid
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
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)
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)
1116 num_file = open_restart_units(filename, directory, g, cs, units=unit, &
1117 file_paths=unit_path, global_files=unit_is_global)
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)
1128 call get_file_info(unit(n), ndim, nvar, natt, ntime)
1129 if (ntime < 1) cycle
1131 allocate(time_vals(ntime))
1132 call get_file_times(unit(n), time_vals)
1134 deallocate(time_vals)
1136 day = real_to_time(t1*86400.0)
1140 if (n>num_file)
call mom_error(warning,
"MOM_restart: " // &
1141 "No times found in restart files.")
1145 if (is_root_pe())
then 1147 call get_file_info(unit(n), ndim, nvar, natt, ntime)
1148 if (ntime < 1) cycle
1150 allocate(time_vals(ntime))
1151 call get_file_times(unit(n), time_vals)
1153 deallocate(time_vals)
1156 write(mesg,
'("WARNING: Restart file ",I2," has time ",F10.4,"whereas & 1157 &simulation is restarted at ",F10.4," (differing by ",F10.4,").")')&
1159 call mom_error(warning,
"MOM_restart: "//mesg)
1166 call get_file_info(unit(n), ndim, nvar, natt, ntime)
1168 allocate(fields(nvar))
1169 call get_file_fields(unit(n),fields(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))
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
1201 call get_checksum_loop_ranges(g, pos, isl, iel, jsl, jel)
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
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.
1213 if (.NOT. cs%checksum_required) is_there_a_checksum = .false.
1215 if (
associated(cs%var_ptr1d(m)%p))
then 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 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 1226 call mom_read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1227 g%Domain, timelevel=1, position=pos)
1229 call read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1230 no_domain=.true., timelevel=1)
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 1235 call mom_read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1236 g%Domain, timelevel=1, position=pos)
1238 call read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1239 no_domain=.true., timelevel=1)
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 1244 call mom_read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1245 g%Domain, timelevel=1, position=pos)
1247 call read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1248 no_domain=.true., timelevel=1)
1250 if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:))
1252 call mom_error(fatal,
"MOM_restart restore_state: No pointers set for "//trim(varname))
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) )
1262 cs%restart_field(m)%initialized = .true.
1266 if (i>nvar) missing_fields = missing_fields+1
1270 if (missing_fields == 0)
exit 1274 call close_file(unit(n))
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.")
1289 end subroutine restore_state
1292 function restart_files_exist(filename, directory, G, CS)
1293 character(len=*),
intent(in) :: filename
1295 character(len=*),
intent(in) :: directory
1299 logical :: restart_files_exist
1302 integer :: num_files
1304 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1305 "restart_files_exist: Module must be initialized before it is used.")
1307 if ((len_trim(filename) == 1) .and. (filename(1:1) ==
'F'))
then 1308 num_files = open_restart_units(
'r', directory, g, cs)
1310 num_files = open_restart_units(filename, directory, g, cs)
1312 restart_files_exist = (num_files > 0)
1314 end function restart_files_exist
1319 function determine_is_new_run(filename, directory, G, CS)
result(is_new_run)
1320 character(len=*),
intent(in) :: filename
1322 character(len=*),
intent(in) :: directory
1326 logical :: is_new_run
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 1336 elseif (filename(1:1) ==
'n')
then 1338 elseif (filename(1:1) ==
'F')
then 1339 cs%new_run = (open_restart_units(
'r', directory, g, cs) == 0)
1341 cs%new_run = .false.
1344 cs%new_run_set = .true.
1345 is_new_run = cs%new_run
1346 end function determine_is_new_run
1350 function is_new_run(CS)
1353 logical :: is_new_run
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.")
1362 is_new_run = cs%new_run
1363 end function is_new_run
1367 function open_restart_units(filename, directory, G, CS, units, file_paths, &
1368 global_files)
result(num_files)
1369 character(len=*),
intent(in) :: filename
1371 character(len=*),
intent(in) :: directory
1375 integer,
dimension(:), &
1376 optional,
intent(out) :: units
1377 character(len=*),
dimension(:), &
1378 optional,
intent(out) :: file_paths
1379 logical,
dimension(:), &
1380 optional,
intent(out) :: global_files
1382 integer :: num_files
1390 character(len=256) :: filepath
1391 character(len=256) :: fname
1392 character(len=8) :: suffix
1395 integer :: num_restart
1397 integer :: start_char
1399 integer :: n, m, err, length
1403 character(len=32) :: filename_appendix =
'' 1404 character(len=80) :: restartname
1406 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1407 "open_restart_units: Module must be initialized before it is used.")
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 1415 fname = filename(start_char:m-1)
1417 do while (start_char <= len_trim(filename))
1418 if (filename(start_char:start_char) ==
' ')
then 1419 start_char = start_char + 1
1425 if ((fname(1:1)==
'r') .and. ( len_trim(fname) == 1))
then 1427 if (num_restart > 0) err = 1
1429 restartname = trim(cs%restartfile)
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' 1438 restartname = restartname(1:length) //
'.'//trim(filename_appendix)
1441 filepath = trim(directory) // trim(restartname)
1443 if (num_restart < 10)
then 1444 write(suffix,
'("_",I1)') num_restart
1446 write(suffix,
'("_",I2)') num_restart
1448 if (num_restart > 0) filepath = trim(filepath) // suffix
1451 filepath = trim(filepath)//
".nc" 1453 num_restart = num_restart + 1
1454 inquire(file=filepath, exist=fexists)
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 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.
1470 if (
present(file_paths)) file_paths(n) = filepath
1472 if (is_root_pe() .and. (
present(units))) &
1473 call mom_error(note,
"MOM_restart: MOM run restarted using : "//trim(filepath))
1479 filepath = trim(directory)//trim(fname)
1480 inquire(file=filepath, exist=fexists)
1481 if (.not. fexists) filepath = trim(filepath)//
".nc" 1483 inquire(file=filepath, exist=fexists)
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
1491 if (is_root_pe() .and. (
present(units))) &
1492 call mom_error(note,
"MOM_restart: MOM run restarted using : "//trim(filepath))
1494 if (
present(units)) &
1495 call mom_error(warning,
"MOM_restart: Unable to find restart file : "//trim(filepath))
1502 end function open_restart_units
1505 subroutine restart_init(param_file, CS, restart_root)
1508 character(len=*),
optional, &
1509 intent(in) :: restart_root
1513 logical :: rotate_index
1516 #include "version_variable.h" 1517 character(len=40) :: mdl =
"MOM_restart" 1518 logical :: all_default
1520 if (
associated(cs))
then 1521 call mom_error(warning,
"restart_init called with an associated control structure.")
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")))
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", &
1549 if (
present(restart_root))
then 1550 cs%restartfile = restart_root
1551 call log_param(param_file, mdl,
"RESTARTFILE from argument", cs%restartfile)
1553 call get_param(param_file, mdl,
"RESTARTFILE", cs%restartfile, &
1554 "The name-root of the restart file.", default=
"MOM.res")
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.", &
1560 call get_param(param_file, mdl,
"MAX_FIELDS", cs%max_fields, &
1561 "The maximum number of restart fields that can be used.", &
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.",&
1571 call get_param(param_file, mdl,
"ROTATE_INDEX", rotate_index, &
1572 default=.false., do_not_log=.true.)
1575 if (rotate_index)
then 1576 call get_param(param_file, mdl,
"INDEX_TURNS", cs%turns, &
1577 default=1, do_not_log=.true.)
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))
1588 end subroutine restart_init
1591 subroutine restart_init_end(CS)
1594 if (
associated(cs))
then 1595 if (cs%novars == 0)
call restart_end(cs)
1598 end subroutine restart_init_end
1601 subroutine restart_end(CS)
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)
1613 end subroutine restart_end
1615 subroutine restart_error(CS)
1618 character(len=16) :: num
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.")
1626 call mom_error(fatal,
"MOM_restart: Unspecified fatal error.")
1628 end subroutine restart_error
1631 subroutine get_checksum_loop_ranges(G, pos, isL, ieL, jsL, jeL)
1633 integer,
intent(in) :: pos
1634 integer,
intent(out) :: isL
1635 integer,
intent(out) :: ieL
1636 integer,
intent(out) :: jsL
1637 integer,
intent(out) :: jeL
1646 if (g%symmetric)
then 1647 if ((pos == east_face) .or. (pos == corner))
then 1648 if (g%idg_offset == 0) isl = isl - 1
1650 if ((pos == north_face) .or. (pos == corner))
then 1651 if (g%jdg_offset == 0) jsl = jsl - 1
1655 end subroutine get_checksum_loop_ranges
Wraps the FMS time manager functions.
Ocean grid type. See mom_grid for details.
A type for making arrays of pointers to scalars.
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Register fields for restarts.
A type for making arrays of pointers to 2-d arrays.
A structure with information about a single restart field.
This module contains I/O framework code.
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.
A restart registry and the control structure for restarts.
Describes the decomposed MOM domain and has routines for communications across PEs.
Routines for error handling and I/O management.
A structure to store information about restart fields that are no longer used.
The MOM6 facility for reading and writing restart files, and querying what has been read.
Type for describing a variable, typically a tracer.
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.
A type for making arrays of pointers to 1-d arrays.
Indicate whether a field has been read from a restart file.
A type for making arrays of pointers to 3-d arrays.
Handy functions for manipulating strings.
Provides a transparent vertical ocean grid type and supporting routines.
Read a data field from a file.
An overloaded interface to read and log the values of various types of parameters.