MOM6
Data Types | Functions/Subroutines
mom_restart Module Reference

Data Types

type  field_restart
 
type  mom_restart_cs
 
type  p0d
 
type  p1d
 
type  p2d
 
type  p3d
 
type  p4d
 
interface  query_initialized
 
interface  register_restart_field
 

Functions/Subroutines

subroutine register_restart_field_ptr3d (f_ptr, var_desc, mandatory, CS)
 
subroutine register_restart_field_ptr4d (f_ptr, var_desc, mandatory, CS)
 
subroutine register_restart_field_ptr2d (f_ptr, var_desc, mandatory, CS)
 
subroutine register_restart_field_ptr1d (f_ptr, var_desc, mandatory, CS)
 
subroutine register_restart_field_ptr0d (f_ptr, var_desc, mandatory, CS)
 
logical function query_initialized_name (name, CS)
 
logical function query_initialized_0d (f_ptr, CS)
 
logical function query_initialized_1d (f_ptr, CS)
 
logical function query_initialized_2d (f_ptr, CS)
 
logical function query_initialized_3d (f_ptr, CS)
 
logical function query_initialized_4d (f_ptr, CS)
 
logical function query_initialized_0d_name (f_ptr, name, CS)
 
logical function query_initialized_1d_name (f_ptr, name, CS)
 
logical function query_initialized_2d_name (f_ptr, name, CS)
 
logical function query_initialized_3d_name (f_ptr, name, CS)
 
logical function query_initialized_4d_name (f_ptr, name, CS)
 
subroutine, public save_restart (directory, time, G, CS, time_stamped, filename, GV)
 
subroutine, public restore_state (filename, directory, day, G, CS)
 
subroutine, public restart_init (param_file, CS, restart_root)
 
subroutine, public restart_init_end (CS)
 
subroutine, public restart_end (CS)
 
subroutine restart_error (CS)
 

Function/Subroutine Documentation

◆ query_initialized_0d()

logical function mom_restart::query_initialized_0d ( real, target  f_ptr,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 381 of file MOM_restart.F90.

References mom_error_handler::mom_error(), and restart_error().

381  real, target :: f_ptr
382  type(mom_restart_cs), pointer :: cs
383  logical :: query_initialized
384 ! This subroutine tests whether the field pointed to by f_ptr has
385 ! been initialized from a restart file.
386 !
387 ! Arguments: f_ptr - A pointer to the field that is being queried.
388 ! (in) CS - The control structure returned by a previous call to
389 ! restart_init.
390  integer :: m,n
391  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
392  "query_initialized: Module must be initialized before it is used.")
393  if (cs%novars > cs%max_fields) call restart_error(cs)
394 
395  query_initialized = .false.
396  n = cs%novars+1
397  do m=1,cs%novars
398  if (ASSOCIATED(cs%var_ptr0d(m)%p,f_ptr)) then
399  if (cs%restart_field(m)%initialized) query_initialized = .true.
400  n = m ; exit
401  endif
402  enddo
403 ! Assume that you are going to initialize it now, so set flag to initialized if
404 ! queried again.
405  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
406 
Here is the call graph for this function:

◆ query_initialized_0d_name()

logical function mom_restart::query_initialized_0d_name ( real, target  f_ptr,
character(len=*)  name,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 526 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), query_initialized_name(), and restart_error().

526  real, target :: f_ptr
527  character(len=*) :: name
528  type(mom_restart_cs), pointer :: cs
529  logical :: query_initialized
530 ! This subroutine tests whether the field pointed to by f_ptr or with the
531 ! specified variable name has been initialized from a restart file.
532 !
533 ! Arguments: f_ptr - A pointer to the field that is being queried.
534 ! (in) name - The name of the field that is being queried.
535 ! (in) CS - The control structure returned by a previous call to
536 ! restart_init.
537  integer :: m,n
538  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
539  "query_initialized: Module must be initialized before it is used.")
540  if (cs%novars > cs%max_fields) call restart_error(cs)
541 
542  query_initialized = .false.
543  n = cs%novars+1
544  do m=1,cs%novars
545  if (ASSOCIATED(cs%var_ptr0d(m)%p,f_ptr)) then
546  if (cs%restart_field(m)%initialized) query_initialized = .true.
547  n = m ; exit
548  endif
549  enddo
550 ! Assume that you are going to initialize it now, so set flag to initialized if
551 ! queried again.
552  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
553  if (n==cs%novars+1) then
554  if (is_root_pe()) &
555  call mom_error(note,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
556  "probably because of the suspect comparison of pointers by ASSOCIATED.")
557  query_initialized = query_initialized_name(name, cs)
558  endif
559 
Here is the call graph for this function:

◆ query_initialized_1d()

logical function mom_restart::query_initialized_1d ( real, dimension(:), target  f_ptr,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 410 of file MOM_restart.F90.

References mom_error_handler::mom_error(), and restart_error().

410  real, dimension(:), target :: f_ptr
411  type(mom_restart_cs), pointer :: cs
412  logical :: query_initialized
413 ! This subroutine tests whether the field pointed to by f_ptr has
414 ! been initialized from a restart file.
415 !
416 ! Arguments: f_ptr - A pointer to the field that is being queried.
417 ! (in) CS - The control structure returned by a previous call to
418 ! restart_init.
419  integer :: m,n
420  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
421  "query_initialized: Module must be initialized before it is used.")
422  if (cs%novars > cs%max_fields) call restart_error(cs)
423 
424  query_initialized = .false.
425  n = cs%novars+1
426  do m=1,cs%novars
427  if (ASSOCIATED(cs%var_ptr1d(m)%p,f_ptr)) then
428  if (cs%restart_field(m)%initialized) query_initialized = .true.
429  n = m ; exit
430  endif
431  enddo
432 ! Assume that you are going to initialize it now, so set flag to initialized if
433 ! queried again.
434  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
435 
Here is the call graph for this function:

◆ query_initialized_1d_name()

logical function mom_restart::query_initialized_1d_name ( real, dimension(:), target  f_ptr,
character(len=*)  name,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 563 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), query_initialized_name(), and restart_error().

563  real, dimension(:), target :: f_ptr
564  character(len=*) :: name
565  type(mom_restart_cs), pointer :: cs
566  logical :: query_initialized
567 ! This subroutine tests whether the field pointed to by f_ptr or with the
568 ! specified variable name has been initialized from a restart file.
569 !
570 ! Arguments: f_ptr - A pointer to the field that is being queried.
571 ! (in) name - The name of the field that is being queried.
572 ! (in) CS - The control structure returned by a previous call to
573 ! restart_init.
574  integer :: m,n
575  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
576  "query_initialized: Module must be initialized before it is used.")
577  if (cs%novars > cs%max_fields) call restart_error(cs)
578 
579  query_initialized = .false.
580  n = cs%novars+1
581  do m=1,cs%novars
582  if (ASSOCIATED(cs%var_ptr1d(m)%p,f_ptr)) then
583  if (cs%restart_field(m)%initialized) query_initialized = .true.
584  n = m ; exit
585  endif
586  enddo
587 ! Assume that you are going to initialize it now, so set flag to initialized if
588 ! queried again.
589  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
590  if (n==cs%novars+1) then
591  if (is_root_pe()) &
592  call mom_error(note,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
593  "probably because of the suspect comparison of pointers by ASSOCIATED.")
594  query_initialized = query_initialized_name(name, cs)
595  endif
596 
Here is the call graph for this function:

