From 535525cfdd91cb60f6f1adc948258cfedd34064f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Apr 2021 09:34:34 -0400 Subject: [PATCH] (*)+Stop ignoring SIS2 namelist entries Revised the handling of the SIS2 namelist entries so that they are no longer ignored, addressing SIS2 issue #96. This includes modification so that the behavior when input_filename = 'F' is exactly the same as if it is 'n' if there are no restart files in the restart_input_dir, or as if it is 'r' if the restart files are there. Previously there had been differences in the output files generated, but the solutions were always if input_filename = 'F'. The entries in dirs%restart_output_dir are now used to guide where SIS2 writes its restarts, whereas this had previously been ignored with the output always going into "./RESTART/". As a part of this change, a 5 routines have been imported from MOM_restart.F90 to help determine when this is a new run in 'F' mode, and there have been a number of new arguments added to the restart-related interfaces, both to support these changes, and to align these interfaces with those of MOM_restart.F90. Answers can change unless input_filename = 'F', and there can be changes in which output files are written and the presence of one entry in the SIS_parameter_doc.all files. --- src/SIS_framework.F90 | 345 +++++++++++++++++++++++++++++++++++------- src/ice_model.F90 | 52 ++++--- src/ice_type.F90 | 13 +- 3 files changed, 329 insertions(+), 81 deletions(-) diff --git a/src/SIS_framework.F90 b/src/SIS_framework.F90 index 67480a75..2d0daa1c 100644 --- a/src/SIS_framework.F90 +++ b/src/SIS_framework.F90 @@ -13,6 +13,9 @@ module SIS_framework use fms_io_mod, only : FMS1_query_initialized=>query_initialized ! use fms2_io_mod, only : query_initialized=>is_registered_to_restart +use ice_grid, only : ice_grid_type +use SIS_hor_grid, only : SIS_hor_grid_type + use MOM_coms_infra, only : SIS_chksum=>field_chksum use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type use MOM_coupler_types, only : coupler_type_spawn, coupler_type_initialized, coupler_type_send_data @@ -23,10 +26,14 @@ module SIS_framework use MOM_domain_infra, only : global_field, redistribute_data=>redistribute_array, broadcast_domain use MOM_domain_infra, only : CENTER, CORNER, EAST=>EAST_FACE, NORTH=>NORTH_FACE, EAST_FACE, NORTH_FACE use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, NOTE +use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, NOTE, is_root_pe, SIS_mesg=>MOM_mesg +use MOM_file_parser, only : get_param, read_param, log_param, log_version, param_file_type +use MOM_io, only : create_file, file_type, fieldtype, file_exists, open_file, close_file +use MOM_io, only : get_filename_appendix +use MOM_io, only : MULTIPLE, READONLY_FILE, SINGLE_FILE use MOM_safe_alloc, only : safe_alloc=>safe_alloc_alloc, safe_alloc_ptr use MOM_string_functions, only : slasher -use MOM_file_parser, only : get_param, read_param, log_param, log_version, param_file_type +use MOM_time_manager, only : time_type implicit none ; private @@ -38,6 +45,7 @@ module SIS_framework public :: coupler_type_redistribute_data, coupler_type_copy_data, coupler_type_rescale_data public :: coupler_type_increment_data, coupler_type_write_chksums, coupler_type_set_diags public :: query_initialized, SIS_restart_init, SIS_restart_end, only_read_from_restarts +public :: determine_is_new_run, is_new_run public :: SIS_initialize_framework, safe_alloc, safe_alloc_ptr ! These encoding constants are used to indicate the discretization position of a variable public :: CENTER, CORNER, EAST, NORTH, EAST_FACE, NORTH_FACE @@ -47,7 +55,10 @@ module SIS_framework type, public :: SIS_restart_CS ; private type(restart_file_type), pointer :: fms_restart => NULL() !< The FMS restart file type to use type(domain2d), pointer :: mpp_domain => NULL() !< The mpp domain to use for read of decomposed fields. - character(len=240) :: restart_file !< The name or name root for MOM restart files. + character(len=240) :: restartfile !< The name or name root for MOM restart files. + logical :: new_run !< If true, the input filenames and restart file existence will + !! result in a new run that is not initialized from restart files. + logical :: new_run_set = .false. !< If true, new_run has been determined for this restart_CS. logical :: use_FMS2 = .false. !< If true use the FMS2 interfaces for restarts. end type SIS_restart_CS @@ -62,7 +73,7 @@ module SIS_framework module procedure register_restart_coupler_type_2d end interface -!> Register fields for restarts +!> Read optional variables from restart files. interface only_read_from_restarts module procedure only_read_restart_field_4d module procedure only_read_restart_field_3d @@ -96,11 +107,232 @@ subroutine SIS_initialize_framework(PF) end subroutine SIS_initialize_framework +!> restart_files_exist determines whether any restart files exist. +function restart_files_exist(filename, directory, CS) + character(len=*), intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), intent(in) :: directory !< The directory in which to find restart files + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init + logical :: restart_files_exist !< The function result, which indicates whether + !! any of the explicitly or automatically named + !! restart files exist in directory + integer :: num_files + + if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & + "restart_files_exist: Module must be initialized before it is used.") + + if ((LEN_TRIM(filename) == 1) .and. (filename(1:1) == 'F')) then + num_files = get_num_restart_files('r', directory, CS) + else + num_files = get_num_restart_files(filename, directory, CS) + endif + restart_files_exist = (num_files > 0) + +end function restart_files_exist + +!> determine_is_new_run determines from the value of filename and the existence of +!! automatically named restart files in directory whether this would be a new, +!! and as a side effect stores this information in CS. +function determine_is_new_run(filename, directory, CS) result(is_new_run) + character(len=*), intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), intent(in) :: directory !< The directory in which to find restart files + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init + logical :: is_new_run !< The function result, which indicates whether + !! this is a new run, based on the value of + !! filename and whether restart files exist + + if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & + "determine_is_new_run: Module must be initialized before it is used.") + if (LEN_TRIM(filename) > 1) then + CS%new_run = .false. + elseif (LEN_TRIM(filename) == 0) then + CS%new_run = .true. + elseif (filename(1:1) == 'n') then + CS%new_run = .true. + elseif (filename(1:1) == 'F') then + CS%new_run = (get_num_restart_files('r', directory, CS) == 0) + else + CS%new_run = .false. + endif + + CS%new_run_set = .true. + is_new_run = CS%new_run +end function determine_is_new_run + +!> is_new_run returns whether this is going to be a new run based on the +!! information stored in CS by a previous call to determine_is_new_run. +function is_new_run(CS) + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init + logical :: is_new_run !< The function result, which had been stored in CS during + !! a previous call to determine_is_new_run + + if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & + "is_new_run: Module must be initialized before it is used.") + if (.not.CS%new_run_set) call SIS_error(FATAL, "SIS_restart " // & + "determine_is_new_run must be called for a restart file before is_new_run.") + + is_new_run = CS%new_run +end function is_new_run + +!> open_restart_units determines the number of existing restart files and optionally opens +!! them and returns unit ids, paths and whether the files are global or spatially decomposed. +function open_restart_units(filename, directory, CS, IO_handles, file_paths) result(num_files) + character(len=*), intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), intent(in) :: directory !< The directory in which to find restart files + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init + type(file_type), dimension(:), & + optional, intent(out) :: IO_handles !< The I/O handles of all opened files + character(len=*), dimension(:), & + optional, intent(out) :: file_paths !< The full paths to the restart files + integer :: num_files !< The number of files (both automatically named restart + !! files and others explicitly in filename) that have been opened. + + ! Local variables + character(len=256) :: filepath ! The path (dir/file) to the file being opened. + character(len=256) :: fname ! The name of the current file. + character(len=8) :: suffix ! A suffix (like "_2") that is added to any + ! additional restart files. + integer :: num_restart ! The number of restart files that have already + ! been opened using their numbered suffix. + integer :: start_char ! The location of the starting character in the + ! current file name. + integer :: nf ! The number of files that have been found so far + integer :: m, length + logical :: still_looking ! If true, the code is still looking for automatically named files + logical :: fexists ! True if a file has been found + character(len=32) :: filename_appendix = '' ! Filename appendix for ensemble runs + character(len=80) :: restartname + + if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & + "open_restart_units: Module must be initialized before it is used.") + + ! Get NetCDF ids for all of the restart files. + num_restart = 0 ; nf = 0 ; start_char = 1 + do while (start_char <= len_trim(filename) ) + do m=start_char,len_trim(filename) + if (filename(m:m) == ' ') exit + enddo + fname = filename(start_char:m-1) + start_char = m + do while (start_char <= len_trim(filename)) + if (filename(start_char:start_char) == ' ') then + start_char = start_char + 1 + else + exit + endif + enddo + + if (((fname(1:1)=='r') .or. (fname(1:1)=='F')) .and. ( len_trim(fname) == 1)) then + still_looking = (num_restart <= 0) ! Avoid going through the file list twice. + do while (still_looking) + restartname = trim(CS%restartfile) + + ! Determine if there is a filename_appendix (used for ensemble runs). + call get_filename_appendix(filename_appendix) + if (len_trim(filename_appendix) > 0) then + length = len_trim(restartname) + if (restartname(length-2:length) == ".nc") then + restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//".nc" + else + restartname = restartname(1:length) //'.'//trim(filename_appendix) + endif + endif + filepath = trim(directory) // trim(restartname) + + if (num_restart < 10) then + write(suffix,'("_",I1)') num_restart + else + write(suffix,'("_",I2)') num_restart + endif + length = len_trim(filepath) + if (length < 3) then + if (num_restart > 0) filepath = trim(filepath) // suffix + filepath = trim(filepath)//".nc" + elseif (filepath(length-2:length) == ".nc") then + if (num_restart > 0) filepath = filepath(1:length-3)//trim(suffix)//".nc" + else + if (num_restart > 0) filepath = trim(filepath) // suffix + filepath = trim(filepath)//".nc" + endif + + num_restart = num_restart + 1 + ! Look for a global netCDF file. + inquire(file=filepath, exist=fexists) + if (fexists) then + nf = nf + 1 + if (present(IO_handles)) & + call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, & + threading=MULTIPLE, fileset=SINGLE_FILE) + if (present(file_paths)) file_paths(nf) = filepath + endif + + if (fexists) then + if (is_root_pe() .and. (present(IO_handles))) & + call SIS_mesg("SIS_restart: MOM run restarted using : "//trim(filepath)) + else + still_looking = .false. ; exit + endif + enddo ! while (still_looking) loop + else + filepath = trim(directory)//trim(fname) + inquire(file=filepath, exist=fexists) + if (.not. fexists) then + filepath = trim(filepath)//".nc" + inquire(file=filepath, exist=fexists) + endif + if (fexists) then + nf = nf + 1 + if (present(IO_handles)) & + call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, & + threading=MULTIPLE, fileset=SINGLE_FILE) + if (present(file_paths)) file_paths(nf) = filepath + if (is_root_pe() .and. (present(IO_handles))) & + call SIS_mesg("SIS_restart: MOM run restarted using : "//trim(filepath)) + else + if (present(IO_handles)) & + call SIS_error(WARNING,"SIS_restart: Unable to find restart file : "//trim(filepath)) + endif + + endif + enddo ! while (start_char < len_trim(filename)) loop + num_files = nf + +end function open_restart_units + +!> get_num_restart_files returns the number of existing restart files that match the provided +!! directory structure and other information stored in the control structure and optionally +!! also provides the full paths to these files. +function get_num_restart_files(filenames, directory, CS) result(num_files) + character(len=*), intent(in) :: filenames !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), intent(in) :: directory !< The directory in which to find restart files + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init + integer :: num_files !< The function result, the number of files (both automatically named + !! restart files and others explicitly in filename) that have been opened + + if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & + "get_num_restart_files: Module must be initialized before it is used.") + + ! This call uses open_restart_units without the optional arguments needed to actually + ! open the files to determine the number of restart files. + num_files = open_restart_units(filenames, directory, CS) + +end function get_num_restart_files + + !> Initialize and set up a restart control structure. -subroutine SIS_restart_init(CS, filename, domain, use_FMS2) - type(SIS_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object that is allocated here +subroutine SIS_restart_init(CS, filename, domain, param_file, use_FMS2) + type(SIS_restart_CS), pointer :: CS !< A pointer to a SIS_restart_CS object that is allocated here character(len=*), intent(in) :: filename !< The path to the restart file. type(MOM_domain_type), intent(in) :: domain !< The MOM domain descriptor being used + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: use_FMS2 !< If true use the FMS2 variant of calls. if (associated(CS)) then @@ -110,7 +342,7 @@ subroutine SIS_restart_init(CS, filename, domain, use_FMS2) allocate(CS) allocate(CS%fms_restart) - CS%restart_file = trim(filename) + CS%restartfile = trim(filename) CS%mpp_domain => domain%mpp_domain CS%use_FMS2 = .false. ; if (present(use_FMS2)) CS%use_FMS2 = use_FMS2 @@ -152,7 +384,7 @@ subroutine register_restart_field_4d(CS, name, f_ptr, longname, units, position, if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, longname=longname, & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, longname=longname, & units=units, mandatory=mandatory, & domain=CS%mpp_domain, position=position) else @@ -202,7 +434,7 @@ subroutine register_restart_field_3d(CS, name, f_ptr, longname, units, position, if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, longname=longname, & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, longname=longname, & units=units, mandatory=mandatory, & domain=CS%mpp_domain, position=position) else @@ -246,7 +478,7 @@ subroutine register_restart_field_2d(CS, name, f_ptr, units, longname, position, if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, longname=longname, & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, longname=longname, & units=units, mandatory=mandatory, & domain=CS%mpp_domain, position=position) @@ -284,7 +516,7 @@ subroutine register_restart_field_1d(CS, name, f_ptr, longname, units, dim_name, if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, longname=longname, & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, longname=longname, & units=units, mandatory=mandatory, no_domain=.true.) else call SIS_error(FATAL, "register_restart_field_1d: The SIS_framework code does not work with FMS2 yet.") @@ -322,7 +554,7 @@ subroutine register_restart_field_0d(CS, name, f_ptr, longname, units, mandatory if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, longname=longname, & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, longname=longname, & units=units, mandatory=mandatory, no_domain=.true.) else call SIS_error(FATAL, "register_restart_field_0d: The SIS_framework code does not work with FMS2 yet.") @@ -357,12 +589,12 @@ subroutine register_restart_coupler_type_3d(CS, bc_ptr, varname_prefix, mandator if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - call coupler_type_register_restarts(bc_ptr, CS%restart_file, CS%fms_restart, mpp_domain=CS%mpp_domain, & + call coupler_type_register_restarts(bc_ptr, CS%restartfile, CS%fms_restart, mpp_domain=CS%mpp_domain, & varname_prefix=varname_prefix) else call SIS_error(FATAL, "register_restart_field_3d: The SIS_framework code does not work with FMS2 yet.") ! This is the FMS2 variant of this call. - call coupler_type_register_restarts(bc_ptr, CS%restart_file, CS%fms_restart, mpp_domain=CS%mpp_domain, & + call coupler_type_register_restarts(bc_ptr, CS%restartfile, CS%fms_restart, mpp_domain=CS%mpp_domain, & varname_prefix=varname_prefix) endif @@ -390,12 +622,12 @@ subroutine register_restart_coupler_type_2d(CS, bc_ptr, varname_prefix, mandator if (.not.CS%use_FMS2) then ! This is the FMS1 variant of this call. - call coupler_type_register_restarts(bc_ptr, CS%restart_file, CS%fms_restart, mpp_domain=CS%mpp_domain, & + call coupler_type_register_restarts(bc_ptr, CS%restartfile, CS%fms_restart, mpp_domain=CS%mpp_domain, & varname_prefix=varname_prefix) else call SIS_error(FATAL, "register_restart_field_2d: The SIS_framework code does not work with FMS2 yet.") ! This is the FMS2 variant of this call. - call coupler_type_register_restarts(bc_ptr, CS%restart_file, CS%fms_restart, mpp_domain=CS%mpp_domain, & + call coupler_type_register_restarts(bc_ptr, CS%restartfile, CS%fms_restart, mpp_domain=CS%mpp_domain, & varname_prefix=varname_prefix) endif @@ -424,10 +656,10 @@ subroutine only_read_restart_field_4d(CS, name, f_ptr, position, directory, doma if (.not.CS%use_FMS2) then if (present(domain)) then - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, read_only=.true., & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, read_only=.true., & domain=domain%mpp_domain, mandatory=.false., position=position) else - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, read_only=.true., & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, read_only=.true., & domain=CS%mpp_domain, mandatory=.false., position=position) endif call FMS1_restore_state(CS%fms_restart, idr, directory=directory) @@ -437,8 +669,8 @@ subroutine only_read_restart_field_4d(CS, name, f_ptr, position, directory, doma if (present(success)) success = .false. call SIS_error(FATAL, "only_read_restart_field_4d: The SIS_framework code does not work with FMS2 yet.") - full_path = trim(CS%restart_file) - if (present(directory)) full_path = trim(slasher(directory))//CS%restart_file + full_path = trim(CS%restartfile) + if (present(directory)) full_path = trim(slasher(directory))//CS%restartfile ! if (present(domain)) then ! opened = open_file(file_ptr, full_path, "read", domain%mpp_domain) ! else @@ -473,10 +705,10 @@ subroutine only_read_restart_field_3d(CS, name, f_ptr, position, directory, doma if (.not.CS%use_FMS2) then if (present(domain)) then - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, read_only=.true., & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, read_only=.true., & domain=domain%mpp_domain, mandatory=.false., position=position) else - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, read_only=.true., & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, read_only=.true., & domain=CS%mpp_domain, mandatory=.false., position=position) endif call FMS1_restore_state(CS%fms_restart, idr, directory=directory) @@ -486,8 +718,8 @@ subroutine only_read_restart_field_3d(CS, name, f_ptr, position, directory, doma if (present(success)) success = .false. call SIS_error(FATAL, "only_read_restart_field_3d: The SIS_framework code does not work with FMS2 yet.") - full_path = trim(CS%restart_file) - if (present(directory)) full_path = trim(slasher(directory))//CS%restart_file + full_path = trim(CS%restartfile) + if (present(directory)) full_path = trim(slasher(directory))//CS%restartfile ! if (present(domain)) then ! opened = open_file(file_ptr, full_path, "read", domain%mpp_domain) ! else @@ -522,10 +754,10 @@ subroutine only_read_restart_field_2d(CS, name, f_ptr, position, directory, doma if (.not.CS%use_FMS2) then if (present(domain)) then - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, read_only=.true., & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, read_only=.true., & domain=domain%mpp_domain, mandatory=.false., position=position) else - idr = FMS1_register_restart(CS%fms_restart, CS%restart_file, name, f_ptr, read_only=.true., & + idr = FMS1_register_restart(CS%fms_restart, CS%restartfile, name, f_ptr, read_only=.true., & domain=CS%mpp_domain, mandatory=.false., position=position) endif call FMS1_restore_state(CS%fms_restart, idr, directory=directory) @@ -535,8 +767,8 @@ subroutine only_read_restart_field_2d(CS, name, f_ptr, position, directory, doma if (present(success)) success = .false. call SIS_error(FATAL, "only_read_restart_field_2d: The SIS_framework code does not work with FMS2 yet.") - full_path = trim(CS%restart_file) - if (present(directory)) full_path = trim(slasher(directory))//CS%restart_file + full_path = trim(CS%restartfile) + if (present(directory)) full_path = trim(slasher(directory))//CS%restartfile ! if (present(domain)) then ! opened = open_file(file_ptr, full_path, "read", domain%mpp_domain) ! else @@ -550,38 +782,31 @@ subroutine only_read_restart_field_2d(CS, name, f_ptr, position, directory, doma end subroutine only_read_restart_field_2d -!> query_initialized_name determines whether a named field has been successfully -!! read from a restart file yet. -function query_initialized(CS, name) result(query_init) +!> query_initialized determines whether a named field has been successfully read from a restart file yet. +logical function query_initialized(CS, name) type(SIS_restart_CS), pointer :: CS !< A pointer to a SIS_restart_CS object (intent in) character(len=*), intent(in) :: name !< The name of the field that is being queried - logical :: query_init !< The returned value, set to true if the named field has been - !! read from a restart file ! This subroutine returns .true. if the field referred to by name has ! initialized from a restart file, and .false. otherwise. if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & "query_initialized: Module must be initialized before it is used.") - query_init = FMS1_query_initialized(CS%fms_restart, name) + query_initialized = FMS1_query_initialized(CS%fms_restart, name) end function query_initialized !> query_inited determines whether a named field has been successfully read from a restart file yet. !! It is identical to query_initialized, but has a separate name to deal with an unexplained !! problem that the pgi compiler has with reused function names between modules. -function query_inited(CS, name) result(query_initialized) +logical function query_inited(CS, name) type(SIS_restart_CS), pointer :: CS !< A pointer to a SIS_restart_CS object (intent in) character(len=*), intent(in) :: name !< The name of the field that is being queried - logical :: query_initialized !< The returned value, set to true if the named field has been - !! read from a restart file - ! This subroutine returns .true. if the field referred to by name has - ! initialized from a restart file, and .false. otherwise. if (.not.associated(CS)) call SIS_error(FATAL, "SIS_restart " // & - "query_initialized: Module must be initialized before it is used.") + "query_inited: Module must be initialized before it is used.") - query_initialized = FMS1_query_initialized(CS%fms_restart, name) + query_inited = FMS1_query_initialized(CS%fms_restart, name) end function query_inited @@ -609,31 +834,47 @@ end subroutine axis_names_from_pos !> save_restart saves all registered variables to restart files. -subroutine save_restart(CS, time_stamp) - type(SIS_restart_CS), pointer :: CS !< A pointer to a SIS_restart_CS object (intent in) - character(len=*), optional , intent(in) :: time_stamp !< A date stamp to use in the restart file name - - call save_restart_FMS1(CS%fms_restart, time_stamp) +subroutine save_restart(directory, time, G, CS, IG, time_stamp) + character(len=*), intent(in) :: directory !< The directory where the restart files + !! are to be written + type(time_type), intent(in) :: time !< The current model time + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init + type(ice_grid_type), & + optional, intent(in) :: IG !< The sea-ice grid type + character(len=*), optional, intent(in) :: time_stamp !< A date stamp to include in the restart file name + + ! Several of the arguments are not needed here, but they will be needed with the new stand-alone SIS2 + ! restart capabilities. + call save_restart_FMS1(CS%fms_restart, time_stamp=time_stamp, directory=directory) end subroutine save_restart !> Restore the entire state of the sea ice or a single varable using a SIS_restart control structure. -subroutine restore_SIS_state(CS, directory) - type(SIS_restart_CS), pointer :: CS !< A pointer to a SIS_restart_CS object (intent in) - character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. +subroutine restore_SIS_state(CS, directory, filelist, G) + type(SIS_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to SIS_restart_init with restart fields + !! already set by calls to register_restart_field + character(len=*), intent(in) :: directory !< The directory in which to find restart files + character(len=*), intent(in) :: filelist !< The list of restart file names or just + !! 'r' or 'F' to read automatically named files + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + + if ((len_trim(filelist) == 1) .and. (filelist(1:1) == 'n')) & + call SIS_error(FATAL, "restore_SIS_state called for a new run.") call FMS1_restore_state(CS%fms_restart, directory=directory) end subroutine restore_SIS_state -!> Deallocate memory associated with a MOM_restart_CS variable. +!> Deallocate memory associated with a SIS_restart_CS variable. subroutine SIS_restart_end(CS) - type(SIS_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object + type(SIS_restart_CS), pointer :: CS !< A pointer to a SIS_restart_CS object if (associated(CS%fms_restart)) deallocate(CS%fms_restart) deallocate(CS) end subroutine SIS_restart_end - end module SIS_framework diff --git a/src/ice_model.F90 b/src/ice_model.F90 index e50f9979..9e00b256 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -75,6 +75,7 @@ module ice_model_mod use SIS_fast_thermo, only : infill_array, SIS_fast_thermo_init, SIS_fast_thermo_end use SIS_framework, only : set_domain, nullify_domain, broadcast_domain use SIS_framework, only : restore_SIS_state, query_initialized=>query_inited, SIS_restart_init +use SIS_framework, only : determine_is_new_run, is_new_run use SIS_framework, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type use SIS_framework, only : coupler_type_spawn, coupler_type_initialized use SIS_framework, only : coupler_type_rescale_data, coupler_type_copy_data @@ -1649,7 +1650,6 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, integer :: i, j, k, l, i2, j2, k2, i_off, j_off, n integer :: isc, iec, jsc, jec, nCat_dflt character(len=120) :: restart_file, fast_rest_file - character(len=240) :: restart_path, fast_rest_path character(len=40) :: mdl = "ice_model" ! This module's name. character(len=8) :: nstr type(directories) :: dirs ! A structure containing several relevant directory paths. @@ -1717,8 +1717,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! answers at roundoff. integer :: CatIce, NkIce, isd, ied, jsd, jed - integer :: idr, id_sal - integer :: write_geom + integer :: write_geom ! A flag indicating whether to write the grid geometry files only for + ! new runs (1), both new runs and restarts (2) or neither (0). logical :: nudge_sea_ice ! If true, nudge sea ice concentrations towards observations. logical :: transmute_ice ! If true, allow ice to be transmuted directly into seawater with a ! spatially varying rate as a form of outflow open boundary condition. @@ -1728,6 +1728,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, logical :: do_ridging logical :: specified_ice ! If true, the ice is specified and there is no dynamics. logical :: Cgrid_dyn + logical :: new_sim ! If true, this is a new simulation, based on the contents of dirs and + ! the presence or absence of a named restart file. logical :: slab_ice ! If true, use the very old slab ice thermodynamics, ! with effectively zero heat capacity of ice and snow. logical :: debug, debug_slow, debug_fast, bounds_check @@ -1970,6 +1972,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, "If =1, write the geometry and vertical grid files only for "//& "a new simulation. If =2, always write the geometry and "//& "vertical grid files. Other values are invalid.", default=1) + if (write_geom<0 .or. write_geom>2) call SIS_error(FATAL,"SIS2: "//& + "WRITE_GEOM must be equal to 0, 1 or 2.") call get_param(param_file, "MOM", "INTERPOLATE_FLUXES", interp_fluxes, & "If true, interpolate a linearized version of the fast "//& "fluxes into arealess categories.", default=.true.) @@ -1977,10 +1981,6 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, "If true, recalculate the thermal updates from the fast "//& "dynamics on the slowly evolving ice state, rather than "//& "copying over the slow ice state to the fast ice state.", default=Concurrent) - if (write_geom<0 .or. write_geom>2) call SIS_error(FATAL,"SIS2: "//& - "WRITE_GEOM must be equal to 0, 1 or 2.") - write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. & - ((dirs%input_filename(1:1)=='n') .and. (LEN_TRIM(dirs%input_filename)==1)))) call get_param(param_file, mdl, "NUDGE_SEA_ICE", nudge_sea_ice, & "If true, constrain the sea ice concentrations using observations.", & @@ -2072,6 +2072,13 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call create_dyn_horgrid(dG, sHI) !, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(sGD, dG%Domain) + ! Set up the restart file and determine whether this is a new simulation. + call set_domain(sGD%mpp_domain) + if (.not.associated(Ice%Ice_restart)) & + call SIS_restart_init(Ice%Ice_restart, restart_file, sGD, param_file) + new_sim = determine_is_new_run(dirs%input_filename, dirs%restart_input_dir, Ice%Ice_restart) + write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. new_sim)) + ! Set the bathymetry, Coriolis parameter, open channel widths and masks. call SIS_initialize_fixed(dG, US, param_file, write_geom_files, dirs%output_directory) @@ -2082,10 +2089,6 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! Allocate and register fields for restarts. - call set_domain(sGD%mpp_domain) - if (.not.associated(Ice%Ice_restart)) & - call SIS_restart_init(Ice%Ice_restart, restart_file, sGD) - call ice_type_slow_reg_restarts(sGD%mpp_domain, CatIce, & param_file, Ice, Ice%Ice_restart) @@ -2229,7 +2232,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, if (.not.slow_ice_PE) call set_domain(fGD%mpp_domain) if (split_restart_files) then if (.not.associated(Ice%Ice_fast_restart)) & - call SIS_restart_init(Ice%Ice_fast_restart, fast_rest_file, fGD) + call SIS_restart_init(Ice%Ice_fast_restart, fast_rest_file, fGD, param_file) else Ice%Ice_fast_restart => Ice%Ice_restart endif @@ -2288,15 +2291,14 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, endif - ! Read the restart file, if it exists, and initialize the ice arrays to - ! to default values if it does not. + ! Read the restart file, if it exists and reading it is indicated by the value of dirs%input_filename, + ! and initialize the ice arrays to default values using other methods if it does not. if (slow_ice_PE) then ! Set some pointers for convenience. sIST => Ice%sCS%IST ; sIG => Ice%sCS%IG ; sG => Ice%sCS%G - restart_path = trim(dirs%restart_input_dir)//trim(restart_file) - - if (file_exists(restart_path)) then + new_sim = is_new_run(Ice%Ice_restart) + if (.not.new_sim) then call callTree_enter("ice_model_init():restore_from_restart_files "//trim(restart_file)) ! Set values of IG%H_to_kg_m2 that will permit its absence from the restart ! file to be detected, and its difference from the value in this run to @@ -2306,7 +2308,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, is_restart = .true. recategorize_ice = .false. ! Assume that the ice is already in the right thickness categories. - call restore_SIS_state(Ice%Ice_restart, directory=dirs%restart_input_dir) + call restore_SIS_state(Ice%Ice_restart, dirs%restart_input_dir, dirs%input_filename, sG) ! If the velocity and other fields have not been initialized, check for ! the fields that would have been read if symmetric were toggled. @@ -2360,7 +2362,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, endif call callTree_leave("ice_model_init():restore_from_restart_files") - endif ! file_exists(restart_path) + endif ! End of (.not.new_sim) ! If there is not a restart file, initialize the ice another way, perhaps with no ice. ! If there is a restart file, the following two calls are just here to read and log parameters. @@ -2533,12 +2535,12 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, fG => Ice%fCS%G ; fGD => Ice%fCS%G%Domain if ((.not.slow_ice_PE) .or. split_restart_files) then - ! Read the fast restart file, if it exists. - fast_rest_path = trim(dirs%restart_input_dir)//trim(fast_rest_file) - if (file_exists(fast_rest_path)) then - call restore_SIS_state(Ice%Ice_fast_restart, directory=dirs%restart_input_dir) + ! Read the fast restart file, if it exists and this is indicated by the value of dirs%input_filename. + new_sim = determine_is_new_run(dirs%input_filename, dirs%restart_input_dir, Ice%Ice_fast_restart) + if (.not.new_sim) then + call restore_SIS_state(Ice%Ice_restart, dirs%restart_input_dir, dirs%input_filename, fG) init_coszen = .not.query_initialized(Ice%Ice_fast_restart, 'coszen') - init_Tskin = .not.query_initialized(Ice%Ice_fast_restart, 'T_skin') + init_Tskin = .not.query_initialized(Ice%Ice_fast_restart, 'T_skin') init_rough = .not.(query_initialized(Ice%Ice_fast_restart, 'rough_mom') .and. & query_initialized(Ice%Ice_fast_restart, 'rough_heat') .and. & query_initialized(Ice%Ice_fast_restart, 'rough_moist')) @@ -2555,7 +2557,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! if (Ice%fCS%Rad%add_diurnal_sw .or. Ice%fCS%Rad%do_sun_angle_for_alb) then ! call set_domain(fGD%mpp_domain) - call astronomy_init + call astronomy_init() ! call nullify_domain() ! endif diff --git a/src/ice_type.F90 b/src/ice_type.F90 index a49d11e8..848fa533 100644 --- a/src/ice_type.F90 +++ b/src/ice_type.F90 @@ -153,6 +153,8 @@ module ice_type_mod !< A pointer to the slow ice restart control structure type(SIS_restart_CS), pointer :: Ice_fast_restart => NULL() !< A pointer to the fast ice restart control structure + character(len=240) :: restart_output_dir = './RESTART/' + !< The directory into which to write restart files. end type ice_data_type ! ice_public_type contains @@ -503,13 +505,16 @@ subroutine ice_model_restart(Ice, time_stamp) character(len=*), optional, intent(in) :: time_stamp !< A date stamp to include in the restart file name if (associated(Ice%Ice_restart)) then - call save_restart(Ice%Ice_restart, time_stamp) + call save_restart(Ice%restart_output_dir, Ice%Time, Ice%sCS%G, Ice%Ice_restart, IG=Ice%sCS%IG, & + time_stamp=time_stamp) if (associated(Ice%Ice_fast_restart)) then - if (.not.associated(Ice%Ice_fast_restart,Ice%Ice_restart)) & - call save_restart(Ice%Ice_fast_restart, time_stamp) + if (.not.associated(Ice%Ice_fast_restart, Ice%Ice_restart)) & + call save_restart(Ice%restart_output_dir, Ice%Time, Ice%fCS%G, Ice%Ice_fast_restart, & + IG=Ice%fCS%IG, time_stamp=time_stamp) endif elseif (associated(Ice%Ice_fast_restart)) then - call save_restart(Ice%Ice_fast_restart, time_stamp) + call save_restart(Ice%restart_output_dir, Ice%Time, Ice%fCS%G, Ice%Ice_fast_restart, & + IG=Ice%fCS%IG, time_stamp=time_stamp) endif call icebergs_save_restart(Ice%icebergs, time_stamp)