diff --git a/full/cheat_mode_mod.F90 b/full/cheat_mode_mod.F90 new file mode 100644 index 00000000..cb73c140 --- /dev/null +++ b/full/cheat_mode_mod.F90 @@ -0,0 +1,87 @@ +!*********************************************************************** +!* Apache License 2.0 +!* +!* This file is part of the GFDL Flexible Modeling System (FMS) Coupler. +!* +!* Licensed under the Apache License, Version 2.0 (the "License"); +!* you may not use this file except in compliance with the License. +!* You may obtain a copy of the License at +!* +!* http://www.apache.org/licenses/LICENSE-2.0 +!* +!* FMS Coupler is distributed in the hope that it will be useful, but +!* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied; +!* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +!* PARTICULAR PURPOSE. See the License for the specific language +!* governing permissions and limitations under the License. +!*********************************************************************** + +!> @defgroup cheat_mode_mod cheat_mode_mod +!> @ingroup cheat_mode_mod +!> @brief Generate or extract a tarball containing the final contents of a run directory. +!! +!> This module supports "cheat mode", so that the workflow can be tested without the +!! computational cost of an actual model run. A directory is supplied via the +!! `cheat_mode_nml` namelist: if a tarball is found in this directory corresponding +!! to the date range of the current segment, `cheat_mode_invoke` will extract this +!! tarball; otherwise, it will generate it from the content of the run directory. + +#ifdef CHEAT_MODE + +module cheat_mode_mod + use FMS + use platform_mod, only: FMS_PATH_LEN + implicit none + private + + public :: cheat_mode_tarball_exists, cheat_mode_tarball_path, cheat_mode_init, cheat_mode_invoke + + logical :: cheat_mode_tarball_exists !< Whether to extract (true) or generate (false) a tarball + character(FMS_PATH_LEN) :: cheat_mode_tarball_path !< Path to the tarball to be extracted or created + character(FMS_PATH_LEN) :: dir !< Directory containing the tarballs + + namelist /cheat_mode_nml/ dir + +!> @addtogroup cheat_mode_mod +!> @{ + +contains + + !> Initialize cheat mode. Determine the path to the tarball from `cheat_mode_nml` and + !! from the date range of the current segment. + subroutine cheat_mode_init(year0, month0, day0, year1, month1, day1) + integer, intent(in) :: year0, month0, day0 !< Initial year, month, and day of the current segment + integer, intent(in) :: year1, month1, day1 !< Final year, month, and day of the current segment + integer :: io_status + + read (fms_mpp_input_nml_file, cheat_mode_nml, iostat=io_status) + io_status = fms_check_nml_error(io_status, "cheat_mode_nml") + + write (cheat_mode_tarball_path, '(A,"/",I0.4,I0.2,I0.2,"_",I0.4,I0.2,I0.2,".tar")') & + trim(dir), year0, month0, day0, year1, month1, day1 + inquire (file=trim(cheat_mode_tarball_path), exist=cheat_mode_tarball_exists) + end subroutine + + !> Invoke the tar command to either create or extract the tarball. This subroutine + !! should only be called by the root PE. + subroutine cheat_mode_invoke + integer :: exitstat + + if (cheat_mode_tarball_exists) then + call execute_command_line("tar -xf " // trim(cheat_mode_tarball_path) // & + " --touch --overwrite", exitstat=exitstat) + else + call execute_command_line("tar -cf " // trim(cheat_mode_tarball_path) // & + " `find . -type f -newer input.nml | xargs`", exitstat=exitstat) + endif + + if (exitstat.ne.0) then + call fms_error_mesg("cheat mode", "tar command failed", FATAL) + endif + end subroutine cheat_mode_invoke +end module cheat_mode_mod + +#endif + +!> @} +! close documentation grouping diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index ffd4f738..9f362a7e 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -336,6 +336,10 @@ program coupler_main use FMS use full_coupler_mod +#ifdef CHEAT_MODE + use cheat_mode_mod, only: cheat_mode_invoke +#endif + implicit none !> model defined types. @@ -687,4 +691,10 @@ program coupler_main !----------------------------------------------------------------------- +#ifdef CHEAT_MODE + if (fms_mpp_pe().eq.fms_mpp_root_pe()) then + call cheat_mode_invoke + endif +#endif + end program coupler_main diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 445ef77b..7d7e3258 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -28,6 +28,10 @@ module full_coupler_mod use fms_io_mod, only: fms_io_exit #endif +#ifdef CHEAT_MODE + use cheat_mode_mod, only: cheat_mode_init, cheat_mode_tarball_exists, cheat_mode_tarball_path +#endif + ! model interfaces used to couple the component models: ! atmosphere, land, ice, and ocean ! @@ -1150,6 +1154,19 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, //trim(walldate)//' '//trim(walltime) endif +!----------------------------------------------------------------------- + +#ifdef CHEAT_MODE + call cheat_mode_init(date_init(1), date_init(2), date_init(3), date(1), date(2), date(3)) + + if (cheat_mode_tarball_exists) then + call fms_error_mesg("cheat mode", "Results tarball will be extracted: " // trim(cheat_mode_tarball_path), NOTE) + num_cpld_calls = 0 + else + call fms_error_mesg("cheat mode", "Results tarball will be created: " // trim(cheat_mode_tarball_path), NOTE) + endif +#endif + end subroutine coupler_init !#######################################################################