◆ query_initialized_2d()

logical function mom_restart::query_initialized_2d ( real, dimension(:,:), target  f_ptr,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 439 of file MOM_restart.F90.

References mom_error_handler::mom_error(), and restart_error().

439  real, dimension(:,:), target :: f_ptr
440  type(mom_restart_cs), pointer :: cs
441  logical :: query_initialized
442 ! This subroutine tests whether the field pointed to by f_ptr has
443 ! been initialized from a restart file.
444 !
445 ! Arguments: f_ptr - A pointer to the field that is being queried.
446 ! (in) CS - The control structure returned by a previous call to
447 ! restart_init.
448  integer :: m,n
449  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
450  "query_initialized: Module must be initialized before it is used.")
451  if (cs%novars > cs%max_fields) call restart_error(cs)
452 
453  query_initialized = .false.
454  n = cs%novars+1
455  do m=1,cs%novars
456  if (ASSOCIATED(cs%var_ptr2d(m)%p,f_ptr)) then
457  if (cs%restart_field(m)%initialized) query_initialized = .true.
458  n = m ; exit
459  endif
460  enddo
461 ! Assume that you are going to initialize it now, so set flag to initialized if
462 ! queried again.
463  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
464 
Here is the call graph for this function:

◆ query_initialized_2d_name()

logical function mom_restart::query_initialized_2d_name ( real, dimension(:,:), target  f_ptr,
character(len=*)  name,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 600 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), query_initialized_name(), and restart_error().

600  real, dimension(:,:), target :: f_ptr
601  character(len=*) :: name
602  type(mom_restart_cs), pointer :: cs
603  logical :: query_initialized
604 ! This subroutine tests whether the field pointed to by f_ptr or with the
605 ! specified variable name has been initialized from a restart file.
606 !
607 ! Arguments: f_ptr - A pointer to the field that is being queried.
608 ! (in) name - The name of the field that is being queried.
609 ! (in) CS - The control structure returned by a previous call to
610 ! restart_init.
611  integer :: m,n
612  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
613  "query_initialized: Module must be initialized before it is used.")
614  if (cs%novars > cs%max_fields) call restart_error(cs)
615 
616  query_initialized = .false.
617  n = cs%novars+1
618  do m=1,cs%novars
619  if (ASSOCIATED(cs%var_ptr2d(m)%p,f_ptr)) then
620  if (cs%restart_field(m)%initialized) query_initialized = .true.
621  n = m ; exit
622  endif
623  enddo
624 ! Assume that you are going to initialize it now, so set flag to initialized if
625 ! queried again.
626  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
627  if (n==cs%novars+1) then
628  if (is_root_pe()) &
629  call mom_error(note,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
630  "probably because of the suspect comparison of pointers by ASSOCIATED.")
631  query_initialized = query_initialized_name(name, cs)
632  endif
633 
Here is the call graph for this function:

◆ query_initialized_3d()

logical function mom_restart::query_initialized_3d ( real, dimension(:,:,:), target  f_ptr,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 468 of file MOM_restart.F90.

References mom_error_handler::mom_error(), and restart_error().

468  real, dimension(:,:,:), target :: f_ptr
469  type(mom_restart_cs), pointer :: cs
470  logical :: query_initialized
471 ! This subroutine tests whether the field pointed to by f_ptr has
472 ! been initialized from a restart file.
473 !
474 ! Arguments: f_ptr - A pointer to the field that is being queried.
475 ! (in) CS - The control structure returned by a previous call to
476 ! restart_init.
477  integer :: m,n
478  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
479  "query_initialized: Module must be initialized before it is used.")
480  if (cs%novars > cs%max_fields) call restart_error(cs)
481 
482  query_initialized = .false.
483  n = cs%novars+1
484  do m=1,cs%novars
485  if (ASSOCIATED(cs%var_ptr3d(m)%p,f_ptr)) then
486  if (cs%restart_field(m)%initialized) query_initialized = .true.
487  n = m ; exit
488  endif
489  enddo
490 ! Assume that you are going to initialize it now, so set flag to initialized if
491 ! queried again.
492  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
493 
Here is the call graph for this function:

◆ query_initialized_3d_name()

logical function mom_restart::query_initialized_3d_name ( real, dimension(:,:,:), target  f_ptr,
character(len=*)  name,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 637 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), query_initialized_name(), and restart_error().

637  real, dimension(:,:,:), target :: f_ptr
638  character(len=*) :: name
639  type(mom_restart_cs), pointer :: cs
640  logical :: query_initialized
641 ! This subroutine tests whether the field pointed to by f_ptr or with the
642 ! specified variable name has been initialized from a restart file.
643 !
644 ! Arguments: f_ptr - A pointer to the field that is being queried.
645 ! (in) name - The name of the field that is being queried.
646 ! (in) CS - The control structure returned by a previous call to
647 ! restart_init.
648  integer :: m, n
649  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
650  "query_initialized: Module must be initialized before it is used.")
651  if (cs%novars > cs%max_fields) call restart_error(cs)
652 
653  query_initialized = .false.
654  n = cs%novars+1
655  do m=1,cs%novars
656  if (ASSOCIATED(cs%var_ptr3d(m)%p,f_ptr)) then
657  if (cs%restart_field(m)%initialized) query_initialized = .true.
658  n = m ; exit
659  endif
660  enddo
661 ! Assume that you are going to initialize it now, so set flag to initialized if
662 ! queried again.
663  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
664  if (n==cs%novars+1) then
665  if (is_root_pe()) &
666  call mom_error(note, "MOM_restart: Unable to find "//name//" queried by pointer, "//&
667  "possibly because of the suspect comparison of pointers by ASSOCIATED.")
668  query_initialized = query_initialized_name(name, cs)
669  endif
670 
Here is the call graph for this function:

◆ query_initialized_4d()

logical function mom_restart::query_initialized_4d ( real, dimension(:,:,:,:), target  f_ptr,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 497 of file MOM_restart.F90.

References mom_error_handler::mom_error(), and restart_error().

497  real, dimension(:,:,:,:), target :: f_ptr
498  type(mom_restart_cs), pointer :: cs
499  logical :: query_initialized
500 ! This subroutine tests whether the field pointed to by f_ptr has
501 ! been initialized from a restart file.
502 !
503 ! Arguments: f_ptr - A pointer to the field that is being queried.
504 ! (in) CS - The control structure returned by a previous call to
505 ! restart_init.
506  integer :: m,n
507  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
508  "query_initialized: Module must be initialized before it is used.")
509  if (cs%novars > cs%max_fields) call restart_error(cs)
510 
511  query_initialized = .false.
512  n = cs%novars+1
513  do m=1,cs%novars
514  if (ASSOCIATED(cs%var_ptr4d(m)%p,f_ptr)) then
515  if (cs%restart_field(m)%initialized) query_initialized = .true.
516  n = m ; exit
517  endif
518  enddo
519 ! Assume that you are going to initialize it now, so set flag to initialized if
520 ! queried again.
521  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
522 
Here is the call graph for this function:

