Skip to content

Commit

Permalink
+Add set_initialized
Browse files Browse the repository at this point in the history 
  Added the overloaded interface set_initialized() to the MOM_restart module, to
record that fields have been initialized, despite not appearing in a restart
file.  This will allow for a second call to set_initialized() after a call to
query_initialized() to replicate the existing behavior of query_initialized()
after MOM6 PR #149 (#149) has been
accepted.  All answers are bitwise identical, but there is a new public
interface.
  • Loading branch information
@Hallberg-NOAA @marshallward
Hallberg-NOAA authored and marshallward committed Jul 5, 2022
1 parent 12f2e55 commit 1c0e1f8
Showing 1 changed file with 163 additions and 11 deletions.
174 changes: 163 additions & 11 deletions src/framework/MOM_restart.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -136,6 +136,13 @@ module MOM_restart
module procedure query_initialized_4d, query_initialized_4d_name
end interface

!> Specify that a field has been initialized, even if it was not read from a restart file
interface set_initialized
module procedure set_initialized_name, set_initialized_0d_name
module procedure set_initialized_1d_name, set_initialized_2d_name
module procedure set_initialized_3d_name, set_initialized_4d_name
end interface

contains

!> Register a restart field as obsolete
Expand Down Expand Up @@ -571,7 +578,7 @@ end subroutine register_restart_field_0d


!> query_initialized_name determines whether a named field has been successfully
!! read from a restart file yet.
!! read from a restart file or has otherwise been recored as being initialzed.
function query_initialized_name(name, CS) result(query_initialized)
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
Expand Down Expand Up @@ -725,10 +732,10 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized)

end function query_initialized_4d

!> Indicate whether the field pointed to by f_ptr or with the specified variable
!> Indicate whether the field stored in f_ptr or with the specified variable
!! name has been initialized from a restart file.
function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized)
real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried
real, target, intent(in) :: f_ptr !< The field that is being queried
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
logical :: query_initialized
Expand Down Expand Up @@ -757,11 +764,11 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized)

end function query_initialized_0d_name

!> Indicate whether the field pointed to by f_ptr or with the specified variable
!> Indicate whether the field stored in f_ptr or with the specified variable
!! name has been initialized from a restart file.
function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized)
real, dimension(:), &
target, intent(in) :: f_ptr !< A pointer to the field that is being queried
target, intent(in) :: f_ptr !< The field that is being queried
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
logical :: query_initialized
Expand Down Expand Up @@ -790,11 +797,11 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized)

end function query_initialized_1d_name

!> Indicate whether the field pointed to by f_ptr or with the specified variable
!> Indicate whether the field stored in f_ptr or with the specified variable
!! name has been initialized from a restart file.
function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized)
real, dimension(:,:), &
target, intent(in) :: f_ptr !< A pointer to the field that is being queried
target, intent(in) :: f_ptr !< The field that is being queried
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
logical :: query_initialized
Expand Down Expand Up @@ -823,11 +830,11 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized)

end function query_initialized_2d_name

!> Indicate whether the field pointed to by f_ptr or with the specified variable
!> Indicate whether the field stored in f_ptr or with the specified variable
!! name has been initialized from a restart file.
function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized)
real, dimension(:,:,:), &
target, intent(in) :: f_ptr !< A pointer to the field that is being queried
target, intent(in) :: f_ptr !< The field that is being queried
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
logical :: query_initialized
Expand Down Expand Up @@ -856,11 +863,11 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized)

end function query_initialized_3d_name

!> Indicate whether the field pointed to by f_ptr or with the specified variable
!> Indicate whether the field stored in f_ptr or with the specified variable
!! name has been initialized from a restart file.
function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized)
real, dimension(:,:,:,:), &
target, intent(in) :: f_ptr !< A pointer to the field that is being queried
target, intent(in) :: f_ptr !< The field that is being queried
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
logical :: query_initialized
Expand Down Expand Up @@ -889,6 +896,151 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized)

end function query_initialized_4d_name

!> set_initialized_name records that a named field has been initialized.
subroutine set_initialized_name(name, CS)
character(len=*), intent(in) :: name !< The name of the field that is being set
type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct

integer :: m

if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"set_initialized: Module must be initialized before it is used.")

do m=1,CS%novars ; if (trim(name) == trim(CS%restart_field(m)%var_name)) then
CS%restart_field(m)%initialized = .true. ; exit
endif ; enddo

