├── cime_config ├── testdefs │ ├── testmods_dirs │ │ └── rtm │ │ │ ├── rtmOff │ │ │ ├── include_user_mods │ │ │ ├── user_nl_rtm │ │ │ └── shell_commands │ │ │ ├── rtmOnIceOff │ │ │ ├── include_user_mods │ │ │ ├── user_nl_rtm │ │ │ └── shell_commands │ │ │ ├── rtmOnIceOn │ │ │ ├── include_user_mods │ │ │ ├── user_nl_rtm │ │ │ └── shell_commands │ │ │ ├── rtmColdStart │ │ │ ├── include_user_mods │ │ │ └── user_nl_rtm │ │ │ ├── rtmOnFloodOnEffvelOff │ │ │ ├── include_user_mods │ │ │ ├── user_nl_rtm │ │ │ └── shell_commands │ │ │ ├── rtmOnFloodOnEffvelOn │ │ │ ├── include_user_mods │ │ │ ├── user_nl_rtm │ │ │ └── shell_commands │ │ │ └── default │ │ │ └── user_nl_rtm │ └── testlist_rtm.xml ├── user_nl_rtm ├── config_archive.xml ├── config_component.xml ├── buildlib ├── namelist_definition_rtm.xml └── buildnml ├── .gitignore ├── README.rst ├── src ├── riverroute │ ├── RtmFinalizeAll.F90 │ ├── RtmDateTime.F90 │ ├── RtmSpmd.F90 │ ├── RtmFileUtils.F90 │ ├── RtmHistFlds.F90 │ ├── RtmVar.F90 │ ├── RunoffMod.F90 │ ├── RtmRestFile.F90 │ └── RtmTimeManager.F90 └── cpl │ └── nuopc │ ├── rof_import_export.F90 │ └── rof_comp_nuopc.F90 ├── LICENSE ├── docs └── release-cesm2.0.ChangeLog └── CODE_OF_CONDUCT.md /cime_config/testdefs/testmods_dirs/rtm/rtmOff/include_user_mods: -------------------------------------------------------------------------------- 1 | ../default 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnIceOff/include_user_mods: -------------------------------------------------------------------------------- 1 | ../default 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnIceOn/include_user_mods: -------------------------------------------------------------------------------- 1 | ../default 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmColdStart/include_user_mods: -------------------------------------------------------------------------------- 1 | ../default 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmColdStart/user_nl_rtm: -------------------------------------------------------------------------------- 1 | finidat_rtm = ' ' 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnFloodOnEffvelOff/include_user_mods: -------------------------------------------------------------------------------- 1 | ../default 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnFloodOnEffvelOn/include_user_mods: -------------------------------------------------------------------------------- 1 | ../default 2 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOff/user_nl_rtm: -------------------------------------------------------------------------------- 1 | &rtm_inparm 2 | rtm_effvel = 'NULL' 3 | ice_runoff = .false. 4 | / 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnIceOff/user_nl_rtm: -------------------------------------------------------------------------------- 1 | &rtm_inparm 2 | rtm_effvel = 'ACTIVE' 3 | ice_runoff = .false. 4 | / 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnIceOn/user_nl_rtm: -------------------------------------------------------------------------------- 1 | &rtm_inparm 2 | rtm_effvel = 'ACTIVE' 3 | ice_runoff = .true. 4 | / 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/default/user_nl_rtm: -------------------------------------------------------------------------------- 1 | rtmhist_ndens = 1,1,1 2 | rtmhist_nhtfrq =-24,-8 3 | rtmhist_mfilt = 1,1 4 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnFloodOnEffvelOff/user_nl_rtm: -------------------------------------------------------------------------------- 1 | &rtm_inparm 2 | rtm_effvel = 'ACTIVE' 3 | ice_runoff = .true. 4 | / 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnFloodOnEffvelOn/user_nl_rtm: -------------------------------------------------------------------------------- 1 | &rtm_inparm 2 | rtm_effvel = 'ACTIVE' 3 | ice_runoff = .true. 4 | / 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOff/shell_commands: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ./xmlchange RTM_MODE="NULL" 4 | ./xmlchange RTM_FLOOD_MODE="NULL" 5 | 6 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnIceOff/shell_commands: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ./xmlchange RTM_MODE="ACTIVE" 4 | ./xmlchange RTM_FLOOD_MODE="NULL" 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnIceOn/shell_commands: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ./xmlchange RTM_MODE="ACTIVE" 4 | ./xmlchange RTM_FLOOD_MODE="NULL" 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnFloodOnEffvelOff/shell_commands: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ./xmlchange RTM_MODE="ACTIVE" 4 | ./xmlchange RTM_FLOOD_MODE="ACTIVE" 5 | -------------------------------------------------------------------------------- /cime_config/testdefs/testmods_dirs/rtm/rtmOnFloodOnEffvelOn/shell_commands: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ./xmlchange RTM_MODE="ACTIVE" 4 | ./xmlchange RTM_FLOOD_MODE="ACTIVE" 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # ignore svn directories 2 | **/.svn/** 3 | .svn/ 4 | 5 | # binary files 6 | *.nc 7 | 8 | # editor files 9 | *.swp 10 | *~ 11 | 12 | # mac files 13 | .DS_Store 14 | 15 | # cmake generated files 16 | build/ 17 | CMakeFiles/ 18 | 19 | # don't ignore cism build utilities directory 20 | !components/cism/**/build 21 | 22 | # build output 23 | *.o 24 | *.mod 25 | core.* 26 | *.gz 27 | *.log 28 | cime_config/buildnmlc 29 | __pycache__ 30 | 31 | # test and case directories 32 | tests/ 33 | scripts/testreporter.pl 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /cime_config/user_nl_rtm: -------------------------------------------------------------------------------- 1 | !---------------------------------------------------------------------------------- 2 | ! Users should add all user specific namelist changes below in the form of 3 | ! namelist_var = new_namelist_value 4 | ! NOTE: namelist variable rtm_tstep CAN ONLY be changed by modifying the value 5 | ! of the xml variable ROF_NCPL in env_run.xml 6 | ! NOTE: if the xml variable RTM_MODE in env_run.xml is set to 'NULL', then 7 | ! then rtm will set rtm_present to .false. - and will ignore everything else 8 | !---------------------------------------------------------------------------------- 9 | 10 | 11 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | ===================== 2 | River Transport Model 3 | ===================== 4 | 5 | The River Transport Model, RTM, is part of the Community Earth System Model (CESM). 6 | It is managed by the Land Model Working Group (LMWG) as a part of CESM. 7 | 8 | See the CESM web site for documentation and information: 9 | 10 | http://www.cesm.ucar.edu 11 | 12 | **IMPORTANT NOTE: RTM is only used for Paleo work -- use MOSART or mizuRoute otherwise** 13 | 14 | RTM is part of CESM3, but it's only supported use is for Paleo 15 | work, and other uses should use MOSART. 16 | 17 | **IMPORTANT NOTE: RTM's planned successor is mizuRoute** 18 | 19 | Longer term RTM will be removed in future versions of CESM and the new model 20 | mizuRoute will be used for Paleo work. 21 | 22 | -------------------------------------------------------------------------------- /src/riverroute/RtmFinalizeAll.F90: -------------------------------------------------------------------------------- 1 | module RtmFinalizeAll 2 | 3 | ! 4 | ! gateway to other Rtm routines to clean up memory. Called from: 5 | ! 6 | ! rof_comp_esmf::rof_final_esmf 7 | ! 8 | 9 | implicit none 10 | private 11 | 12 | public :: RtmFinalizeMemory ! other Rtm routines to clean up memory 13 | 14 | contains 15 | 16 | subroutine RtmFinalizeMemory 17 | 18 | !----------------------------------------------------------------------- 19 | use RunoffMod , only : RunoffFinalize 20 | use RtmMod , only : RtmFinalize 21 | use RtmRestFile, only : RtmRestFinalize 22 | use RtmHistFile , only : RtmHistFileFinalize 23 | use RtmTimeManager, only : timemgr_finalize 24 | use RtmVar, only : rtm_active 25 | !----------------------------------------------------------------------- 26 | implicit none 27 | 28 | ! 29 | ! deal with clean up of memory for parts of RTM here 30 | ! 31 | if (rtm_active) then 32 | 33 | call RtmFinalize() 34 | call RunoffFinalize() 35 | call RtmRestFinalize() 36 | call RtmHistFileFinalize() 37 | ! 38 | ! clean up ESMF clock memory here. There is no 39 | ! equivalent for rof_final_esmf. 40 | ! For further info. please see comments in 41 | ! RtmTimeManager.F90::timemgr_finalize 42 | ! 43 | call timemgr_finalize() 44 | 45 | end if 46 | 47 | end subroutine RtmFinalizeMemory 48 | 49 | end module RtmFinalizeAll 50 | -------------------------------------------------------------------------------- /cime_config/config_archive.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | r 5 | rh\da 6 | rh\di 7 | h\d*.*\.nc$ 8 | e 9 | locfnh 10 | 11 | rpointer.rof$NINST_STRING.$DATENAME 12 | $CASE.rtm$NINST_STRING.r.$DATENAME.nc 13 | 14 | 15 | rpointer.rof.1976-01-01-00000 16 | rpointer.rof.1976-01-02-00000 17 | rpointer.rof_9999.1976-01-01-00000 18 | casename.rtm.r.1976-01-01-00000.nc 19 | casename.rtm.rh4a.1976-01-01-00000.nc 20 | casename.rtm.rh4i.1976-01-01-00000.nc 21 | casename.rtm.h0a.1976-01-01-00000.nc 22 | casename.rtm.h0i.1976-01-01-00000.nc 23 | casename.rtm.h0a.1976-01-01-00000.nc.base 24 | casename.rtm.h0i.1976-01-01-00000.nc.base 25 | 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /src/riverroute/RtmDateTime.F90: -------------------------------------------------------------------------------- 1 | module RtmDateTime 2 | 3 | contains 4 | 5 | !----------------------------------------------------------------------- 6 | !BOP 7 | ! 8 | ! !ROUTINE: getdatetime 9 | ! 10 | ! !INTERFACE: 11 | subroutine getdatetime (cdate, ctime) 12 | ! 13 | ! !DESCRIPTION: 14 | ! A generic Date and Time routine 15 | ! 16 | ! !USES: 17 | use RtmSpmd, only : mpicom_rof, masterproc, MPI_CHARACTER 18 | ! !ARGUMENTS: 19 | implicit none 20 | character(len=8), intent(out) :: cdate !current date 21 | character(len=8), intent(out) :: ctime !current time 22 | ! 23 | ! !REVISION HISTORY: 24 | ! Created by Mariana Vertenstein 25 | ! 26 | ! 27 | ! !LOCAL VARIABLES: 28 | !EOP 29 | character(len=8) :: date !current date 30 | character(len=10) :: time !current time 31 | character(len=5) :: zone !zone 32 | integer, dimension(8) :: values !temporary 33 | integer :: ier !MPI error code 34 | !----------------------------------------------------------------------- 35 | if (masterproc) then 36 | 37 | call date_and_time (date, time, zone, values) 38 | 39 | cdate(1:2) = date(5:6) 40 | cdate(3:3) = '/' 41 | cdate(4:5) = date(7:8) 42 | cdate(6:6) = '/' 43 | cdate(7:8) = date(3:4) 44 | 45 | ctime(1:2) = time(1:2) 46 | ctime(3:3) = ':' 47 | ctime(4:5) = time(3:4) 48 | ctime(6:6) = ':' 49 | ctime(7:8) = time(5:6) 50 | 51 | endif 52 | 53 | call mpi_bcast (cdate,len(cdate),MPI_CHARACTER, 0, mpicom_rof, ier) 54 | call mpi_bcast (ctime,len(ctime),MPI_CHARACTER, 0, mpicom_rof, ier) 55 | 56 | end subroutine getdatetime 57 | 58 | end module RtmDateTime 59 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2005-2017, University Corporation for Atmospheric Research (UCAR) 2 | All rights reserved. 3 | 4 | Developed by: 5 | University Corporation for Atmospheric Research - National Center for Atmospheric Research 6 | https://www2.cesm.ucar.edu/working-groups/sewg 7 | 8 | Permission is hereby granted, free of charge, to any person obtaining 9 | a copy of this software and associated documentation files (the "Software"), 10 | to deal with the Software without restriction, including without limitation 11 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 12 | and/or sell copies of the Software, and to permit persons to whom 13 | the Software is furnished to do so, subject to the following conditions: 14 | 15 | - Redistributions of source code must retain the above copyright notice, 16 | this list of conditions and the following disclaimers. 17 | - Redistributions in binary form must reproduce the above copyright notice, 18 | this list of conditions and the following disclaimers in the documentation 19 | and/or other materials provided with the distribution. 20 | - Neither the names of [Name of Development Group, UCAR], 21 | nor the names of its contributors may be used to endorse or promote 22 | products derived from this Software without specific prior written permission. 23 | 24 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 25 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 26 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 27 | ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE 28 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 29 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 30 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 31 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 32 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 33 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 | POSSIBILITY OF SUCH DAMAGE. 35 | -------------------------------------------------------------------------------- /cime_config/config_component.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 14 | 15 | 16 | RTM: River Transport Model 17 | RTM model with flood: 18 | 19 | 20 | 21 | char 22 | rtm 23 | rtm 24 | case_comp 25 | env_case.xml 26 | Name of river component 27 | 28 | 29 | 30 | char 31 | ACTIVE,NULL 32 | ACTIVE 33 | 34 | NULL 35 | 36 | build_component_rtm 37 | env_build.xml 38 | mode for rtm model, NULL means rtm is turned off 39 | 40 | 41 | 42 | char 43 | ACTIVE,NULL 44 | NULL 45 | 46 | ACTIVE 47 | 48 | build_component_rtm 49 | env_build.xml 50 | mode for rtm flood feature, NULL means rtm flood is turned off 51 | 52 | 53 | 54 | char 55 | 56 | 2000 57 | 58 | 1850 59 | 1850 60 | 1850 61 | 2000 62 | 63 | run_component_rtm 64 | env_run.xml 65 | RTM build-namelist options 66 | 67 | 68 | 69 | ========================================= 70 | RTM naming conventions 71 | ========================================= 72 | 73 | 74 | 75 | -------------------------------------------------------------------------------- /src/riverroute/RtmSpmd.F90: -------------------------------------------------------------------------------- 1 | 2 | module RtmSpmd 3 | 4 | !----------------------------------------------------------------------- 5 | !BOP 6 | ! 7 | ! !MODULE: RtmSpmd 8 | ! 9 | ! !DESCRIPTION: 10 | ! RTM SPMD initialization 11 | ! 12 | ! !REVISION HISTORY: 13 | ! Author: Mariana Vertenstein 14 | ! 15 | !EOP 16 | !----------------------------------------------------------------------- 17 | 18 | implicit none 19 | private 20 | #include 21 | save 22 | 23 | ! Default settings valid even if there is no spmd 24 | 25 | logical, public :: masterproc ! proc 0 logical for printing msgs 26 | integer, public :: iam ! processor number 27 | integer, public :: npes ! number of processors for rtm 28 | integer, public :: mpicom_rof ! communicator group for rtm 29 | integer, parameter :: DEFAULT_MASTERPROC=0 ! the value of iam which is assigned 30 | ! the masterproc duties 31 | 32 | ! 33 | ! Public methods 34 | ! 35 | public :: RtmSpmdInit ! Initialization 36 | 37 | ! 38 | ! Values from mpif.h that can be used 39 | ! 40 | public :: MPI_INTEGER 41 | public :: MPI_REAL8 42 | public :: MPI_LOGICAL 43 | public :: MPI_SUM 44 | public :: MPI_MIN 45 | public :: MPI_MAX 46 | public :: MPI_LOR 47 | public :: MPI_STATUS_SIZE 48 | public :: MPI_ANY_SOURCE 49 | public :: MPI_CHARACTER 50 | public :: MPI_COMM_WORLD 51 | public :: MPI_MAX_PROCESSOR_NAME 52 | 53 | contains 54 | 55 | !----------------------------------------------------------------------- 56 | 57 | subroutine RtmSpmdInit(mpicom) 58 | 59 | !----------------------------------------------------------------------- 60 | ! !DESCRIPTION: 61 | ! MPI initialization (number of processes, etc) 62 | ! 63 | ! !ARGUMENTS: 64 | implicit none 65 | integer, intent(in) :: mpicom 66 | ! 67 | ! !LOCAL VARIABLES: 68 | integer :: ier ! return error status 69 | !----------------------------------------------------------------------- 70 | 71 | ! Initialize mpi communicator group 72 | 73 | mpicom_rof = mpicom 74 | 75 | ! Get my processor id 76 | 77 | call mpi_comm_rank(mpicom_rof, iam, ier) 78 | if (iam == DEFAULT_MASTERPROC) then 79 | masterproc = .true. 80 | else 81 | masterproc = .false. 82 | end if 83 | 84 | ! Get number of processors 85 | 86 | call mpi_comm_size(mpicom_rof, npes, ier) 87 | 88 | end subroutine RtmSpmdInit 89 | 90 | end module RtmSpmd 91 | -------------------------------------------------------------------------------- /cime_config/buildlib: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | """ 3 | Build the rtm component library 4 | """ 5 | #pylint: disable=unused-wildcard-import, wildcard-import, multiple-imports 6 | #pylint: disable=wrong-import-position, invalid-name, too-many-locals 7 | import os, sys 8 | 9 | CIMEROOT = os.environ.get("CIMEROOT") 10 | if CIMEROOT is None: 11 | raise SystemExit("ERROR: must set CIMEROOT environment variable") 12 | sys.path.append(os.path.join(CIMEROOT, "CIME", "Tools")) 13 | 14 | from standard_script_setup import * 15 | from CIME.case import Case 16 | from CIME.utils import expect, run_cmd 17 | from CIME.buildlib import parse_input 18 | from CIME.build import get_standard_makefile_args 19 | 20 | logger = logging.getLogger(__name__) 21 | 22 | ############################################################################### 23 | def _build_rtm(): 24 | ############################################################################### 25 | 26 | caseroot, libroot, bldroot = parse_input(sys.argv) 27 | 28 | with Case(caseroot) as case: 29 | casetools = case.get_value("CASETOOLS") 30 | gmake_j = case.get_value("GMAKE_J") 31 | gmake = case.get_value("GMAKE") 32 | cimeroot = case.get_value("CIMEROOT") 33 | # create Filepath file 34 | objroot = case.get_value("OBJROOT") 35 | filepath_file = os.path.join(objroot, "rof", "obj", "Filepath") 36 | driver = case.get_value("COMP_INTERFACE").lower() 37 | 38 | if not os.path.isfile(filepath_file): 39 | srcroot = case.get_value("SRCROOT") 40 | caseroot = case.get_value("CASEROOT") 41 | paths = [os.path.join(caseroot, "SourceMods", "src.rtm"), 42 | os.path.join(srcroot, "components", "rtm", "src", "riverroute"), 43 | os.path.join(srcroot, "components", "rtm", "src", "cpl", driver)] 44 | 45 | with open(filepath_file, "w") as filepath: 46 | filepath.write("\n".join(paths)) 47 | filepath.write("\n") 48 | 49 | # build the library 50 | complib = os.path.join(libroot, "librof.a") 51 | makefile = os.path.join(casetools, "Makefile") 52 | 53 | cmd = "{} complib -j {} MODEL=rtm COMPLIB={} -f {} {}" \ 54 | .format(gmake, gmake_j, complib, makefile, get_standard_makefile_args(case)) 55 | 56 | rc, out, err = run_cmd(cmd, from_dir=bldroot) 57 | expect(rc == 0, "Command %s failed rc=%d\nout=%s\nerr=%s" % (cmd, rc, out, err)) 58 | 59 | logger.info("Command %s completed with output %s\nerr %s", cmd, out, err) 60 | 61 | ############################################################################### 62 | 63 | if __name__ == "__main__": 64 | _build_rtm() 65 | -------------------------------------------------------------------------------- /src/riverroute/RtmFileUtils.F90: -------------------------------------------------------------------------------- 1 | module RtmFileUtils 2 | 3 | !----------------------------------------------------------------------- 4 | ! Module containing file I/O utilities 5 | ! 6 | ! !USES: 7 | use shr_sys_mod , only : shr_sys_abort 8 | use RtmSpmd , only : masterproc 9 | use RtmVar , only : iulog 10 | ! 11 | ! !PUBLIC TYPES: 12 | implicit none 13 | save 14 | ! 15 | ! !PUBLIC MEMBER FUNCTIONS: 16 | public :: get_filename !Returns filename given full pathname 17 | public :: getfil !Obtain local copy of file 18 | ! 19 | ! !REVISION HISTORY: 20 | ! Created by Mariana Vertenstein 21 | ! 22 | ! 23 | ! !PRIVATE MEMBER FUNCTIONS: None 24 | !----------------------------------------------------------------------- 25 | 26 | contains 27 | 28 | !----------------------------------------------------------------------- 29 | 30 | character(len=256) function get_filename (fulpath) 31 | 32 | ! !DESCRIPTION: 33 | ! Returns filename given full pathname 34 | ! 35 | ! !ARGUMENTS: 36 | implicit none 37 | character(len=*), intent(in) :: fulpath !full pathname 38 | ! 39 | ! !LOCAL VARIABLES: 40 | integer i !loop index 41 | integer klen !length of fulpath character string 42 | !---------------------------------------------------------- 43 | 44 | klen = len_trim(fulpath) 45 | do i = klen, 1, -1 46 | if (fulpath(i:i) == '/') go to 10 47 | end do 48 | i = 0 49 | 10 get_filename = fulpath(i+1:klen) 50 | 51 | end function get_filename 52 | 53 | !------------------------------------------------------------------------ 54 | 55 | subroutine getfil (fulpath, locfn, iflag) 56 | 57 | ! !DESCRIPTION: 58 | ! Obtain local copy of file. First check current working directory, 59 | ! Next check full pathname[fulpath] on disk 60 | ! 61 | ! !ARGUMENTS: 62 | implicit none 63 | character(len=*), intent(in) :: fulpath !Archival or permanent disk full pathname 64 | character(len=*), intent(out) :: locfn !output local file name 65 | integer, intent(in) :: iflag !0=>abort if file not found 1=>do not abort 66 | 67 | ! !LOCAL VARIABLES: 68 | integer i !loop index 69 | integer klen !length of fulpath character string 70 | logical lexist !true if local file exists 71 | !-------------------------------------------------- 72 | 73 | ! get local file name from full name 74 | locfn = get_filename( fulpath ) 75 | if (len_trim(locfn) == 0) then 76 | if (masterproc) write(iulog,*)'(GETFIL): local filename has zero length' 77 | call shr_sys_abort() 78 | else 79 | if (masterproc) write(iulog,*)'(GETFIL): attempting to find local file ', & 80 | trim(locfn) 81 | endif 82 | 83 | ! first check if file is in current working directory. 84 | inquire (file=locfn,exist=lexist) 85 | if (lexist) then 86 | if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), & 87 | ' in current working directory' 88 | RETURN 89 | endif 90 | 91 | ! second check for full pathname on disk 92 | locfn = fulpath 93 | 94 | inquire (file=fulpath,exist=lexist) 95 | if (lexist) then 96 | if (masterproc) write(iulog,*) '(GETFIL): using ',trim(fulpath) 97 | RETURN 98 | else 99 | if (masterproc) write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath 100 | if (iflag==0) then 101 | call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath)) 102 | else 103 | RETURN 104 | endif 105 | endif 106 | 107 | end subroutine getfil 108 | 109 | !------------------------------------------------------------------------ 110 | 111 | end module RtmFileUtils 112 | -------------------------------------------------------------------------------- /docs/release-cesm2.0.ChangeLog: -------------------------------------------------------------------------------- 1 | =============================================================== 2 | Tag name: release-cesm2.0.02 3 | Originator(s): erik 4 | Date: Oct 19, 2018 5 | One-line Summary: Fix some issues with nag compiler, remove rtmhist_ndens==2 option 6 | 7 | basetype wasn't declared and needed to be. Also add more "implicit none" 8 | statements in. Remove the deletion of "rtm.input_data_list" file, as cime 9 | now does this. Remove the option of setting single-precision 10 | history output, as it sometimes has numerical conversion issues. The 11 | real solution for it should be to keep a single-precision history 12 | buffer that then outputs at the same precision as stored, rather than 13 | converting just before. This would trigger issues with the conversion 14 | earlier. 15 | 16 | RTM Master Tag This Corresponds To: rtm1_0_66 (with changes) 17 | 18 | Software Changes since last release: release-cesm2.0.01 19 | * Fix issues with nag compiler 20 | * Remove single precision output option 21 | 22 | Science Changes since last release: release-cesm2.0.00 23 | * None 24 | 25 | Changes to User Interface since: release-cesm2.0.00 26 | * rtmhist_ndens can no longer equal 2. 27 | 28 | Pull Requests that document the changes (include PR ids): 29 | #10 -- Fix some issues with nag compiler 30 | 31 | Testing: 32 | rtm testlist on hobart and cheyenne (PASS) 33 | 34 | 35 | =============================================================== 36 | Tag name: release-cesm2.0.01 37 | Originator(s): erik 38 | Date: Oct 10, 2018 39 | One-line Summary: pylint cleanup, and fill value changes for pio2 40 | 41 | Changes ported from mosart/#15 to rtm. Run pylint through buildlib/buildnml, 42 | changes for fill value needed for pio2. Also use the floor operator 43 | for a specific integer divide as python3 turns it into reals. 44 | 45 | RTM Master Tag This Corresponds To: rtm1_0_66 (with changes) 46 | 47 | Purpose: 48 | 49 | Software Changes since last release: release-cesm2.0.00 50 | * pylint on buildlib/buildnml 51 | * fill value changes needed for pio2 from the mosart changes 52 | * Use floor operator in buildnml for an integer division 53 | 54 | Science Changes since last release: release-cesm2.0.00 55 | * None 56 | 57 | Changes to User Interface since: release-cesm2.0.00 58 | * None 59 | 60 | Pull Requests that document the changes (include PR ids): 61 | #9 -- Same changes on mosart fill-value and pylint cleanup on rtm enhancement 62 | 63 | Testing: 64 | rtm testlist on hobart and cheyenne (PASS) 65 | 66 | =============================================================== 67 | Tag name: release-cesm2.0.00 68 | Originator(s): erik 69 | Date: May 21, 2018 70 | One-line Summary: First CESM2.0 release version, identical to rtm1_0_66 71 | 72 | Purpose: 73 | 74 | First RTM version for the CESM2.0 release. This tag is identical to rtm1_0_66 75 | 76 | RTM Master Tag This Corresponds To: rtm1_0_66 77 | 78 | Software Changes since last release: rtm1_0_30 79 | 80 | * Add in model_doi_url read in from infodata from coupler. 81 | * RTM own's version of config_archive.xml 82 | * Remove old rof_comp_esmf 83 | * Remove revision_id from output files 84 | * Convert testlist format to version 2, and use new Clm5 compset names. 85 | * Remove yellowstone tests. 86 | * Update config_component.xml to version 3 format. 87 | * if NINST_RTM > 1, will check if REFCASE has instance name and use it, otherwise without it. 88 | * I/O fixes from Jim Edwards 89 | * Update buildnamelist to cime5 python namelist infrastructure 90 | * Add time period frequency to output history file 91 | * Remove ESMF top level coupler interface and tests 92 | * Have RTM react to CLM_ACCELERATED_SPINUP setting from CLM and turn itself off 93 | * Update to newer cime versions 94 | * Move tests from goldbach to hobart 95 | * Don't assume that direction files are global 96 | * NAG6.0 requires additional pointers to be nullified 97 | * readnamelist on mastertask only 98 | * PIO2 Compatibility changes 99 | * address valgrind errors 100 | * add SHR_ASSERT macros 101 | * migration of cpl_share/, cpl_esmf/ and cpl_mct code into new cpl/ and introduction of rof_import_export.F90 102 | 103 | Science Changes since last release: rtm1_0_30 104 | 105 | * Treat irrigation as a seperate flux 106 | * Remove directo to ocean runnoff 107 | * fix fthresh bug and refactor RtmFloodInit 108 | * convert volr coupling field from state to flux 109 | * RTM Master Tag this corresponds to: rtm1_0_66 110 | 111 | =============================================================== 112 | -------------------------------------------------------------------------------- /cime_config/testdefs/testlist_rtm.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | -------------------------------------------------------------------------------- /src/riverroute/RtmHistFlds.F90: -------------------------------------------------------------------------------- 1 | module RtmHistFlds 2 | 3 | !----------------------------------------------------------------------- 4 | ! !DESCRIPTION: 5 | ! Module containing initialization of RTM history fields and files 6 | ! This is the module that the user must modify in order to add new 7 | ! history fields or modify defaults associated with existing history 8 | ! fields. 9 | ! 10 | ! !USES: 11 | use shr_kind_mod , only: r8 => shr_kind_r8 12 | use RunoffMod , only : runoff 13 | use RtmHistFile , only : RtmHistAddfld, RtmHistPrintflds 14 | use RtmVar , only : nt_rtm, rtm_tracers 15 | 16 | implicit none 17 | ! 18 | ! !PUBLIC MEMBER FUNCTIONS: 19 | public :: RtmHistFldsInit 20 | public :: RtmHistFldsSet 21 | ! 22 | !------------------------------------------------------------------------ 23 | 24 | contains 25 | 26 | !----------------------------------------------------------------------- 27 | 28 | subroutine RtmHistFldsInit() 29 | 30 | !------------------------------------------------------- 31 | ! DESCRIPTION: 32 | ! Build master field list of all possible fields in a history file. 33 | ! Each field has associated with it a ``long\_name'' netcdf attribute that 34 | ! describes what the field is, and a ``units'' attribute. A subroutine is 35 | ! called to add each field to the masterlist. 36 | ! 37 | ! !USES: 38 | ! ARGUMENTS: 39 | implicit none 40 | !------------------------------------------------------- 41 | 42 | call RtmHistAddfld (fname='QCHANR', units='m3/s', & 43 | avgflag='A', long_name='RTM river flow: '//trim(rtm_tracers(1)), & 44 | ptr_rof=runoff%runofflnd_nt1) 45 | 46 | call RtmHistAddfld (fname='QCHANR'//'_'//trim(rtm_tracers(2)), units='m3/s', & 47 | avgflag='A', long_name='RTM river flow: '//trim(rtm_tracers(2)), & 48 | ptr_rof=runoff%runofflnd_nt2) 49 | 50 | call RtmHistAddfld (fname='QCHOCNR', units='m3/s', & 51 | avgflag='A', long_name='RTM river discharge into ocean: '//trim(rtm_tracers(1)), & 52 | ptr_rof=runoff%runoffocn_nt1) 53 | 54 | call RtmHistAddfld (fname='QCHOCNR'//'_'//trim(rtm_tracers(2)), units='m3/s', & 55 | avgflag='A', long_name='RTM river discharge into ocean: '//trim(rtm_tracers(2)), & 56 | ptr_rof=runoff%runoffocn_nt2) 57 | 58 | call RtmHistAddfld (fname='VOLR'//'_'//trim(rtm_tracers(1)), units='m3', & 59 | avgflag='A', long_name='RTM storage: '//trim(rtm_tracers(1)), & 60 | ptr_rof=runoff%volr_nt1, default='inactive') 61 | 62 | call RtmHistAddfld (fname='VOLR'//'_'//trim(rtm_tracers(2)), units='m3', & 63 | avgflag='A', long_name='RTM storage: '//trim(rtm_tracers(2)), & 64 | ptr_rof=runoff%volr_nt2, default='inactive') 65 | 66 | call RtmHistAddfld (fname='DVOLRDT_LND', units='mm/s', & 67 | avgflag='A', long_name='RTM land change in storage: '//trim(rtm_tracers(1)), & 68 | ptr_rof=runoff%dvolrdtlnd_nt1, default='inactive') 69 | 70 | call RtmHistAddfld (fname='DVOLRDT_LND'//'_'//trim(rtm_tracers(2)), units='mm/s', & 71 | avgflag='A', long_name='RTM land change in storage: '//trim(rtm_tracers(2)), & 72 | ptr_rof=runoff%dvolrdtlnd_nt2, default='inactive') 73 | 74 | call RtmHistAddfld (fname='DVOLRDT_OCN', units='mm/s', & 75 | avgflag='A', long_name='RTM ocean change of storage: '//trim(rtm_tracers(1)), & 76 | ptr_rof=runoff%dvolrdtocn_nt1, default='inactive') 77 | 78 | call RtmHistAddfld (fname='DVOLRDT_OCN'//'_'//trim(rtm_tracers(2)), units='mm/s', & 79 | avgflag='A', long_name='RTM ocean change of storage: '//trim(rtm_tracers(2)), & 80 | ptr_rof=runoff%dvolrdtocn_nt2, default='inactive') 81 | 82 | ! RTM and MOSART (unlike the CLM) do not have the history_tape_in_use 83 | ! capability, so both models throw an error when h0i is empty. For this 84 | ! reason RTM and MOSART always need at least one instantaneous field so 85 | ! that h0i will not be empty. 86 | call RtmHistAddfld (fname='RTMFLOOD', units='m3/s', & 87 | avgflag='I', long_name='RTM flooding flux', & 88 | ptr_rof=runoff%flood) 89 | 90 | call RtmHistAddfld (fname='QIRRIG', units='mm/s', & 91 | avgflag='A', long_name='Irrigation flux from land', & 92 | ptr_rof=runoff%qirrig, default='inactive') 93 | 94 | ! Print masterlist of history fields 95 | 96 | call RtmHistPrintflds() 97 | 98 | end subroutine RtmHistFldsInit 99 | 100 | !----------------------------------------------------------------------- 101 | 102 | subroutine RtmHistFldsSet() 103 | 104 | !----------------------------------------------------------------------- 105 | ! !DESCRIPTION: 106 | ! Set rtm history fields as 1d pointer arrays 107 | ! 108 | implicit none 109 | !----------------------------------------------------------------------- 110 | 111 | ! Currently only have two tracers 112 | 113 | runoff%runofflnd_nt1(:) = runoff%runofflnd(:,1) 114 | runoff%runofflnd_nt2(:) = runoff%runofflnd(:,2) 115 | 116 | runoff%runoffocn_nt1(:) = runoff%runoffocn(:,1) 117 | runoff%runoffocn_nt2(:) = runoff%runoffocn(:,2) 118 | 119 | runoff%dvolrdtlnd_nt1(:) = runoff%dvolrdtlnd(:,1) 120 | runoff%dvolrdtlnd_nt2(:) = runoff%dvolrdtlnd(:,2) 121 | 122 | runoff%dvolrdtocn_nt1(:) = runoff%dvolrdtocn(:,1) 123 | runoff%dvolrdtocn_nt2(:) = runoff%dvolrdtocn(:,2) 124 | 125 | runoff%volr_nt1(:) = runoff%volrlnd(:,1) 126 | runoff%volr_nt2(:) = runoff%volrlnd(:,2) 127 | 128 | end subroutine RtmHistFldsSet 129 | 130 | 131 | end module RtmHistFlds 132 | -------------------------------------------------------------------------------- /src/riverroute/RtmVar.F90: -------------------------------------------------------------------------------- 1 | module RtmVar 2 | 3 | use shr_kind_mod , only : r8 => shr_kind_r8, CL => SHR_KIND_CL 4 | use shr_const_mod, only : SHR_CONST_CDAY,SHR_CONST_REARTH 5 | use shr_sys_mod , only : shr_sys_abort 6 | use RtmSpmd , only : masterproc 7 | 8 | implicit none 9 | 10 | !TODO - nt_rtm and rtm_tracers need to be removed and set by access to the index array 11 | integer, parameter, public :: nt_rtm = 2 ! number of tracers 12 | character(len=3), parameter, public :: rtm_tracers(nt_rtm) = (/'LIQ','ICE'/) 13 | 14 | ! Constants 15 | integer, parameter, private :: iundef = -9999999 16 | integer, parameter, private :: rundef = -9999999._r8 17 | 18 | real(r8), public, parameter :: secspday = SHR_CONST_CDAY ! Seconds per day 19 | integer, public, parameter :: isecspday= secspday ! Integer seconds per day 20 | real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data 21 | integer , public, parameter :: ispval = -9999 ! special value for int data 22 | real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) 23 | 24 | ! Run control variables 25 | character(len=CL), public :: caseid = ' ' ! case id 26 | character(len=CL), public :: ctitle = ' ' ! case title 27 | integer, public, parameter :: nsrStartup = 0 ! Startup from initial conditions 28 | integer, public, parameter :: nsrContinue = 1 ! Continue from restart files 29 | integer, public, parameter :: nsrBranch = 2 ! Branch from restart files 30 | integer, public :: nsrest = iundef ! Type of run 31 | logical, public :: brnch_retain_casename = .false. ! true => allow case name to remain the same for branch run 32 | ! by default this is not allowed 33 | logical, public :: noland = .false. ! true => no valid land points -- do NOT run 34 | character(len=CL), public :: hostname = ' ' ! Hostname of machine running on 35 | character(len=CL), public :: username = ' ' ! username of user running program 36 | character(len=CL), public :: version = " " ! version of program 37 | character(len=CL), public :: conventions = "CF-1.0" ! dataset conventions 38 | character(len=CL), public :: source = "River Transport Model RTM1.0" ! description of this source 39 | character(len=CL), public :: model_doi_url ! Web address of the Digital Object Identifier (DOI) for this model version 40 | 41 | ! Unit Numbers 42 | integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6 43 | 44 | ! Instance control 45 | integer, public :: inst_index 46 | character(len=16), public :: inst_name 47 | character(len=16), public :: inst_suffix 48 | 49 | ! Rtm control variables 50 | character(len=CL), public :: nrevsn_rtm = ' ' ! restart data file name for branch run 51 | character(len=CL), public :: finidat_rtm = ' ' ! initial conditions file name 52 | character(len=CL), public :: frivinp_rtm = ' ' ! RTM input data file name 53 | logical, public :: ice_runoff = .true. ! true => runoff is split into liquid and ice, 54 | ! otherwise just liquid 55 | logical, public :: rtm_active = .true. ! true => rtm on 56 | logical, public :: flood_active = .false. ! true => flood on 57 | logical, public :: effvel_active = .false. ! true => calculate eff. velocity from rdirc file 58 | 59 | ! Rtm grid size 60 | integer :: rtmlon = 1 ! number of rtm longitudes (initialize) 61 | integer :: rtmlat = 1 ! number of rtm latitudes (initialize) 62 | 63 | character(len=CL), public :: rpntfil = 'rpointer.rof' ! file name for local restart pointer file 64 | 65 | logical, private :: RtmVar_isset = .false. 66 | 67 | contains 68 | 69 | 70 | !================================================================================ 71 | 72 | subroutine RtmVarSet( caseid_in, ctitle_in, brnch_retain_casename_in, & 73 | nsrest_in, version_in, hostname_in, username_in, & 74 | model_doi_url_in ) 75 | 76 | !----------------------------------------------------------------------- 77 | ! Set input control variables. 78 | ! 79 | ! !ARGUMENTS: 80 | character(len=CL), optional, intent(IN) :: caseid_in ! case id 81 | character(len=CL), optional, intent(IN) :: ctitle_in ! case title 82 | integer , optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch 83 | character(len=CL), optional, intent(IN) :: version_in ! model version 84 | character(len=CL), optional, intent(IN) :: hostname_in ! hostname running on 85 | character(len=CL), optional, intent(IN) :: username_in ! username running job 86 | character(len=CL), optional, intent(IN) :: model_doi_url_in ! web address of Digital Object Identifier (DOI) for model version 87 | logical , optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to 88 | !----------------------------------------------------------------------- 89 | 90 | if ( RtmVar_isset )then 91 | call shr_sys_abort( 'RtmVarSet ERROR:: control variables already set -- EXIT' ) 92 | end if 93 | 94 | if (present(caseid_in)) caseid = caseid_in 95 | if (present(ctitle_in)) ctitle = ctitle_in 96 | if (present(nsrest_in)) nsrest = nsrest_in 97 | if (present(version_in)) version = version_in 98 | if (present(username_in)) username = username_in 99 | if (present(hostname_in)) hostname = hostname_in 100 | if (present(model_doi_url_in)) model_doi_url = model_doi_url_in 101 | if (present(brnch_retain_casename_in)) brnch_retain_casename = brnch_retain_casename_in 102 | 103 | end subroutine RtmVarSet 104 | 105 | !================================================================================ 106 | 107 | subroutine RtmVarInit( ) 108 | if (masterproc) then 109 | if (nsrest == iundef) then 110 | call shr_sys_abort( 'RtmVarInit ERROR:: must set nsrest' ) 111 | end if 112 | if (nsrest == nsrBranch .and. nrevsn_rtm == ' ') then 113 | call shr_sys_abort( 'RtmVarInit ERROR: need to set restart data file name' ) 114 | end if 115 | if (nsrest == nsrStartup ) then 116 | nrevsn_rtm = ' ' 117 | end if 118 | if (nsrest == nsrContinue) then 119 | nrevsn_rtm = 'set by restart pointer file file' 120 | end if 121 | if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) then 122 | call shr_sys_abort( 'RtmVarInit ERROR: nsrest NOT set to a valid value' ) 123 | end if 124 | endif 125 | RtmVar_isset = .true. 126 | end subroutine RtmVarInit 127 | 128 | end module RtmVar 129 | -------------------------------------------------------------------------------- /cime_config/namelist_definition_rtm.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | char 13 | rtm 14 | rtm_inparm 15 | ACTIVE,NULL 16 | 17 | If ACTIVE, turn on rtm river routing. If the value rtm_mode is 18 | NULL, then rof_present will be set to false at runtime. 19 | 20 | 21 | ACTIVE 22 | ACTIVE 23 | NULL 24 | NULL 25 | NULL 26 | 27 | 28 | 29 | 30 | char 31 | rtm 32 | rtm_inparm 33 | ACTIVE,NULL 34 | 35 | If ACTIVE, turn on rtm flooding back to clm. Note that rtm flood 36 | is not supported in CESM1.1 37 | 38 | 39 | $RTM_FLOOD_MODE 40 | 41 | 42 | 43 | 44 | logical 45 | rtm 46 | rtm_inparm 47 | 48 | If .true., river runoff will be split up into liquid and ice streams, 49 | otherwise ice runoff will be zero and all runoff directed to liquid stream. 50 | 51 | 52 | .true. 53 | .false. 54 | .false. 55 | 56 | 57 | 58 | 59 | integer 60 | rtm 61 | rtm_inparm 62 | RTM time step (sec). - set automatically via the value of ROF_NCPL 63 | 64 | -999 65 | 66 | 67 | 68 | 69 | char 70 | rtm 71 | rtm_inparm 72 | ACTIVE,NULL 73 | 74 | If ACTIVE, calculate the effective velocity using slope. 75 | 76 | 77 | ACTIVE 78 | NULL 79 | 80 | 81 | 82 | 83 | char 84 | rtm 85 | rtm_inparm 86 | abs 87 | 88 | Full pathname of initial rtm file 89 | 90 | 91 | UNSET 92 | $DIN_LOC_ROOT/rof/rtm/initdata/rtmi.I1850CRUCLM45BGC.0241-01-01.R05_simyr1850_c130515.nc 93 | $DIN_LOC_ROOT/rof/rtm/initdata/rtmi.ICRUCLM45BGC.2000-01-01.R05_simyr2000_c130518.nc 94 | 95 | 96 | 97 | 98 | char 99 | rtm 100 | rtm_inparm 101 | 102 | Full pathname of master restart file for a branch run. (only used if RUN_TYPE is branch) 103 | 104 | 105 | 106 | 107 | char 108 | rtm 109 | rtm_inparm 110 | abs 111 | 112 | Full pathname of input datafile for RTM. 113 | 114 | 115 | UNSET 116 | $DIN_LOC_ROOT/lnd/clm2/rtmdata/rdirc_0.5x0.5_simyr2000_slpmxvl_c120717.nc 117 | $DIN_LOC_ROOT/lnd/clm2/rtmdata/rdirc_0.1x0.1_qian_c130115.nc 118 | 119 | 120 | 121 | 122 | char(1000) 123 | history 124 | rtm_inparm 125 | 126 | Fields to exclude from history tape series 1. 127 | 128 | 129 | '' 130 | 131 | 132 | 133 | 134 | char(1000) 135 | history 136 | rtm_inparm 137 | 138 | Fields to exclude from history tape series 2. 139 | 140 | 141 | '' 142 | 143 | 144 | 145 | 146 | char(1000) 147 | history 148 | rtm_inparm 149 | 150 | Fields to exclude from history tape series 3. 151 | 152 | 153 | '' 154 | 155 | 156 | 157 | 158 | char(1000) 159 | history 160 | rtm_inparm 161 | 162 | Fields to add to history tape series 1. 163 | 164 | 165 | '' 166 | 167 | 168 | 169 | 170 | char(1000) 171 | history 172 | rtm_inparm 173 | 174 | Fields to add to history tape series 2. 175 | 176 | 177 | '' 178 | 179 | 180 | 181 | 182 | char(1000) 183 | history 184 | rtm_inparm 185 | 186 | Fields to add to history tape series 3. 187 | 188 | 189 | '' 190 | 191 | 192 | 193 | 194 | integer(6) 195 | history 196 | rtm_inparm 197 | 198 | Per tape series maximum number of time samples. 199 | 200 | 201 | 1 202 | 203 | 204 | 205 | 206 | integer(6) 207 | history 208 | rtm_inparm 209 | 1 210 | 211 | Per tape series history file density (i.e. output precision) 212 | 1=double precision, 2=single precision (NOT functional) 213 | 214 | 215 | 1 216 | 217 | 218 | 219 | 220 | integer(6) 221 | history 222 | rtm_inparm 223 | 224 | Per tape series history write frequency. 225 | positive means in time steps, 0=monthly, negative means hours 226 | (i.e. 24 means every 24 time-steps and -24 means every day 227 | 228 | 229 | 0 230 | 231 | 232 | 233 | 234 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | _The Contributor Code of Conduct is for participants in our software projects and community._ 3 | 4 | ## Our Pledge 5 | We, as contributors, creators, stewards, and maintainers (participants), of River Transport Model (RTM) pledge to make participation in our software, system or hardware project and community a safe, productive, welcoming and inclusive experience for everyone. 6 | All participants are required to abide by this Code of Conduct. 7 | This includes respectful treatment of everyone regardless of age, body size, disability, ethnicity, gender identity or expression, level of experience, nationality, political affiliation, veteran status, pregnancy, genetic information, physical appearance, race, religion, or sexual orientation, as well as any other characteristic protected under applicable US federal or state law. 8 | 9 | ## Our Standards 10 | Examples of behaviors that contribute to a positive environment include: 11 | 12 | * All participants are treated with respect and consideration, valuing a diversity of views and opinions 13 | * Be considerate, respectful, and collaborative 14 | * Communicate openly with respect for others, critiquing ideas rather than individuals and gracefully accepting criticism 15 | * Acknowledging the contributions of others 16 | * Avoid personal attacks directed toward other participants 17 | * Be mindful of your surroundings and of your fellow participants 18 | * Alert UCAR staff and suppliers/vendors if you notice a dangerous situation or someone in distress 19 | * Respect the rules and policies of the project and venue 20 | 21 | Examples of unacceptable behavior include, but are not limited to: 22 | 23 | * Harassment, intimidation, or discrimination in any form 24 | * Physical, verbal, or written abuse by anyone to anyone, including repeated use of pronouns other than those requested 25 | * Unwelcome sexual attention or advances 26 | * Personal attacks directed at other guests, members, participants, etc. 27 | * Publishing others' private information, such as a physical or electronic address, without explicit permission 28 | * Alarming, intimidating, threatening, or hostile comments or conduct 29 | * Inappropriate use of nudity and/or sexual images 30 | * Threatening or stalking anyone, including a participant 31 | * Other conduct which could reasonably be considered inappropriate in a professional setting 32 | 33 | ## Scope 34 | This Code of Conduct applies to all spaces managed by the Project whether they be physical, online or face-to-face. 35 | This includes project code, code repository, associated web pages, documentation, mailing lists, project websites and wiki pages, issue tracker, meetings, telecons, events, project social media accounts, and any other forums created by the project team which the community uses for communication. 36 | In addition, violations of this Code of Conduct outside these spaces may affect a person's ability to participate within them. 37 | Representation of a project may be further defined and clarified by project maintainers. 38 | 39 | ## Community Responsibilities 40 | Everyone in the community is empowered to respond to people who are showing unacceptable behavior. 41 | They can talk to them privately or publicly. 42 | Anyone requested to stop unacceptable behavior is expected to comply immediately. 43 | If the behavior continues concerns may be brought to the project administrators or to any other party listed in the [Reporting](#reporting) section below. 44 | 45 | ## Project Administrator Responsibilities 46 | Project administrators are responsible for clarifying the standards of acceptable behavior and are encouraged to model appropriate behavior and provide support when people in the community point out inappropriate behavior. 47 | Project administrator(s) are normally the ones that would be tasked to carry out the actions in the [Consequences](#consequences) section below. 48 | 49 | Project administrators are also expected to keep this Code of Conduct updated with the main one housed at UCAR, as listed below in the [Attribution](#attribution) section. 50 | 51 | ## Reporting 52 | Instances of unacceptable behavior can be brought to the attention of the project administrator(s) who may take any action as outlined in the [Consequences](#consequences) section below. 53 | However, making a report to a project administrator is not considered an 'official report' to UCAR. 54 | 55 | Instances of unacceptable behavior may also be reported directly to UCAR pursuant to [UCAR's Harassment Reporting and Complaint Procedure](https://www2.fin.ucar.edu/procedures/hr/harassment-reporting-and-complaint-procedure), or anonymously through [UCAR's EthicsPoint Hotline](https://www2.fin.ucar.edu/ethics/anonymous-reporting). 56 | 57 | Complaints received by UCAR will be handled pursuant to the procedures outlined in UCAR's Harassment Reporting and Complaint Procedure. 58 | Complaints to UCAR will be held as confidential as practicable under the circumstances, and retaliation against a person who initiates a complaint or an inquiry about inappropriate behavior will not be tolerated. 59 | 60 | Any Contributor can use these reporting methods even if they are not directly affiliated with UCAR. 61 | The Frequently Asked Questions (FAQ) page for reporting is [here](https://www2.fin.ucar.edu/procedures/hr/reporting-faqs). 62 | 63 | ## Consequences 64 | Upon receipt of a complaint, the project administrator(s) may take any action deemed necessary and appropriate under the circumstances. 65 | Such action can include things such as: removing, editing, or rejecting comments, commits, code, wiki edits, email, issues, and other contributions that are not aligned to this Code of Conduct, or banning temporarily or permanently any contributor for other behaviors that are deemed inappropriate, threatening, offensive, or harmful. 66 | Project administrators also have the right to report violations to UCAR HR and/or UCAR's Office of Diversity, Equity and Inclusion (ODEI), as well as a participant's home institution and/or law enforcement. 67 | In the event an incident is reported to UCAR, UCAR will follow its Harassment Reporting and Complaint Procedure. 68 | 69 | ## Process for Changes 70 | All UCAR managed projects are required to adopt this Contributor Code of Conduct. 71 | Adoption is assumed even if not expressly stated in the repository. 72 | Projects should fill in sections where prompted with project-specific information, including, project name and adoption date. 73 | 74 | Projects that adopt this Code of Conduct need to stay up to date with UCAR's Contributor Code of Conduct, linked with a DOI in the [Attribution](#attribution) section below. 75 | Projects can make limited substantive changes to the Code of Conduct, however, the changes must be limited in scope and may not contradict the UCAR Contributor Code of Conduct. 76 | 77 | ## Attribution 78 | This Code of Conduct was originally adapted from the [Contributor Covenant](http://contributor-covenant.org/version/1/4), version 1.4. 79 | We then aligned it with the UCAR Participant Code of Conduct, which also borrows from the American Geophysical Union (AGU) Code of Conduct. 80 | The UCAR Participant Code of Conduct applies to both UCAR employees as well as participants in activities run by UCAR. 81 | The original version of this for all software projects that have strong management from UCAR or UCAR staff is available on the UCAR website at https://doi.org/10.5065/6w2c-a132. 82 | The date that it was adopted by this project was Dec/5th/2018 83 | When responding to complaints, UCAR HR and ODEI will do so based on the latest published version. 84 | Therefore, any project-specific changes should follow the [Process for Changes](#process-for-changes) section above. 85 | -------------------------------------------------------------------------------- /src/riverroute/RunoffMod.F90: -------------------------------------------------------------------------------- 1 | module RunoffMod 2 | 3 | !----------------------------------------------------------------------- 4 | !BOP 5 | ! 6 | ! !MODULE: RunoffMod 7 | ! 8 | ! !DESCRIPTION: 9 | ! Module containing utilities for history file and coupler runoff data 10 | ! 11 | ! !USES: 12 | use shr_kind_mod, only : r8 => shr_kind_r8 13 | use shr_sys_mod , only : shr_sys_abort 14 | use RtmVar , only : iulog, spval, ispval, nt_rtm 15 | 16 | ! !PUBLIC TYPES: 17 | implicit none 18 | private 19 | 20 | public :: runoff_flow 21 | type runoff_flow 22 | ! - local initialization 23 | real(r8), pointer :: lonc(:) => null() ! lon of cell 24 | real(r8), pointer :: latc(:) => null() ! lat of cell 25 | real(r8), pointer :: area(:) => null() ! area of cell 26 | integer , pointer :: gindex(:) => null() ! global index 27 | integer , pointer :: dsi(:) => null() ! downstream index 28 | 29 | ! - local runtime 30 | real(r8), pointer :: runoff(:,:) => null() ! RTM flow (m**3 H2O/s) 31 | real(r8), pointer :: runofflnd(:,:) => null() ! runoff masked for land (m**3 H2O/s) 32 | real(r8), pointer :: runoffocn(:,:) => null() ! runoff masked for ocn (m**3 H2O/s) 33 | real(r8), pointer :: dvolrdt(:,:) => null() ! RTM change in storage (mm/s) 34 | real(r8), pointer :: dvolrdtlnd(:,:) => null() ! dvolrdt masked for land (mm/s) 35 | real(r8), pointer :: dvolrdtocn(:,:) => null() ! dvolrdt masked for ocn (mm/s) 36 | real(r8), pointer :: volr(:,:) => null() ! RTM storage (m**3) 37 | real(r8), pointer :: volrlnd(:,:) => null() ! RTM storage masked for land (m**3) 38 | real(r8), pointer :: fluxout(:,:) => null() ! RTM cell tracer outlflux (m3/s) 39 | real(r8), pointer :: fthresh(:) => null() ! RTM water flood threshold 40 | real(r8), pointer :: flood(:) => null() ! RTM water (flood) sent back to clm (mm/s) 41 | real(r8), pointer :: qirrig(:) => null() ! irrigation flux from land (mm/s) 42 | 43 | ! - global 44 | integer , pointer :: mask(:) => null() ! mask of cell 0=none, 1=lnd, 2=ocn 45 | real(r8), pointer :: rlon(:) => null() ! rtm longitude list, 1d 46 | real(r8), pointer :: rlat(:) => null() ! rtm latitude list, 1d 47 | 48 | real(r8) :: totarea ! global area 49 | integer :: numr ! rtm gdc global number of cells 50 | integer :: numrl ! rtm gdc global number of lnd cells 51 | integer :: numro ! rtm gdc global number of ocn cells 52 | 53 | ! - local 54 | integer :: begr,endr ! local start/stop indices 55 | integer :: lnumr ! local number of cells 56 | 57 | ! - 1d field pointers for history files (currently needed) 58 | real(r8), pointer :: runofflnd_nt1(:) => null() 59 | real(r8), pointer :: runofflnd_nt2(:) => null() 60 | real(r8), pointer :: runoffocn_nt1(:) => null() 61 | real(r8), pointer :: runoffocn_nt2(:) => null() 62 | real(r8), pointer :: dvolrdtlnd_nt1(:) => null() 63 | real(r8), pointer :: dvolrdtlnd_nt2(:) => null() 64 | real(r8), pointer :: dvolrdtocn_nt1(:) => null() 65 | real(r8), pointer :: dvolrdtocn_nt2(:) => null() 66 | real(r8), pointer :: volr_nt1(:) => null() 67 | real(r8), pointer :: volr_nt2(:) => null() 68 | end type runoff_flow 69 | ! 70 | type (runoff_flow), public :: runoff 71 | 72 | public :: RunoffInit 73 | public :: RunoffFinalize 74 | 75 | contains 76 | 77 | subroutine RunoffInit(begr, endr, numr) 78 | 79 | integer, intent(in) :: begr, endr, numr 80 | 81 | integer :: ier 82 | 83 | allocate(runoff%runoff(begr:endr,nt_rtm), & 84 | runoff%dvolrdt(begr:endr,nt_rtm), & 85 | runoff%runofflnd(begr:endr,nt_rtm), & 86 | runoff%dvolrdtlnd(begr:endr,nt_rtm), & 87 | runoff%runoffocn(begr:endr,nt_rtm), & 88 | runoff%dvolrdtocn(begr:endr,nt_rtm), & 89 | runoff%area(begr:endr), & 90 | runoff%volr(begr:endr,nt_rtm), & 91 | runoff%volrlnd(begr:endr,nt_rtm), & 92 | runoff%fluxout(begr:endr,nt_rtm), & 93 | runoff%lonc(begr:endr), & 94 | runoff%latc(begr:endr), & 95 | runoff%dsi(begr:endr), & 96 | runoff%runofflnd_nt1(begr:endr), & 97 | runoff%runofflnd_nt2(begr:endr), & 98 | runoff%runoffocn_nt1(begr:endr), & 99 | runoff%runoffocn_nt2(begr:endr), & 100 | runoff%volr_nt1(begr:endr), & 101 | runoff%volr_nt2(begr:endr), & 102 | runoff%dvolrdtlnd_nt1(begr:endr), & 103 | runoff%dvolrdtlnd_nt2(begr:endr), & 104 | runoff%dvolrdtocn_nt1(begr:endr), & 105 | runoff%dvolrdtocn_nt2(begr:endr), & 106 | runoff%mask(numr), & 107 | runoff%gindex(begr:endr), & 108 | runoff%fthresh(begr:endr), & 109 | runoff%flood(begr:endr), & 110 | runoff%qirrig(begr:endr), & 111 | stat=ier) 112 | if (ier /= 0) then 113 | write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' 114 | call shr_sys_abort 115 | end if 116 | 117 | runoff%runoff(:,:) = 0._r8 118 | runoff%runofflnd(:,:) = spval 119 | runoff%runoffocn(:,:) = spval 120 | runoff%dvolrdt(:,:) = 0._r8 121 | runoff%dvolrdtlnd(:,:) = spval 122 | runoff%dvolrdtocn(:,:) = spval 123 | runoff%volr(:,:) = 0._r8 124 | runoff%volrlnd(:,:) = 0._r8 125 | runoff%volr_nt1(:) = 0._r8 126 | runoff%volr_nt2(:) = 0._r8 127 | runoff%gindex(:) = ispval 128 | runoff%fthresh(:) = spval 129 | runoff%flood(:) = 0._r8 130 | 131 | end subroutine RunoffInit 132 | 133 | subroutine RunoffFinalize() 134 | 135 | if (associated(runoff%runoff)) deallocate(runoff%runoff) 136 | if (associated(runoff%dvolrdt)) deallocate(runoff%dvolrdt) 137 | if (associated(runoff%runofflnd)) deallocate(runoff%runofflnd) 138 | if (associated(runoff%dvolrdtlnd)) deallocate(runoff%dvolrdtlnd) 139 | if (associated(runoff%runoffocn)) deallocate(runoff%runoffocn) 140 | if (associated(runoff%dvolrdtocn)) deallocate(runoff%dvolrdtocn) 141 | if (associated(runoff%area)) deallocate(runoff%area) 142 | if (associated(runoff%volr)) deallocate(runoff%volr) 143 | if (associated(runoff%volrlnd)) deallocate(runoff%volrlnd) 144 | if (associated(runoff%fluxout)) deallocate(runoff%fluxout) 145 | if (associated(runoff%lonc)) deallocate(runoff%lonc) 146 | if (associated(runoff%latc)) deallocate(runoff%latc) 147 | if (associated(runoff%rlon)) deallocate(runoff%rlon) 148 | if (associated(runoff%rlat)) deallocate(runoff%rlat) 149 | if (associated(runoff%dsi)) deallocate(runoff%dsi) 150 | if (associated(runoff%runofflnd_nt1)) deallocate(runoff%runofflnd_nt1) 151 | if (associated(runoff%runofflnd_nt2)) deallocate(runoff%runofflnd_nt2) 152 | if (associated(runoff%runoffocn_nt1)) deallocate(runoff%runoffocn_nt1) 153 | if (associated(runoff%runoffocn_nt2)) deallocate(runoff%runoffocn_nt2) 154 | if (associated(runoff%volr_nt1)) deallocate(runoff%volr_nt1) 155 | if (associated(runoff%volr_nt2)) deallocate(runoff%volr_nt2) 156 | if (associated(runoff%dvolrdtlnd_nt1)) deallocate(runoff%dvolrdtlnd_nt1) 157 | if (associated(runoff%dvolrdtlnd_nt2)) deallocate(runoff%dvolrdtlnd_nt2) 158 | if (associated(runoff%dvolrdtocn_nt1)) deallocate(runoff%dvolrdtocn_nt1) 159 | if (associated(runoff%dvolrdtocn_nt2)) deallocate(runoff%dvolrdtocn_nt2) 160 | if (associated(runoff%mask)) deallocate(runoff%mask) 161 | if (associated(runoff%gindex)) deallocate(runoff%gindex) 162 | if (associated(runoff%fthresh)) deallocate(runoff%fthresh) 163 | if (associated(runoff%flood)) deallocate(runoff%flood) 164 | if (associated(runoff%qirrig)) deallocate(runoff%qirrig) 165 | 166 | end subroutine RunoffFinalize 167 | 168 | end module RunoffMod 169 | -------------------------------------------------------------------------------- /cime_config/buildnml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | """Namelist creator for RTM 4 | """ 5 | 6 | # Typically ignore this. 7 | # pylint: disable=invalid-name 8 | 9 | # Disable these because this is our standard setup 10 | # pylint: disable=wildcard-import,unused-wildcard-import,wrong-import-position 11 | # pylint: disable=multiple-imports 12 | import os, sys, glob 13 | 14 | CIMEROOT = os.environ.get("CIMEROOT") 15 | if CIMEROOT is None: 16 | raise SystemExit("ERROR: must set CIMEROOT environment variable") 17 | sys.path.append(os.path.join(CIMEROOT, "CIME", "Tools")) 18 | 19 | from standard_script_setup import * 20 | from CIME.case import Case 21 | from CIME.nmlgen import NamelistGenerator 22 | from CIME.utils import expect, safe_copy 23 | from CIME.buildnml import create_namelist_infile, parse_input 24 | 25 | logger = logging.getLogger(__name__) 26 | 27 | # pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements 28 | #################################################################################### 29 | def _create_namelists(case, confdir, inst_string, infile, nmlgen, data_list_path): 30 | #################################################################################### 31 | """Write out the namelist for this component. 32 | 33 | Most arguments are the same as those for `NamelistGenerator`. The 34 | `inst_string` argument is used as a suffix to distinguish files for 35 | different instances. The `confdir` argument is used to specify the directory 36 | in which output files will be placed. 37 | """ 38 | #---------------------------------------------------- 39 | # Create config dictionary 40 | #---------------------------------------------------- 41 | config = {} 42 | config['rtm_mode'] = case.get_value("RTM_MODE") 43 | config['rtm_flood_mode'] = case.get_value("RTM_FLOOD_MODE") 44 | config['clm_accelerated_spinup'] = case.get_value("CLM_ACCELERATED_SPINUP") 45 | config['rof_grid'] = case.get_value("ROF_GRID") 46 | config['lnd_grid'] = case.get_value("LND_GRID") 47 | config['rof_ncpl'] = case.get_value("ROF_NCPL") 48 | config["simyr"] = case.get_value("RTM_SIM_YEAR") 49 | config["compset"] = case.get_value("COMPSET") 50 | 51 | #---------------------------------------------------- 52 | # Check for incompatible options. 53 | #---------------------------------------------------- 54 | if config["rof_grid"] == "null" and config["rtm_mode"] != "NULL": 55 | expect(False, "ROF_GRID is null RTM_MODE not NULL") 56 | 57 | #---------------------------------------------------- 58 | # Initialize namelist defaults 59 | #---------------------------------------------------- 60 | nmlgen.init_defaults(infile, config) 61 | 62 | #---------------------------------------------------- 63 | # Set values not obtained in the default settings 64 | #---------------------------------------------------- 65 | 66 | run_type = case.get_value("RUN_TYPE") 67 | if ( config["rtm_mode"] != "NULL" ): 68 | finidat_rtm = str(nmlgen.get_value("finidat_rtm")) 69 | else: 70 | finidat_rtm = " " 71 | 72 | if run_type == 'branch' or run_type == 'hybrid': 73 | run_refcase = case.get_value("RUN_REFCASE") 74 | run_refdate = case.get_value("RUN_REFDATE") 75 | run_tod = case.get_value("RUN_REFTOD") 76 | filename = "%s.rtm%s.r.%s-%s.nc" %(run_refcase, inst_string, run_refdate, run_tod) 77 | rundir = case.get_value("RUNDIR") 78 | if not os.path.exists(os.path.join(rundir, filename)): 79 | filename = "%s.rtm.r.%s-%s.nc" %(run_refcase, run_refdate, run_tod) 80 | 81 | if run_type == "hybrid": 82 | nmlgen.add_default("finidat_rtm", value=filename, ignore_abs_path=True) 83 | else: 84 | nmlgen.add_default("nrevsn_rtm", value=filename) 85 | elif finidat_rtm.strip() == '': 86 | nmlgen.set_value('finidat_rtm', value=' ') 87 | else: 88 | if nmlgen.get_default('finidat_rtm') == 'UNSET': 89 | nmlgen.add_default('finidat_rtm', value=' ', ignore_abs_path=True) 90 | else: 91 | nmlgen.add_default("finidat_rtm") 92 | 93 | ncpl_base_period = case.get_value('NCPL_BASE_PERIOD') 94 | if ncpl_base_period == 'hour': 95 | basedt = 3600 96 | elif ncpl_base_period == 'day': 97 | basedt = 3600 * 24 98 | elif ncpl_base_period == 'year': 99 | if case.get_value('CALENDAR') == 'NO_LEAP': 100 | basedt = 3600 * 24 * 365 101 | else: 102 | expect(False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " %ncpl_base_period) 103 | elif ncpl_base_period == 'decade': 104 | if case.get_value('CALENDAR') == 'NO_LEAP': 105 | basedt = 3600 * 24 * 365 * 10 106 | else: 107 | expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) 108 | else: 109 | expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) 110 | 111 | if basedt < 0: 112 | expect(False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " %ncpl_base_period) 113 | 114 | rof_ncpl = case.get_value("ROF_NCPL") 115 | if basedt % rof_ncpl != 0: 116 | expect(False, "rof_ncpl %s doesn't divide evenly into basedt %s\n" 117 | %(rof_ncpl, basedt)) 118 | else: 119 | rtm_tstep = basedt // rof_ncpl 120 | nmlgen.set_value("rtm_tstep", value=rtm_tstep) 121 | 122 | if ( nmlgen.get_value( "frivinp_rtm" ) == "UNSET" and config["rtm_mode"] != "NULL" ): 123 | raise SystemExit("ERROR: Direction file is NOT set and is required when RTM is active: frivinp_rtm") 124 | 125 | #---------------------------------------------------- 126 | # Write output namelist 127 | #---------------------------------------------------- 128 | namelist_file = os.path.join(confdir, "rof_in") 129 | nmlgen.write_output_file(namelist_file, data_list_path, groups=['rtm_inparm']) 130 | 131 | ############################################################################### 132 | def buildnml(case, caseroot, compname): 133 | ############################################################################### 134 | """Build the namelist """ 135 | 136 | # Build the component namelist 137 | if compname != "rtm": 138 | raise AttributeError 139 | 140 | srcroot = case.get_value("SRCROOT") 141 | rundir = case.get_value("RUNDIR") 142 | ninst = case.get_value("NINST_ROF") 143 | 144 | # Determine configuration directory 145 | confdir = os.path.join(caseroot, "Buildconf", "rtmconf") 146 | if not os.path.isdir(confdir): 147 | os.makedirs(confdir) 148 | 149 | #---------------------------------------------------- 150 | # Construct the namelist generator 151 | #---------------------------------------------------- 152 | # determine directory for user modified namelist_definitions.xml and namelist_defaults.xml 153 | user_xml_dir = os.path.join(caseroot, "SourceMods", "src.rtm") 154 | expect(os.path.isdir(user_xml_dir), 155 | "user_xml_dir %s does not exist "%user_xml_dir) 156 | 157 | # NOTE: User definition *replaces* existing definition. 158 | namelist_xml_dir = os.path.join(srcroot, "components", "rtm", "cime_config") 159 | definition_file = [os.path.join(namelist_xml_dir, "namelist_definition_rtm.xml")] 160 | user_definition = os.path.join(user_xml_dir, "namelist_definition_rtm.xml") 161 | if os.path.isfile(user_definition): 162 | definition_file = [user_definition] 163 | for file_ in definition_file: 164 | expect(os.path.isfile(file_), "Namelist XML file %s not found!" % file_) 165 | 166 | # Create the namelist generator object - independent of instance 167 | nmlgen = NamelistGenerator(case, definition_file) 168 | 169 | #---------------------------------------------------- 170 | # Clear out old data. 171 | #---------------------------------------------------- 172 | data_list_path = os.path.join(case.get_case_root(), "Buildconf", "rtm.input_data_list") 173 | if os.path.exists(data_list_path): 174 | os.remove(data_list_path) 175 | #---------------------------------------------------- 176 | # Loop over instances 177 | #---------------------------------------------------- 178 | for inst_counter in range(1, ninst+1): 179 | 180 | # determine instance string 181 | inst_string = "" 182 | if ninst > 1: 183 | inst_string = '_' + '%04d' % inst_counter 184 | 185 | # If multi-instance case does not have restart file, use 186 | # single-case restart for each instance 187 | rpointer = "rpointer.rof" 188 | if (os.path.isfile(os.path.join(rundir, rpointer)) and 189 | (not os.path.isfile(os.path.join(rundir, rpointer + inst_string)))): 190 | safe_copy(os.path.join(rundir, rpointer), 191 | os.path.join(rundir, rpointer + inst_string)) 192 | 193 | inst_string_label = inst_string 194 | if not inst_string_label: 195 | inst_string_label = "\"\"" 196 | 197 | # create namelist output infile using user_nl_file as input 198 | user_nl_file = os.path.join(caseroot, "user_nl_rtm" + inst_string) 199 | expect(os.path.isfile(user_nl_file), 200 | "Missing required user_nl_file %s " %(user_nl_file)) 201 | infile = os.path.join(confdir, "namelist_infile") 202 | create_namelist_infile(case, user_nl_file, infile) 203 | namelist_infile = [infile] 204 | 205 | # create namelist 206 | _create_namelists(case, confdir, inst_string, namelist_infile, nmlgen, data_list_path) 207 | 208 | # copy namelist files and stream text files, to rundir 209 | if os.path.isdir(rundir): 210 | file_src = os.path.join(confdir, 'rof_in') 211 | file_dest = os.path.join(rundir, 'rof_in') 212 | if inst_string: 213 | file_dest += inst_string 214 | safe_copy(file_src, file_dest) 215 | 216 | 217 | ############################################################################### 218 | def _main_func(): 219 | 220 | caseroot = parse_input(sys.argv) 221 | with Case(caseroot) as case: 222 | buildnml(case, caseroot, "rtm") 223 | 224 | if __name__ == "__main__": 225 | _main_func() 226 | -------------------------------------------------------------------------------- /src/riverroute/RtmRestFile.F90: -------------------------------------------------------------------------------- 1 | module RtmRestFile 2 | 3 | !----------------------------------------------------------------------- 4 | !BOP 5 | ! 6 | ! !MODULE: restFileMod 7 | ! 8 | ! !DESCRIPTION: 9 | ! Reads from or writes to/ the RTM restart file. 10 | ! !USES: 11 | use shr_kind_mod , only : r8 => shr_kind_r8 12 | use shr_sys_mod , only : shr_sys_abort 13 | use RtmSpmd , only : masterproc 14 | use RtmVar , only : rtmlon, rtmlat, iulog, inst_suffix, rpntfil, & 15 | caseid, nsrest, brnch_retain_casename, & 16 | finidat_rtm, nrevsn_rtm, spval, & 17 | nsrContinue, nsrBranch, nsrStartup, & 18 | ctitle, version, username, hostname, conventions, source, & 19 | nt_rtm, rtm_tracers 20 | use RtmHistFile , only : RtmHistRestart 21 | use RtmFileUtils , only : getfil 22 | use RtmTimeManager, only : timemgr_restart, get_nstep, get_curr_date, is_last_step, get_prev_date 23 | use RunoffMod , only : runoff 24 | use RtmIO 25 | use RtmDateTime 26 | ! 27 | ! !PUBLIC TYPES: 28 | implicit none 29 | save 30 | ! 31 | ! !PUBLIC MEMBER FUNCTIONS: 32 | public :: RtmRestFileName 33 | public :: RtmRestFileRead 34 | public :: RtmRestFileWrite 35 | public :: RtmRestGetfile 36 | public :: RtmRestTimeManager 37 | public :: RtmRestart 38 | public :: RtmRestFinalize 39 | ! 40 | ! !PRIVATE MEMBER FUNCTIONS: 41 | private :: restFile_read_pfile 42 | private :: restFile_write_pfile ! Writes restart pointer file 43 | private :: restFile_dimset 44 | ! 45 | ! !REVISION HISTORY: 46 | ! Author: Mariana Vertenstein 47 | ! 48 | ! !PRIVATE TYPES: None 49 | private 50 | 51 | !----------------------------------------------------------------------- 52 | contains 53 | !----------------------------------------------------------------------- 54 | 55 | !======================================================================= 56 | 57 | subroutine RtmRestFileWrite( file, rdate ) 58 | 59 | !----------------------------------------------------------------------- 60 | ! !DESCRIPTION: 61 | ! Read/write RTM restart file. 62 | 63 | ! !ARGUMENTS: 64 | implicit none 65 | character(len=*) , intent(in) :: file ! output netcdf restart file 66 | character(len=*) , intent(in) :: rdate ! restart file time stamp for name 67 | 68 | ! !LOCAL VARIABLES: 69 | type(file_desc_t) :: ncid ! netcdf id 70 | integer :: i ! index 71 | logical :: ptrfile ! write out the restart pointer file 72 | !----------------------------------------------------------------------- 73 | 74 | ! Define dimensions and variables 75 | 76 | if (masterproc) then 77 | write(iulog,*) 78 | write(iulog,*)'restFile_open: writing RTM restart dataset ' 79 | write(iulog,*) 80 | end if 81 | call ncd_pio_createfile(ncid, trim(file)) 82 | call restFile_dimset( ncid ) 83 | call RtmRestart( ncid, flag='define' ) 84 | call RtmHistRestart ( ncid, flag='define', rdate=rdate ) 85 | call timemgr_restart( ncid, flag='define' ) 86 | call ncd_enddef(ncid) 87 | 88 | ! Write restart file variables 89 | call RtmRestart( ncid, flag='write' ) 90 | call RtmHistRestart ( ncid, flag='write' ) 91 | call timemgr_restart( ncid, flag='write' ) 92 | call ncd_pio_closefile(ncid) 93 | 94 | if (masterproc) then 95 | write(iulog,*) 'Successfully wrote local restart file ',trim(file) 96 | write(iulog,'(72a1)') ("-",i=1,60) 97 | write(iulog,*) 98 | end if 99 | 100 | ! Write restart pointer file 101 | call restFile_write_pfile( file ) 102 | 103 | ! Write out diagnostic info 104 | 105 | if (masterproc) then 106 | write(iulog,*) 'Successfully wrote out restart data at nstep = ',get_nstep() 107 | write(iulog,'(72a1)') ("-",i=1,60) 108 | end if 109 | 110 | end subroutine RtmRestFileWrite 111 | 112 | !----------------------------------------------------------------------- 113 | 114 | subroutine RtmRestFileRead( file ) 115 | 116 | ! !DESCRIPTION: 117 | ! Read a RTM restart file. 118 | ! 119 | ! !ARGUMENTS: 120 | implicit none 121 | character(len=*), intent(in) :: file ! output netcdf restart file 122 | ! 123 | ! !LOCAL VARIABLES: 124 | type(file_desc_t) :: ncid ! netcdf id 125 | integer :: i ! index 126 | !------------------------------------- 127 | 128 | ! Read file 129 | if (masterproc) write(iulog,*) 'Reading restart dataset' 130 | call ncd_pio_openfile (ncid, trim(file), 0) 131 | call RtmRestart( ncid, flag='read' ) 132 | call RtmHistRestart(ncid, flag='read') 133 | call ncd_pio_closefile(ncid) 134 | 135 | ! Write out diagnostic info 136 | if (masterproc) then 137 | write(iulog,'(72a1)') ("-",i=1,60) 138 | write(iulog,*) 'Successfully read restart data for restart run' 139 | write(iulog,*) 140 | end if 141 | 142 | end subroutine RtmRestFileRead 143 | 144 | !----------------------------------------------------------------------- 145 | 146 | subroutine RtmRestTimeManager( file ) 147 | 148 | ! !DESCRIPTION: 149 | ! Read a RTM restart file. 150 | ! 151 | ! !ARGUMENTS: 152 | implicit none 153 | character(len=*), intent(in) :: file ! output netcdf restart file 154 | ! 155 | ! !LOCAL VARIABLES: 156 | type(file_desc_t) :: ncid ! netcdf id 157 | integer :: i ! index 158 | !------------------------------------- 159 | 160 | ! Read file 161 | if (masterproc) write(iulog,*) 'Reading restart Timemanager: '//trim(file) 162 | call ncd_pio_openfile (ncid, trim(file), 0) 163 | call timemgr_restart(ncid, flag='read') 164 | call ncd_pio_closefile(ncid) 165 | 166 | ! Write out diagnostic info 167 | if (masterproc) then 168 | write(iulog,'(72a1)') ("-",i=1,60) 169 | write(iulog,*) 'Successfully read restart data for restart run' 170 | write(iulog,*) 171 | end if 172 | 173 | end subroutine RtmRestTimeManager 174 | 175 | !----------------------------------------------------------------------- 176 | 177 | subroutine RtmRestGetfile( file, path ) 178 | 179 | !--------------------------------------------------- 180 | ! DESCRIPTION: 181 | ! Determine and obtain netcdf restart file 182 | 183 | ! ARGUMENTS: 184 | implicit none 185 | character(len=*), intent(out) :: file ! name of netcdf restart file 186 | character(len=*), intent(out) :: path ! full pathname of netcdf restart file 187 | 188 | ! LOCAL VARIABLES: 189 | integer :: status ! return status 190 | integer :: length ! temporary 191 | character(len=256) :: ftest,ctest ! temporaries 192 | !--------------------------------------------------- 193 | 194 | ! Continue run: 195 | ! Restart file pathname is read restart pointer file 196 | if (nsrest==nsrContinue) then 197 | call restFile_read_pfile( path ) 198 | call getfil( path, file, 0 ) 199 | end if 200 | 201 | ! Branch run: 202 | ! Restart file pathname is obtained from namelist "nrevsn_rtm" 203 | if (nsrest==nsrBranch) then 204 | length = len_trim(nrevsn_rtm) 205 | if (nrevsn_rtm(length-2:length) == '.nc') then 206 | path = trim(nrevsn_rtm) 207 | else 208 | path = trim(nrevsn_rtm) // '.nc' 209 | end if 210 | call getfil( path, file, 0 ) 211 | 212 | ! Check case name consistency (case name must be different 213 | ! for branch run, unless brnch_retain_casename is set) 214 | ctest = 'xx.'//trim(caseid)//'.rtm' 215 | ftest = 'xx.'//trim(file) 216 | status = index(trim(ftest),trim(ctest)) 217 | if (status /= 0 .and. .not.(brnch_retain_casename)) then 218 | write(iulog,*) 'Must change case name on branch run if ',& 219 | 'brnch_retain_casename namelist is not set' 220 | write(iulog,*) 'previous case filename= ',trim(file),& 221 | ' current case = ',trim(caseid), ' ctest = ',trim(ctest), & 222 | ' ftest = ',trim(ftest) 223 | call shr_sys_abort() 224 | end if 225 | end if 226 | 227 | ! Initial run 228 | if (nsrest==nsrStartup) then 229 | call getfil( finidat_rtm, file, 0 ) 230 | end if 231 | 232 | end subroutine RtmRestGetfile 233 | 234 | !----------------------------------------------------------------------- 235 | 236 | subroutine restFile_read_pfile( pnamer ) 237 | ! !DESCRIPTION: 238 | ! Setup restart file and perform necessary consistency checks 239 | !!USES: 240 | use mpi, only : MPI_CHARACTER 241 | use RtmSpmd, only : mpicom_rof 242 | 243 | ! !ARGUMENTS: 244 | implicit none 245 | character(len=*), intent(out) :: pnamer ! full path of restart file 246 | 247 | ! !LOCAL VARIABLES: 248 | integer :: nio ! restart unit 249 | integer :: ier ! error return from fortran open 250 | integer :: i ! indices 251 | integer :: yr, mon, day, tod ! Year, month, day of month, and time-of-day 252 | character(len=17) :: timestamp ! Simulation timestamp for current date 253 | character(len=256) :: locfn ! Restart pointer file name 254 | !------------------------------------- 255 | 256 | if (masterproc) then 257 | call get_curr_date(yr, mon, day, tod) 258 | write(timestamp,'(".",i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,tod 259 | locfn = './'// trim(rpntfil)//trim(inst_suffix)//timestamp 260 | 261 | write(iulog,*) 'Reading restart pointer file: '//trim(locfn) 262 | open (newunit=nio, file=trim(locfn), status='old', form='formatted', iostat=ier) 263 | if (ier /= 0) then 264 | locfn = './'// trim(rpntfil)//trim(inst_suffix) 265 | open (newunit=nio, file=trim(locfn), status='old', form='formatted', iostat=ier) 266 | if (ier /= 0) then 267 | write(iulog,'(a,i8)')'(restFile_read_pfile): failed to open file '//trim(locfn)//' ierr=',ier 268 | call shr_sys_abort() 269 | end if 270 | endif 271 | read (nio,'(a256)') pnamer 272 | close(nio) 273 | endif 274 | 275 | call mpi_bcast (pnamer, len(pnamer), MPI_CHARACTER, 0, mpicom_rof, ier) 276 | if (masterproc) then 277 | write(iulog,'(a)') 'Reading restart data: ',trim(pnamer) 278 | write(iulog,'(72a1)') ("-",i=1,60) 279 | end if 280 | 281 | end subroutine restFile_read_pfile 282 | 283 | !----------------------------------------------------------------------- 284 | 285 | subroutine restFile_write_pfile( fnamer ) 286 | 287 | ! !DESCRIPTION: 288 | ! Open restart pointer file. Write names of current netcdf restart file. 289 | ! 290 | ! !ARGUMENTS: 291 | implicit none 292 | character(len=*), intent(in) :: fnamer 293 | ! 294 | ! !LOCAL VARIABLES: 295 | integer :: m ! index 296 | integer :: nio ! restart pointer file unit number 297 | character(len=256) :: filename ! local file name 298 | integer :: ier ! error return from fortran open 299 | integer :: yr, mon, day, tod ! Year, month, day, time-of-day 300 | character(len=17) :: timestamp ! Simulation current time-stamp as string 301 | 302 | if (masterproc) then 303 | call get_curr_date(yr, mon, day, tod) 304 | write(timestamp,'(".",i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr, mon, day, tod 305 | filename= './'// trim(rpntfil)//trim(inst_suffix)//timestamp 306 | open (newunit=nio, file=trim(filename), status='unknown', form='formatted', iostat=ier) 307 | if (ier /= 0) then 308 | write(iulog,'(a,i8)')'(restFile_write_pfile): failed to open file '//trim(filename)//' ierr=',ier 309 | call shr_sys_abort() 310 | end if 311 | 312 | write(nio,'(a)') fnamer 313 | close( nio ) 314 | write(iulog,*)'Successfully wrote local restart pointer file: '//trim(filename) 315 | end if 316 | 317 | end subroutine restFile_write_pfile 318 | 319 | !----------------------------------------------------------------------- 320 | 321 | character(len=256) function RtmRestFileName( rdate ) 322 | 323 | implicit none 324 | character(len=*), intent(in) :: rdate ! input date for restart file name 325 | 326 | RtmRestFileName = "./"//trim(caseid)//".rtm"//trim(inst_suffix)//".r."//trim(rdate)//".nc" 327 | if (masterproc) then 328 | write(iulog,*)'writing restart file ',trim(RtmRestFileName),' for model date = ',rdate 329 | end if 330 | 331 | end function RtmRestFileName 332 | 333 | !------------------------------------------------------------------------ 334 | 335 | subroutine restFile_dimset( ncid ) 336 | 337 | !---------------------------------------------------------------- 338 | ! !DESCRIPTION: 339 | ! Read/Write initial data from/to netCDF instantaneous initial data file 340 | 341 | ! !ARGUMENTS: 342 | implicit none 343 | type(file_desc_t), intent(inout) :: ncid 344 | 345 | ! !LOCAL VARIABLES: 346 | integer :: dimid ! netCDF dimension id 347 | integer :: ier ! error status 348 | character(len= 8) :: curdate ! current date 349 | character(len= 8) :: curtime ! current time 350 | character(len=256) :: str 351 | character(len= 32) :: subname='restFile_dimset' ! subroutine name 352 | !---------------------------------------------------------------- 353 | 354 | ! Define dimensions 355 | 356 | call ncd_defdim(ncid, 'rtmlon' , rtmlon , dimid) 357 | call ncd_defdim(ncid, 'rtmlat' , rtmlat , dimid) 358 | call ncd_defdim(ncid, 'string_length', 64 , dimid) 359 | 360 | ! Define global attributes 361 | 362 | call ncd_putatt(ncid, NCD_GLOBAL, 'Conventions', trim(conventions)) 363 | call getdatetime(curdate, curtime) 364 | str = 'created on ' // curdate // ' ' // curtime 365 | call ncd_putatt(ncid, NCD_GLOBAL, 'history' , trim(str)) 366 | call ncd_putatt(ncid, NCD_GLOBAL, 'username', trim(username)) 367 | call ncd_putatt(ncid, NCD_GLOBAL, 'host' , trim(hostname)) 368 | call ncd_putatt(ncid, NCD_GLOBAL, 'version' , trim(version)) 369 | call ncd_putatt(ncid, NCD_GLOBAL, 'source' , trim(source)) 370 | call ncd_putatt(ncid, NCD_GLOBAL, 'case_title' , trim(ctitle)) 371 | call ncd_putatt(ncid, NCD_GLOBAL, 'case_id' , trim(caseid)) 372 | call ncd_putatt(ncid, NCD_GLOBAL, 'title', & 373 | 'RTM Restart information, required to continue a simulation' ) 374 | 375 | end subroutine restFile_dimset 376 | 377 | !----------------------------------------------------------------------- 378 | 379 | subroutine RtmRestart(ncid, flag) 380 | 381 | !----------------------------------------------------------------------- 382 | ! DESCRIPTION: 383 | ! Read/write RTM restart data. 384 | ! 385 | ! ARGUMENTS: 386 | implicit none 387 | type(file_desc_t), intent(inout) :: ncid ! netcdf id 388 | character(len=*) , intent(in) :: flag ! 'read' or 'write' 389 | ! LOCAL VARIABLES: 390 | logical :: readvar ! determine if variable is on initial file 391 | integer :: nt,nv,n ! indices 392 | real(r8) , pointer :: dfld(:) ! temporary array 393 | character(len=32) :: vname,uname 394 | character(len=255) :: lname 395 | !----------------------------------------------------------------------- 396 | 397 | do nv = 1,4 398 | do nt = 1,nt_rtm 399 | 400 | if (nv == 1) then 401 | vname = 'RTM_VOLR_'//trim(rtm_tracers(nt)) 402 | lname = 'water volume in cell (volr)' 403 | uname = 'm3' 404 | dfld => runoff%volr(:,nt) 405 | elseif (nv == 2) then 406 | vname = 'RTM_FLUXOUT_'//trim(rtm_tracers(nt)) 407 | lname = 'water fluxout in cell (fluxout)' 408 | uname = 'm3/s' 409 | dfld => runoff%fluxout(:,nt) 410 | elseif (nv == 3) then 411 | vname = 'RTM_RUNOFF_'//trim(rtm_tracers(nt)) 412 | lname = 'runoff (runoff)' 413 | uname = 'm3/s' 414 | dfld => runoff%runoff(:,nt) 415 | elseif (nv == 4) then 416 | vname = 'RTM_DVOLRDT_'//trim(rtm_tracers(nt)) 417 | lname = 'water volume change in cell (dvolrdt)' 418 | uname = 'mm/s' 419 | dfld => runoff%dvolrdt(:,nt) 420 | else 421 | write(iulog,*) 'Rtm ERROR: illegal nv value a ',nv 422 | call shr_sys_abort() 423 | endif 424 | 425 | if (flag == 'define') then 426 | call ncd_defvar(ncid=ncid, varname=trim(vname), & 427 | xtype=ncd_double, dim1name='rtmlon', dim2name='rtmlat', & 428 | long_name=trim(lname), units=trim(uname), fill_value=spval) 429 | else if (flag == 'read' .or. flag == 'write') then 430 | call ncd_io(varname=trim(vname), data=dfld, dim1name='allrof', & 431 | ncid=ncid, flag=flag, readvar=readvar) 432 | if (flag=='read' .and. .not. readvar) then 433 | if (nsrest == nsrContinue) then 434 | call shr_sys_abort() 435 | else 436 | dfld = 0._r8 437 | end if 438 | end if 439 | end if 440 | 441 | enddo 442 | enddo 443 | 444 | if (flag == 'read') then 445 | do n = runoff%begr,runoff%endr 446 | do nt = 1,nt_rtm 447 | if (abs(runoff%volr(n,nt)) > 1.e30) runoff%volr(n,nt) = 0. 448 | if (abs(runoff%runoff(n,nt)) > 1.e30) runoff%runoff(n,nt) = 0. 449 | if (abs(runoff%dvolrdt(n,nt)) > 1.e30) runoff%dvolrdt(n,nt) = 0. 450 | if (abs(runoff%fluxout(n,nt)) > 1.e30) runoff%fluxout(n,nt) = 0. 451 | end do 452 | if (runoff%mask(n) == 1) then 453 | do nt = 1,nt_rtm 454 | runoff%runofflnd(n,nt) = runoff%runoff(n,nt) 455 | runoff%dvolrdtlnd(n,nt)= runoff%dvolrdt(n,nt) 456 | runoff%volrlnd(n,nt) = runoff%volr(n,nt) 457 | end do 458 | elseif (runoff%mask(n) == 2) then 459 | do nt = 1,nt_rtm 460 | runoff%runoffocn(n,nt) = runoff%runoff(n,nt) 461 | runoff%dvolrdtocn(n,nt)= runoff%dvolrdt(n,nt) 462 | enddo 463 | endif 464 | enddo 465 | endif 466 | 467 | end subroutine RtmRestart 468 | 469 | subroutine RtmRestFinalize( ) 470 | 471 | ! !DESCRIPTION: 472 | ! clean up memory after a RTM restart handling 473 | ! 474 | use RtmIO , only : ncd_finalize 475 | ! 476 | ! !ARGUMENTS: 477 | implicit none 478 | 479 | call ncd_finalize() 480 | 481 | end subroutine RtmRestFinalize 482 | 483 | end module RtmRestFile 484 | -------------------------------------------------------------------------------- /src/cpl/nuopc/rof_import_export.F90: -------------------------------------------------------------------------------- 1 | module rof_import_export 2 | 3 | ! This module provides the interface layer to transfer ESMF import/export data to the 4 | ! RTM data structures. 5 | 6 | use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet 7 | use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO 8 | use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError 9 | use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag 10 | use ESMF , only : operator(/=), operator(==) 11 | use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected 12 | use NUOPC_Model , only : NUOPC_ModelGet 13 | use shr_kind_mod , only : r8 => shr_kind_r8 14 | use shr_sys_mod , only : shr_sys_abort 15 | use nuopc_shr_methods , only : chkerr 16 | use RunoffMod , only : runoff 17 | use RtmVar , only : iulog, nt_rtm, rtm_tracers, rtmlon, rtmlat 18 | use RtmSpmd , only : masterproc 19 | use RtmTimeManager , only : get_nstep 20 | 21 | implicit none 22 | private ! except 23 | 24 | public :: advertise_fields 25 | public :: realize_fields 26 | public :: import_fields 27 | public :: export_fields 28 | 29 | private :: fldlist_add 30 | private :: fldlist_realize 31 | private :: state_getimport 32 | private :: state_setexport 33 | private :: check_for_nans 34 | 35 | type fld_list_type 36 | character(len=128) :: stdname 37 | end type fld_list_type 38 | 39 | integer, parameter :: fldsMax = 100 40 | integer :: fldsToRof_num = 0 41 | integer :: fldsFrRof_num = 0 42 | type (fld_list_type) :: fldsToRof(fldsMax) 43 | type (fld_list_type) :: fldsFrRof(fldsMax) 44 | 45 | ! area correction factors for fluxes send and received from mediator 46 | real(r8), allocatable :: mod2med_areacor(:) 47 | real(r8), allocatable :: med2mod_areacor(:) 48 | 49 | character(*),parameter :: F01 = "('(rof_import_export) ',a,i5,2x,3(i8,2x),d21.9)" 50 | character(*),parameter :: u_FILE_u = & 51 | __FILE__ 52 | 53 | !=============================================================================== 54 | contains 55 | !=============================================================================== 56 | 57 | subroutine advertise_fields(gcomp, flds_scalar_name, rc) 58 | 59 | ! input/output variables 60 | type(ESMF_GridComp) :: gcomp 61 | character(len=*) , intent(in) :: flds_scalar_name 62 | integer , intent(out) :: rc 63 | 64 | ! local variables 65 | type(ESMF_State) :: importState 66 | type(ESMF_State) :: exportState 67 | character(ESMF_MAXSTR) :: stdname 68 | character(ESMF_MAXSTR) :: cvalue 69 | integer :: n, num 70 | character(len=128) :: fldname 71 | character(len=*), parameter :: subname='(rof_import_export:advertise_fields)' 72 | !------------------------------------------------------------------------------- 73 | 74 | rc = ESMF_SUCCESS 75 | 76 | call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) 77 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 78 | 79 | !-------------------------------- 80 | ! Advertise export fields 81 | !-------------------------------- 82 | 83 | call fldlist_add(fldsFrRof_num, fldsFrRof, trim(flds_scalar_name)) 84 | call fldlist_add(fldsFrRof_num, fldsFrRof, 'Forr_rofl') 85 | call fldlist_add(fldsFrRof_num, fldsFrRof, 'Forr_rofi') 86 | call fldlist_add(fldsFrRof_num, fldsFrRof, 'Flrr_flood') 87 | call fldlist_add(fldsFrRof_num, fldsFrRof, 'Flrr_volr') 88 | call fldlist_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch') 89 | 90 | do n = 1,fldsFrRof_num 91 | call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & 92 | TransferOfferGeomObject='will provide', rc=rc) 93 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 94 | enddo 95 | 96 | !-------------------------------- 97 | ! Advertise import fields 98 | !-------------------------------- 99 | 100 | call fldlist_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) 101 | 102 | call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') 103 | call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') 104 | call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofsub') 105 | call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') 106 | call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_irrig') 107 | 108 | do n = 1,fldsToRof_num 109 | call NUOPC_Advertise(importState, standardName=fldsToRof(n)%stdname, & 110 | TransferOfferGeomObject='will provide', rc=rc) 111 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 112 | enddo 113 | 114 | end subroutine advertise_fields 115 | 116 | !=============================================================================== 117 | subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) 118 | 119 | use ESMF , only : ESMF_GridComp, ESMF_StateGet 120 | use ESMF , only : ESMF_Mesh, ESMF_MeshGet 121 | use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldRegridGetArea 122 | use shr_const_mod , only : shr_const_rearth 123 | use shr_mpi_mod , only : shr_mpi_min, shr_mpi_max 124 | use RtmSpmd , only : masterproc, mpicom_rof 125 | 126 | ! input/output variables 127 | type(ESMF_GridComp) , intent(inout) :: gcomp 128 | type(ESMF_Mesh) , intent(in) :: Emesh 129 | character(len=*) , intent(in) :: flds_scalar_name 130 | integer , intent(in) :: flds_scalar_num 131 | integer , intent(out) :: rc 132 | 133 | ! local variables 134 | type(ESMF_State) :: importState 135 | type(ESMF_State) :: exportState 136 | type(ESMF_Field) :: lfield 137 | integer :: numOwnedElements 138 | integer :: n,g 139 | real(r8), allocatable :: mesh_areas(:) 140 | real(r8), allocatable :: model_areas(:) 141 | real(r8), pointer :: dataptr(:) 142 | real(r8) :: re = shr_const_rearth*0.001_r8 ! radius of earth (km) 143 | real(r8) :: max_mod2med_areacor 144 | real(r8) :: max_med2mod_areacor 145 | real(r8) :: min_mod2med_areacor 146 | real(r8) :: min_med2mod_areacor 147 | real(r8) :: max_mod2med_areacor_glob 148 | real(r8) :: max_med2mod_areacor_glob 149 | real(r8) :: min_mod2med_areacor_glob 150 | real(r8) :: min_med2mod_areacor_glob 151 | character(len=*), parameter :: subname='(rof_import_export:realize_fields)' 152 | !--------------------------------------------------------------------------- 153 | 154 | rc = ESMF_SUCCESS 155 | 156 | call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) 157 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 158 | 159 | call fldlist_realize( & 160 | state=ExportState, & 161 | fldList=fldsFrRof, & 162 | numflds=fldsFrRof_num, & 163 | flds_scalar_name=flds_scalar_name, & 164 | flds_scalar_num=flds_scalar_num, & 165 | tag=subname//':RTMExport',& 166 | mesh=Emesh, rc=rc) 167 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 168 | 169 | call fldlist_realize( & 170 | state=importState, & 171 | fldList=fldsToRof, & 172 | numflds=fldsToRof_num, & 173 | flds_scalar_name=flds_scalar_name, & 174 | flds_scalar_num=flds_scalar_num, & 175 | tag=subname//':RTMImport',& 176 | mesh=Emesh, rc=rc) 177 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 178 | 179 | ! Determine areas for regridding 180 | call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc) 181 | if (chkerr(rc,__LINE__,u_FILE_u)) return 182 | call ESMF_StateGet(exportState, itemName=trim(fldsFrRof(2)%stdname), field=lfield, rc=rc) 183 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 184 | call ESMF_FieldRegridGetArea(lfield, rc=rc) 185 | if (chkerr(rc,__LINE__,u_FILE_u)) return 186 | call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) 187 | if (chkerr(rc,__LINE__,u_FILE_u)) return 188 | allocate(mesh_areas(numOwnedElements)) 189 | mesh_areas(:) = dataptr(:) 190 | 191 | ! Determine flux correction factors (module variables) 192 | allocate(model_areas(numOwnedElements)) 193 | allocate (mod2med_areacor(numOwnedElements)) 194 | allocate (med2mod_areacor(numOwnedElements)) 195 | n = 0 196 | do g = runoff%begr,runoff%endr 197 | n = n + 1 198 | model_areas(n) = runoff%area(g)*1.0e-6_r8/(re*re) 199 | mod2med_areacor(n) = model_areas(n) / mesh_areas(n) 200 | med2mod_areacor(n) = mesh_areas(n) / model_areas(n) 201 | end do 202 | deallocate(model_areas) 203 | deallocate(mesh_areas) 204 | 205 | min_mod2med_areacor = minval(mod2med_areacor) 206 | max_mod2med_areacor = maxval(mod2med_areacor) 207 | min_med2mod_areacor = minval(med2mod_areacor) 208 | max_med2mod_areacor = maxval(med2mod_areacor) 209 | call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom_rof) 210 | call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom_rof) 211 | call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom_rof) 212 | call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom_rof) 213 | 214 | if (masterproc) then 215 | write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& 216 | min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'RTM' 217 | write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& 218 | min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'RTM' 219 | end if 220 | 221 | end subroutine realize_fields 222 | 223 | !=============================================================================== 224 | subroutine import_fields( gcomp, totrunin, rc ) 225 | 226 | !--------------------------------------------------------------------------- 227 | ! Obtain the runoff input from the mediator and convert from kg/m2s to m3/s 228 | !--------------------------------------------------------------------------- 229 | 230 | ! input/output variables 231 | type(ESMF_GridComp) :: gcomp 232 | real(r8), intent(out) :: totrunin( runoff%begr: ,: ) 233 | integer , intent(out) :: rc 234 | 235 | ! Local variables 236 | type(ESMF_State) :: importState 237 | integer :: n,nt,ix,iy 238 | integer :: begr, endr 239 | integer :: nliq, nfrz 240 | real(r8), pointer :: temp(:,:) 241 | character(len=*), parameter :: subname='(rof_import_export:import_fields)' 242 | !--------------------------------------------------------------------------- 243 | 244 | rc = ESMF_SUCCESS 245 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 246 | 247 | ! Get import state 248 | call NUOPC_ModelGet(gcomp, importState=importState, rc=rc) 249 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 250 | 251 | ! Set tracers 252 | nliq = 0 253 | nfrz = 0 254 | do nt = 1,nt_rtm 255 | if (trim(rtm_tracers(nt)) == 'LIQ') nliq = nt 256 | if (trim(rtm_tracers(nt)) == 'ICE') nfrz = nt 257 | enddo 258 | if (nliq == 0 .or. nfrz == 0) then 259 | write(iulog,*) trim(subname),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers 260 | call shr_sys_abort() 261 | endif 262 | 263 | ! determine output array and scale by unit convertsion 264 | ! NOTE: the call to state_getimport will convert from input kg/m2s to m3/s 265 | 266 | begr = runoff%begr 267 | endr = runoff%endr 268 | allocate(temp(begr:endr,3)) 269 | 270 | call state_getimport(importState, 'Flrl_rofsur', begr, endr, runoff%area, output=temp(:,1), do_area_correction=.true., rc=rc) 271 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 272 | 273 | call state_getimport(importState, 'Flrl_rofsub', begr, endr, runoff%area, output=temp(:,2), do_area_correction=.true., rc=rc) 274 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 275 | 276 | call state_getimport(importState, 'Flrl_rofgwl', begr, endr, runoff%area, output=temp(:,3), do_area_correction=.true., rc=rc) 277 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 278 | 279 | call state_getimport(importState, 'Flrl_irrig', begr, endr, runoff%area, output=runoff%qirrig, do_area_correction=.true., rc=rc) 280 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 281 | 282 | do n = begr,endr 283 | totrunin(n,nliq) = temp(n,1) + temp(n,2) + temp(n,3) + runoff%qirrig(n) 284 | enddo 285 | 286 | call state_getimport(importState, 'Flrl_rofi', begr, endr, runoff%area, output=totrunin(:,nfrz), do_area_correction=.true., rc=rc) 287 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 288 | 289 | 290 | ! convert to mm/s for rtmmod 291 | do n = begr,endr 292 | totrunin(n,:) = totrunin(n,:) /(0.001_r8 * runoff%area(n)) 293 | enddo 294 | deallocate(temp) 295 | 296 | end subroutine import_fields 297 | 298 | !==================================================================================== 299 | subroutine export_fields (gcomp, rc) 300 | 301 | !--------------------------------------------------------------------------- 302 | ! Send the runoff model export state to the mediator and convert from m3/s to kg/m2s 303 | !--------------------------------------------------------------------------- 304 | 305 | ! uses 306 | use RtmVar, only : ice_runoff 307 | 308 | ! input/output/variables 309 | type(ESMF_GridComp) :: gcomp 310 | integer, intent(out) :: rc 311 | 312 | ! Local variables 313 | type(ESMF_State) :: exportState 314 | integer :: n,nt,ix,iy 315 | integer :: begr,endr 316 | integer :: nliq, nfrz 317 | real(r8), pointer :: rofl(:) 318 | real(r8), pointer :: rofi(:) 319 | real(r8), pointer :: flood(:) 320 | real(r8), pointer :: volr(:) 321 | real(r8), pointer :: volrmch(:) 322 | logical, save :: first_time = .true. 323 | character(len=*), parameter :: subname='(rof_import_export:export_fields)' 324 | !--------------------------------------------------------------------------- 325 | 326 | rc = ESMF_SUCCESS 327 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 328 | 329 | ! Get export state 330 | call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) 331 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 332 | 333 | ! Set tracers 334 | nliq = 0 335 | nfrz = 0 336 | do nt = 1,nt_rtm 337 | if (trim(rtm_tracers(nt)) == 'LIQ') nliq = nt 338 | if (trim(rtm_tracers(nt)) == 'ICE') nfrz = nt 339 | enddo 340 | if (nliq == 0 .or. nfrz == 0) then 341 | write(iulog,*) trim(subname),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers 342 | call shr_sys_abort() 343 | endif 344 | 345 | if (first_time) then 346 | if (masterproc) then 347 | if ( ice_runoff )then 348 | write(iulog,*)'Snow capping will flow out in frozen river runoff' 349 | else 350 | write(iulog,*)'Snow capping will flow out in liquid river runoff' 351 | endif 352 | endif 353 | first_time = .false. 354 | end if 355 | 356 | begr = runoff%begr 357 | endr = runoff%endr 358 | 359 | allocate(rofl(begr:endr)) ; rofl(:) = 0._r8 360 | allocate(rofi(begr:endr)) ; rofi(:) = 0._r8 361 | allocate(flood(begr:endr)) ; flood(:) = 0._r8 362 | allocate(volr(begr:endr)) ; volr(:) = 0._r8 363 | allocate(volrmch(begr:endr)) ; volrmch = 0._r8 364 | 365 | if ( ice_runoff )then 366 | ! separate liquid and ice runoff 367 | do n = begr,endr 368 | if (runoff%mask(n) >= 2) then 369 | ! liquid and ice runoff are treated separately - this is what goes to the ocean 370 | rofl(n) = runoff%runoff(n,nliq)/(runoff%area(n)*1.0e-6_r8*1000._r8) 371 | rofi(n) = runoff%runoff(n,nfrz)/(runoff%area(n)*1.0e-6_r8*1000._r8) 372 | end if 373 | end do 374 | else 375 | do n = begr,endr 376 | if (runoff%mask(n) == 2) then 377 | ! liquid and ice runoff are bundled together to liquid runoff 378 | ! and then ice runoff set to zero 379 | rofl(n) = (runoff%runoff(n,nfrz) + runoff%runoff(n,nliq)) / (runoff%area(n)*1.0e-6_r8*1000._r8) 380 | rofi(n) = 0._r8 381 | end if 382 | end do 383 | end if 384 | call state_setexport(exportState, 'Forr_rofl', begr, endr, input=rofl, do_area_correction=.true., rc=rc) 385 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 386 | call state_setexport(exportState, 'Forr_rofi', begr, endr, input=rofi, do_area_correction=.true., rc=rc) 387 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 388 | 389 | ! Flooding back to land, sign convention is positive in land->rof direction 390 | ! so if water is sent from rof to land, the flux must be negative. 391 | 392 | do n = begr, endr 393 | flood(n) = -runoff%flood(n) / runoff%area(n) 394 | end do 395 | call state_setexport(exportState, 'Flrr_flood', begr, endr, input=flood, do_area_correction=.true., rc=rc) 396 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 397 | 398 | do n = begr, endr 399 | volr(n) = runoff%volr(n,nliq)/ runoff%area(n) 400 | volrmch(n) = volr(n) ! main channel not defined in rtm so use total 401 | end do 402 | call state_setexport(exportState, 'Flrr_volr', begr, endr, input=volr, do_area_correction=.true., rc=rc) 403 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 404 | call state_setexport(exportState, 'Flrr_volrmch', begr, endr, input=volrmch, do_area_correction=.true., rc=rc) 405 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 406 | 407 | deallocate(rofl, rofi, flood, volr, volrmch) 408 | 409 | end subroutine export_fields 410 | 411 | !=============================================================================== 412 | subroutine fldlist_add(num, fldlist, stdname) 413 | integer, intent(inout) :: num 414 | type(fld_list_type), intent(inout) :: fldlist(:) 415 | character(len=*), intent(in) :: stdname 416 | 417 | ! local variables 418 | integer :: rc 419 | character(len=*), parameter :: subname='(rof_import_export:fldlist_add)' 420 | !------------------------------------------------------------------------------- 421 | 422 | ! Set up a list of field information 423 | 424 | num = num + 1 425 | if (num > fldsMax) then 426 | call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & 427 | ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) 428 | return 429 | endif 430 | fldlist(num)%stdname = trim(stdname) 431 | 432 | end subroutine fldlist_add 433 | 434 | !=============================================================================== 435 | subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) 436 | 437 | use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize 438 | use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 439 | use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove 440 | use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS 441 | use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU 442 | 443 | type(ESMF_State) , intent(inout) :: state 444 | type(fld_list_type) , intent(in) :: fldList(:) 445 | integer , intent(in) :: numflds 446 | character(len=*) , intent(in) :: flds_scalar_name 447 | integer , intent(in) :: flds_scalar_num 448 | character(len=*) , intent(in) :: tag 449 | type(ESMF_Mesh) , intent(in) :: mesh 450 | integer , intent(inout) :: rc 451 | 452 | ! local variables 453 | integer :: n 454 | type(ESMF_Field) :: field 455 | character(len=80) :: stdname 456 | character(len=*),parameter :: subname='(rof_import_export:fldlist_realize)' 457 | ! ---------------------------------------------- 458 | 459 | rc = ESMF_SUCCESS 460 | 461 | do n = 1, numflds 462 | stdname = fldList(n)%stdname 463 | if (NUOPC_IsConnected(state, fieldName=stdname)) then 464 | if (stdname == trim(flds_scalar_name)) then 465 | call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & 466 | ESMF_LOGMSG_INFO) 467 | ! Create the scalar field 468 | call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) 469 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 470 | else 471 | call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & 472 | ESMF_LOGMSG_INFO) 473 | ! Create the field 474 | field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) 475 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 476 | endif 477 | 478 | ! NOW call NUOPC_Realize 479 | call NUOPC_Realize(state, field=field, rc=rc) 480 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 481 | else 482 | if (stdname /= trim(flds_scalar_name)) then 483 | call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & 484 | ESMF_LOGMSG_INFO) 485 | call ESMF_StateRemove(state, (/stdname/), rc=rc) 486 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 487 | end if 488 | end if 489 | end do 490 | 491 | contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 492 | 493 | subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) 494 | ! ---------------------------------------------- 495 | ! create a field with scalar data on the root pe 496 | ! ---------------------------------------------- 497 | use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid 498 | use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU 499 | use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 500 | 501 | type(ESMF_Field) , intent(inout) :: field 502 | character(len=*) , intent(in) :: flds_scalar_name 503 | integer , intent(in) :: flds_scalar_num 504 | integer , intent(inout) :: rc 505 | 506 | ! local variables 507 | type(ESMF_Distgrid) :: distgrid 508 | type(ESMF_Grid) :: grid 509 | character(len=*), parameter :: subname='(rof_import_export:SetScalarField)' 510 | ! ---------------------------------------------- 511 | 512 | rc = ESMF_SUCCESS 513 | 514 | ! create a DistGrid with a single index space element, which gets mapped onto DE 0. 515 | distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) 516 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 517 | 518 | grid = ESMF_GridCreate(distgrid, rc=rc) 519 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 520 | 521 | field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & 522 | ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), gridToFieldMap=(/2/), rc=rc) 523 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 524 | 525 | end subroutine SetScalarField 526 | 527 | end subroutine fldlist_realize 528 | 529 | !=============================================================================== 530 | subroutine state_getimport(state, fldname, begr, endr, area, output, do_area_correction, rc) 531 | 532 | ! ---------------------------------------------- 533 | ! Map import state field to output array 534 | ! ---------------------------------------------- 535 | 536 | use ESMF, only : ESMF_StateGet, ESMF_FieldGet, ESMF_Field 537 | 538 | ! input/output variables 539 | type(ESMF_State) , intent(in) :: state 540 | character(len=*) , intent(in) :: fldname 541 | integer , intent(in) :: begr 542 | integer , intent(in) :: endr 543 | real(r8) , intent(in) :: area(begr:endr) 544 | logical , intent(in) :: do_area_correction 545 | real(r8) , intent(out) :: output(begr:endr) 546 | integer , intent(out) :: rc 547 | 548 | ! local variables 549 | type(ESMF_Field) :: lfield 550 | integer :: g, i 551 | real(R8), pointer :: fldptr(:) 552 | character(len=*), parameter :: subname='(rof_import_export:state_getimport)' 553 | ! ---------------------------------------------- 554 | 555 | rc = ESMF_SUCCESS 556 | 557 | ! get field pointer 558 | call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) 559 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 560 | call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) 561 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 562 | 563 | ! determine output array and scale by unit convertsion 564 | if (do_area_correction) then 565 | fldptr(:) = fldptr(:) * med2mod_areacor(:) 566 | end if 567 | do g = begr,endr 568 | output(g) = fldptr(g-begr+1) * area(g)*0.001_r8 569 | end do 570 | 571 | ! check for nans 572 | call check_for_nans(fldptr, trim(fldname), begr) 573 | 574 | end subroutine state_getimport 575 | 576 | !=============================================================================== 577 | subroutine state_setexport(state, fldname, begr, endr, input, do_area_correction, rc) 578 | 579 | ! ---------------------------------------------- 580 | ! Map input array to export state field 581 | ! ---------------------------------------------- 582 | 583 | use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_Field 584 | use shr_const_mod, only : fillvalue=>SHR_CONST_SPVAL 585 | 586 | ! input/output variables 587 | type(ESMF_State) , intent(inout) :: state 588 | character(len=*) , intent(in) :: fldname 589 | integer , intent(in) :: begr 590 | integer , intent(in) :: endr 591 | real(r8) , intent(in) :: input(begr:endr) 592 | logical , intent(in) :: do_area_correction 593 | integer , intent(out) :: rc 594 | 595 | ! local variables 596 | type(ESMF_Field) :: lfield 597 | integer :: g, i 598 | real(R8), pointer :: fldptr(:) 599 | character(len=*), parameter :: subname='(rof_import_export:state_setexport)' 600 | ! ---------------------------------------------- 601 | 602 | rc = ESMF_SUCCESS 603 | 604 | ! get field pointer 605 | call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) 606 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 607 | call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) 608 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 609 | 610 | ! set fldptr values to input array 611 | fldptr(:) = 0._r8 612 | do g = begr,endr 613 | fldptr(g-begr+1) = input(g) 614 | end do 615 | if (do_area_correction) then 616 | fldptr(:) = fldptr(:) * mod2med_areacor(:) 617 | end if 618 | 619 | ! check for nans 620 | call check_for_nans(fldptr, trim(fldname), begr) 621 | 622 | end subroutine state_setexport 623 | 624 | !=============================================================================== 625 | subroutine check_for_nans(array, fname, begg) 626 | 627 | ! uses 628 | use shr_infnan_mod, only : isnan => shr_infnan_isnan 629 | 630 | ! input/output variables 631 | real(r8), pointer :: array(:) 632 | character(len=*) , intent(in) :: fname 633 | integer , intent(in) :: begg 634 | 635 | ! local variables 636 | integer :: i 637 | !------------------------------------------------------------------------------- 638 | 639 | ! Check if any input from mediator or output to mediator is NaN 640 | 641 | if (any(isnan(array))) then 642 | write(iulog,*) '# of NaNs = ', count(isnan(array)) 643 | write(iulog,*) 'Which are NaNs = ', isnan(array) 644 | do i = 1, size(array) 645 | if (isnan(array(i))) then 646 | write(iulog,*) "NaN found in field ", trim(fname), ' at gridcell index ',begg+i-1 647 | end if 648 | end do 649 | call shr_sys_abort(' ERROR: One or more of the output from RTM to the coupler are NaN ' ) 650 | end if 651 | end subroutine check_for_nans 652 | 653 | end module rof_import_export 654 | -------------------------------------------------------------------------------- /src/cpl/nuopc/rof_comp_nuopc.F90: -------------------------------------------------------------------------------- 1 | module rof_comp_nuopc 2 | 3 | !---------------------------------------------------------------------------- 4 | ! This is the NUOPC cap for RTM 5 | !---------------------------------------------------------------------------- 6 | 7 | use ESMF 8 | use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize 9 | use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet 10 | use NUOPC_Model , only : model_routine_SS => SetServices 11 | use NUOPC_Model , only : SetVM 12 | use NUOPC_Model , only : model_label_Advance => label_Advance 13 | use NUOPC_Model , only : model_label_DataInitialize => label_DataInitialize 14 | use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock 15 | use NUOPC_Model , only : model_label_Finalize => label_Finalize 16 | use NUOPC_Model , only : NUOPC_ModelGet 17 | use shr_kind_mod , only : R8=>SHR_KIND_R8, CL=>SHR_KIND_CL 18 | use shr_sys_mod , only : shr_sys_abort 19 | use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit 20 | use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date 21 | use RtmVar , only : rtmlon, rtmlat, iulog 22 | use RtmVar , only : nsrStartup, nsrContinue, nsrBranch 23 | use RtmVar , only : inst_index, inst_suffix, inst_name, RtmVarSet 24 | use RtmVar , only : ice_runoff, nt_rtm 25 | use RtmVar , only : nsrStartup, nsrContinue, nsrBranch 26 | use RtmVar , only : rtm_active, flood_active 27 | use RtmSpmd , only : RtmSpmdInit, masterproc, mpicom_rof, iam, npes 28 | use RunoffMod , only : runoff 29 | use RtmMod , only : Rtmini, Rtmrun 30 | use RtmTimeManager , only : timemgr_setup, get_curr_date, get_step_size, advance_timestep 31 | use perf_mod , only : t_startf, t_stopf 32 | use rof_import_export , only : advertise_fields, realize_fields 33 | use rof_import_export , only : import_fields, export_fields 34 | use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit 35 | use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance 36 | !$ use omp_lib , only : omp_set_num_threads 37 | implicit none 38 | private ! except 39 | 40 | ! Module routines 41 | public :: SetServices 42 | public :: SetVM 43 | private :: InitializeP0 44 | private :: InitializeAdvertise 45 | private :: InitializeRealize 46 | private :: ModelSetRunClock 47 | private :: ModelAdvance 48 | private :: ModelFinalize 49 | 50 | !-------------------------------------------------------------------------- 51 | ! Private module data 52 | !-------------------------------------------------------------------------- 53 | 54 | character(len=CL) :: flds_scalar_name = '' 55 | integer :: flds_scalar_num = 0 56 | integer :: flds_scalar_index_nx = 0 57 | integer :: flds_scalar_index_ny = 0 58 | integer :: flds_scalar_index_nextsw_cday = 0._r8 59 | integer :: nthrds 60 | real(r8), allocatable :: totrunin(:,:) ! cell tracer lnd forcing on rtm grid (mm/s) 61 | 62 | integer , parameter :: debug = 1 63 | character(*), parameter :: modName = "(rof_comp_nuopc)" 64 | 65 | logical :: write_restart_at_endofrun = .false. 66 | 67 | character(*), parameter :: u_FILE_u = & 68 | __FILE__ 69 | 70 | !=============================================================================== 71 | contains 72 | !=============================================================================== 73 | 74 | subroutine SetServices(gcomp, rc) 75 | type(ESMF_GridComp) :: gcomp 76 | integer, intent(out) :: rc 77 | 78 | character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' 79 | 80 | rc = ESMF_SUCCESS 81 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 82 | 83 | ! the NUOPC gcomp component will register the generic methods 84 | call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) 85 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 86 | 87 | ! switching to IPD versions 88 | call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 89 | userRoutine=InitializeP0, phase=0, rc=rc) 90 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 91 | 92 | ! set entry point for methods that require specific implementation 93 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 94 | phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) 95 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 96 | 97 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 98 | phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) 99 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 100 | 101 | ! attach specializing method(s) 102 | 103 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & 104 | specRoutine=ModelAdvance, rc=rc) 105 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 106 | 107 | call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) 108 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 109 | 110 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & 111 | specRoutine=ModelSetRunClock, rc=rc) 112 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 113 | 114 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & 115 | specRoutine=ModelFinalize, rc=rc) 116 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 117 | 118 | call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) 119 | 120 | end subroutine SetServices 121 | 122 | !=============================================================================== 123 | 124 | subroutine InitializeP0(gcomp, importState, exportState, clock, rc) 125 | type(ESMF_GridComp) :: gcomp 126 | type(ESMF_State) :: importState, exportState 127 | type(ESMF_Clock) :: clock 128 | integer, intent(out) :: rc 129 | !------------------------------------------------------------------------------- 130 | 131 | rc = ESMF_SUCCESS 132 | 133 | ! Switch to IPDv01 by filtering all other phaseMap entries 134 | 135 | call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) 136 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 137 | 138 | end subroutine InitializeP0 139 | 140 | !=============================================================================== 141 | 142 | subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 143 | 144 | ! input/output arguments 145 | type(ESMF_GridComp) :: gcomp 146 | type(ESMF_State) :: importState, exportState 147 | type(ESMF_Clock) :: clock 148 | integer, intent(out) :: rc 149 | 150 | ! local variables 151 | type(ESMF_VM) :: vm 152 | integer :: mpicom 153 | character(CL) :: cvalue 154 | integer :: shrlogunit 155 | integer :: n 156 | character(len=CL) :: logmsg 157 | logical :: isPresent, isSet 158 | character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' 159 | character(len=*), parameter :: format = "('("//trim(subname)//") :',A)" 160 | !------------------------------------------------------------------------------- 161 | 162 | rc = ESMF_SUCCESS 163 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 164 | 165 | !---------------------------------------------------------------------------- 166 | ! generate local mpi comm 167 | !---------------------------------------------------------------------------- 168 | 169 | call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) 170 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 171 | 172 | call ESMF_VMGet(vm, mpiCommunicator=mpicom, rc=rc) 173 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 174 | 175 | !---------------------------------------------------------------------------- 176 | ! initialize RTM MPI communicator 177 | !---------------------------------------------------------------------------- 178 | 179 | ! The following call initializees the module variable mpicom_rof in RtmSpmd 180 | call RtmSpmdInit(mpicom) 181 | 182 | !---------------------------------------------------------------------------- 183 | ! determine instance information 184 | !---------------------------------------------------------------------------- 185 | 186 | call get_component_instance(gcomp, inst_suffix, inst_index, rc) 187 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 188 | 189 | inst_name = "ROF" 190 | 191 | !---------------------------------------------------------------------------- 192 | ! reset shr logging to my log file 193 | !---------------------------------------------------------------------------- 194 | 195 | call set_component_logging(gcomp, masterproc, iulog, shrlogunit, rc) 196 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 197 | 198 | !---------------------------------------------------------------------------- 199 | ! advertise fields 200 | !---------------------------------------------------------------------------- 201 | 202 | call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) 203 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 204 | if (isPresent .and. isSet) then 205 | flds_scalar_name = trim(cvalue) 206 | call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) 207 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 208 | else 209 | call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') 210 | endif 211 | 212 | call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) 213 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 214 | if (isPresent .and. isSet) then 215 | read(cvalue, *) flds_scalar_num 216 | write(logmsg,*) flds_scalar_num 217 | call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) 218 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 219 | else 220 | call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') 221 | endif 222 | 223 | call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) 224 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 225 | if (isPresent .and. isSet) then 226 | read(cvalue,*) flds_scalar_index_nx 227 | write(logmsg,*) flds_scalar_index_nx 228 | call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) 229 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 230 | else 231 | call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') 232 | endif 233 | 234 | call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) 235 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 236 | if (isPresent .and. isSet) then 237 | read(cvalue,*) flds_scalar_index_ny 238 | write(logmsg,*) flds_scalar_index_ny 239 | call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) 240 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 241 | else 242 | call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') 243 | endif 244 | 245 | call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) 246 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 247 | if (isPresent .and. isSet) then 248 | read(cvalue,*) flds_scalar_index_nextsw_cday 249 | write(logmsg,*) flds_scalar_index_nextsw_cday 250 | call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) 251 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 252 | else 253 | call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') 254 | endif 255 | 256 | call advertise_fields(gcomp, flds_scalar_name, rc) 257 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 258 | 259 | !---------------------------------------------------------------------------- 260 | ! Reset shr logging to original values 261 | !---------------------------------------------------------------------------- 262 | 263 | call shr_log_setLogUnit (shrlogunit) 264 | call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) 265 | 266 | end subroutine InitializeAdvertise 267 | 268 | !=============================================================================== 269 | 270 | subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 271 | 272 | ! input/output variables 273 | type(ESMF_GridComp) :: gcomp 274 | type(ESMF_State) :: importState 275 | type(ESMF_State) :: exportState 276 | type(ESMF_Clock) :: clock 277 | integer, intent(out) :: rc 278 | 279 | ! local variables 280 | type(ESMF_Mesh) :: Emesh 281 | type(ESMF_DistGrid) :: DistGrid ! esmf global index space descriptor 282 | type(ESMF_Time) :: currTime ! Current time 283 | type(ESMF_Time) :: startTime ! Start time 284 | type(ESMF_Time) :: stopTime ! Stop time 285 | type(ESMF_Time) :: refTime ! Ref time 286 | type(ESMF_TimeInterval) :: timeStep ! Model timestep 287 | type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type 288 | type(ESMF_VM) :: vm ! esmf virtual machine type 289 | integer , allocatable :: gindex(:) ! global index space on my processor 290 | integer :: ref_ymd ! reference date (YYYYMMDD) 291 | integer :: ref_tod ! reference time of day (sec) 292 | integer :: yy,mm,dd ! Temporaries for time query 293 | integer :: start_ymd ! start date (YYYYMMDD) 294 | integer :: start_tod ! start time of day (sec) 295 | integer :: stop_ymd ! stop date (YYYYMMDD) 296 | integer :: stop_tod ! stop time of day (sec) 297 | integer :: curr_ymd ! Start date (YYYYMMDD) 298 | integer :: curr_tod ! Start time of day (sec) 299 | logical :: flood_present ! flag 300 | logical :: rof_prognostic ! flag 301 | integer :: shrlogunit ! original log unit 302 | integer :: lsize ! local size ofarrays 303 | integer :: n,ni ! indices 304 | integer :: lbnum ! input to memory diagnostic 305 | integer :: nsrest ! restart type 306 | character(CL) :: calendar ! calendar type name 307 | character(CL) :: username ! user name 308 | character(CL) :: caseid ! case identifier name 309 | character(CL) :: ctitle ! case description title 310 | character(CL) :: hostname ! hostname of machine running on 311 | character(CL) :: model_version ! model version 312 | character(CL) :: starttype ! start-type (startup, continue, branch, hybrid) 313 | character(CL) :: stdname, shortname ! needed for advertise 314 | logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type 315 | integer :: localPet, localPeCount ! mpi task and thread count variables 316 | character(CL) :: cvalue 317 | character(ESMF_MAXSTR) :: convCIM, purpComp 318 | logical :: isPresent ! If attribute is present 319 | logical :: isSet ! If attribute is present and also set 320 | character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' 321 | !--------------------------------------------------------------------------- 322 | 323 | rc = ESMF_SUCCESS 324 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 325 | 326 | !---------------------------------------------------------------------------- 327 | ! Reset shr logging to my log file 328 | !---------------------------------------------------------------------------- 329 | 330 | call shr_log_getLogUnit (shrlogunit) 331 | call shr_log_setLogUnit (iulog) 332 | 333 | #if (defined _MEMTRACE) 334 | if (masterproc) then 335 | lbnum=1 336 | call memmon_dump_fort('memmon.out','rof_comp_nuopc_InitializeRealize:start::',lbnum) 337 | endif 338 | #endif 339 | !---------------------- 340 | ! Obtain threading information 341 | !---------------------- 342 | call ESMF_GridCompGet(gcomp, vm=vm, localpet=localPet, rc=rc) 343 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 344 | call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) 345 | if (chkerr(rc,__LINE__,u_FILE_u)) return 346 | 347 | if(localPeCount == 1) then 348 | call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) 349 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 350 | read(cvalue,*) nthrds 351 | else 352 | nthrds = localPeCount 353 | endif 354 | 355 | !$ call omp_set_num_threads(nthrds) 356 | 357 | !---------------------- 358 | ! Obtain attribute values 359 | !---------------------- 360 | 361 | call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) 362 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 363 | read(cvalue,*) caseid 364 | ctitle=trim(caseid) 365 | 366 | call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) 367 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 368 | read(cvalue,*) brnch_retain_casename 369 | 370 | call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) 371 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 372 | read(cvalue,*) starttype 373 | 374 | call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) 375 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 376 | read(cvalue,*) model_version 377 | 378 | call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) 379 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 380 | read(cvalue,*) hostname 381 | 382 | call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) 383 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 384 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 385 | read(cvalue,*) username 386 | 387 | !---------------------- 388 | ! Get properties from clock 389 | !---------------------- 390 | 391 | call ESMF_ClockGet( clock, & 392 | currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & 393 | timeStep=timeStep, rc=rc) 394 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 395 | 396 | call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) 397 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 398 | call shr_cal_ymd2date(yy,mm,dd,curr_ymd) 399 | 400 | call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) 401 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 402 | call shr_cal_ymd2date(yy,mm,dd,start_ymd) 403 | 404 | call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) 405 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 406 | call shr_cal_ymd2date(yy,mm,dd,stop_ymd) 407 | 408 | call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) 409 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 410 | call shr_cal_ymd2date(yy,mm,dd,ref_ymd) 411 | 412 | call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) 413 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 414 | 415 | if (esmf_caltype == ESMF_CALKIND_NOLEAP) then 416 | calendar = shr_cal_noleap 417 | else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then 418 | calendar = shr_cal_gregorian 419 | else 420 | call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) 421 | end if 422 | 423 | call NUOPC_CompAttributeGet(gcomp, name="write_restart_at_endofrun", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) 424 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 425 | if (isPresent .and. isSet) then 426 | if (trim(cvalue) .eq. '.true.') write_restart_at_endofrun = .true. 427 | else 428 | call shr_sys_abort( subname//'ERROR:: write_restart_at_endofrun not isPresent or not isSet' ) 429 | end if 430 | 431 | !---------------------- 432 | ! Set time manager module variables 433 | !---------------------- 434 | 435 | call timemgr_setup(& 436 | calendar_in=calendar, & 437 | start_ymd_in=start_ymd, & 438 | start_tod_in=start_tod, & 439 | ref_ymd_in=ref_ymd, & 440 | ref_tod_in=ref_tod, & 441 | stop_ymd_in=stop_ymd, & 442 | stop_tod_in=stop_tod) 443 | 444 | !---------------------- 445 | ! Read namelist, grid and surface data 446 | !---------------------- 447 | 448 | if (masterproc) then 449 | write(iulog,*) "RTM river model initialization" 450 | write(iulog,*) ' rtm npes = ',npes 451 | write(iulog,*) ' rtm iam = ',iam 452 | write(iulog,*) ' inst_name = ',trim(inst_name) 453 | endif 454 | 455 | ! Initialize RtmVar module variables 456 | ! TODO: the following strings must not be hard-wired - must have module variables 457 | ! like seq_infodata_start_type_type - maybe another entry in seq_flds_mod? 458 | if ( trim(starttype) == trim('startup')) then 459 | nsrest = nsrStartup 460 | else if (trim(starttype) == trim('continue') ) then 461 | nsrest = nsrContinue 462 | else if (trim(starttype) == trim('branch')) then 463 | nsrest = nsrBranch 464 | else 465 | call shr_sys_abort( subname//' ERROR: unknown starttype' ) 466 | end if 467 | 468 | call RtmVarSet(& 469 | caseid_in=caseid, & 470 | ctitle_in=ctitle, & 471 | brnch_retain_casename_in=brnch_retain_casename, & 472 | nsrest_in=nsrest, & 473 | version_in=model_version, & 474 | hostname_in=hostname, & 475 | username_in=username) 476 | 477 | call Rtmini( currTime ) 478 | 479 | ! Initialize memory for input state 480 | 481 | if (rtm_active) then 482 | allocate (totrunin(runoff%begr:runoff%endr,nt_rtm)) 483 | end if 484 | 485 | !-------------------------------- 486 | ! generate the mesh and realize fields 487 | !-------------------------------- 488 | 489 | ! determine global index array 490 | lsize = runoff%endr - runoff%begr + 1 491 | allocate(gindex(lsize)) 492 | ni = 0 493 | do n = runoff%begr,runoff%endr 494 | ni = ni + 1 495 | gindex(ni) = runoff%gindex(n) 496 | end do 497 | 498 | ! create distGrid from global index array 499 | DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) 500 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 501 | deallocate(gindex) 502 | 503 | ! read in the mesh 504 | call NUOPC_CompAttributeGet(gcomp, name='mesh_rof', value=cvalue, rc=rc) 505 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 506 | 507 | EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, & 508 | elementDistgrid=Distgrid, rc=rc) 509 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 510 | if (masterproc) then 511 | write(iulog,*)'mesh file for domain is ',trim(cvalue) 512 | end if 513 | 514 | !-------------------------------- 515 | ! realize actively coupled fields 516 | !-------------------------------- 517 | 518 | call realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) 519 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 520 | 521 | !-------------------------------- 522 | ! Create RTM export state 523 | !-------------------------------- 524 | 525 | call export_fields(gcomp, rc) 526 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 527 | 528 | ! Set global grid size scalars in export state 529 | call State_SetScalar(dble(rtmlon), flds_scalar_index_nx, exportState, & 530 | flds_scalar_name, flds_scalar_num, rc) 531 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 532 | 533 | call State_SetScalar(dble(rtmlat), flds_scalar_index_ny, exportState, & 534 | flds_scalar_name, flds_scalar_num, rc) 535 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 536 | 537 | !---------------------------------------------------------------------------- 538 | ! Reset shr logging 539 | !---------------------------------------------------------------------------- 540 | 541 | call shr_log_setLogUnit (shrlogunit) 542 | 543 | call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) 544 | 545 | !-------------------------------- 546 | ! diagnostics 547 | !-------------------------------- 548 | 549 | if (debug > 1) then 550 | call State_diagnose(exportState,subname//':ES',rc=rc) 551 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 552 | endif 553 | 554 | #if (defined _MEMTRACE) 555 | if(masterproc) then 556 | write(iulog,*) TRIM(Sub) // ':end::' 557 | lbnum=1 558 | call memmon_dump_fort('memmon.out','rof_comp_nuopc_InitializeRealize:end::',lbnum) 559 | call memmon_reset_addr() 560 | endif 561 | #endif 562 | 563 | end subroutine InitializeRealize 564 | 565 | !=============================================================================== 566 | 567 | subroutine ModelAdvance(gcomp, rc) 568 | 569 | !------------------------ 570 | ! Run RTM 571 | !------------------------ 572 | 573 | ! arguments: 574 | type(ESMF_GridComp) :: gcomp 575 | integer, intent(out) :: rc 576 | 577 | ! local variables: 578 | type(ESMF_Clock) :: clock 579 | type(ESMF_Alarm) :: alarm 580 | type(ESMF_Time) :: currTime 581 | type(ESMF_Time) :: nextTime 582 | type(ESMF_State) :: importState 583 | type(ESMF_State) :: exportState 584 | character(CL) :: cvalue 585 | integer :: shrlogunit ! original log unit 586 | integer :: dtime ! time step size 587 | integer :: ymd_sync, ymd ! current date (YYYYMMDD) 588 | integer :: yr_sync, yr ! current year 589 | integer :: mon_sync, mon ! current month 590 | integer :: day_sync, day ! current day 591 | integer :: tod_sync, tod ! current time of day (sec) 592 | logical :: rstwr ! .true. ==> write restart file before returning 593 | logical :: nlend ! .true. ==> signaling last time-step 594 | integer :: lbnum ! input to memory diagnostic 595 | integer :: g,i ! indices 596 | character(len=32) :: rdate ! date char string for restart file names 597 | character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' 598 | !------------------------------------------------------- 599 | 600 | rc = ESMF_SUCCESS 601 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 602 | 603 | call shr_log_getLogUnit (shrlogunit) 604 | call shr_log_setLogUnit (iulog) 605 | 606 | #if (defined _MEMTRACE) 607 | if(masterproc) then 608 | lbnum=1 609 | call memmon_dump_fort('memmon.out','rtm_comp_nuopc_ModelAdvance:start::',lbnum) 610 | endif 611 | #endif 612 | !$ call omp_set_num_threads(nthrds) 613 | 614 | !-------------------------------- 615 | ! Query the Component for its clock, importState and exportState 616 | !-------------------------------- 617 | 618 | call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) 619 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 620 | 621 | !--------------------------------------------------------------------------------------------- 622 | ! Determine if time to stop, do this before the restart alarm in case it needs the stop alarm 623 | !--------------------------------------------------------------------------------------------- 624 | 625 | call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) 626 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 627 | 628 | if (ESMF_AlarmIsRinging(alarm, rc=rc)) then 629 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 630 | nlend = .true. 631 | call ESMF_AlarmRingerOff( alarm, rc=rc ) 632 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 633 | else 634 | nlend = .false. 635 | endif 636 | 637 | !---------------------------------------------------------- 638 | ! Determine if time to write restart, after the stop alarm 639 | !----------------------------------------------------------- 640 | 641 | rstwr = .false. 642 | if (nlend .and. write_restart_at_endofrun) then 643 | rstwr = .true. 644 | else 645 | call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) 646 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 647 | 648 | if (ESMF_AlarmIsRinging(alarm, rc=rc)) then 649 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 650 | rstwr = .true. 651 | call ESMF_AlarmRingerOff( alarm, rc=rc ) 652 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 653 | endif 654 | endif 655 | !-------------------------------- 656 | ! First advance rtm time step 657 | !-------------------------------- 658 | 659 | ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of 660 | ! the timestep and is preferred for restart file names 661 | 662 | call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) 663 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 664 | 665 | call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) 666 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 667 | 668 | call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) 669 | write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync 670 | 671 | !-------------------------------- 672 | ! Unpack import state from mediator 673 | !-------------------------------- 674 | 675 | call t_startf ('lc_rtm_import') 676 | call import_fields(gcomp, totrunin, rc) 677 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 678 | call t_stopf ('lc_rtm_import') 679 | 680 | !-------------------------------- 681 | ! Run RTM 682 | !-------------------------------- 683 | 684 | ! Advance rtm time step (export data is in runoff and Trunoff data types) 685 | call advance_timestep() 686 | ! input is totrunin, output is runoff 687 | call Rtmrun(totrunin, rstwr, nlend, rdate) 688 | 689 | !-------------------------------- 690 | ! Pack export state to mediator 691 | !-------------------------------- 692 | 693 | ! (input is runoff, output is r2x) 694 | call t_startf ('lc_rof_export') 695 | call export_fields(gcomp, rc) 696 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 697 | call t_stopf ('lc_rof_export') 698 | 699 | !-------------------------------- 700 | ! Check that internal clock is in sync with master clock 701 | !-------------------------------- 702 | 703 | ! Check that internal clock is in sync with master clock 704 | ! Note that the driver clock has not been updated yet - so at this point 705 | ! RTM is actually 1 coupling intervals ahead of the driver clock 706 | 707 | dtime = get_step_size() 708 | !call get_curr_date( yr, mon, day, tod, offset=-dtime ) TODO: WHY DOES THIS NOT WORK? 709 | call get_curr_date( yr, mon, day, tod ) 710 | ymd = yr*10000 + mon*100 + day 711 | tod = tod 712 | 713 | if ( (ymd /= ymd_sync) .or. (tod /= tod_sync) ) then 714 | write(iulog,*)' rtm ymd=',ymd ,' rtm tod= ',tod 715 | write(iulog,*)' sync ymd=',ymd_sync,' sync tod= ',tod_sync 716 | rc = ESMF_FAILURE 717 | call ESMF_LogWrite(subname//" RTM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) 718 | end if 719 | 720 | !-------------------------------- 721 | ! diagnostics 722 | !-------------------------------- 723 | 724 | if (debug > 1) then 725 | call State_diagnose(exportState,subname//':ES',rc=rc) 726 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 727 | end if 728 | 729 | if (masterproc) then 730 | call ESMF_ClockPrint(clock, options="currTime", preString="------>Advancing ROF from: ", rc=rc) 731 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 732 | call ESMF_ClockPrint(clock, options="stopTime", preString="--------------------------------> to: ", rc=rc) 733 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 734 | endif 735 | 736 | !-------------------------------- 737 | ! Reset shr logging to my original values 738 | !-------------------------------- 739 | 740 | call shr_log_setLogUnit (shrlogunit) 741 | 742 | #if (defined _MEMTRACE) 743 | if(masterproc) then 744 | lbnum=1 745 | call memmon_dump_fort('memmon.out','rtm_comp_nuopc_ModelAdvance:end::',lbnum) 746 | call memmon_reset_addr() 747 | endif 748 | #endif 749 | 750 | end subroutine ModelAdvance 751 | 752 | !=============================================================================== 753 | 754 | subroutine ModelSetRunClock(gcomp, rc) 755 | 756 | ! input/output variables 757 | type(ESMF_GridComp) :: gcomp 758 | integer, intent(out) :: rc 759 | 760 | ! local variables 761 | type(ESMF_Clock) :: mclock, dclock 762 | type(ESMF_Time) :: mcurrtime, dcurrtime 763 | type(ESMF_Time) :: mstoptime 764 | type(ESMF_TimeInterval) :: mtimestep, dtimestep 765 | character(len=256) :: cvalue 766 | character(len=256) :: restart_option ! Restart option units 767 | integer :: restart_n ! Number until restart interval 768 | integer :: restart_ymd ! Restart date (YYYYMMDD) 769 | type(ESMF_ALARM) :: restart_alarm 770 | character(len=256) :: stop_option ! Stop option units 771 | integer :: stop_n ! Number until stop interval 772 | integer :: stop_ymd ! Stop date (YYYYMMDD) 773 | type(ESMF_ALARM) :: stop_alarm 774 | character(len=128) :: name 775 | integer :: alarmcount 776 | character(len=*),parameter :: subname=trim(modName)//':(ModelSetRunClock) ' 777 | !------------------------------------------------------------------------------- 778 | 779 | rc = ESMF_SUCCESS 780 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 781 | 782 | ! query the Component for its clocks 783 | call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) 784 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 785 | 786 | call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) 787 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 788 | 789 | call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) 790 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 791 | 792 | !-------------------------------- 793 | ! force model clock currtime and timestep to match driver and set stoptime 794 | !-------------------------------- 795 | 796 | mstoptime = mcurrtime + dtimestep 797 | call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) 798 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 799 | 800 | !-------------------------------- 801 | ! set restart and stop alarms 802 | !-------------------------------- 803 | 804 | call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) 805 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 806 | 807 | if (alarmCount == 0) then 808 | 809 | call ESMF_GridCompGet(gcomp, name=name, rc=rc) 810 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 811 | call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) 812 | 813 | !---------------- 814 | ! Restart alarm 815 | !---------------- 816 | call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) 817 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 818 | 819 | call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) 820 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 821 | read(cvalue,*) restart_n 822 | 823 | call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) 824 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 825 | read(cvalue,*) restart_ymd 826 | 827 | call alarmInit(mclock, restart_alarm, restart_option, & 828 | opt_n = restart_n, & 829 | opt_ymd = restart_ymd, & 830 | RefTime = mcurrTime, & 831 | alarmname = 'alarm_restart', rc=rc) 832 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 833 | 834 | call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) 835 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 836 | 837 | !---------------- 838 | ! Stop alarm 839 | !---------------- 840 | call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) 841 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 842 | 843 | call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) 844 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 845 | read(cvalue,*) stop_n 846 | 847 | call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) 848 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 849 | read(cvalue,*) stop_ymd 850 | 851 | call alarmInit(mclock, stop_alarm, stop_option, & 852 | opt_n = stop_n, & 853 | opt_ymd = stop_ymd, & 854 | RefTime = mcurrTime, & 855 | alarmname = 'alarm_stop', rc=rc) 856 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 857 | 858 | call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) 859 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 860 | 861 | end if 862 | 863 | !-------------------------------- 864 | ! Advance model clock to trigger alarms then reset model clock back to currtime 865 | !-------------------------------- 866 | 867 | call ESMF_ClockAdvance(mclock,rc=rc) 868 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 869 | 870 | call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) 871 | if (ChkErr(rc,__LINE__,u_FILE_u)) return 872 | 873 | call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) 874 | 875 | end subroutine ModelSetRunClock 876 | 877 | !=============================================================================== 878 | 879 | subroutine ModelFinalize(gcomp, rc) 880 | type(ESMF_GridComp) :: gcomp 881 | integer, intent(out) :: rc 882 | 883 | ! local variables 884 | character(*), parameter :: F00 = "('(rtm_comp_nuopc) ',8a)" 885 | character(*), parameter :: F91 = "('(rtm_comp_nuopc) ',73('-'))" 886 | character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' 887 | !------------------------------------------------------------------------------- 888 | 889 | !-------------------------------- 890 | ! Finalize routine 891 | !-------------------------------- 892 | 893 | rc = ESMF_SUCCESS 894 | call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) 895 | 896 | if (masterproc) then 897 | write(iulog,F91) 898 | write(iulog,F00) 'RTM: end of main integration loop' 899 | write(iulog,F91) 900 | end if 901 | 902 | call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) 903 | 904 | end subroutine ModelFinalize 905 | 906 | !=============================================================================== 907 | 908 | end module rof_comp_nuopc 909 | -------------------------------------------------------------------------------- /src/riverroute/RtmTimeManager.F90: -------------------------------------------------------------------------------- 1 | module RtmTimeManager 2 | 3 | use shr_kind_mod, only: r8 => shr_kind_r8 4 | use shr_sys_mod , only: shr_sys_abort 5 | use RtmSpmd , only: masterproc, iam, mpicom_rof, MPI_INTEGER, MPI_CHARACTER 6 | use RtmVar , only: isecspday, iulog, nsrest, nsrContinue 7 | use RtmIO 8 | use ESMF 9 | 10 | implicit none 11 | private 12 | 13 | ! Public methods 14 | 15 | public ::& 16 | timemgr_setup, &! setup startup values 17 | timemgr_init, &! time manager initialization, always called 18 | timemgr_restart, &! read/write time manager restart info and make sure synchronized with time 19 | timemgr_finalize, &! calls ESMF_ClockDestroy to clean up ESMF clock memory 20 | advance_timestep, &! increment timestep number 21 | get_clock, &! get the clock from the time-manager 22 | get_step_size, &! return step size in seconds 23 | get_nstep, &! return timestep number 24 | get_curr_date, &! return date components at end of current timestep 25 | get_prev_date, &! return date components at beginning of current timestep 26 | get_start_date, &! return components of the start date 27 | get_ref_date, &! return components of the reference date 28 | get_curr_time, &! return components of elapsed time since reference date at end of current timestep 29 | get_prev_time, &! return components of elapsed time since reference date at beg of current timestep 30 | get_calendar, &! return calendar 31 | is_first_step, &! return true on first step of initial run 32 | is_first_restart_step, &! return true on first step of restart or branch run 33 | is_end_curr_day, &! return true on last timestep in current day 34 | is_end_curr_month, &! return true on last timestep in current month 35 | is_last_step, &! return true on last timestep 36 | is_restart ! return true if this is a restart run 37 | 38 | ! Public parameter data 39 | character(len=*), public, parameter :: NO_LEAP_C = 'NO_LEAP' 40 | character(len=*), public, parameter :: GREGORIAN_C = 'GREGORIAN' 41 | 42 | 43 | ! Private module data 44 | 45 | ! Private data for input 46 | 47 | character(len=ESMF_MAXSTR), save :: calendar = NO_LEAP_C ! Calendar to use in date calculations 48 | integer, parameter :: uninit_int = -999999999 49 | real(r8), parameter :: uninit_r8 = -999999999.0 50 | 51 | ! Input 52 | integer, save ::& 53 | dtime = uninit_int ! timestep in seconds 54 | 55 | ! Input from CESM driver 56 | integer, save ::& 57 | nelapse = uninit_int, &! number of timesteps (or days if negative) to extend a run 58 | start_ymd = uninit_int, &! starting date for run in yearmmdd format 59 | start_tod = 0, &! starting time of day for run in seconds 60 | stop_ymd = uninit_int, &! stopping date for run in yearmmdd format 61 | stop_tod = 0, &! stopping time of day for run in seconds 62 | ref_ymd = uninit_int, &! reference date for time coordinate in yearmmdd format 63 | ref_tod = 0 ! reference time of day for time coordinate in seconds 64 | type(ESMF_Calendar), target, save :: & 65 | tm_cal ! calendar 66 | type(ESMF_Clock), save :: & 67 | tm_clock ! model clock 68 | integer, save ::& ! Data required to restart time manager: 69 | rst_nstep = uninit_int, &! current step number 70 | rst_step_days = uninit_int, &! days component of timestep size 71 | rst_step_sec = uninit_int, &! timestep size seconds 72 | rst_start_ymd = uninit_int, &! start date 73 | rst_start_tod = uninit_int, &! start time of day 74 | rst_ref_ymd = uninit_int, &! reference date 75 | rst_ref_tod = uninit_int, &! reference time of day 76 | rst_curr_ymd = uninit_int, &! current date 77 | rst_curr_tod = uninit_int ! current time of day 78 | character(len=ESMF_MAXSTR), save :: & 79 | rst_calendar ! Calendar 80 | 81 | logical, save :: tm_first_restart_step = .false. ! true for first step of a restart or branch run 82 | integer, save :: cal_type = uninit_int ! calendar type 83 | logical, save :: timemgr_set = .false. ! true when timemgr initialized 84 | 85 | ! Private module methods 86 | private :: timemgr_spmdbcast 87 | private :: init_calendar 88 | private :: init_clock 89 | private :: timemgr_print 90 | private :: TimeGetymd 91 | 92 | contains 93 | 94 | !========================================================================================= 95 | 96 | subroutine timemgr_setup( calendar_in, start_ymd_in, start_tod_in, ref_ymd_in, & 97 | ref_tod_in, stop_ymd_in, stop_tod_in, nelapse_in) 98 | 99 | ! set time manager startup values 100 | character(len=*), optional, intent(IN) :: calendar_in ! Calendar type 101 | integer , optional, intent(IN) :: nelapse_in ! Number of step (or days) to advance 102 | integer , optional, intent(IN) :: start_ymd_in ! Start date (YYYYMMDD) 103 | integer , optional, intent(IN) :: start_tod_in ! Start time of day (sec) 104 | integer , optional, intent(IN) :: ref_ymd_in ! Reference date (YYYYMMDD) 105 | integer , optional, intent(IN) :: ref_tod_in ! Reference time of day (sec) 106 | integer , optional, intent(IN) :: stop_ymd_in ! Stop date (YYYYMMDD) 107 | integer , optional, intent(IN) :: stop_tod_in ! Stop time of day (sec) 108 | character(len=*), parameter :: sub = 'rtm::timemgr_setup' 109 | 110 | ! timemgr_set is called in timemgr_init and timemgr_restart 111 | if ( timemgr_set ) then 112 | call shr_sys_abort( sub//":: timemgr_init already called" ) 113 | end if 114 | if (present(calendar_in) ) calendar = trim(calendar_in) 115 | if (present(start_ymd_in)) start_ymd = start_ymd_in 116 | if (present(start_tod_in)) start_tod = start_tod_in 117 | if (present(ref_ymd_in) ) ref_ymd = ref_ymd_in 118 | if (present(ref_tod_in) ) ref_tod = ref_tod_in 119 | if (present(stop_ymd_in) ) stop_ymd = stop_ymd_in 120 | if (present(stop_tod_in) ) stop_tod = stop_tod_in 121 | if (present(nelapse_in) ) nelapse = nelapse_in 122 | 123 | end subroutine timemgr_setup 124 | 125 | !========================================================================================= 126 | 127 | subroutine timemgr_init( dtime_in, curr_date ) 128 | 129 | ! Initialize the ESMF time manager from the sync clock 130 | ! 131 | integer, intent(in) :: dtime_in ! ` Time-step (sec) 132 | type(ESMF_Time), intent(in) :: curr_date ! Current time from coupler`` 133 | ! 134 | integer :: rc ! return code 135 | integer :: yr, mon, day, tod ! Year, month, day, and second as integers 136 | type(ESMF_Time) :: start_date ! start date for run 137 | type(ESMF_Time) :: stop_date ! stop date for run 138 | type(ESMF_Time) :: ref_date ! reference date for time coordinate 139 | type(ESMF_Time) :: current ! current date (from clock) 140 | type(ESMF_TimeInterval) :: day_step_size ! day step size 141 | type(ESMF_TimeInterval) :: step_size ! timestep size 142 | logical :: run_length_specified = .false. 143 | character(len=*), parameter :: sub = 'rtm::timemgr_init' 144 | 145 | ! 146 | dtime = real(dtime_in) 147 | call timemgr_spmdbcast( ) 148 | 149 | ! Initalize calendar 150 | call init_calendar() 151 | 152 | ! Initalize start date. 153 | if ( start_ymd == uninit_int ) then 154 | write(iulog,*)sub,': start_ymd must be specified ' 155 | call shr_sys_abort 156 | end if 157 | if ( start_tod == uninit_int ) then 158 | write(iulog,*)sub,': start_tod must be specified ' 159 | call shr_sys_abort 160 | end if 161 | start_date = TimeSetymd( start_ymd, start_tod, "start_date" ) 162 | 163 | ! Initalize stop date. 164 | stop_date = TimeSetymd( 99991231, stop_tod, "stop_date" ) 165 | 166 | call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) 167 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') 168 | 169 | call ESMF_TimeIntervalSet( day_step_size, d=1, rc=rc ) 170 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting day_step_size') 171 | 172 | if ( stop_ymd /= uninit_int ) then 173 | current = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) 174 | if ( current < stop_date ) stop_date = current 175 | run_length_specified = .true. 176 | end if 177 | if ( nelapse /= uninit_int ) then 178 | if ( nelapse >= 0 ) then 179 | current = curr_date + step_size*nelapse 180 | else 181 | current = curr_date - day_step_size*nelapse 182 | end if 183 | if ( current < stop_date ) stop_date = current 184 | run_length_specified = .true. 185 | end if 186 | if ( .not. run_length_specified ) then 187 | call shr_sys_abort (sub//': Must specify stop_ymd or nelapse') 188 | end if 189 | 190 | ! Error check 191 | if ( stop_date <= start_date ) then 192 | write(iulog,*)sub, ': stop date must be specified later than start date: ' 193 | call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) 194 | write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod 195 | call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) 196 | write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod 197 | call shr_sys_abort 198 | end if 199 | if ( curr_date >= stop_date ) then 200 | write(iulog,*)sub, ': stop date must be specified later than current date: ' 201 | call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) 202 | write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod 203 | call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) 204 | write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod 205 | call shr_sys_abort 206 | end if 207 | 208 | ! Initalize reference date for time coordinate. 209 | if ( ref_ymd /= uninit_int ) then 210 | ref_date = TimeSetymd( ref_ymd, ref_tod, "ref_date" ) 211 | else 212 | ref_date = start_date 213 | end if 214 | 215 | ! Initialize clock 216 | call init_clock( start_date, ref_date, curr_date, stop_date ) 217 | 218 | ! Print configuration summary to log file (stdout). 219 | if (masterproc) call timemgr_print() 220 | 221 | timemgr_set = .true. 222 | 223 | end subroutine timemgr_init 224 | 225 | !========================================================================================= 226 | 227 | subroutine init_clock( start_date, ref_date, curr_date, stop_date ) 228 | 229 | ! Initialize the clock based on the start_date, ref_date, and curr_date 230 | ! as well as the settings from the namelist specifying the time to stop 231 | ! 232 | type(ESMF_Time), intent(in) :: start_date ! start date for run 233 | type(ESMF_Time), intent(in) :: ref_date ! reference date for time coordinate 234 | type(ESMF_Time), intent(in) :: curr_date ! current date (equal to start_date) 235 | type(ESMF_Time), intent(in) :: stop_date ! stop date for run 236 | ! 237 | character(len=*), parameter :: sub = 'rtm::init_clock' 238 | type(ESMF_TimeInterval) :: step_size ! timestep size 239 | type(ESMF_Time) :: current ! current date (from clock) 240 | integer :: yr, mon, day, tod ! Year, month, day, and second as integers 241 | integer :: rc ! return code 242 | ! 243 | call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) 244 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') 245 | 246 | ! Initialize the clock 247 | 248 | tm_clock = ESMF_ClockCreate(name="RTM Time-manager clock", timeStep=step_size, startTime=start_date, & 249 | stopTime=stop_date, refTime=ref_date, rc=rc) 250 | call chkrc(rc, sub//': error return from ESMF_ClockSetup') 251 | 252 | ! Advance clock to the current time (in case of a restart) 253 | 254 | call ESMF_ClockGet(tm_clock, currTime=current, rc=rc ) 255 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 256 | do while( curr_date > current ) 257 | call ESMF_ClockAdvance( tm_clock, rc=rc ) 258 | call chkrc(rc, sub//': error return from ESMF_ClockAdvance') 259 | call ESMF_ClockGet(tm_clock, currTime=current ) 260 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 261 | end do 262 | 263 | end subroutine init_clock 264 | 265 | !========================================================================================= 266 | 267 | function TimeSetymd( ymd, tod, desc ) 268 | 269 | ! Set the time by an integer as YYYYMMDD and integer seconds in the day 270 | ! 271 | integer, intent(in) :: ymd ! Year, month, day YYYYMMDD 272 | integer, intent(in) :: tod ! Time of day in seconds 273 | character(len=*), intent(in) :: desc ! Description of time to set 274 | ! 275 | type(ESMF_Time) :: TimeSetymd ! Return value 276 | ! 277 | character(len=*), parameter :: sub = 'rtm::TimeSetymd' 278 | integer :: yr, mon, day ! Year, month, day as integers 279 | integer :: rc ! return code 280 | ! 281 | if ( (ymd < 0) .or. (tod < 0) .or. (tod > isecspday) )then 282 | write(iulog,*) sub//': error yymmdd is a negative number or time-of-day out of bounds', & 283 | ymd, tod 284 | call shr_sys_abort 285 | end if 286 | yr = ymd / 10000 287 | mon = (ymd - yr*10000) / 100 288 | day = ymd - yr*10000 - mon*100 289 | call ESMF_TimeSet( TimeSetymd, yy=yr, mm=mon, dd=day, s=tod, & 290 | calendar=tm_cal, rc=rc) 291 | call chkrc(rc, sub//': error return from ESMF_TimeSet: setting '//trim(desc)) 292 | end function TimeSetymd 293 | 294 | !========================================================================================= 295 | 296 | integer function TimeGetymd( date, tod ) 297 | 298 | ! Get the date and time of day in ymd from ESMF Time. 299 | ! 300 | type(ESMF_Time), intent(inout) :: date ! Input date to convert to ymd 301 | integer, intent(out), optional :: tod ! Time of day in seconds 302 | ! 303 | character(len=*), parameter :: sub = 'rtm::TimeGetymd' 304 | integer :: yr, mon, day 305 | integer :: rc ! return code 306 | ! 307 | call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, rc=rc) 308 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 309 | TimeGetymd = yr*10000 + mon*100 + day 310 | if ( present( tod ) )then 311 | call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) 312 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 313 | end if 314 | if ( yr < 0 )then 315 | write(iulog,*) sub//': error year is less than zero', yr 316 | call shr_sys_abort 317 | end if 318 | end function TimeGetymd 319 | 320 | !========================================================================================= 321 | 322 | subroutine timemgr_restart(ncid, flag) 323 | 324 | ! Read/Write information needed on restart to a netcdf file. 325 | ! 326 | type(file_desc_t), intent(inout) :: ncid ! netcdf id 327 | character(len=*) , intent(in) :: flag ! 'read' or 'write' 328 | ! 329 | logical :: run_length_specified = .false. 330 | integer :: rc ! return code 331 | integer :: yr, mon, day, tod ! Year, month, day, and second as integers 332 | logical :: readvar ! determine if variable is on initial file 333 | integer :: rst_caltype ! calendar type 334 | type(ESMF_Time) :: start_date ! start date for run 335 | type(ESMF_Time) :: stop_date ! stop date for run 336 | type(ESMF_Time) :: ref_date ! reference date for run 337 | type(ESMF_Time) :: curr_date ! date of data in restart file 338 | type(ESMF_Time) :: current ! current date (from clock) 339 | type(ESMF_TimeInterval) :: day_step_size ! day step size 340 | type(ESMF_TimeInterval) :: step_size ! timestep size 341 | integer, parameter :: noleap = 1 342 | integer, parameter :: gregorian = 2 343 | character(len=135) :: varname 344 | character(len=len(calendar)) :: cal 345 | character(len=*), parameter :: sub = 'timemgr_restart' 346 | ! 347 | ! 348 | if ( .not. timemgr_set ) then 349 | call shr_sys_abort( sub//":: timemgr_init MUST be called first" ) 350 | end if 351 | ! 352 | ! Read/Write/Define restart time from restart file 353 | ! 354 | if (flag == 'write') then 355 | rst_calendar = calendar 356 | else if (flag == 'read') then 357 | calendar = rst_calendar 358 | end if 359 | varname = 'timemgr_rst_type' 360 | if (flag == 'define') then 361 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 362 | long_name='calendar type', units='unitless', flag_meanings=(/ "NO_LEAP_C", "GREGORIAN" /), & 363 | flag_values=(/ noleap, gregorian /), ifill_value=uninit_int ) 364 | else if (flag == 'read' .or. flag == 'write') then 365 | if (flag== 'write') then 366 | cal = to_upper(calendar) 367 | if ( trim(cal) == NO_LEAP_C ) then 368 | rst_caltype = noleap 369 | else if ( trim(cal) == GREGORIAN_C ) then 370 | rst_caltype = gregorian 371 | else 372 | call shr_sys_abort(sub//'ERROR: unrecognized calendar specified= '//trim(calendar)) 373 | end if 374 | end if 375 | call ncd_io(varname=varname, data=rst_caltype, & 376 | ncid=ncid, flag=flag, readvar=readvar) 377 | if (flag=='read' .and. .not. readvar) then 378 | if (is_restart()) then 379 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 380 | end if 381 | end if 382 | if (flag == 'read') then 383 | if ( rst_caltype == noleap ) then 384 | calendar = NO_LEAP_C 385 | else if ( rst_caltype == gregorian ) then 386 | calendar = GREGORIAN_C 387 | else 388 | write(iulog,*)sub,': unrecognized calendar type in restart file: ',rst_caltype 389 | call shr_sys_abort( sub//'ERROR: bad calendar type in restart file') 390 | end if 391 | end if 392 | end if 393 | 394 | if (flag == 'write') then 395 | call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, refTime=ref_date, rc=rc ) 396 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 397 | rst_step_sec = dtime 398 | rst_start_ymd = TimeGetymd( start_date, tod=rst_start_tod ) 399 | rst_ref_ymd = TimeGetymd( ref_date, tod=rst_ref_tod ) 400 | rst_curr_ymd = TimeGetymd( curr_date, tod=rst_curr_tod ) 401 | end if 402 | 403 | varname = 'timemgr_rst_step_sec' 404 | if (flag == 'define') then 405 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 406 | long_name='seconds component of timestep size', units='sec', nvalid_range=(/0,isecspday/), ifill_value=uninit_int) 407 | else if (flag == 'read' .or. flag == 'write') then 408 | call ncd_io(varname=varname, data=rst_step_sec, & 409 | ncid=ncid, flag=flag, readvar=readvar) 410 | if (flag=='read' .and. .not. readvar) then 411 | if (is_restart()) then 412 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 413 | end if 414 | end if 415 | if ( rst_step_sec < 0 .or. rst_step_sec > isecspday ) then 416 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' out of range') 417 | end if 418 | end if 419 | 420 | varname = 'timemgr_rst_start_ymd' 421 | if (flag == 'define') then 422 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 423 | long_name='start date', units='YYYYMMDD', ifill_value=uninit_int) 424 | else if (flag == 'read' .or. flag == 'write') then 425 | call ncd_io(varname=varname, data=rst_start_ymd, & 426 | ncid=ncid, flag=flag, readvar=readvar) 427 | if (flag=='read' .and. .not. readvar) then 428 | if (is_restart()) then 429 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 430 | end if 431 | end if 432 | end if 433 | 434 | varname = 'timemgr_rst_start_tod' 435 | if (flag == 'define') then 436 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 437 | long_name='start time of day', units='sec', nvalid_range=(/0,isecspday/), ifill_value=uninit_int) 438 | else if (flag == 'read' .or. flag == 'write') then 439 | call ncd_io(varname=varname, data=rst_start_tod, & 440 | ncid=ncid, flag=flag, readvar=readvar) 441 | if (flag=='read' .and. .not. readvar) then 442 | if (is_restart()) then 443 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 444 | end if 445 | end if 446 | if ( rst_start_tod < 0 .or. rst_start_tod > isecspday ) then 447 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' out of range') 448 | end if 449 | end if 450 | 451 | varname = 'timemgr_rst_ref_ymd' 452 | if (flag == 'define') then 453 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 454 | long_name='reference date', units='YYYYMMDD', ifill_value=uninit_int) 455 | else if (flag == 'read' .or. flag == 'write') then 456 | call ncd_io(varname=varname, data=rst_ref_ymd, & 457 | ncid=ncid, flag=flag, readvar=readvar) 458 | if (flag=='read' .and. .not. readvar) then 459 | if (is_restart()) then 460 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 461 | end if 462 | end if 463 | end if 464 | 465 | varname = 'timemgr_rst_ref_tod' 466 | if (flag == 'define') then 467 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 468 | long_name='reference time of day', units='sec', nvalid_range=(/0,isecspday/), ifill_value=uninit_int) 469 | else if (flag == 'read' .or. flag == 'write') then 470 | call ncd_io(varname=varname, data=rst_ref_tod, & 471 | ncid=ncid, flag=flag, readvar=readvar) 472 | if (flag=='read' .and. .not. readvar) then 473 | if (is_restart()) then 474 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 475 | end if 476 | end if 477 | if ( rst_start_tod < 0 .or. rst_start_tod > isecspday ) then 478 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' out of range') 479 | end if 480 | end if 481 | 482 | varname = 'timemgr_rst_curr_ymd' 483 | if (flag == 'define') then 484 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 485 | long_name='current date', units='YYYYMMDD', ifill_value=uninit_int) 486 | else if (flag == 'read' .or. flag == 'write') then 487 | call ncd_io(varname=varname, data=rst_curr_ymd, & 488 | ncid=ncid, flag=flag, readvar=readvar) 489 | if (flag=='read' .and. .not. readvar) then 490 | if (is_restart()) then 491 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 492 | end if 493 | end if 494 | end if 495 | 496 | varname = 'timemgr_rst_curr_tod' 497 | if (flag == 'define') then 498 | call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & 499 | long_name='current time of day', units='sec', nvalid_range=(/0,isecspday/), ifill_value=uninit_int ) 500 | else if (flag == 'read' .or. flag == 'write') then 501 | call ncd_io(varname=varname, data=rst_curr_tod, & 502 | ncid=ncid, flag=flag, readvar=readvar) 503 | if (flag=='read' .and. .not. readvar) then 504 | if (is_restart()) then 505 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' not on file') 506 | end if 507 | end if 508 | if ( rst_curr_tod < 0 .or. rst_curr_tod > isecspday ) then 509 | call shr_sys_abort( sub//'ERROR: '//trim(varname)//' out of range') 510 | end if 511 | end if 512 | 513 | 514 | if (flag == 'read') then 515 | ! 516 | ! On read make sure restart read in agrees with the system clock sent in 517 | ! 518 | ! Compare the timestep to restart file 519 | if(dtime .ne. rst_step_sec) then 520 | call shr_sys_abort( sub//'ERROR: dtime does not match restart file rst_step_sec') 521 | endif 522 | if(start_ymd .ne. rst_start_ymd) then 523 | call shr_sys_abort( sub//'ERROR: start_ymd does not match restart file rst_start_ymd') 524 | endif 525 | if(start_tod .ne. rst_start_tod) then 526 | call shr_sys_abort( sub//'ERROR: start_tod does not match restart file rst_start_tod') 527 | endif 528 | 529 | if(ref_ymd .ne. rst_ref_ymd) then 530 | call shr_sys_abort( sub//'ERROR: ref_ymd does not match restart file rst_ref_ymd') 531 | endif 532 | if(ref_tod .ne. rst_ref_tod) then 533 | call shr_sys_abort( sub//'ERROR: ref_tod does not match restart file rst_ref_tod') 534 | endif 535 | 536 | call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) 537 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') 538 | call ESMF_TimeIntervalSet( day_step_size, d=1, rc=rc ) 539 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting day_step_size') 540 | 541 | if ( stop_ymd /= uninit_int ) then 542 | current = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) 543 | if ( current < stop_date ) stop_date = current 544 | run_length_specified = .true. 545 | else if ( nelapse /= uninit_int ) then 546 | if ( nelapse >= 0 ) then 547 | current = curr_date + step_size*nelapse 548 | else 549 | current = curr_date - day_step_size*nelapse 550 | end if 551 | if ( current < stop_date ) stop_date = current 552 | run_length_specified = .true. 553 | end if 554 | if ( .not. run_length_specified ) then 555 | call shr_sys_abort (sub//': Must specify stop_ymd or nelapse') 556 | end if 557 | 558 | ! Error check 559 | if ( stop_date <= start_date ) then 560 | write(iulog,*)sub, ': stop date must be specified later than start date: ' 561 | call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) 562 | write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod 563 | call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) 564 | write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod 565 | call shr_sys_abort 566 | end if 567 | if ( curr_date >= stop_date ) then 568 | write(iulog,*)sub, ': stop date must be specified later than current date: ' 569 | call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) 570 | write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod 571 | call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) 572 | write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod 573 | call shr_sys_abort 574 | end if 575 | 576 | ! Set flag that this is the first timestep of the restart run. 577 | tm_first_restart_step = .true. 578 | 579 | end if 580 | 581 | end subroutine timemgr_restart 582 | 583 | !========================================================================================= 584 | 585 | subroutine init_calendar( ) 586 | 587 | !--------------------------------------------------------------------------------- 588 | ! Initialize calendar 589 | ! 590 | ! Local variables 591 | ! 592 | character(len=*), parameter :: sub = 'rtm::init_calendar' 593 | type(ESMF_CalKind_Flag) :: cal_type ! calendar type 594 | character(len=len(calendar)) :: caltmp 595 | integer :: rc ! return code 596 | !--------------------------------------------------------------------------------- 597 | 598 | caltmp = to_upper(calendar) 599 | if ( trim(caltmp) == NO_LEAP_C ) then 600 | cal_type = ESMF_CALKIND_NOLEAP 601 | else if ( trim(caltmp) == GREGORIAN_C ) then 602 | cal_type = ESMF_CALKIND_GREGORIAN 603 | else 604 | write(iulog,*)sub,': unrecognized calendar specified: ',calendar 605 | call shr_sys_abort 606 | end if 607 | tm_cal = ESMF_CalendarCreate( name=caltmp, calkindflag=cal_type, rc=rc ) 608 | call chkrc(rc, sub//': error return from ESMF_CalendarSet') 609 | 610 | end subroutine init_calendar 611 | 612 | !========================================================================================= 613 | 614 | subroutine timemgr_print() 615 | 616 | !--------------------------------------------------------------------------------- 617 | character(len=*), parameter :: sub = 'rtm::timemgr_print' 618 | integer :: rc 619 | integer :: yr, mon, day 620 | integer :: & ! Data required to restart time manager: 621 | nstep = uninit_int, &! current step number 622 | step_sec = uninit_int, &! timestep size seconds 623 | start_yr = uninit_int, &! start year 624 | start_mon = uninit_int, &! start month 625 | start_day = uninit_int, &! start day of month 626 | start_tod = uninit_int, &! start time of day 627 | stop_yr = uninit_int, &! stop year 628 | stop_mon = uninit_int, &! stop month 629 | stop_day = uninit_int, &! stop day of month 630 | stop_tod = uninit_int, &! stop time of day 631 | ref_yr = uninit_int, &! reference year 632 | ref_mon = uninit_int, &! reference month 633 | ref_day = uninit_int, &! reference day of month 634 | ref_tod = uninit_int, &! reference time of day 635 | curr_yr = uninit_int, &! current year 636 | curr_mon = uninit_int, &! current month 637 | curr_day = uninit_int, &! current day of month 638 | curr_tod = uninit_int ! current time of day 639 | integer(ESMF_KIND_I8) :: step_no 640 | type(ESMF_Time) :: start_date! start date for run 641 | type(ESMF_Time) :: stop_date ! stop date for run 642 | type(ESMF_Time) :: curr_date ! date of data in restart file 643 | type(ESMF_Time) :: ref_date ! reference date 644 | type(ESMF_TimeInterval) :: step ! Time-step 645 | !--------------------------------------------------------------------------------- 646 | 647 | call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, & 648 | refTime=ref_date, stopTime=stop_date, timeStep=step, & 649 | advanceCount=step_no, rc=rc ) 650 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 651 | nstep = step_no 652 | 653 | write(iulog,*)' ******** RTM Time Manager Configuration ********' 654 | 655 | call ESMF_TimeIntervalGet( step, s=step_sec, rc=rc ) 656 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') 657 | 658 | call ESMF_TimeGet( start_date, yy=start_yr, mm=start_mon, dd=start_day, & 659 | s=start_tod, rc=rc ) 660 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 661 | call ESMF_TimeGet( stop_date, yy=stop_yr, mm=stop_mon, dd=stop_day, & 662 | s=stop_tod, rc=rc ) 663 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 664 | call ESMF_TimeGet( ref_date, yy=ref_yr, mm=ref_mon, dd=ref_day, s=ref_tod, & 665 | rc=rc ) 666 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 667 | call ESMF_TimeGet( curr_date, yy=curr_yr, mm=curr_mon, dd=curr_day, & 668 | s=curr_tod, rc=rc ) 669 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 670 | 671 | write(iulog,*)' Calendar type: ',trim(calendar) 672 | write(iulog,*)' Timestep size (seconds): ', step_sec 673 | write(iulog,*)' Start date (yr mon day tod): ', start_yr, start_mon, & 674 | start_day, start_tod 675 | write(iulog,*)' Stop date (yr mon day tod): ', stop_yr, stop_mon, & 676 | stop_day, stop_tod 677 | write(iulog,*)' Reference date (yr mon day tod): ', ref_yr, ref_mon, & 678 | ref_day, ref_tod 679 | write(iulog,*)' Current step number: ', nstep 680 | write(iulog,*)' Current date (yr mon day tod): ', curr_yr, curr_mon, & 681 | curr_day, curr_tod 682 | 683 | write(iulog,*)' ************************************************' 684 | 685 | end subroutine timemgr_print 686 | 687 | !========================================================================================= 688 | 689 | subroutine advance_timestep() 690 | 691 | ! Increment the timestep number. 692 | 693 | character(len=*), parameter :: sub = 'rtm::advance_timestep' 694 | integer :: rc 695 | 696 | call ESMF_ClockAdvance( tm_clock, rc=rc ) 697 | call chkrc(rc, sub//': error return from ESMF_ClockAdvance') 698 | 699 | tm_first_restart_step = .false. 700 | 701 | end subroutine advance_timestep 702 | 703 | !========================================================================================= 704 | 705 | subroutine get_clock( clock ) 706 | 707 | ! Return the ESMF clock 708 | 709 | type(ESMF_Clock), intent(inout) :: clock 710 | 711 | character(len=*), parameter :: sub = 'rtm::get_clock' 712 | type(ESMF_TimeInterval) :: step_size 713 | type(ESMF_Time) :: start_date, stop_date, ref_date 714 | integer :: rc 715 | 716 | call ESMF_ClockGet( tm_clock, timeStep=step_size, startTime=start_date, & 717 | stoptime=stop_date, reftime=ref_date, rc=rc ) 718 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 719 | call ESMF_ClockSet(clock, timeStep=step_size, startTime=start_date, & 720 | stoptime=stop_date, reftime=ref_date, rc=rc) 721 | call chkrc(rc, sub//': error return from ESMF_ClockSet') 722 | 723 | end subroutine get_clock 724 | 725 | !========================================================================================= 726 | 727 | integer function get_step_size() 728 | 729 | ! Return the step size in seconds. 730 | 731 | character(len=*), parameter :: sub = 'rtm::get_step_size' 732 | type(ESMF_TimeInterval) :: step_size ! timestep size 733 | integer :: rc 734 | 735 | call ESMF_ClockGet(tm_clock, timeStep=step_size, rc=rc) 736 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 737 | 738 | call ESMF_TimeIntervalGet(step_size, s=get_step_size, rc=rc) 739 | call chkrc(rc, sub//': error return from ESMF_ClockTimeIntervalGet') 740 | 741 | end function get_step_size 742 | 743 | !========================================================================================= 744 | 745 | integer function get_nstep() 746 | 747 | ! Return the timestep number. 748 | 749 | character(len=*), parameter :: sub = 'rtm::get_nstep' 750 | integer :: rc 751 | integer(ESMF_KIND_I8) :: step_no 752 | 753 | call ESMF_ClockGet(tm_clock, advanceCount=step_no, rc=rc) 754 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 755 | 756 | get_nstep = step_no 757 | 758 | end function get_nstep 759 | 760 | !========================================================================================= 761 | 762 | subroutine get_curr_date(yr, mon, day, tod, offset) 763 | 764 | !----------------------------------------------------------------------------------------- 765 | ! Return date components valid at end of current timestep with an optional 766 | ! offset (positive or negative) in seconds. 767 | 768 | integer, intent(out) ::& 769 | yr, &! year 770 | mon, &! month 771 | day, &! day of month 772 | tod ! time of day (seconds past 0Z) 773 | 774 | integer, optional, intent(in) :: offset ! Offset from current time in seconds. 775 | ! Positive for future times, negative 776 | ! for previous times. 777 | 778 | character(len=*), parameter :: sub = 'rtm::get_curr_date' 779 | integer :: rc 780 | type(ESMF_Time) :: date 781 | type(ESMF_TimeInterval) :: off 782 | !----------------------------------------------------------------------------------------- 783 | 784 | call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) 785 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 786 | 787 | if (present(offset)) then 788 | if (offset > 0) then 789 | call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) 790 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') 791 | date = date + off 792 | else if (offset < 0) then 793 | call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) 794 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') 795 | date = date - off 796 | end if 797 | end if 798 | 799 | call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) 800 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 801 | 802 | end subroutine get_curr_date 803 | 804 | !========================================================================================= 805 | 806 | subroutine get_prev_date(yr, mon, day, tod) 807 | 808 | ! Return date components valid at beginning of current timestep. 809 | 810 | ! Arguments 811 | integer, intent(out) ::& 812 | yr, &! year 813 | mon, &! month 814 | day, &! day of month 815 | tod ! time of day (seconds past 0Z) 816 | 817 | ! Local variables 818 | character(len=*), parameter :: sub = 'rtm::get_prev_date' 819 | integer :: rc 820 | type(ESMF_Time) :: date 821 | !----------------------------------------------------------------------------------------- 822 | 823 | call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) 824 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 825 | 826 | call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) 827 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 828 | 829 | end subroutine get_prev_date 830 | 831 | !========================================================================================= 832 | 833 | subroutine get_start_date(yr, mon, day, tod) 834 | 835 | ! Return date components valid at beginning of initial run. 836 | integer, intent(out) ::& 837 | yr, &! year 838 | mon, &! month 839 | day, &! day of month 840 | tod ! time of day (seconds past 0Z) 841 | 842 | character(len=*), parameter :: sub = 'rtm::get_start_date' 843 | integer :: rc 844 | type(ESMF_Time) :: date 845 | 846 | call ESMF_ClockGet(tm_clock, startTime=date, rc=rc) 847 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 848 | 849 | call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) 850 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 851 | 852 | end subroutine get_start_date 853 | 854 | !========================================================================================= 855 | 856 | subroutine get_ref_date(yr, mon, day, tod) 857 | 858 | ! Return date components of the reference date. 859 | 860 | ! Arguments 861 | integer, intent(out) ::& 862 | yr, &! year 863 | mon, &! month 864 | day, &! day of month 865 | tod ! time of day (seconds past 0Z) 866 | 867 | ! Local variables 868 | character(len=*), parameter :: sub = 'rtm::get_ref_date' 869 | integer :: rc 870 | type(ESMF_Time) :: date 871 | !----------------------------------------------------------------------------------------- 872 | 873 | call ESMF_ClockGet(tm_clock, refTime=date, rc=rc) 874 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 875 | 876 | call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) 877 | call chkrc(rc, sub//': error return from ESMF_TimeGet') 878 | 879 | end subroutine get_ref_date 880 | 881 | !========================================================================================= 882 | 883 | subroutine get_curr_time(days, seconds) 884 | 885 | ! Return time components valid at end of current timestep. 886 | ! Current time is the time interval between the current date and the reference date. 887 | 888 | ! Arguments 889 | integer, intent(out) ::& 890 | days, &! number of whole days in time interval 891 | seconds ! remaining seconds in time interval 892 | 893 | ! Local variables 894 | character(len=*), parameter :: sub = 'rtm::get_curr_time' 895 | integer :: rc 896 | type(ESMF_Time) :: cdate, rdate 897 | type(ESMF_TimeInterval) :: diff 898 | !----------------------------------------------------------------------------------------- 899 | 900 | call ESMF_ClockGet( tm_clock, currTime=cdate, rc=rc ) 901 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 902 | 903 | call ESMF_ClockGet( tm_clock, refTime=rdate, rc=rc ) 904 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 905 | 906 | diff = cdate - rdate 907 | 908 | call ESMF_TimeIntervalGet(diff, d=days, s=seconds, rc=rc) 909 | call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') 910 | 911 | end subroutine get_curr_time 912 | 913 | !========================================================================================= 914 | 915 | subroutine get_prev_time(days, seconds) 916 | 917 | ! Return time components valid at beg of current timestep. 918 | ! prev time is the time interval between the prev date and the reference date. 919 | 920 | ! Arguments 921 | integer, intent(out) ::& 922 | days, &! number of whole days in time interval 923 | seconds ! remaining seconds in time interval 924 | 925 | ! Local variables 926 | character(len=*), parameter :: sub = 'rtm::get_prev_time' 927 | integer :: rc 928 | type(ESMF_Time) :: date, ref_date 929 | type(ESMF_TimeInterval) :: diff 930 | !----------------------------------------------------------------------------------------- 931 | 932 | call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) 933 | call chkrc(rc, sub//': error return from ESMF_ClockGet for prevTime') 934 | call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) 935 | call chkrc(rc, sub//': error return from ESMF_ClockGet for refTime') 936 | diff = date - ref_date 937 | call ESMF_TimeIntervalGet( diff, d=days, s=seconds, rc=rc ) 938 | call chkrc(rc, sub//': error return from ESMF_TimeintervalGet') 939 | 940 | end subroutine get_prev_time 941 | 942 | !========================================================================================= 943 | 944 | function get_calendar() 945 | 946 | ! Return calendar 947 | 948 | character(len=ESMF_MAXSTR) :: get_calendar 949 | 950 | get_calendar = calendar 951 | 952 | end function get_calendar 953 | 954 | !========================================================================================= 955 | 956 | function is_end_curr_day() 957 | 958 | ! Return true if current timestep is last timestep in current day. 959 | logical :: is_end_curr_day 960 | 961 | integer ::& 962 | yr, &! year 963 | mon, &! month 964 | day, &! day of month 965 | tod ! time of day (seconds past 0Z) 966 | 967 | call get_curr_date(yr, mon, day, tod) 968 | is_end_curr_day = (tod == 0) 969 | 970 | end function is_end_curr_day 971 | 972 | !========================================================================================= 973 | 974 | logical function is_end_curr_month() 975 | 976 | ! Return true if current timestep is last timestep in current month. 977 | integer :: yr, mon, day, tod ! time of day (seconds past 0Z) 978 | 979 | call get_curr_date(yr, mon, day, tod) 980 | is_end_curr_month = (day == 1 .and. tod == 0) 981 | 982 | end function is_end_curr_month 983 | 984 | !========================================================================================= 985 | 986 | logical function is_first_step() 987 | 988 | ! Return true on first step of startup and hybrid runs. 989 | character(len=*), parameter :: sub = 'rtm::is_first_step' 990 | integer :: rc 991 | integer :: nstep 992 | integer(ESMF_KIND_I8) :: step_no 993 | 994 | call ESMF_ClockGet( tm_clock, advanceCount=step_no, rc=rc ) 995 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 996 | nstep = step_no 997 | is_first_step = (nstep == 1) 998 | 999 | end function is_first_step 1000 | 1001 | !========================================================================================= 1002 | 1003 | logical function is_first_restart_step() 1004 | 1005 | ! Return true on first step of restart run only. 1006 | is_first_restart_step = tm_first_restart_step 1007 | 1008 | end function is_first_restart_step 1009 | 1010 | !========================================================================================= 1011 | 1012 | logical function is_last_step() 1013 | 1014 | ! Return true on last timestep. 1015 | character(len=*), parameter :: sub = 'rtm::is_last_step' 1016 | type(ESMF_Time) :: stop_date 1017 | type(ESMF_Time) :: curr_date 1018 | type(ESMF_TimeInterval) :: time_step 1019 | integer :: rc 1020 | 1021 | call ESMF_ClockGet( tm_clock, stopTime=stop_date, & 1022 | currTime=curr_date, TimeStep=time_step, rc=rc ) 1023 | call chkrc(rc, sub//': error return from ESMF_ClockGet') 1024 | if ( curr_date+time_step > stop_date ) then 1025 | is_last_step = .true. 1026 | else 1027 | is_last_step = .false. 1028 | end if 1029 | 1030 | end function is_last_step 1031 | 1032 | !========================================================================================= 1033 | 1034 | subroutine chkrc(rc, mes) 1035 | integer, intent(in) :: rc ! return code from time management library 1036 | character(len=*), intent(in) :: mes ! error message 1037 | if ( rc == ESMF_SUCCESS ) return 1038 | write(iulog,*) mes 1039 | call shr_sys_abort ('CHKRC') 1040 | end subroutine chkrc 1041 | 1042 | !========================================================================================= 1043 | 1044 | function to_upper(str) 1045 | 1046 | ! Convert character string to upper case. Use achar and iachar intrinsics 1047 | ! to ensure use of ascii collating sequence. 1048 | character(len=*), intent(in) :: str ! String to convert to upper case 1049 | character(len=len(str)) :: to_upper 1050 | 1051 | integer :: i ! Index 1052 | integer :: aseq ! ascii collating sequence 1053 | character(len=1) :: ctmp ! Character temporary 1054 | 1055 | do i = 1, len(str) 1056 | ctmp = str(i:i) 1057 | aseq = iachar(ctmp) 1058 | if ( aseq >= 97 .and. aseq <= 122 ) ctmp = achar(aseq - 32) 1059 | to_upper(i:i) = ctmp 1060 | end do 1061 | 1062 | end function to_upper 1063 | 1064 | !========================================================================================= 1065 | 1066 | logical function is_restart( ) 1067 | ! Determine if restart run 1068 | if (nsrest == nsrContinue) then 1069 | is_restart = .true. 1070 | else 1071 | is_restart = .false. 1072 | end if 1073 | end function is_restart 1074 | 1075 | !========================================================================================= 1076 | 1077 | subroutine timemgr_finalize( ) 1078 | ! 1079 | ! call ESMF_ClockDestroy to clean up ESMF clock memory 1080 | ! 1081 | implicit none 1082 | 1083 | integer :: rc ! return code 1084 | character(len=*), parameter :: sub = 'rtm::timemgr_finalize' 1085 | ! 1086 | ! tm_clock is a module variable 1087 | ! 1088 | ! 1089 | #ifndef USE_ESMF_LIB 1090 | call ESMF_ClockDestroy( tm_clock, rc ) 1091 | call chkrc(rc, sub//': error return from ESMF_ClockDestory') 1092 | #endif 1093 | 1094 | end subroutine timemgr_finalize 1095 | 1096 | !========================================================================================= 1097 | 1098 | subroutine timemgr_spmdbcast( ) 1099 | 1100 | integer :: ier 1101 | 1102 | call mpi_bcast (dtime, 1, MPI_INTEGER, 0, mpicom_rof, ier) 1103 | 1104 | end subroutine timemgr_spmdbcast 1105 | 1106 | end module RtmTimeManager 1107 | --------------------------------------------------------------------------------