◆ query_initialized_4d_name()

logical function mom_restart::query_initialized_4d_name ( real, dimension(:,:,:,:), target  f_ptr,
character(len=*)  name,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 674 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), query_initialized_name(), and restart_error().

674  real, dimension(:,:,:,:), target :: f_ptr
675  character(len=*) :: name
676  type(mom_restart_cs), pointer :: cs
677  logical :: query_initialized
678 ! This subroutine tests whether the field pointed to by f_ptr or with the
679 ! specified variable name has been initialized from a restart file.
680 !
681 ! Arguments: f_ptr - A pointer to the field that is being queried.
682 ! (in) name - The name of the field that is being queried.
683 ! (in) CS - The control structure returned by a previous call to
684 ! restart_init.
685  integer :: m, n
686  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
687  "query_initialized: Module must be initialized before it is used.")
688  if (cs%novars > cs%max_fields) call restart_error(cs)
689 
690  query_initialized = .false.
691  n = cs%novars+1
692  do m=1,cs%novars
693  if (ASSOCIATED(cs%var_ptr4d(m)%p,f_ptr)) then
694  if (cs%restart_field(m)%initialized) query_initialized = .true.
695  n = m ; exit
696  endif
697  enddo
698 ! Assume that you are going to initialize it now, so set flag to initialized if
699 ! queried again.
700  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
701  if (n==cs%novars+1) then
702  if (is_root_pe()) &
703  call mom_error(note, "MOM_restart: Unable to find "//name//" queried by pointer, "//&
704  "possibly because of the suspect comparison of pointers by ASSOCIATED.")
705  query_initialized = query_initialized_name(name, cs)
706  endif
707 
Here is the call graph for this function:

◆ query_initialized_name()

logical function mom_restart::query_initialized_name ( character(len=*)  name,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 345 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), and restart_error().

Referenced by query_initialized_0d_name(), query_initialized_1d_name(), query_initialized_2d_name(), query_initialized_3d_name(), and query_initialized_4d_name().

345  character(len=*) :: name
346  type(mom_restart_cs), pointer :: cs
347  logical :: query_initialized
348 ! This subroutine returns .true. if the field referred to by name has
349 ! initialized from a restart file, and .false. otherwise.
350 !
351 ! Arguments: name - A pointer to the field that is being queried.
352 ! (in) CS - The control structure returned by a previous call to
353 ! restart_init.
354  integer :: m,n
355  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
356  "query_initialized: Module must be initialized before it is used.")
357  if (cs%novars > cs%max_fields) call restart_error(cs)
358 
359  query_initialized = .false.
360  n = cs%novars+1
361  do m=1,cs%novars
362  if (trim(name) == cs%restart_field(m)%var_name) then
363  if (cs%restart_field(m)%initialized) query_initialized = .true.
364  n = m ; exit
365  endif
366  enddo
367 ! Assume that you are going to initialize it now, so set flag to initialized if
368 ! queried again.
369  if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
370  if ((n==cs%novars+1) .and. (is_root_pe())) &
371  call mom_error(note,"MOM_restart: Unknown restart variable "//name// &
372  " queried for initialization.")
373 
374  if ((is_root_pe()) .and. query_initialized) &
375  call mom_error(note,"MOM_restart: "//name// &
376  " initialization confirmed by name.")
377 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ register_restart_field_ptr0d()

subroutine mom_restart::register_restart_field_ptr0d ( real, target  f_ptr,
type(vardesc), intent(in)  var_desc,
logical, intent(in)  mandatory,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 307 of file MOM_restart.F90.

References mom_error_handler::mom_error().

307  real, target :: f_ptr
308  type(vardesc), intent(in) :: var_desc
309  logical, intent(in) :: mandatory
310  type(mom_restart_cs), pointer :: cs
311 ! Set up a field that will be written to and read from restart
312 ! files.
313 !
314 ! Arguments: f_ptr - A pointer to the field to be read or written.
315 ! (in) var_desc - The descriptive structure for the field.
316 ! (in) mandatory - If .true. the run will abort if this field is not
317 ! successfully read from the restart file. If .false.,
318 ! alternate techniques are provided to initialize this
319 ! field if it is cannot be read from the file.
320 ! (in/out) CS - The control structure returned by a previous call to
321 ! restart_init.
322  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
323  "register_restart_field: Module must be initialized before it is used.")
324 
325  cs%novars = cs%novars+1
326  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
327  ! once the total number of fields is known.
328 
329  cs%restart_field(cs%novars)%vars = var_desc
330  cs%restart_field(cs%novars)%mand_var = mandatory
331  cs%restart_field(cs%novars)%initialized = .false.
332  call query_vardesc(cs%restart_field(cs%novars)%vars, &
333  name=cs%restart_field(cs%novars)%var_name, &
334  caller="register_restart_field_ptr0d")
335 
336  cs%var_ptr0d(cs%novars)%p => f_ptr
337  cs%var_ptr4d(cs%novars)%p => null()
338  cs%var_ptr3d(cs%novars)%p => null()
339  cs%var_ptr2d(cs%novars)%p => null()
340  cs%var_ptr1d(cs%novars)%p => null()
341 
Here is the call graph for this function:

◆ register_restart_field_ptr1d()

subroutine mom_restart::register_restart_field_ptr1d ( real, dimension(:), target  f_ptr,
type(vardesc), intent(in)  var_desc,
logical, intent(in)  mandatory,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 269 of file MOM_restart.F90.

References mom_error_handler::mom_error().

269  real, dimension(:), target :: f_ptr
270  type(vardesc), intent(in) :: var_desc
271  logical, intent(in) :: mandatory
272  type(mom_restart_cs), pointer :: cs
273 ! Set up a field that will be written to and read from restart
274 ! files.
275 !
276 ! Arguments: f_ptr - A pointer to the field to be read or written.
277 ! (in) var_desc - The descriptive structure for the field.
278 ! (in) mandatory - If .true. the run will abort if this field is not
279 ! successfully read from the restart file. If .false.,
280 ! alternate techniques are provided to initialize this
281 ! field if it is cannot be read from the file.
282 ! (in/out) CS - The control structure returned by a previous call to
283 ! restart_init.
284  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
285  "register_restart_field: Module must be initialized before it is used.")
286 
287  cs%novars = cs%novars+1
288  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
289  ! once the total number of fields is known.
290 
291  cs%restart_field(cs%novars)%vars = var_desc
292  cs%restart_field(cs%novars)%mand_var = mandatory
293  cs%restart_field(cs%novars)%initialized = .false.
294  call query_vardesc(cs%restart_field(cs%novars)%vars, &
295  name=cs%restart_field(cs%novars)%var_name, &
296  caller="register_restart_field_ptr1d")
297 
298  cs%var_ptr1d(cs%novars)%p => f_ptr
299  cs%var_ptr4d(cs%novars)%p => null()
300  cs%var_ptr3d(cs%novars)%p => null()
301  cs%var_ptr2d(cs%novars)%p => null()
302  cs%var_ptr0d(cs%novars)%p => null()
303 
Here is the call graph for this function:

◆ register_restart_field_ptr2d()