if ((m==CS%novars+1) .and. (is_root_pe())) &
call MOM_error(NOTE,"MOM_restart: Unknown restart variable "//name// &
" used in set_initialized call.")

end subroutine set_initialized_name

!> Record that the array in f_ptr with the given name has been initialized.
subroutine set_initialized_0d_name(f_ptr, name, CS)
real, target, intent(in) :: f_ptr !< The variable that has been initialized
character(len=*), intent(in) :: name !< The name of the field that has been initialized
type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct

integer :: m

if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"set_initialized: Module must be initialized before it is used.")

do m=1,CS%novars ; if (associated(CS%var_ptr0d(m)%p,f_ptr)) then
CS%restart_field(m)%initialized = .true. ; exit
endif ; enddo

if (m==CS%novars+1) then
if (is_root_pe()) &
call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
"probably because of the suspect comparison of pointers by ASSOCIATED.")
call set_initialized_name(name, CS)
endif

end subroutine set_initialized_0d_name

!> Record that the array in f_ptr with the given name has been initialized.
subroutine set_initialized_1d_name(f_ptr, name, CS)
real, dimension(:), &
target, intent(in) :: f_ptr !< The array that has been initialized
character(len=*), intent(in) :: name !< The name of the field that has been initialized
type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct

integer :: m

if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"set_initialized: Module must be initialized before it is used.")

do m=1,CS%novars ; if (associated(CS%var_ptr1d(m)%p,f_ptr)) then
CS%restart_field(m)%initialized = .true. ; exit
endif ; enddo

if (m==CS%novars+1) then
if (is_root_pe()) &
call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
"probably because of the suspect comparison of pointers by ASSOCIATED.")
call set_initialized_name(name, CS)
endif

end subroutine set_initialized_1d_name

!> Record that the array in f_ptr with the given name has been initialized.
subroutine set_initialized_2d_name(f_ptr, name, CS)
real, dimension(:,:), &
target, intent(in) :: f_ptr !< The array that has been initialized
character(len=*), intent(in) :: name !< The name of the field that has been initialized
type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct

integer :: m

if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"set_initialized: Module must be initialized before it is used.")

do m=1,CS%novars ; if (associated(CS%var_ptr2d(m)%p,f_ptr)) then
CS%restart_field(m)%initialized = .true. ; exit
endif ; enddo

if (m==CS%novars+1) then
if (is_root_pe()) &
call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
"probably because of the suspect comparison of pointers by ASSOCIATED.")
call set_initialized_name(name, CS)
endif

end subroutine set_initialized_2d_name

!> Record that the array in f_ptr with the given name has been initialized.
subroutine set_initialized_3d_name(f_ptr, name, CS)
real, dimension(:,:,:), &
target, intent(in) :: f_ptr !< The array that has been initialized
character(len=*), intent(in) :: name !< The name of the field that has been initialized
type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct

integer :: m

if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"set_initialized: Module must be initialized before it is used.")

do m=1,CS%novars ; if (associated(CS%var_ptr3d(m)%p,f_ptr)) then
CS%restart_field(m)%initialized = .true. ; exit
endif ; enddo

if (m==CS%novars+1) then
if (is_root_pe()) &
call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
"probably because of the suspect comparison of pointers by ASSOCIATED.")
call set_initialized_name(name, CS)
endif

end subroutine set_initialized_3d_name

!> Record that the array in f_ptr with the given name has been initialized.
subroutine set_initialized_4d_name(f_ptr, name, CS)
real, dimension(:,:,:,:), &
target, intent(in) :: f_ptr !< The array that has been initialized
character(len=*), intent(in) :: name !< The name of the field that has been initialized
type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct

integer :: m

if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"set_initialized: Module must be initialized before it is used.")

do m=1,CS%novars ; if (associated(CS%var_ptr4d(m)%p,f_ptr)) then
CS%restart_field(m)%initialized = .true. ; exit
endif ; enddo

if (m==CS%novars+1) then
if (is_root_pe()) &
call MOM_error(NOTE,"MOM_restart: Unable to find "//name//" queried by pointer, "//&
"probably because of the suspect comparison of pointers by ASSOCIATED.")
call set_initialized_name(name, CS)
endif

end subroutine set_initialized_4d_name


!> save_restart saves all registered variables to restart files.
subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_rest_files, write_IC)
character(len=*), intent(in) :: directory !< The directory where the restart files
Expand Down

0 comments on commit 1c0e1f8

Please sign in to comment.