subroutine mom_restart::register_restart_field_ptr2d ( real, dimension(:,:), target  f_ptr,
type(vardesc), intent(in)  var_desc,
logical, intent(in)  mandatory,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 231 of file MOM_restart.F90.

References mom_error_handler::mom_error().

231  real, dimension(:,:), target :: f_ptr
232  type(vardesc), intent(in) :: var_desc
233  logical, intent(in) :: mandatory
234  type(mom_restart_cs), pointer :: cs
235 ! Set up a field that will be written to and read from restart
236 ! files.
237 !
238 ! Arguments: f_ptr - A pointer to the field to be read or written.
239 ! (in) var_desc - The descriptive structure for the field.
240 ! (in) mandatory - If .true. the run will abort if this field is not
241 ! successfully read from the restart file. If .false.,
242 ! alternate techniques are provided to initialize this
243 ! field if it is cannot be read from the file.
244 ! (in/out) CS - The control structure returned by a previous call to
245 ! restart_init.
246  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
247  "register_restart_field: Module must be initialized before it is used.")
248 
249  cs%novars = cs%novars+1
250  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
251  ! once the total number of fields is known.
252 
253  cs%restart_field(cs%novars)%vars = var_desc
254  cs%restart_field(cs%novars)%mand_var = mandatory
255  cs%restart_field(cs%novars)%initialized = .false.
256  call query_vardesc(cs%restart_field(cs%novars)%vars, &
257  name=cs%restart_field(cs%novars)%var_name, &
258  caller="register_restart_field_ptr2d")
259 
260  cs%var_ptr2d(cs%novars)%p => f_ptr
261  cs%var_ptr4d(cs%novars)%p => null()
262  cs%var_ptr3d(cs%novars)%p => null()
263  cs%var_ptr1d(cs%novars)%p => null()
264  cs%var_ptr0d(cs%novars)%p => null()
265 
Here is the call graph for this function:

◆ register_restart_field_ptr3d()

subroutine mom_restart::register_restart_field_ptr3d ( real, dimension(:,:,:), target  f_ptr,
type(vardesc), intent(in)  var_desc,
logical, intent(in)  mandatory,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 155 of file MOM_restart.F90.

References mom_error_handler::mom_error().

155  real, dimension(:,:,:), target :: f_ptr
156  type(vardesc), intent(in) :: var_desc
157  logical, intent(in) :: mandatory
158  type(mom_restart_cs), pointer :: cs
159 ! Set up a field that will be written to and read from restart
160 ! files.
161 !
162 ! Arguments: f_ptr - A pointer to the field to be read or written.
163 ! (in) var_desc - The descriptive structure for the field.
164 ! (in) mandatory - If .true. the run will abort if this field is not
165 ! successfully read from the restart file. If .false.,
166 ! alternate techniques are provided to initialize this
167 ! field if it is cannot be read from the file.
168 ! (in/out) CS - The control structure returned by a previous call to
169 ! restart_init.
170  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
171  "register_restart_field: Module must be initialized before it is used.")
172 
173  cs%novars = cs%novars+1
174  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
175  ! once the total number of fields is known.
176 
177  cs%restart_field(cs%novars)%vars = var_desc
178  cs%restart_field(cs%novars)%mand_var = mandatory
179  cs%restart_field(cs%novars)%initialized = .false.
180  call query_vardesc(cs%restart_field(cs%novars)%vars, &
181  name=cs%restart_field(cs%novars)%var_name, &
182  caller="register_restart_field_ptr3d")
183 
184  cs%var_ptr3d(cs%novars)%p => f_ptr
185  cs%var_ptr4d(cs%novars)%p => null()
186  cs%var_ptr2d(cs%novars)%p => null()
187  cs%var_ptr1d(cs%novars)%p => null()
188  cs%var_ptr0d(cs%novars)%p => null()
189 
Here is the call graph for this function:

◆ register_restart_field_ptr4d()

subroutine mom_restart::register_restart_field_ptr4d ( real, dimension(:,:,:,:), target  f_ptr,
type(vardesc), intent(in)  var_desc,
logical, intent(in)  mandatory,
type(mom_restart_cs), pointer  CS 
)
private

Definition at line 193 of file MOM_restart.F90.

References mom_error_handler::mom_error().

193  real, dimension(:,:,:,:), target :: f_ptr
194  type(vardesc), intent(in) :: var_desc
195  logical, intent(in) :: mandatory
196  type(mom_restart_cs), pointer :: cs
197 ! Set up a field that will be written to and read from restart
198 ! files.
199 !
200 ! Arguments: f_ptr - A pointer to the field to be read or written.
201 ! (in) var_desc - The descriptive structure for the field.
202 ! (in) mandatory - If .true. the run will abort if this field is not
203 ! successfully read from the restart file. If .false.,
204 ! alternate techniques are provided to initialize this
205 ! field if it is cannot be read from the file.
206 ! (in/out) CS - The control structure returned by a previous call to
207 ! restart_init.
208  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
209  "register_restart_field: Module must be initialized before it is used.")
210 
211  cs%novars = cs%novars+1
212  if (cs%novars > cs%max_fields) return ! This is an error that will be reported
213  ! once the total number of fields is known.
214 
215  cs%restart_field(cs%novars)%vars = var_desc
216  cs%restart_field(cs%novars)%mand_var = mandatory
217  cs%restart_field(cs%novars)%initialized = .false.
218  call query_vardesc(cs%restart_field(cs%novars)%vars, &
219  name=cs%restart_field(cs%novars)%var_name, &
220  caller="register_restart_field_ptr4d")
221 
222  cs%var_ptr4d(cs%novars)%p => f_ptr
223  cs%var_ptr3d(cs%novars)%p => null()
224  cs%var_ptr2d(cs%novars)%p => null()
225  cs%var_ptr1d(cs%novars)%p => null()
226  cs%var_ptr0d(cs%novars)%p => null()
227 
Here is the call graph for this function:

◆ restart_end()

subroutine, public mom_restart::restart_end ( type(mom_restart_cs), pointer  CS)

Definition at line 1310 of file MOM_restart.F90.

Referenced by restart_init_end().

1310  type(mom_restart_cs), pointer :: cs
1311 
1312  if (associated(cs%restart_field)) deallocate(cs%restart_field)
1313  if (associated(cs%var_ptr0d)) deallocate(cs%var_ptr0d)
1314  if (associated(cs%var_ptr1d)) deallocate(cs%var_ptr1d)
1315  if (associated(cs%var_ptr2d)) deallocate(cs%var_ptr2d)
1316  if (associated(cs%var_ptr3d)) deallocate(cs%var_ptr3d)
1317  if (associated(cs%var_ptr4d)) deallocate(cs%var_ptr4d)
1318  deallocate(cs)
1319 
Here is the caller graph for this function:

◆ restart_error()

subroutine mom_restart::restart_error ( type(mom_restart_cs), pointer  CS)
private

Definition at line 1323 of file MOM_restart.F90.

References mom_error_handler::mom_error().

Referenced by query_initialized_0d(), query_initialized_0d_name(), query_initialized_1d(), query_initialized_1d_name(), query_initialized_2d(), query_initialized_2d_name(), query_initialized_3d(), query_initialized_3d_name(), query_initialized_4d(), query_initialized_4d_name(), query_initialized_name(), restore_state(), and save_restart().

1323  type(mom_restart_cs), pointer :: cs
1324 ! Arguments: CS - A pointer that is set to point to the control structure
1325 ! for this module. (Intent in.)
1326  character(len=16) :: num ! String for error messages
1327 
1328  if (cs%novars > cs%max_fields) then
1329  write(num,'(I0)') cs%novars
1330  call mom_error(fatal,"MOM_restart: Too many fields registered for " // &
1331  "restart. Set MAX_FIELDS to be at least " // &
1332  trim(adjustl(num)) // " in the MOM input file.")
1333  else
1334  call mom_error(fatal,"MOM_restart: Unspecified fatal error.")
1335  endif
Here is the call graph for this function:
Here is the caller graph for this function:

◆ restart_init()

subroutine, public mom_restart::restart_init ( type(param_file_type), intent(in)  param_file,
type(mom_restart_cs), pointer  CS,
character(len=*), intent(in), optional  restart_root 
)
Parameters
[in]param_fileA structure to parse for run-time parameters

Definition at line 1248 of file MOM_restart.F90.

References mom_error_handler::mom_error().

Referenced by mom::initialize_mom().

1248  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
1249  type(mom_restart_cs), pointer :: cs
1250  character(len=*), optional, intent(in) :: restart_root
1251 ! Arguments: param_file - A structure indicating the open file to parse for
1252 ! model parameter values.
1253 ! (in/out) CS - A pointer that is set to point to the control structure
1254 ! for this module.
1255 ! (in,opt) restart_root - A filename root that overrides the value in
1256 ! RESTARTFILE. This will enable the use of this
1257 ! module by other components.
1258 ! This include declares and sets the variable "version".
1259 #include "version_variable.h"
1260  character(len=40) :: mdl = "MOM_restart" ! This module's name.
1261 
1262  if (associated(cs)) then
1263  call mom_error(warning, "restart_init called with an associated control structure.")
1264  return
1265  endif
1266  allocate(cs)
1267 
1268  ! Read all relevant parameters and write them to the model log.
1269  call log_version(param_file, mdl, version, "")
1270  call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", &
1271  cs%parallel_restartfiles, &
1272  "If true, each processor writes its own restart file, \n"//&
1273  "otherwise a single restart file is generated", &
1274  default=.false.)
1275 
1276  if (present(restart_root)) then
1277  cs%restartfile = restart_root
1278  call log_param(param_file, mdl, "RESTARTFILE from argument", cs%restartfile)
1279  else
1280  call get_param(param_file, mdl, "RESTARTFILE", cs%restartfile, &
1281  "The name-root of the restart file.", default="MOM.res")
1282  endif
1283  call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", cs%large_file_support, &
1284  "If true, use the file-size limits with NetCDF large \n"//&
1285  "file support (4Gb), otherwise the limit is 2Gb.", &
1286  default=.true.)
1287  call get_param(param_file, mdl, "MAX_FIELDS", cs%max_fields, &
1288  "The maximum number of restart fields that can be used.", &
1289  default=100)
1290 
1291  allocate(cs%restart_field(cs%max_fields))
1292  allocate(cs%var_ptr0d(cs%max_fields))
1293  allocate(cs%var_ptr1d(cs%max_fields))
1294  allocate(cs%var_ptr2d(cs%max_fields))
1295  allocate(cs%var_ptr3d(cs%max_fields))
1296  allocate(cs%var_ptr4d(cs%max_fields))
1297 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ restart_init_end()

subroutine, public mom_restart::restart_init_end ( type(mom_restart_cs), pointer  CS)

Definition at line 1301 of file MOM_restart.F90.

References restart_end().

1301  type(mom_restart_cs), pointer :: cs
1302 
1303  if (associated(cs)) then
1304  if (cs%novars == 0) call restart_end(cs)
1305  endif
1306 
Here is the call graph for this function:

◆ restore_state()

subroutine, public mom_restart::restore_state ( character(len=*), intent(in)  filename,
character(len=*), intent(in)  directory,
type(time_type), intent(out)  day,
type(ocean_grid_type), intent(in)  G,
type(mom_restart_cs), pointer  CS 
)
Parameters
[in]gThe ocean's grid structure

Definition at line 889 of file MOM_restart.F90.

References mom_error_handler::is_root_pe(), mom_string_functions::lowercase(), mom_error_handler::mom_error(), and restart_error().

Referenced by mom_state_initialization::mom_initialize_state().

889  character(len=*), intent(in) :: filename
890  character(len=*), intent(in) :: directory
891  type(time_type), intent(out) :: day
892  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
893  type(mom_restart_cs), pointer :: cs
894 ! This subroutine reads the model state from previously
895 ! generated files. All restart variables are read from the first
896 ! file in the input filename list in which they are found.
897 
898 ! Arguments: filename - A series of space delimited strings, each of
899 ! which is either "r" or the name of a file
900 ! from which the run is to be restarted.
901 ! (in) directory - The directory where the restart or save
902 ! files should be found.
903 ! (out) day - The time of the restarted run.
904 ! (in) G - The ocean's grid structure.
905 ! (in/out) CS - The control structure returned by a previous call to
906 ! restart_init.
907 
908  character(len=200) :: filepath ! The path (dir/file) to the file being opened.
909  character(len=80) :: fname ! The name of the current file.
910  character(len=8) :: suffix ! A suffix (like "_2") that is added to any
911  ! additional restart files.
912  character(len=256) :: mesg ! A message for warnings.
913  character(len=80) :: varname ! A variable's name.
914  integer :: num_restart ! The number of restart files that have already
915  ! been opened.
916  integer :: num_file ! The number of files (restart files and others
917  ! explicitly in filename) that are open.
918  integer :: start_char ! The location of the starting character in the
919  ! current file name.
920  integer :: n, m, start_of_day, num_days
921  integer :: isl, iel, jsl, jel, is0, js0
922  integer :: sizes(7)
923  integer :: ndim, nvar, natt, ntime, pos
924  integer :: unit(cs%max_fields) ! The mpp unit of all open files.
925  logical :: unit_is_global(cs%max_fields) ! True if the file is global.
926  character(len=8) :: hor_grid ! Variable grid info.
927  character(len=200) :: unit_path(cs%max_fields) ! The file names.
928  logical :: fexists
929  real, allocatable :: time_vals(:)
930  type(fieldtype), allocatable :: fields(:)
931  integer :: i, missing_fields
932  real :: t1, t2
933  integer :: err
934  character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs
935  character(len=80) :: restartname
936  integer :: length
937 
938  num_restart = 0 ; n = 1 ; start_char = 1
939  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
940  "restore_state: Module must be initialized before it is used.")
941  if (cs%novars > cs%max_fields) call restart_error(cs)
942 
943 ! Get NetCDF ids for all of the restart files.
944  do while (start_char <= len_trim(filename) )
945  do m=start_char,len_trim(filename)
946  if (filename(m:m) == ' ') exit
947  enddo
948  fname = filename(start_char:m-1)
949  start_char = m
950  do while ((start_char <= len_trim(filename)) .and. (filename(start_char:start_char) == ' '))
951  start_char = start_char + 1
952  enddo
953 
954  if ((fname(1:1)=='r') .and. ( len_trim(fname) == 1)) then
955  err = 0
956  if (num_restart > 0) err = 1 ! Avoid going through the file list twice.
957  do while (err == 0)
958  restartname = trim(cs%restartfile)
959 
960  !query fms_io if there is a filename_appendix (for ensemble runs)
961  call get_filename_appendix(filename_appendix)
962  if(len_trim(filename_appendix) > 0) then
963  length = len_trim(restartname)
964  if(restartname(length-2:length) == '.nc') then
965  restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc'
966  else
967  restartname = restartname(1:length) //'.'//trim(filename_appendix)
968  end if
969  end if
970  filepath = trim(directory) // trim(restartname)
971 
972  if (num_restart < 10) then
973  write(suffix,'("_",I1)') num_restart
974  else
975  write(suffix,'("_",I2)') num_restart
976  endif
977  if (num_restart > 0) filepath = trim(filepath) // suffix
978 
979  ! if (.not.file_exists(filepath)) &
980  filepath = trim(filepath)//".nc"
981 
982  num_restart = num_restart + 1
983  inquire(file=filepath, exist=fexists)
984  if (fexists) then
985  call open_file(unit(n), trim(filepath), readonly_file, netcdf_file, &
986  threading = multiple, fileset = single_file)
987  unit_is_global(n) = .true.
988  elseif (cs%parallel_restartfiles) then
989  if (g%Domain%use_io_layout) then
990  ! Look for decomposed files using the I/O Layout.
991  fexists = file_exists(filepath, g%Domain)
992  if (fexists) &
993  call open_file(unit(n), trim(filepath), readonly_file, netcdf_file, &
994  domain=g%Domain%mpp_domain)
995  else
996  ! Look for any PE-specific files of the form NAME.nc.####.
997  if (num_pes()>10000) then
998  write(filepath, '(a,i6.6)' ) trim(filepath)//'.', pe_here()
999  else
1000  write(filepath, '(a,i4.4)' ) trim(filepath)//'.', pe_here()
1001  endif
1002  inquire(file=filepath, exist=fexists)
1003  if (fexists) &
1004  call open_file(unit(n), trim(filepath), readonly_file, netcdf_file, &
1005  threading = multiple, fileset = single_file)
1006  endif
1007  if (fexists) unit_is_global(n) = .false.
1008  endif
1009 
1010  if (fexists) then
1011  unit_path(n) = filepath
1012  n = n + 1
1013  if (is_root_pe()) &
1014  call mom_error(note, "MOM_restart: MOM run restarted using : "//trim(filepath))
1015  else
1016  err = 1 ; exit
1017  endif
1018  enddo ! while (err == 0) loop
1019  else
1020  filepath = trim(directory)//trim(fname)
1021  inquire(file=filepath, exist=fexists)
1022  if (.not. fexists) filepath = trim(filepath)//".nc"
1023 
1024  inquire(file=filepath, exist=fexists)
1025  if (fexists) then
1026  call open_file(unit(n), trim(filepath), readonly_file, netcdf_file, &
1027  threading = multiple, fileset = single_file)
1028  unit_is_global(n) = .true.
1029  unit_path(n) = filepath
1030  n = n + 1
1031  if (is_root_pe()) &
1032  call mom_error(note,"MOM_restart: MOM run restarted using : "//trim(filepath))
1033  else
1034  call mom_error(warning,"MOM_restart: Unable to find restart file : "//trim(filepath))
1035  endif
1036 
1037  endif
1038  enddo ! while (start_char < strlen(filename)) loop
1039  num_file = n-1
1040 
1041  if (num_file == 0) then
1042  write(mesg,'("Unable to find any restart files specified by ",A," in directory ",A,".")') &
1043  trim(filename), trim(directory)
1044  call mom_error(fatal,"MOM_restart: "//mesg)
1045  endif
1046 
1047 ! Get the time from the first file in the list that has one.
1048  do n=1,num_file
1049  call get_file_info(unit(n), ndim, nvar, natt, ntime)
1050  if (ntime < 1) cycle
1051 
1052  allocate(time_vals(ntime))
1053  call get_file_times(unit(n), time_vals)
1054  t1 = time_vals(1)
1055  deallocate(time_vals)
1056 
1057  start_of_day = int((t1 - int(t1)) *86400) ! Number of seconds.
1058  num_days = int(t1)
1059  day = set_time(start_of_day, num_days)
1060  exit
1061  enddo
1062 
1063  if (n>num_file) call mom_error(warning,"MOM_restart: " // &
1064  "No times found in restart files.")
1065 
1066 ! Check the remaining files for different times and issue a warning
1067 ! if they differ from the first time.
1068  if (is_root_pe()) then
1069  do m = n+1,num_file
1070  call get_file_info(unit(n), ndim, nvar, natt, ntime)
1071  if (ntime < 1) cycle
1072 
1073  allocate(time_vals(ntime))
1074  call get_file_times(unit(n), time_vals)
1075  t2 = time_vals(1)
1076  deallocate(time_vals)
1077 
1078  if (t1 /= t2) then
1079  write(mesg,'("WARNING: Restart file ",I2," has time ",F10.4,"whereas &
1080  &simulation is restarted at ",F10.4," (differing by ",F10.4,").")')&
1081  m,t1,t2,t1-t2
1082  call mom_error(warning, "MOM_restart: "//mesg)
1083  endif
1084  enddo
1085  endif
1086 
1087 ! Read each variable from the first file in which it is found.
1088  do n=1,num_file
1089  call get_file_info(unit(n), ndim, nvar, natt, ntime)
1090 
1091  allocate(fields(nvar))
1092  call get_file_fields(unit(n),fields(1:nvar))
1093 
1094  missing_fields = 0
1095 
1096  do m=1,cs%novars
1097  if (cs%restart_field(m)%initialized) cycle
1098  call query_vardesc(cs%restart_field(m)%vars, hor_grid=hor_grid, &
1099  caller="restore_state")
1100  select case (hor_grid)
1101  case ('q') ; pos = corner
1102  case ('h') ; pos = center
1103  case ('u') ; pos = east_face
1104  case ('v') ; pos = north_face
1105  case ('Bu') ; pos = corner
1106  case ('T') ; pos = center
1107  case ('Cu') ; pos = east_face
1108  case ('Cv') ; pos = north_face
1109  case ('1') ; pos = 0
1110  case default ; pos = 0
1111  end select
1112 
1113  do i=1, nvar
1114  call get_file_atts(fields(i),name=varname)
1115  if (lowercase(trim(varname)) == lowercase(trim(cs%restart_field(m)%var_name))) then
1116  if (ASSOCIATED(cs%var_ptr1d(m)%p)) then
1117  ! Read a 1d array, which should be invariant to domain decomposition.
1118  call read_data(unit_path(n), varname, cs%var_ptr1d(m)%p, &
1119  no_domain=.true., timelevel=1)
1120  elseif (ASSOCIATED(cs%var_ptr0d(m)%p)) then ! Read a scalar...
1121  call read_data(unit_path(n), varname, cs%var_ptr0d(m)%p, &
1122  no_domain=.true., timelevel=1)
1123  elseif ((pos == 0) .and. ASSOCIATED(cs%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array.
1124  ! Probably should query the field type to make sure that the sizes are right.
1125  call read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1126  no_domain=.true., timelevel=1)
1127  elseif ((pos == 0) .and. ASSOCIATED(cs%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array.
1128  ! Probably should query the field type to make sure that the sizes are right.
1129  call read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1130  no_domain=.true., timelevel=1)
1131  elseif ((pos == 0) .and. ASSOCIATED(cs%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array.
1132  ! Probably should query the field type to make sure that the sizes are right.
1133  call read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1134  no_domain=.true., timelevel=1)
1135  elseif (unit_is_global(n) .or. g%Domain%use_io_layout) then
1136  if (ASSOCIATED(cs%var_ptr3d(m)%p)) then
1137  ! Read 3d array... Time level 1 is always used.
1138  call read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1139  g%Domain%mpp_domain, 1, position=pos)
1140  elseif (ASSOCIATED(cs%var_ptr2d(m)%p)) then ! Read 2d array...
1141  call read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1142  g%Domain%mpp_domain, 1, position=pos)
1143  elseif (ASSOCIATED(cs%var_ptr4d(m)%p)) then ! Read 4d array...
1144  call read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1145  g%Domain%mpp_domain, 1, position=pos)
1146  else
1147  call mom_error(fatal, "MOM_restart restore_state: "//&
1148  "No pointers set for "//trim(varname))
1149  endif
1150  else ! Do not use an io_layout. !### GET RID OF THIS BRANCH ONCE read_data_4d_new IS AVAILABLE.
1151  ! This file is decomposed onto the current processors. We need
1152  ! to check whether the sizes look right, and abort if not.
1153  call get_file_atts(fields(i),ndim=ndim,siz=sizes)
1154 
1155  ! NOTE: The index ranges f var_ptrs always start with 1, so with
1156  ! symmetric memory the staggering is swapped from NE to SW!
1157  is0 = 1-g%isd
1158  if ((pos == east_face) .or. (pos == corner)) is0 = 1-g%IsdB
1159  if (sizes(1) == g%iec-g%isc+1) then
1160  isl = g%isc+is0 ; iel = g%iec+is0
1161  elseif (sizes(1) == g%IecB-g%IscB+1) then
1162  isl = g%IscB+is0 ; iel = g%IecB+is0
1163  elseif (((pos == east_face) .or. (pos == corner)) .and. &
1164  (g%IscB == g%isc) .and. (sizes(1) == g%iec-g%isc+2)) then
1165  ! This is reading a symmetric file in a non-symmetric model.
1166  isl = g%isc-1+is0 ; iel = g%iec+is0
1167  else
1168  call mom_error(warning, "MOM_restart restore_state, "//trim(varname)//&
1169  " has the wrong i-size in "//trim(filepath))
1170  exit
1171  endif
1172 
1173  js0 = 1-g%jsd
1174  if ((pos == north_face) .or. (pos == corner)) js0 = 1-g%JsdB
1175  if (sizes(2) == g%jec-g%jsc+1) then
1176  jsl = g%jsc+js0 ; jel = g%jec+js0
1177  elseif (sizes(2) == g%jecB-g%jscB+1) then
1178  jsl = g%jscB+js0 ; jel = g%jecB+js0
1179  elseif (((pos == north_face) .or. (pos == corner)) .and. &
1180  (g%JscB == g%jsc) .and. (sizes(2) == g%jec-g%jsc+2)) then
1181  ! This is reading a symmetric file in a non-symmetric model.
1182  jsl = g%jsc-1+js0 ; jel = g%jec+js0
1183  else
1184  call mom_error(warning, "MOM_restart restore_state, "//trim(varname)//&
1185  " has the wrong j-size in "//trim(filepath))
1186  exit
1187  endif
1188 
1189  if (ASSOCIATED(cs%var_ptr3d(m)%p)) then
1190  if (ntime == 0) then
1191  call read_field(unit(n), fields(i), &
1192  cs%var_ptr3d(m)%p(isl:iel,jsl:jel,:))
1193  else
1194  call read_field(unit(n), fields(i), &
1195  cs%var_ptr3d(m)%p(isl:iel,jsl:jel,:), 1)
1196  endif
1197  elseif (ASSOCIATED(cs%var_ptr2d(m)%p)) then
1198  if (ntime == 0) then
1199  call read_field(unit(n), fields(i), &
1200  cs%var_ptr2d(m)%p(isl:iel,jsl:jel))
1201  else
1202  call read_field(unit(n), fields(i), &
1203  cs%var_ptr2d(m)%p(isl:iel,jsl:jel), 1)
1204  endif
1205  elseif (ASSOCIATED(cs%var_ptr4d(m)%p)) then
1206  if (ntime == 0) then
1207  call read_field(unit(n), fields(i), &
1208  cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:))
1209  else
1210  call read_field(unit(n), fields(i), &
1211  cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:), 1)
1212  endif
1213  else
1214  call mom_error(fatal, "MOM_restart restore_state: "//&
1215  "No pointers set for "//trim(varname))
1216  endif
1217  endif
1218  cs%restart_field(m)%initialized = .true.
1219  exit ! Start search for next restart variable.
1220  endif
1221  enddo
1222  if (i>nvar) missing_fields = missing_fields+1
1223  enddo
1224 
1225  deallocate(fields)
1226  if (missing_fields == 0) exit
1227  enddo
1228 
1229  do n=1,num_file
1230  call close_file(unit(n))
1231  enddo
1232 
1233 ! Check whether any mandatory fields have not been found.
1234  cs%restart = .true.
1235  do m=1,cs%novars
1236  if (.not.(cs%restart_field(m)%initialized)) then
1237  cs%restart = .false.
1238  if (cs%restart_field(m)%mand_var) then
1239  call mom_error(fatal,"MOM_restart: Unable to find mandatory variable " &
1240  //trim(cs%restart_field(m)%var_name)//" in restart files.")
1241  endif
1242  endif
1243  enddo
1244 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ save_restart()

subroutine, public mom_restart::save_restart ( character(len=*), intent(in)  directory,
type(time_type), intent(in)  time,
type(ocean_grid_type), intent(inout)  G,
type(mom_restart_cs), pointer  CS,
logical, intent(in), optional  time_stamped,
character(len=*), intent(in), optional  filename,
type(verticalgrid_type), intent(in), optional  GV 
)
Parameters
[in,out]gThe ocean's grid structure
[in]gvThe ocean's vertical grid structure

Definition at line 711 of file MOM_restart.F90.

References mom_error_handler::mom_error(), and restart_error().

Referenced by mom_main(), ocean_model_mod::ocean_model_restart(), and ocean_model_mod::ocean_model_save_restart().

711 ! save_restart saves all registered variables to restart files.
712  character(len=*), intent(in) :: directory
713  type(time_type), intent(in) :: time
714  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure
715  type(mom_restart_cs), pointer :: cs
716  logical, optional, intent(in) :: time_stamped
717  character(len=*), optional, intent(in) :: filename
718  type(verticalgrid_type), optional, intent(in) :: gv !< The ocean's vertical grid structure
719 ! Arguments: directory - The directory where the restart file goes.
720 ! (in) time - The time of this restart file.
721 ! (in) G - The ocean's grid structure.
722 ! (in) CS - The control structure returned by a previous call to
723 ! restart_init.
724 ! (in, opt) time_stamped - If true, the restart file names include
725 ! a unique time stamp. The default is false.
726 ! (in, opt) filename - A filename that overrides the name in CS%restartfile.
727 !
728 ! (in, opt) GV - The ocean's vertical grid structure.
729  type(vardesc) :: vars(cs%max_fields) ! Descriptions of the fields that
730  ! are to be read from the restart file.
731  type(fieldtype) :: fields(cs%max_fields) !
732  character(len=200) :: restartpath ! The restart file path (dir/file).
733  character(len=80) :: restartname ! The restart file name (no dir).
734  character(len=8) :: suffix ! A suffix (like _2) that is appended
735  ! to the name of files after the first.
736  integer(kind=8) :: var_sz, size_in_file ! The size in bytes of each variable
737  ! and the variables already in a file.
738  integer(kind=8) :: max_file_size = 2147483647_8 ! The maximum size in bytes
739  ! for any one file. With NetCDF3,
740  ! this should be 2 Gb or less.
741  integer :: start_var, next_var ! The starting variables of the
742  ! current and next files.
743  integer :: unit ! The mpp unit of the open file.
744  integer :: m, nz, num_files, var_periods
745  integer :: seconds, days, year, month, hour, minute
746  character(len=8) :: hor_grid, z_grid, t_grid ! Variable grid info.
747  character(len=8) :: t_grid_read
748  character(len=64) :: var_name ! A variable's name.
749  real :: restart_time
750  character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs
751  integer :: length
752 
753  if (.not.associated(cs)) call mom_error(fatal, "MOM_restart " // &
754  "save_restart: Module must be initialized before it is used.")
755  if (cs%novars > cs%max_fields) call restart_error(cs)
756 
757  ! With parallel read & write, it is possible to disable the following...
758 
759 ! jgj: this was set to 4294967292, changed to 4294967295 (see mpp_parameter.F90)
760  if (cs%large_file_support) max_file_size = 4294967295_8
761 
762  num_files = 0
763  next_var = 0
764  nz = 1 ; if (present(gv)) nz = gv%ke
765 
766  call get_time(time,seconds,days)
767  restart_time = real(days) + real(seconds)/86400.0
768 
769  restartname = trim(cs%restartfile)
770  if (present(filename)) restartname = trim(filename)
771  if (PRESENT(time_stamped)) then ; if (time_stamped) then
772  call get_date(time,year,month,days,hour,minute,seconds)
773  ! Compute the year-day, because I don't like months. - RWH
774  do m=1,month-1
775  days = days + days_in_month(set_date(year,m,2,0,0,0))
776  enddo
777  seconds = seconds + 60*minute + 3600*hour
778  if (year <= 9999) then
779  write(restartname,'("_Y",I4.4,"_D",I3.3,"_S",I5.5)') year, days, seconds
780  else if (year <= 99999) then
781  write(restartname,'("_Y",I5.5,"_D",I3.3,"_S",I5.5)') year, days, seconds
782  else
783  write(restartname,'("_Y",I10.10,"_D",I3.3,"_S",I5.5)') year, days, seconds
784  endif
785  restartname = trim(cs%restartfile)//trim(restartname)
786  endif ; endif
787 
788  next_var = 1
789  do while (next_var <= cs%novars )
790  start_var = next_var
791  size_in_file = 8*(2*g%Domain%niglobal+2*g%Domain%njglobal+2*nz+1000)
792 
793  do m=start_var,cs%novars
794  call query_vardesc(cs%restart_field(m)%vars, hor_grid=hor_grid, &
795  z_grid=z_grid, t_grid=t_grid, caller="save_restart")
796  if (hor_grid == '1') then
797  var_sz = 8
798  else
799  var_sz = 8*(g%Domain%niglobal+1)*(g%Domain%njglobal+1)
800  endif
801  select case (z_grid)
802  case ('L') ; var_sz = var_sz * nz
803  case ('i') ; var_sz = var_sz * (nz+1)
804  end select
805  t_grid = adjustl(t_grid)
806  if (t_grid(1:1) == 'p') then
807  if (len_trim(t_grid(2:8)) > 0) then
808  var_periods = -1
809  t_grid_read = adjustl(t_grid(2:8))
810  read(t_grid_read,*) var_periods
811  if (var_periods > 1) var_sz = var_sz * var_periods
812  endif
813  endif
814 
815  if ((m==start_var) .OR. (size_in_file < max_file_size-var_sz)) then
816  size_in_file = size_in_file + var_sz
817  else ; exit
818  endif
819 
820  enddo
821  next_var = m
822 
823  !query fms_io if there is a filename_appendix (for ensemble runs)
824  call get_filename_appendix(filename_appendix)
825  if(len_trim(filename_appendix) > 0) then
826  length = len_trim(restartname)
827  if(restartname(length-2:length) == '.nc') then
828  restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc'
829  else
830  restartname = restartname(1:length) //'.'//trim(filename_appendix)
831  end if
832  end if
833 
834  restartpath = trim(directory)// trim(restartname)
835 
836  if (num_files < 10) then
837  write(suffix,'("_",I1)') num_files
838  else
839  write(suffix,'("_",I2)') num_files
840  endif
841 
842  if (num_files > 0) restartpath = trim(restartpath) // trim(suffix)
843 
844  do m=start_var,next_var-1
845  vars(m-start_var+1) = cs%restart_field(m)%vars
846  enddo
847  call query_vardesc(vars(1), t_grid=t_grid, caller="save_restart")
848  t_grid = adjustl(t_grid)
849  if (t_grid(1:1) /= 'p') &
850  call modify_vardesc(vars(1), t_grid='s', caller="save_restart")
851 
852  if (cs%parallel_restartfiles) then
853  call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
854  fields, multiple, g=g, gv=gv)
855  else
856  call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
857  fields, single_file, g=g, gv=gv)
858  endif
859 
860  do m=start_var,next_var-1
861 
862  if (ASSOCIATED(cs%var_ptr3d(m)%p)) then
863  call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
864  cs%var_ptr3d(m)%p, restart_time)
865  elseif (ASSOCIATED(cs%var_ptr2d(m)%p)) then
866  call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
867  cs%var_ptr2d(m)%p, restart_time)
868  elseif (ASSOCIATED(cs%var_ptr4d(m)%p)) then
869  call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
870  cs%var_ptr4d(m)%p, restart_time)
871  elseif (ASSOCIATED(cs%var_ptr1d(m)%p)) then
872  call write_field(unit, fields(m-start_var+1), cs%var_ptr1d(m)%p, &
873  restart_time)
874  elseif (ASSOCIATED(cs%var_ptr0d(m)%p)) then
875  call write_field(unit, fields(m-start_var+1), cs%var_ptr0d(m)%p, &
876  restart_time)
877  endif
878  enddo
879 
880  call close_file(unit)
881 
882  num_files = num_files+1
883 
884  enddo
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function: