diff --git a/.github/actions/buildcdeps/action.yaml b/.github/actions/buildcdeps/action.yaml new file mode 100644 index 000000000..9d775dd12 --- /dev/null +++ b/.github/actions/buildcdeps/action.yaml @@ -0,0 +1,46 @@ +name: CDEPS build and cache +description: 'Build the CDEPS library' +inputs: + cdeps_version: + description: 'Tag in the CDEPS repository to use' + default: main + required: False + type: string + pio_path: + description: 'Path to the installed parallelio code root' + default: $HOME/pio + required: False + type: string + esmfmkfile: + description: 'Path to the installed ESMF library mkfile' + default: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + required: False + type: string + src_root: + description: 'Path to cdeps source' + default: $GITHUB_WORKSPACE + required: False + type: string + cmake_flags: + description: 'Extra flags for cmake command' + default: -Wno-dev + required: False + type: string + install_prefix: + description: 'Install path of cdeps' + default: $HOME/cdeps + required: False + type: string +runs: + using: composite + steps: + - id : Build-CDEPS + shell: bash + run: | + mkdir build-cdeps + pushd build-cdeps + export ESMFMKFILE=${{ inputs.esmfmkfile }} + export PIO=${{ inputs.pio_path }} + cmake ${{ inputs.cmake_flags }} ${{ inputs.src_root }} + make VERBOSE=1 + popd diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index c3a54360e..52afb7b81 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,10 +19,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu " # Versions of all dependencies can be updated here - these match tag names in the github repo - ESMF_VERSION: v8.4.0 - #PNETCDF_VERSION: checkpoint.1.12.3 - #NETCDF_FORTRAN_VERSION: v4.6.0 - ParallelIO_VERSION: pio2_5_10 + ESMF_VERSION: v8.5.0 + ParallelIO_VERSION: pio2_6_0 steps: - id: checkout-CDEPS uses: actions/checkout@v3 @@ -37,35 +35,11 @@ jobs: sudo apt-get install netcdf-bin libnetcdf-dev libnetcdff-dev sudo apt-get install pnetcdf-bin libpnetcdf-dev sudo apt-get install autotools-dev autoconf - # - id: cache-pnetcdf - # uses: actions/cache@v3 - # with: - # path: ~/pnetcdf - # key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf1 - # - name: Build PNetCDF - # if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - # uses: ./.github/actions/buildpnetcdf - # with: - # pnetcdf_version: ${{ env.PNETCDF_VERSION }} - # install_prefix: $HOME/pnetcdf - # - name: Cache netcdf-fortran - # id: cache-netcdf-fortran - # uses: actions/cache@v3 - # with: - # path: ~/netcdf-fortran - # key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran1 - # - name: Build NetCDF Fortran - # if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - # uses: ./.github/actions/buildnetcdff - # with: - # netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} - # install_prefix: $HOME/netcdf-fortran - # netcdf_c_path: /usr - name: Cache PARALLELIO id: cache-PARALLELIO uses: actions/cache@v3 with: - path: ~/pio + path: ${GITHUB_WORKSPACE}/pio key: ${{ runner.os }}-${{ env.ParallelIO_VERSION }}-parallelio2 - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' @@ -73,32 +47,33 @@ jobs: with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True - install_prefix: $HOME/pio - - name: Cache ESMF - id: cache-esmf - uses: actions/cache@v3 - with: - path: ~/ESMF - key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF2 - - name: Build ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ./.github/actions/buildesmf + install_prefix: ${GITHUB_WORKSPACE}/pio + - name: Install ESMF + uses: esmf-org/install-esmf-action@v1 + env: + ESMF_COMPILER: gfortran + ESMF_BOPT: g + ESMF_COMM: openmpi + ESMF_NETCDF: nc-config + ESMF_PNETCDF: pnetcdf-config + ESMF_INSTALL_PREFIX: ${GITHUB_WORKSPACE}/ESMF + ESMF_PIO: external + ESMF_PIO_INCLUDE: ${GITHUB_WORKSPACE}/pio/include + ESMF_PIO_LIBPATH: ${GITHUB_WORKSPACE}/pio/lib with: - esmf_version: ${{ env.ESMF_VERSION }} - esmf_bopt: g - esmf_comm: openmpi - install_prefix: $HOME/ESMF - netcdf_c_path: /usr - netcdf_fortran_path: /usr - pnetcdf_path: /usr - parallelio_path: $HOME/pio + version: ${{ env.ESMF_VERSION }} + esmpy: false + cache: true + - name: Build CDEPS + uses: ./.github/actions/buildcdeps + with: + esmfmkfile: $ESMFMKFILE + pio_path: ${GITHUB_WORKSPACE}/pio + src_root: ${GITHUB_WORKSPACE} + cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" + - name: Test CDEPS run: | - export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk - export PIO=$HOME/pio - export SRC_ROOT= - mkdir build-cdeps - pushd build-cdeps - cmake -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-DCPRGNU -g -Wall -ffree-form -ffree-line-length-none -fallow-argument-mismatch " -DWERROR=ON ../ + cd build-cdeps make VERBOSE=1 - popd diff --git a/.gitignore b/.gitignore index 34b286f3e..625692541 100644 --- a/.gitignore +++ b/.gitignore @@ -31,5 +31,9 @@ *.out *.app +# Externals +fox +share/genf90 + # ignore pycache __pycache__ diff --git a/CMakeLists.txt b/CMakeLists.txt index 5d88135b8..28fb2a269 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -2,6 +2,12 @@ cmake_minimum_required(VERSION 3.10) include(ExternalProject) include(FetchContent) +set(DISABLE_FoX OFF CACHE BOOL "Disable FoX library to process XML files.") +message("DISABLE_FoX = ${DISABLE_FoX}") +if(DISABLE_FoX) + add_definitions(-DDISABLE_FoX) +endif() + if (DEFINED CIMEROOT) message("Using CIME in ${CIMEROOT} with compiler ${COMPILER}") include(${CASEROOT}/Macros.cmake) @@ -23,7 +29,9 @@ else() set(BLD_STANDALONE TRUE) project(NUOPC_DATA_MODELS LANGUAGES Fortran VERSION 0.1) list(APPEND CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake) - set(FOX_ROOT ${CMAKE_SOURCE_DIR}/fox) + if(NOT DISABLE_FoX) + set(FOX_ROOT ${CMAKE_SOURCE_DIR}/fox) + endif() endif() message("CMAKE_MODULE_PATH is ${CMAKE_MODULE_PATH}, CMAKE_Fortran_COMPILER is ${CMAKE_Fortran_COMPILER}") enable_language(Fortran) @@ -62,29 +70,32 @@ endif() add_subdirectory(streams) add_subdirectory(dshr) -if(IS_DIRECTORY "${FOX_ROOT}") - message(STATUS "FoX library is already checked out!") - message(STATUS "FoX source dir: ${FOX_ROOT}") -else() - FetchContent_Declare(fox - GIT_REPOSITORY https://github.com/ESMCI/fox.git - GIT_TAG 4.1.2.1 - SOURCE_DIR ${FOX_ROOT} - BINARY_DIR ${FOX_ROOT}/.. - ) - FetchContent_GetProperties(fox) - if(NOT fox_POPULATED) - FetchContent_Populate(fox) - message(STATUS "FoX source dir: ${fox_SOURCE_DIR}") - message(STATUS "FoX binary dir: ${fox_BINARY_DIR}") +if(NOT DISABLE_FoX) + if(IS_DIRECTORY "${FOX_ROOT}") + message(STATUS "FoX library is already checked out!") + message(STATUS "FoX source dir: ${FOX_ROOT}") + else() + FetchContent_Declare(fox + GIT_REPOSITORY https://github.com/ESMCI/fox.git + GIT_TAG 4.1.2.1 + SOURCE_DIR ${FOX_ROOT} + BINARY_DIR ${FOX_ROOT}/.. + ) + FetchContent_GetProperties(fox) + if(NOT fox_POPULATED) + FetchContent_Populate(fox) + message(STATUS "FoX source dir: ${fox_SOURCE_DIR}") + message(STATUS "FoX binary dir: ${fox_BINARY_DIR}") + endif() endif() + add_subdirectory(fox) + + target_include_directories(streams PUBLIC $ + $) + target_include_directories(dshr PUBLIC $ + $) endif() -add_subdirectory(fox) -target_include_directories(streams PUBLIC $ - $) -target_include_directories(dshr PUBLIC $ - $) target_include_directories(dshr PUBLIC $ $) @@ -112,6 +123,9 @@ foreach(COMP datm dice dlnd docn drof dwav) endforeach(COMP) foreach(DEPS streams dshr cdeps_share FoX_dom FoX_wxml FoX_sax FoX_common FoX_utils FoX_fsys) + if(DISABLE_FoX AND ${DEPS} MATCHES "^FoX") + continue() + endif() if(NOT BLD_STANDALONE AND ${DEPS} STREQUAL "cdeps_share") continue() endif() diff --git a/README.md b/README.md index e46df19ae..00da8d28c 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ Community Data Models for Earth Prediction Systems For documentation see -https://escomp.github.io/CDEPS/html/index.html +https://escomp.github.io/CDEPS/versions/master/html/index.html ## A note on github tag action diff --git a/cime_config/buildlib b/cime_config/buildlib index 965836cff..a692a4e50 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -77,9 +77,7 @@ def buildlib(bldroot, libroot, case): logger.info("Running cmake for CDEPS") srcpath = os.path.abspath(os.path.join(os.path.dirname(__file__), os.pardir)) - cmake_flags = get_standard_cmake_args( - case, os.path.join(sharedpath, "cdeps") - ) + cmake_flags = get_standard_cmake_args(case, os.path.join(sharedpath, "cdeps")) # base path of install to be completed by setting DESTDIR in make install cmake_flags += " -DCMAKE_INSTALL_PREFIX:PATH=/" cmake_flags += " -DLIBROOT={} ".format(libroot) @@ -180,8 +178,8 @@ def buildlib(bldroot, libroot, case): # Do not allow any warnings except from fox external nextline = "" for line in e.split("\n"): - if "F90" in line and not "fox" in line: - nextline.append(line) + if "f90" in line.lower() and not "fox" in line.lower(): + nextline = nextline + line if len(nextline) > 0: expect(False, nextline) diff --git a/cime_config/buildlib_comps b/cime_config/buildlib_comps index 1eba5bee6..281f0d4e9 100755 --- a/cime_config/buildlib_comps +++ b/cime_config/buildlib_comps @@ -11,7 +11,7 @@ if _CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) -_LIBDIR = os.path.join(_CIMEROOT, "scripts", "lib") +_LIBDIR = os.path.join(_CIMEROOT, "CIME") sys.path.append(_LIBDIR) from standard_script_setup import * @@ -19,28 +19,36 @@ from CIME.buildlib import parse_input from CIME.case import Case from CIME.utils import run_cmd, symlink_force, expect +# pragma pylint: disable=unused-argument,undefined-variable + logger = logging.getLogger(__name__) + def buildlib(bldroot, libroot, case, compname=None): if not compname: - expect(bldroot.endswith("obj"), - "It appears that buildlib_comps is being called for the main CDEPS build\n" - "(the main CDEPS build should use buildlib, not buildlib_comps)") - compname = os.path.basename(os.path.abspath(os.path.join(bldroot,os.pardir))) + expect( + bldroot.endswith("obj"), + "It appears that buildlib_comps is being called for the main CDEPS build\n" + "(the main CDEPS build should use buildlib, not buildlib_comps)", + ) + compname = os.path.basename(os.path.abspath(os.path.join(bldroot, os.pardir))) _, o, e = run_cmd("make d{}".format(compname), from_dir=bldroot, verbose=True) libname = "lib{}.a".format(compname) dlibname = "libd{}.a".format(compname) dlibpath = os.path.join(bldroot, dlibname) if os.path.exists(dlibpath): - symlink_force(os.path.join(bldroot,dlibname), os.path.join(libroot,libname)) + symlink_force(os.path.join(bldroot, dlibname), os.path.join(libroot, libname)) else: - expect(False, "ERROR in {} build {} {}".format(compname,o,e)) + expect(False, "ERROR in {} build {} {}".format(compname, o, e)) + logger.info(f"build successful for comp={compname}") + def _main_func(args): caseroot, libroot, bldroot = parse_input(args) with Case(caseroot) as case: buildlib(bldroot, libroot, case) + if __name__ == "__main__": _main_func(sys.argv) diff --git a/cime_config/stream_cdeps.py b/cime_config/stream_cdeps.py index ead74bbf2..1f702a13c 100644 --- a/cime_config/stream_cdeps.py +++ b/cime_config/stream_cdeps.py @@ -7,12 +7,11 @@ import re import hashlib -from standard_script_setup import * from CIME.XML.standard_module_setup import * from CIME.XML.generic_xml import GenericXML -from CIME.XML.files import Files from CIME.utils import expect +# pragma pylint: disable=undefined-variable logger = logging.getLogger(__name__) _var_ref_re = re.compile(r"\$(\{)?(?P\w+)(?(1)\})") @@ -44,25 +43,40 @@ """ valid_values = {} -valid_values["mapalgo"] = ["bilinear", "nn", "redist", "mapconsd", "mapconf", "none"] +valid_values["mapalgo"] = ["bilinear", "nn", "redist", "mapconsd", "mapconf", "none"] valid_values["tintalgo"] = ["lower", "upper", "nearest", "linear", "coszen"] -valid_values["taxmode"] = ["cycle", "extend", "limit"] +valid_values["taxmode"] = ["cycle", "extend", "limit"] -xml_scalar_names = ["stream_meshfile", "stream_mapalgo", "stream_tintalgo", "stream_taxmode", "stream_dtlimit"] +xml_scalar_names = [ + "stream_meshfile", + "stream_mapalgo", + "stream_tintalgo", + "stream_taxmode", + "stream_dtlimit", +] -class StreamCDEPS(GenericXML): +class StreamCDEPS(GenericXML): def __init__(self, infile, schema): """ Initialize a CDEPS stream object """ logger.debug("Verifying using schema {}".format(schema)) GenericXML.__init__(self, infile, schema) + self.stream_nodes = None + if os.path.exists(infile): GenericXML.read(self, infile, schema) - def create_stream_xml(self, stream_names, case, streams_xml_file, data_list_file, user_mods_file, - available_neon_data=None): + def create_stream_xml( + self, + stream_names, + case, + streams_xml_file, + data_list_file, + user_mods_file, + available_neon_data=None, + ): """ Create the stream xml file and append the required stream input data to the input data list file available_neon_data is an optional list of NEON tower data available for the given case, if provided @@ -71,98 +85,134 @@ def create_stream_xml(self, stream_names, case, streams_xml_file, data_list_file # determine if there are user mods lines_input = [] - expect (os.path.isfile(user_mods_file), - "No file {} found in case directory".format(user_mods_file)) - with open(user_mods_file, "r", encoding='utf-8') as stream_mods_file: + expect( + os.path.isfile(user_mods_file), + "No file {} found in case directory".format(user_mods_file), + ) + with open(user_mods_file, "r", encoding="utf-8") as stream_mods_file: lines_input = stream_mods_file.readlines() stream_mod_dict = {} n = len(lines_input) index = 0 lines_input_new = [] - while index < len(lines_input): + while index < n: line = lines_input[index].strip() - if line.startswith('!') or (not line): + if line.startswith("!") or (not line): index = index + 1 continue - while line[-1] == '\\': + while line[-1] == "\\": index += 1 - if index < len(lines_input): - line = line[:-1].strip() + ' ' + lines_input[index].strip() + if index < n: + line = line[:-1].strip() + " " + lines_input[index].strip() else: - line = line.replace('\\', '').strip() + line = line.replace("\\", "").strip() break # endif # end while index += 1 line = case.get_resolved_value(line) lines_input_new.append(line) - #end while + # end while for line in lines_input_new: # read in a single line in user_nl_xxx_streams and parse it if it is not a comment - stream_mods = [x.strip() for x in line.strip().split(":",maxsplit=1) if x] - expect(len(stream_mods) == 2, - "input stream mod can only be of the form streamname:var=value(s)") - stream,varmod = stream_mods - expect (stream in stream_names, - "{} contains a streamname \'{}\' that is not part of valid streamnames {}". - format(user_mods_file,stream,stream_names)) - if stream not in stream_mod_dict: + stream_mods = [x.strip() for x in line.strip().split(":", maxsplit=1) if x] + expect( + len(stream_mods) == 2, + "input stream mod can only be of the form streamname:var=value(s)", + ) + stream, varmod = stream_mods + expect( + stream in stream_names, + "{} contains a streamname '{}' that is not part of valid streamnames {}".format( + user_mods_file, stream, stream_names + ), + ) + if stream not in stream_mod_dict: stream_mod_dict[stream] = {} # var=value and check the validity varmod_args = [x.strip() for x in varmod.split("=") if x] - expect(len(varmod_args) == 2, - "input stream mod can only be of the form streamname:var=value(s)") + expect( + len(varmod_args) == 2, + "input stream mod can only be of the form streamname:var=value(s)", + ) # allow multiple entries for varmod_args, most recent wins - varname,varval = varmod_args + varname, varval = varmod_args if varname in stream_mod_dict[stream]: - logger.warning("varname {} is already in stream mod dictionary".format(varname)) + logger.warning( + "varname {} is already in stream mod dictionary".format(varname) + ) if varname == "datavars" or varname == "datafiles": if varname == "datavars": - varvals = ["{}".format(x.strip()) for x in varval.split(",") if x] + varvals = [ + "{}".format(x.strip()) + for x in varval.split(",") + if x + ] if varname == "datafiles": - varvals = ["{}".format(x.strip()) for x in varval.split(",") if x] + varvals = [ + "{}".format(x.strip()) + for x in varval.split(",") + if x + ] varval = " " + "\n ".join(varvals) varval = varval.strip() stream_mod_dict[stream][varname] = varval # write header of stream file - with open(streams_xml_file, 'w', encoding='utf-8') as stream_file: + with open(streams_xml_file, "w", encoding="utf-8") as stream_file: stream_file.write('\n') stream_file.write('\n') # write contents of stream file for stream_name in stream_names: # include NEON.$NEONSITE non-precipitation data streams whether use PRISM or NEON precip - if stream_name.startswith("NEON.") and ('PRECIP' not in stream_name): - self.stream_nodes = super(StreamCDEPS,self).get_child("stream_entry", {"name" : "NEON.$NEONSITE"}, - err_msg="No stream_entry {} found".format(stream_name)) + if stream_name.startswith("NEON.") and ("PRECIP" not in stream_name): + self.stream_nodes = super(StreamCDEPS, self).get_child( + "stream_entry", + {"name": "NEON.$NEONSITE"}, + err_msg="No stream_entry {} found".format(stream_name), + ) elif stream_name.startswith("NEON.PRISM_PRECIP"): - self.stream_nodes = super(StreamCDEPS,self).get_child("stream_entry", {"name" : "NEON.PRISM_PRECIP.$NEONSITE"}, - err_msg="No stream_entry {} found".format(stream_name)) + self.stream_nodes = super(StreamCDEPS, self).get_child( + "stream_entry", + {"name": "NEON.PRISM_PRECIP.$NEONSITE"}, + err_msg="No stream_entry {} found".format(stream_name), + ) elif stream_name.startswith("NEON.NEON_PRECIP"): - self.stream_nodes = super(StreamCDEPS,self).get_child("stream_entry", {"name" : "NEON.NEON_PRECIP.$NEONSITE"}, - err_msg="No stream_entry {} found".format(stream_name)) + self.stream_nodes = super(StreamCDEPS, self).get_child( + "stream_entry", + {"name": "NEON.NEON_PRECIP.$NEONSITE"}, + err_msg="No stream_entry {} found".format(stream_name), + ) elif stream_name.startswith("CLM_USRDAT."): - self.stream_nodes = super(StreamCDEPS,self).get_child("stream_entry", {"name" : "CLM_USRDAT.$CLM_USRDAT_NAME"}, - err_msg="No stream_entry {} found".format(stream_name)) + self.stream_nodes = super(StreamCDEPS, self).get_child( + "stream_entry", + {"name": "CLM_USRDAT.$CLM_USRDAT_NAME"}, + err_msg="No stream_entry {} found".format(stream_name), + ) elif stream_name: - self.stream_nodes = super(StreamCDEPS,self).get_child("stream_entry", {"name" : stream_name}, - err_msg="No stream_entry {} found".format(stream_name)) + self.stream_nodes = super(StreamCDEPS, self).get_child( + "stream_entry", + {"name": stream_name}, + err_msg="No stream_entry {} found".format(stream_name), + ) # determine stream_year_first and stream_year_list - data_year_first,data_year_last = self._get_stream_first_and_last_dates(self.stream_nodes, case) + data_year_first, data_year_last = self._get_stream_first_and_last_dates( + self.stream_nodes, case + ) # now write the data model streams xml file stream_vars = {} - stream_vars['streamname'] = stream_name + stream_vars["streamname"] = stream_name attributes = {} for node in self.get_children(root=self.stream_nodes): node_name = node.xml_element.tag.strip() - if node_name == 'stream_datavars': + if node_name == "stream_datavars": # Get the resolved stream data variables stream_vars[node_name] = None for child in self.get_children(root=node): @@ -171,52 +221,79 @@ def create_stream_xml(self, stream_names, case, streams_xml_file, data_list_file datavars = self._sub_glc_fields(datavars, case) datavars = self._add_xml_delimiter(datavars.split("\n"), "var") if stream_vars[node_name]: - stream_vars[node_name] = stream_vars[node_name] + "\n " + datavars.strip() + stream_vars[node_name] = ( + stream_vars[node_name] + "\n " + datavars.strip() + ) else: stream_vars[node_name] = datavars.strip() # endif - elif node_name == 'stream_datafiles': + elif node_name == "stream_datafiles": # Get the resolved stream data files stream_vars[node_name] = "" stream_datafiles = "" for child in self.get_children(root=node): - if available_neon_data and stream_name.startswith("NEON") and ('PRISM' not in stream_name): + if ( + available_neon_data + and stream_name.startswith("NEON") + and ("PRISM" not in stream_name) + ): rundir = case.get_value("RUNDIR") for neon in available_neon_data: - stream_datafiles += os.path.join(rundir,"inputdata","atm",neon) + "\n" + stream_datafiles += ( + os.path.join(rundir, "inputdata", "atm", neon) + + "\n" + ) else: stream_datafiles = child.xml_element.text - stream_datafiles = self._resolve_values(case, stream_datafiles) - #endif neon - if 'first_year' in child.xml_element.attrib and 'last_year' in child.xml_element.attrib: - value = child.xml_element.get('first_year') + stream_datafiles = self._resolve_values( + case, stream_datafiles + ) + # endif neon + if ( + "first_year" in child.xml_element.attrib + and "last_year" in child.xml_element.attrib + ): + value = child.xml_element.get("first_year") value = self._resolve_values(case, value) - stream_year_first= int(value) - value = child.xml_element.get('last_year') + stream_year_first = int(value) + value = child.xml_element.get("last_year") value = self._resolve_values(case, value) stream_year_last = int(value) year_first = max(stream_year_first, data_year_first) year_last = min(stream_year_last, data_year_last) - if 'filename_advance_days' in child.xml_element.attrib: - filename_advance_days = int(child.xml_element.get('filename_advance_days')) + if "filename_advance_days" in child.xml_element.attrib: + filename_advance_days = int( + child.xml_element.get("filename_advance_days") + ) else: filename_advance_days = 0 - stream_datafiles = self._sub_paths(stream_name, - stream_datafiles, - year_first, year_last, - filename_advance_days) + stream_datafiles = self._sub_paths( + stream_name, + stream_datafiles, + year_first, + year_last, + filename_advance_days, + ) stream_datafiles = stream_datafiles.strip() - #endif + # endif if stream_vars[node_name]: - stream_vars[node_name] += "\n " + self._add_xml_delimiter(stream_datafiles.split("\n"), "file") + stream_vars[ + node_name + ] += "\n " + self._add_xml_delimiter( + stream_datafiles.split("\n"), "file" + ) else: - stream_vars[node_name] = self._add_xml_delimiter(stream_datafiles.split("\n"), "file") - #endif - elif (node_name in xml_scalar_names): - attributes['model_grid'] = case.get_value("GRID") - attributes['compset'] = case.get_value("COMPSET") - value = self._get_value_match(node, node_name[7:], attributes=attributes) + stream_vars[node_name] = self._add_xml_delimiter( + stream_datafiles.split("\n"), "file" + ) + # endif + elif node_name in xml_scalar_names: + attributes["model_grid"] = case.get_value("GRID") + attributes["compset"] = case.get_value("COMPSET") + value = self._get_value_match( + node, node_name[7:], attributes=attributes + ) if value: value = self._resolve_values(case, value) value = value.strip() @@ -224,36 +301,50 @@ def create_stream_xml(self, stream_names, case, streams_xml_file, data_list_file elif node_name.strip(): # Get the other dependencies - stream_dict = self._add_value_to_dict(stream_vars, case, node) + self._add_value_to_dict(stream_vars, case, node) # substitute user_mods in generated stream file (i.e. stream_vars) mod_dict = {} - if stream_vars['streamname'] in stream_mod_dict: - mod_dict = stream_mod_dict[stream_vars['streamname']] + if stream_vars["streamname"] in stream_mod_dict: + mod_dict = stream_mod_dict[stream_vars["streamname"]] for var_key in mod_dict: - expect( 'stream_' + var_key in stream_vars, - "stream mod {} is not a valid name in {}".format(var_key,user_mods_file)) + expect( + "stream_" + var_key in stream_vars, + "stream mod {} is not a valid name in {}".format( + var_key, user_mods_file + ), + ) if var_key in valid_values: - expect(mod_dict[var_key] in valid_values[var_key], - "{} can only have values of {} for stream {} in file {}". - format(var_key, valid_values[var_key], stream_name, user_mods_file)) - stream_vars['stream_' + var_key] = mod_dict[var_key] - if var_key == 'datafiles': + expect( + mod_dict[var_key] in valid_values[var_key], + "{} can only have values of {} for stream {} in file {}".format( + var_key, + valid_values[var_key], + stream_name, + user_mods_file, + ), + ) + stream_vars["stream_" + var_key] = mod_dict[var_key] + if var_key == "datafiles": stream_datafiles = mod_dict[var_key] - stream_datafiles = stream_datafiles.replace('','').replace('','') + stream_datafiles = stream_datafiles.replace( + "", "" + ).replace("", "") # append to stream xml file stream_file_text = _stream_file_template.format(**stream_vars) - with open(streams_xml_file, 'a', encoding='utf-8') as stream_file: + with open(streams_xml_file, "a", encoding="utf-8") as stream_file: stream_file.write(case.get_resolved_value(stream_file_text)) # append to input_data_list - if stream_vars['stream_meshfile']: - stream_meshfile = stream_vars['stream_meshfile'].strip() - self._add_entries_to_inputdata_list(stream_meshfile, stream_datafiles.split("\n"), data_list_file) + if stream_vars["stream_meshfile"]: + stream_meshfile = stream_vars["stream_meshfile"].strip() + self._add_entries_to_inputdata_list( + stream_meshfile, stream_datafiles.split("\n"), data_list_file + ) # write close of stream xml file - with open(streams_xml_file, 'a', encoding='utf-8') as stream_file: + with open(streams_xml_file, "a", encoding="utf-8") as stream_file: stream_file.write("\n") def _get_stream_first_and_last_dates(self, stream, case): @@ -261,32 +352,34 @@ def _get_stream_first_and_last_dates(self, stream, case): Get first and last dates for data for the stream file """ for node in self.get_children(root=stream): - if node.xml_element.tag == 'stream_year_first': + if node.xml_element.tag == "stream_year_first": data_year_first = node.xml_element.text.strip() data_year_first = int(self._resolve_values(case, data_year_first)) - if node.xml_element.tag == 'stream_year_last': + if node.xml_element.tag == "stream_year_last": data_year_last = node.xml_element.text.strip() data_year_last = int(self._resolve_values(case, data_year_last)) return data_year_first, data_year_last - def _add_entries_to_inputdata_list(self, stream_meshfile, stream_datafiles, data_list_file): + def _add_entries_to_inputdata_list( + self, stream_meshfile, stream_datafiles, data_list_file + ): """ Appends input data information entries to input data list file and writes out the new file """ lines_hash = self._get_input_file_hash(data_list_file) - with open(data_list_file, 'a', encoding='utf-8') as input_data_list: + with open(data_list_file, "a", encoding="utf-8") as input_data_list: # write out the mesh file separately string = "mesh = {}\n".format(stream_meshfile) - hashValue = hashlib.md5(string.rstrip().encode('utf-8')).hexdigest() + hashValue = hashlib.md5(string.rstrip().encode("utf-8")).hexdigest() if hashValue not in lines_hash: input_data_list.write(string) # now append the stream_datafile entries for i, filename in enumerate(stream_datafiles): - if filename.strip() == '': + if filename.strip() == "": continue - string = "file{:d} = {}\n".format(i+1, filename.strip()) - hashValue = hashlib.md5(string.rstrip().encode('utf-8')).hexdigest() + string = "file{:d} = {}\n".format(i + 1, filename.strip()) + hashValue = hashlib.md5(string.rstrip().encode("utf-8")).hexdigest() if hashValue not in lines_hash: input_data_list.write(string) @@ -296,15 +389,15 @@ def _get_input_file_hash(self, data_list_file): """ lines_hash = set() if os.path.isfile(data_list_file): - with open(data_list_file, "r", encoding='utf-8') as input_data_list: + with open(data_list_file, "r", encoding="utf-8") as input_data_list: for line in input_data_list: - hashValue = hashlib.md5(line.rstrip().encode('utf-8')).hexdigest() - logger.debug( "Found line {} with hash {}".format(line,hashValue)) + hashValue = hashlib.md5(line.rstrip().encode("utf-8")).hexdigest() + logger.debug("Found line {} with hash {}".format(line, hashValue)) lines_hash.add(hashValue) return lines_hash def _get_value_match(self, node, child_name, attributes=None, exact_match=False): - ''' + """ Get the first best match for multiple tags in child_name based on the attributes input @@ -314,7 +407,7 @@ def _get_value_match(self, node, child_name, attributes=None, exact_match=False) Z - ''' + """ # Store nodes that match the attributes and their scores. matches = [] nodes = self.get_children(child_name, root=node) @@ -328,13 +421,15 @@ def _get_value_match(self, node, child_name, attributes=None, exact_match=False) # If some attribute is specified that we don't know about, # or the values don't match, it's not a match we want. if exact_match: - if attribute not in attributes or \ - attributes[attribute] != self.get(vnode, attribute): + if attribute not in attributes or attributes[ + attribute + ] != self.get(vnode, attribute): score = -1 break else: - if attribute not in attributes or not \ - re.search(self.get(vnode, attribute),attributes[attribute]): + if attribute not in attributes or not re.search( + self.get(vnode, attribute), attributes[attribute] + ): score = -1 break @@ -348,7 +443,7 @@ def _get_value_match(self, node, child_name, attributes=None, exact_match=False) # Get maximum score using either a "last" or "first" match in case of a tie max_score = -1 mnode = None - for score,node in matches: + for score, node in matches: # take the *first* best match if score > max_score: max_score = score @@ -374,10 +469,13 @@ def _resolve_values(self, case, value): """ match = _var_ref_re.search(value) while match: - env_val = case.get_value(match.group('name')) - expect(env_val is not None, - "Namelist default for variable {} refers to unknown XML variable {}.". - format(value, match.group('name'))) + env_val = case.get_value(match.group("name")) + expect( + env_val is not None, + "Namelist default for variable {} refers to unknown XML variable {}.".format( + value, match.group("name") + ), + ) value = value.replace(match.group(0), str(env_val), 1) match = _var_ref_re.search(value) return value @@ -413,10 +511,10 @@ def _sub_glc_fields(self, datavars, case): if not line: continue if "%glc" in line: - if case.get_value('GLC_NEC') == 0: + if case.get_value("GLC_NEC") == 0: glc_nec_indices = [] else: - glc_nec_indices = range(case.get_value('GLC_NEC')+1) + glc_nec_indices = range(case.get_value("GLC_NEC") + 1) for i in glc_nec_indices: new_lines.append(line.replace("%glc", "{:02d}".format(i))) else: @@ -432,7 +530,7 @@ def _days_in_month(month, year=1): """ month_start = datetime.date(year, month, 1) if month == 12: - next_year = year+1 + next_year = year + 1 next_month = 1 else: next_year = year @@ -466,7 +564,9 @@ def _add_day(cls, year, month, day): adjusted_year = adjusted_year + 1 return (adjusted_year, adjusted_month, adjusted_day) - def _sub_paths(self, stream_name, filenames, year_start, year_end, filename_advance_days): + def _sub_paths( + self, stream_name, filenames, year_start, year_end, filename_advance_days + ): """Substitute indicators with given values in a list of filenames. Replace any instance of the following substring indicators with the @@ -500,9 +600,12 @@ def _sub_paths(self, stream_name, filenames, year_start, year_end, filename_adva Returns a string (filenames separated by newlines). """ - expect(filename_advance_days == 0 or filename_advance_days == 1, - "Bad filename_advance_days attribute ({}) for {}: must be 0 or 1".format( - filename_advance_days, stream_name)) + expect( + filename_advance_days == 0 or filename_advance_days == 1, + "Bad filename_advance_days attribute ({}) for {}: must be 0 or 1".format( + filename_advance_days, stream_name + ), + ) lines = [line for line in filenames.split("\n") if line] new_lines = [] @@ -511,23 +614,33 @@ def _sub_paths(self, stream_name, filenames, year_start, year_end, filename_adva if match is None: new_lines.append(line) continue - if match.group('digits'): - year_format = "{:0"+match.group('digits')+"d}" + if match.group("digits"): + year_format = "{:0" + match.group("digits") + "d}" else: year_format = "{:04d}" - for year in range(year_start, year_end+1): - if match.group('day'): + for year in range(year_start, year_end + 1): + if match.group("day"): for month in range(1, 13): days = self._days_in_month(month) - for day in range(1, days+1): + for day in range(1, days + 1): if filename_advance_days == 1: - (adjusted_year, adjusted_month, adjusted_day) = self._add_day(year, month, day) + ( + adjusted_year, + adjusted_month, + adjusted_day, + ) = self._add_day(year, month, day) else: - (adjusted_year, adjusted_month, adjusted_day) = (year, month, day) - date_string = (year_format + "-{:02d}-{:02d}").format(adjusted_year, adjusted_month, adjusted_day) + (adjusted_year, adjusted_month, adjusted_day) = ( + year, + month, + day, + ) + date_string = (year_format + "-{:02d}-{:02d}").format( + adjusted_year, adjusted_month, adjusted_day + ) new_line = line.replace(match.group(0), date_string) new_lines.append(new_line) - elif match.group('month'): + elif match.group("month"): for month in range(1, 13): date_string = (year_format + "-{:02d}").format(year, month) new_line = line.replace(match.group(0), date_string) @@ -543,22 +656,24 @@ def _add_xml_delimiter(list_to_deliminate, delimiter): expect(delimiter and not " " in delimiter, "Missing or badly formed delimiter") pred = "<{}>".format(delimiter) postd = "".format(delimiter) - for n,item in enumerate(list_to_deliminate): + for n, item in enumerate(list_to_deliminate): if item.strip(): list_to_deliminate[n] = pred + item.strip() + postd - #endif - #endfor + # endif + # endfor return "\n ".join(list_to_deliminate) def update_input_data_list(self, data_list_file): - ''' From the stream object parse out and list required input files ''' + """From the stream object parse out and list required input files""" sinodes = self.scan_children("stream_info") for node in sinodes: meshnode = self.scan_child("stream_mesh_file", root=node) stream_meshfile = self.text(meshnode) data_file_node = self.scan_child("stream_data_files", root=node) - filenodes = self.scan_children("file",root=data_file_node) + filenodes = self.scan_children("file", root=data_file_node) stream_datafiles = [] for fnode in filenodes: stream_datafiles.append(self.text(fnode)) - self._add_entries_to_inputdata_list(stream_meshfile, stream_datafiles, data_list_file) + self._add_entries_to_inputdata_list( + stream_meshfile, stream_datafiles, data_list_file + ) diff --git a/datm/CMakeLists.txt b/datm/CMakeLists.txt index f25ad9f4d..4899e0626 100644 --- a/datm/CMakeLists.txt +++ b/datm/CMakeLists.txt @@ -8,8 +8,8 @@ set(SRCFILES atm_comp_nuopc.F90 datm_datamode_cfsr_mod.F90 datm_datamode_gfs_mod.F90 datm_datamode_gfs_hafs_mod.F90 - datm_datamode_era5_mod.F90) - + datm_datamode_era5_mod.F90 + datm_datamode_simple_mod.F90) foreach(FILE ${SRCFILES}) if(EXISTS "${CASEROOT}/SourceMods/src.datm/${FILE}") @@ -27,4 +27,17 @@ add_dependencies(datm dshr streams) target_include_directories (datm PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (datm PRIVATE ${CMAKE_SOURCE_DIR}) target_include_directories (datm PRIVATE ${PIO_Fortran_INCLUDE_DIR}) -target_include_directories (datm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +if(NOT DISABLE_FoX) + target_include_directories (datm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + +if(BLD_STANDALONE) + # ESMX requires mod files + foreach (SRC ${SRCFILES}) + string(REGEX REPLACE "[.]F90$" ".mod" MOD ${SRC}) + if (NOT DEFINED CIMEROOT AND MOD STREQUAL atm_comp_nuopc.mod) + set(MOD cdeps_datm_comp.mod) + endif() + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/${MOD}" DESTINATION include) + endforeach () +endif() diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index 82703ba64..a00610eb9 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -94,6 +94,12 @@ module cdeps_datm_comp use datm_datamode_gfs_hafs_mod , only : datm_datamode_gfs_hafs_restart_write use datm_datamode_gfs_hafs_mod , only : datm_datamode_gfs_hafs_restart_read + use datm_datamode_simple_mod , only : datm_datamode_simple_advertise + use datm_datamode_simple_mod , only : datm_datamode_simple_init_pointers + use datm_datamode_simple_mod , only : datm_datamode_simple_advance + use datm_datamode_simple_mod , only : datm_datamode_simple_restart_write + use datm_datamode_simple_mod , only : datm_datamode_simple_restart_read + implicit none private ! except @@ -148,6 +154,7 @@ module cdeps_datm_comp integer :: nx_global ! global nx integer :: ny_global ! global ny logical :: skip_restart_read = .false. ! true => skip restart read in continuation run + logical :: export_all = .false. ! true => export all fields, do not check connected or not ! linked lists type(fldList_type) , pointer :: fldsImport => null() @@ -224,7 +231,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -234,7 +241,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables integer :: nu ! unit number integer :: ierr ! error code - integer :: bcasttmp(9) + integer :: bcasttmp(10) type(ESMF_VM) :: vm character(len=*),parameter :: subname=trim(modName) // ':(InitializeAdvertise) ' character(*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" @@ -259,7 +266,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) anomaly_forcing, & skip_restart_read, & flds_presndep, & - flds_preso3 + flds_preso3, & + export_all rc = ESMF_SUCCESS @@ -280,6 +288,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (my_task == main_task) then nlfilename = "datm_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") + call shr_nl_find_group_name(nu, 'datm_nml', status=ierr) + if (ierr > 0) then + write(logunit,*) 'ERROR: reading input namelist, '//trim(nlfilename)//' iostat=',ierr + call shr_sys_abort(subName//': namelist read error '//trim(nlfilename)) + end if read (nu,nml=datm_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -296,8 +309,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if(flds_co2) bcasttmp(7) = 1 if(flds_wiso) bcasttmp(8) = 1 if(skip_restart_read) bcasttmp(9) = 1 - + if(export_all) bcasttmp(10) = 1 end if + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -317,7 +331,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, restfilm, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 9, main_task, rc=rc) + call ESMF_VMBroadcast(vm, bcasttmp, 10, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nx_global = bcasttmp(1) ny_global = bcasttmp(2) @@ -328,6 +342,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) flds_co2 = (bcasttmp(7) == 1) flds_wiso = (bcasttmp(8) == 1) skip_restart_read = (bcasttmp(9) == 1) + export_all = (bcasttmp(10) == 1) ! write namelist input to standard out if (my_task == main_task) then @@ -347,6 +362,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logunit,F02)' flds_co2 = ',flds_co2 write(logunit,F02)' flds_wiso = ',flds_wiso write(logunit,F02)' skip_restart_read = ',skip_restart_read + write(logunit,F02)' export_all = ',export_all end if ! Validate sdat datamode @@ -360,7 +376,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) trim(datamode) == 'CFSR' .or. & trim(datamode) == 'GFS' .or. & trim(datamode) == 'GFS_HAFS' .or. & - trim(datamode) == 'ERA5') then + trim(datamode) == 'ERA5' .or. & + trim(datamode) == 'SIMPLE') then else call shr_sys_abort(' ERROR illegal datm datamode = '//trim(datamode)) endif @@ -397,6 +414,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return case ('GFS_HAFS') call datm_datamode_gfs_hafs_advertise(exportState, fldsExport, flds_scalar_name, rc) + case ('SIMPLE') + call datm_datamode_simple_advertise(exportState, fldsExport, flds_scalar_name, & + nlfilename, my_task, vm, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end select @@ -453,10 +473,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState ! by replacing the advertised fields with the newly created fields of the same name. call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':datmExport', rc=rc) + subname//':datmExport', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_fldlist_realize( importState, fldsImport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':datmImport', rc=rc) + subname//':datmImport', .false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get the time to interpolate the stream data to @@ -646,6 +666,8 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe if (ChkErr(rc,__LINE__,u_FILE_u)) return case('GFS_HAFS') call datm_datamode_gfs_hafs_init_pointers(exportState, sdat, rc) + case('SIMPLE') + call datm_datamode_simple_init_pointers(exportState, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end select @@ -670,6 +692,8 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe call datm_datamode_gfs_restart_read(restfilm, inst_suffix, logunit, my_task, mpicom, sdat) case('GFS_HAFS') call datm_datamode_gfs_hafs_restart_read(restfilm, inst_suffix, logunit, my_task, mpicom, sdat) + case('SIMPLE') + call datm_datamode_simple_restart_read(restfilm, inst_suffix, logunit, my_task, mpicom, sdat) end select end if @@ -731,6 +755,9 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe case('GFS_HAFS') call datm_datamode_gfs_hafs_advance(exportstate, mainproc, logunit, mpicom, target_ymd, & target_tod, sdat%model_calendar, rc) + case('SIMPLE') + call datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & + sdat%model_calendar, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end select @@ -768,6 +795,9 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe call datm_datamode_gfs_hafs_restart_write(case_name, inst_suffix, target_ymd, target_tod, & logunit, my_task, sdat) if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('SIMPLE') + call datm_datamode_simple_restart_write(case_name, inst_suffix, target_ymd, target_tod, & + logunit, my_task, sdat) end select end if @@ -816,6 +846,7 @@ subroutine datm_init_dfields(rc) call ESMF_StateGet(exportState, itemNameList=lfieldnames, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount + call ESMF_LogWrite(trim(subname)//': field name = '//trim(lfieldnames(n)), ESMF_LOGMSG_INFO) call ESMF_StateGet(exportState, itemName=trim(lfieldnames(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=rank, rc=rc) diff --git a/datm/cime_config/buildnml b/datm/cime_config/buildnml index c3d59375a..afee50344 100755 --- a/datm/cime_config/buildnml +++ b/datm/cime_config/buildnml @@ -64,10 +64,10 @@ def _get_neon_data_availability(case, neonsite): for version in dataversions: # Once a date range for a version has been determined for any version, the loop is complete. - # Eg, if data is available for v3, the loop will not continue to v2; - # however, if data is not available for v3, it will check for v2. - # Thus, it is important for dataversions to be listed from newest to oldest. - if not newestdate: + # Eg, if data is available for v3, the loop will not continue to v2; + # however, if data is not available for v3, it will check for v2. + # Thus, it is important for dataversions to be listed from newest to oldest. + if not newestdate: with open(fullpath, "r") as fd: for line in fd.readlines(): fpath, fname = os.path.split(line) @@ -174,7 +174,7 @@ def _create_namelists(case, confdir, inst_string, infile, nmlgen, data_list_path # Generate datm_in namelist_file = os.path.join(confdir, "datm_in") - nmlgen.write_output_file(namelist_file, data_list_path, groups=['datm_nml']) + nmlgen.write_output_file(namelist_file, data_list_path, groups=['datm_nml','const_forcing_nml']) # Determine streams streamlist = nmlgen.get_streams() @@ -220,7 +220,7 @@ def _create_drv_flds_in(case, confdir): # for now we are hard-coding this file name and values because we only need it for ozone if datm_preso3 != "none": - # Generate drv_flds_in file + # Generate drv_flds_in file outfile = os.path.join(confdir, "drv_flds_in") ozone_nl_name = "&ozone_coupling_nl" ozone_freq_par = "atm_ozone_frequency" diff --git a/datm/cime_config/config_component.xml b/datm/cime_config/config_component.xml index de8840a01..e0a04797d 100644 --- a/datm/cime_config/config_component.xml +++ b/datm/cime_config/config_component.xml @@ -10,7 +10,7 @@ This file may have atm desc entries. --> - Data driven ATM + Data driven ATM QIAN data set QIAN with water isotopes CRUNCEP data set @@ -27,6 +27,7 @@ JRA55 Repeat Year Forcing v1.3 1990-1991 JRA55 Repeat Year Forcing v1.3 2003-2004 ERA5 interannual forcing + Namelist-configurable, constant datm forcing for simple experiments @@ -40,7 +41,7 @@ char - CORE2_NYF,CORE2_IAF,CLM_QIAN,CLM_QIAN_WISO,1PT,CLMCRUNCEP,CLMCRUNCEPv7,CLMGSWP3v1,CLMNLDAS2,CPLHIST,CORE_IAF_JRA,CORE_IAF_JRA_1p4_2018,ERA5 + CORE2_NYF,CORE2_IAF,CLM_QIAN,CLM_QIAN_WISO,1PT,CLMCRUNCEP,CLMCRUNCEPv7,CLMGSWP3v1,CLMNLDAS2,CPLHIST,CORE_IAF_JRA,CORE_IAF_JRA_1p4_2018,ERA5,SIMPLE CORE2_NYF run_component_datm env_run.xml @@ -61,6 +62,7 @@ 1PT ERA5 CPLHIST + SIMPLE diff --git a/datm/cime_config/namelist_definition_datm.xml b/datm/cime_config/namelist_definition_datm.xml index 08749a02b..491b6f6d1 100644 --- a/datm/cime_config/namelist_definition_datm.xml +++ b/datm/cime_config/namelist_definition_datm.xml @@ -70,6 +70,7 @@ ERA5_HOURLY + CPLHISTForcing.Solar,CPLHISTForcing.nonSolarFlux,CPLHISTForcing.State3hr,CPLHISTForcing.State1hr @@ -80,7 +81,7 @@ char datm datm_nml - CLMNCEP,CORE2_NYF,CORE2_IAF,CORE_IAF_JRA,ERA5,CPLHIST,1PT + CLMNCEP,CORE2_NYF,CORE2_IAF,CORE_IAF_JRA,ERA5,SIMPLE,CPLHIST,1PT general method that operates on the data. ----datamode = "CPLHIST"---- @@ -114,6 +115,8 @@ active-land-only simulations. ----datamode = "ERA5"---- Fifth generation ECMWF atmospheric reanalysis of the global climate + ----datamode = "SIMPLE"---- + Namelist-configurable, constant datm forcing for simple experiments ----datamode = "CPLHIST" ---- @@ -132,6 +135,9 @@ ERA5 + + SIMPLE + CPLHIST @@ -364,4 +370,107 @@ + + real + datm + const_forcing_nml + + density at the lowest model layer + units: kg m-3 + + + 1.204 + + + + + real + datm + const_forcing_nml + + inst_pres_height_surface + units: Pa + + + 101325.0 + + + + + real + datm + const_forcing_nml + + Constant bottom layer specific humidity + units: kg kg-1 + + + 0.0 + + + + + real + datm + const_forcing_nml + + Constant air temperature at lowest model layer + units: K + + + 273.15 + + + + + real + datm + const_forcing_nml + + Constant zonal wind speed forcing for simple models. + units: m s-1 + + + 0.0 + + + + + real + datm + const_forcing_nml + + Constant meridional wind speed forcing for simple models. + units: m s-1 + + + 0.0 + + + + + real + datm + const_forcing_nml + + Peak idealized shortwave radiation to be passed to ice/ocean surface. + units: W m-2 + + + 330.0 + + + + + real + datm + const_forcing_nml + + Peak idealized longwave radiation to be passed to ice/ocean surface. + units: W m-2 + + + 450.0 + + diff --git a/datm/cime_config/stream_definition_datm.xml b/datm/cime_config/stream_definition_datm.xml index 4da427f2d..310c5097e 100644 --- a/datm/cime_config/stream_definition_datm.xml +++ b/datm/cime_config/stream_definition_datm.xml @@ -41,6 +41,7 @@ CORE_RYF9091_JRA = JRA55 repeat year forcing, v1.3, 1990-1991 (for forcing POP and CICE) CORE_RYF0304_JRA = JRA55 repeat year forcing, v1.3, 2003-2004 (for forcing POP and CICE) ERA5 = ERA5 intra-annual year forcing + SIMPLE = Namelist-configurable, constant datm forcing for simple experiments CPLHIST = Streams for lnd or ocn/ice forcing used for spinup Currently the following optional streams are supported @@ -4619,10 +4620,10 @@ $ATM_DOMAIN_MESH - $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.ha2x3h.%ym.nc + $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.hx.atm.3h.avrg.%ymd-10800.nc - a2x3h_Sa_topo Sa_topo + atmImp_Sa_topo Sa_topo null @@ -4649,23 +4650,23 @@ $ATM_DOMAIN_MESH - $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.ha2x1d.%ym.nc + $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.hx.atm.24h.avrg.%ymd-00000.nc - a2x1d_Faxa_bcphiwet Faxa_bcphiwet - a2x1d_Faxa_bcphodry Faxa_bcphodry - a2x1d_Faxa_bcphidry Faxa_bcphidry - a2x1d_Faxa_ocphiwet Faxa_ocphiwet - a2x1d_Faxa_ocphidry Faxa_ocphidry - a2x1d_Faxa_ocphodry Faxa_ocphodry - a2x1d_Faxa_dstwet1 Faxa_dstwet1 - a2x1d_Faxa_dstdry1 Faxa_dstdry1 - a2x1d_Faxa_dstwet2 Faxa_dstwet2 - a2x1d_Faxa_dstdry2 Faxa_dstdry2 - a2x1d_Faxa_dstwet3 Faxa_dstwet3 - a2x1d_Faxa_dstdry3 Faxa_dstdry3 - a2x1d_Faxa_dstwet4 Faxa_dstwet4 - a2x1d_Faxa_dstdry4 Faxa_dstdry4 + atmImp_Faxa_bcph1 Faxa_bcphidry + atmImp_Faxa_bcph2 Faxa_bcphodry + atmImp_Faxa_bcph3 Faxa_bcphiwet + atmImp_Faxa_ocph1 Faxa_ocphidry + atmImp_Faxa_ocph2 Faxa_ocphodry + atmImp_Faxa_ocph3 Faxa_ocphiwet + atmImp_Faxa_dstwet1 Faxa_dstwet1 + atmImp_Faxa_dstdry1 Faxa_dstdry1 + atmImp_Faxa_dstwet2 Faxa_dstwet2 + atmImp_Faxa_dstdry2 Faxa_dstdry2 + atmImp_Faxa_dstwet3 Faxa_dstwet3 + atmImp_Faxa_dstdry3 Faxa_dstdry3 + atmImp_Faxa_dstwet4 Faxa_dstwet4 + atmImp_Faxa_dstdry4 Faxa_dstdry4 null @@ -4724,13 +4725,13 @@ $ATM_DOMAIN_MESH - $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.ha2x1hi.%ym.nc + $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.hx.atm.1h.inst.%ymd-03600.nc - a2x1hi_Faxa_swndr Faxa_swndr - a2x1hi_Faxa_swvdr Faxa_swvdr - a2x1hi_Faxa_swndf Faxa_swndf - a2x1hi_Faxa_swvdf Faxa_swvdf + atmImp_Faxa_swndr Faxa_swndr + atmImp_Faxa_swvdr Faxa_swvdr + atmImp_Faxa_swndf Faxa_swndf + atmImp_Faxa_swvdf Faxa_swvdf null @@ -4740,7 +4741,7 @@ $DATM_YR_ALIGN $DATM_YR_START $DATM_YR_END - 2700 + -900 nearest @@ -4758,14 +4759,14 @@ $ATM_DOMAIN_MESH - $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.ha2x3h.%ym.nc + $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.hx.atm.3h.avrg.%ymd-10800.nc - a2x3h_Faxa_rainc Faxa_rainc - a2x3h_Faxa_rainl Faxa_rainl - a2x3h_Faxa_snowc Faxa_snowc - a2x3h_Faxa_snowl Faxa_snowl - a2x3h_Faxa_lwdn Faxa_lwdn + atmImp_Faxa_rainc Faxa_rainc + atmImp_Faxa_rainl Faxa_rainl + atmImp_Faxa_snowc Faxa_snowc + atmImp_Faxa_snowl Faxa_snowl + atmImp_Faxa_lwdn Faxa_lwdn null @@ -4793,18 +4794,18 @@ $ATM_DOMAIN_MESH - $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.ha2x3h.%ym.nc + $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.hx.atm.3h.avrg.%ymd-10800.nc - a2x3h_Sa_z Sa_z - a2x3h_Sa_tbot Sa_tbot - a2x3h_Sa_ptem Sa_ptem - a2x3h_Sa_shum Sa_shum - a2x3h_Sa_pbot Sa_pbot - a2x3h_Sa_dens Sa_dens - a2x3h_Sa_pslv Sa_pslv - a2x3h_Sa_co2diag Sa_co2diag - a2x3h_Sa_co2prog Sa_co2prog + atmImp_Sa_z Sa_z + atmImp_Sa_tbot Sa_tbot + atmImp_Sa_ptem Sa_ptem + atmImp_Sa_shum Sa_shum + atmImp_Sa_pbot Sa_pbot + atmImp_Sa_dens Sa_dens + atmImp_Sa_pslv Sa_pslv + atmImp_Sa_co2diag Sa_co2diag + atmImp_Sa_co2prog Sa_co2prog null @@ -4832,11 +4833,11 @@ $ATM_DOMAIN_MESH - $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.ha2x1h.%ym.nc + $DATM_CPLHIST_DIR/$DATM_CPLHIST_CASE.cpl.hx.atm.1h.avrg.%ymd-03600.nc - a2x1h_Sa_u Sa_u - a2x1h_Sa_v Sa_v + atmImp_Sa_u Sa_u + atmImp_Sa_v Sa_v null diff --git a/datm/datm_datamode_era5_mod.F90 b/datm/datm_datamode_era5_mod.F90 index e10fe3028..b35973248 100644 --- a/datm/datm_datamode_era5_mod.F90 +++ b/datm/datm_datamode_era5_mod.F90 @@ -26,11 +26,17 @@ module datm_datamode_era5_mod real(r8), pointer :: Sa_z(:) => null() real(r8), pointer :: Sa_u10m(:) => null() real(r8), pointer :: Sa_v10m(:) => null() + real(r8), pointer :: Sa_u(:) => null() + real(r8), pointer :: Sa_v(:) => null() real(r8), pointer :: Sa_wspd10m(:) => null() + real(r8), pointer :: Sa_wspd(:) => null() real(r8), pointer :: Sa_t2m(:) => null() + real(r8), pointer :: Sa_tbot(:) => null() real(r8), pointer :: Sa_tskn(:) => null() real(r8), pointer :: Sa_q2m(:) => null() + real(r8), pointer :: Sa_shum(:) => null() real(r8), pointer :: Sa_pslv(:) => null() + real(r8), pointer :: Sa_pbot(:) => null() real(r8), pointer :: Faxa_rain(:) => null() real(r8), pointer :: Faxa_rainc(:) => null() real(r8), pointer :: Faxa_rainl(:) => null() @@ -52,10 +58,19 @@ module datm_datamode_era5_mod ! real(r8), pointer :: Faxa_ndep(:,:) => null() ! stream data + real(r8), pointer :: strm_z(:) => null() real(r8), pointer :: strm_tdew(:) => null() - - real(r8) :: t2max ! units detector - real(r8) :: td2max ! units detector + real(r8), pointer :: strm_wind(:) => null() + real(r8), pointer :: strm_wind10m(:) => null() + real(r8), pointer :: strm_u(:) => null() + real(r8), pointer :: strm_v(:) => null() + real(r8), pointer :: strm_u10m(:) => null() + real(r8), pointer :: strm_v10m(:) => null() + + real(r8) :: t2max ! units detector + real(r8) :: td2max ! units detector + real(r8) :: lwmax ! units detector + real(r8) :: precmax ! units detector real(r8) , parameter :: tKFrz = SHR_CONST_TKFRZ real(r8) , parameter :: rdair = SHR_CONST_RDAIR ! dry air gas constant ~ J/K/kg @@ -89,11 +104,17 @@ subroutine datm_datamode_era5_advertise(exportState, fldsexport, & call dshr_fldList_add(fldsExport, 'Sa_z' ) call dshr_fldList_add(fldsExport, 'Sa_u10m' ) call dshr_fldList_add(fldsExport, 'Sa_v10m' ) + call dshr_fldList_add(fldsExport, 'Sa_u' ) + call dshr_fldList_add(fldsExport, 'Sa_v' ) call dshr_fldList_add(fldsExport, 'Sa_wspd10m' ) + call dshr_fldList_add(fldsExport, 'Sa_wspd' ) call dshr_fldList_add(fldsExport, 'Sa_t2m' ) + call dshr_fldList_add(fldsExport, 'Sa_tbot' ) call dshr_fldList_add(fldsExport, 'Sa_tskn' ) call dshr_fldList_add(fldsExport, 'Sa_q2m' ) + call dshr_fldList_add(fldsExport, 'Sa_shum' ) call dshr_fldList_add(fldsExport, 'Sa_pslv' ) + call dshr_fldList_add(fldsExport, 'Sa_pbot' ) call dshr_fldList_add(fldsExport, 'Faxa_rain' ) call dshr_fldList_add(fldsExport, 'Faxa_rainc' ) call dshr_fldList_add(fldsExport, 'Faxa_rainl' ) @@ -137,7 +158,21 @@ subroutine datm_datamode_era5_init_pointers(exportState, sdat, rc) rc = ESMF_SUCCESS ! initialize pointers for module level stream arrays - call shr_strdata_get_stream_pointer( sdat, 'Sa_tdew' , strm_tdew , rc) + call shr_strdata_get_stream_pointer(sdat, 'Sa_z' , strm_z , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_tdew' , strm_tdew, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_wspd' , strm_wind, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_wspd10m', strm_wind10m, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_u' , strm_u, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_v' , strm_v, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_u10m' , strm_u10m, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_strdata_get_stream_pointer(sdat, 'Sa_v10m' , strm_v10m, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get export state pointers @@ -147,16 +182,28 @@ subroutine datm_datamode_era5_init_pointers(exportState, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_v10m' , fldptr1=Sa_v10m , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , allowNullReturn=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_v' , fldptr1=Sa_v , allowNullReturn=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_wspd10m' , fldptr1=Sa_wspd10m , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_wspd' , fldptr1=Sa_wspd , allowNullReturn=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_t2m' , fldptr1=Sa_t2m , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_tbot' , fldptr1=Sa_tbot , allowNullReturn=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_tskn' , fldptr1=Sa_tskn , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_q2m' , fldptr1=Sa_q2m , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_shum' , fldptr1=Sa_shum , allowNullReturn=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Sa_pslv' , fldptr1=Sa_pslv , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pbot' , fldptr1=Sa_pbot , allowNullReturn=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rain' , fldptr1=Faxa_rain , allowNullReturn=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_state_getfldptr(exportState, 'Faxa_rainc' , fldptr1=Faxa_rainc , allowNullReturn=.true., rc=rc) @@ -211,9 +258,9 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta ! local variables logical :: first_time = .true. integer :: n ! indices - integer :: lsize ! size of attr vect + integer :: lsize = 0 ! size of attr vect real(r8) :: rtmp(2) - real(r8) :: t2, pslv + real(r8) :: tbot, pbot real(r8) :: e, qsat type(ESMF_VM) :: vm character(len=*), parameter :: subname='(datm_datamode_era5_advance): ' @@ -221,24 +268,66 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta rc = ESMF_SUCCESS - lsize = size(strm_tdew) + ! one of the following needs to be in the stream + if (associated(Sa_z)) lsize = size(Sa_z) + if (associated(strm_tdew)) lsize = size(strm_tdew) + if (mainproc .and. lsize == 0) then + write(logunit,*) trim(subname),' Sa_z or Sa_tdew need to be in the stream! Exiting ...' + end if + if (first_time) then call ESMF_VMGetCurrent(vm, rc=rc) ! determine t2max (see below for use) if (associated(Sa_t2m)) then - rtmp(1) = maxval(Sa_t2m(:)) - - call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) - t2max = rtmp(2) - if (mainproc) write(logunit,*) trim(subname),' t2max = ',t2max + rtmp(1) = maxval(Sa_t2m(:)) + call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) + t2max = rtmp(2) + if (mainproc) write(logunit,*) trim(subname),' t2max = ',t2max end if ! determine tdewmax (see below for use) - rtmp(1) = maxval(strm_tdew(:)) - call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) - td2max = rtmp(2) + if (associated(strm_tdew)) then + rtmp(1) = maxval(strm_tdew(:)) + call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) + td2max = rtmp(2) + if (mainproc) write(logunit,*) trim(subname),' td2max = ',td2max + end if - if (mainproc) write(logunit,*) trim(subname),' td2max = ',td2max + ! determine lwmax / lwmax + if (associated(Faxa_lwdn)) then + rtmp(1) = maxval(Faxa_lwdn(:)) + call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) + lwmax = rtmp(2) + if (mainproc) write(logunit,*) trim(subname),' lwmax = ',lwmax + else + ! try with other variable since Faxa_lwdn is not available + if (associated(Faxa_lwnet)) then + rtmp(1) = maxval(Faxa_lwnet(:)) + call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) + lwmax = rtmp(2) + if (mainproc) write(logunit,*) trim(subname),' lwmax = ',lwmax + else + lwmax = 0.0_r8 + end if + end if + + ! determine precmax + if (associated(Faxa_rain)) then + rtmp(1) = maxval(Faxa_rain(:)) + call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) + precmax = rtmp(2) + if (mainproc) write(logunit,*) trim(subname),' precmax = ', precmax + else + ! try with other variable since Faxa_rain is not available + if (associated(Faxa_rainl)) then + rtmp(1) = maxval(Faxa_rainl(:)) + call ESMF_VMAllReduce(vm, rtmp, rtmp(2:), 1, ESMF_REDUCE_MAX, rc=rc) + precmax = rtmp(2) + if (mainproc) write(logunit,*) trim(subname),' precmax = ', precmax + else + precmax = 0.0_r8 + end if + end if ! reset first_time first_time = .false. @@ -246,23 +335,47 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta do n = 1, lsize !--- bottom layer height --- - if (associated(Sa_z)) then - Sa_z(n) = 10.0_r8 + if (.not. associated(strm_z) .and. associated(Sa_z)) then + Sa_z(n) = 10.0_r8 + end if + + !--- calculate wind components if wind speed is provided --- + if (associated(strm_wind)) then + Sa_u(n) = strm_wind(n)/sqrt(2.0_r8) + Sa_v(n) = Sa_u(n) + end if + if (associated(strm_wind10m)) then + Sa_u10m(n) = strm_wind10m(n)/sqrt(2.0_r8) + Sa_v10m(n) = Sa_u10m(n) end if - !--- calculate wind speed --- - if (associated(Sa_wspd10m)) then - Sa_wspd10m(n) = sqrt(Sa_u10m(n)*Sa_u10m(n)+Sa_v10m(n)*Sa_v10m(n)) + !--- calculate wind speed if wind components are provided --- + if (associated(strm_u10m) .and. associated(strm_v10m) .and. associated(Sa_wspd10m)) then + Sa_wspd10m(n) = sqrt(Sa_u10m(n)*Sa_u10m(n)+Sa_v10m(n)*Sa_v10m(n)) + end if + if (associated(strm_u) .and. associated(strm_v) .and. associated(Sa_wspd)) then + Sa_wspd(n) = sqrt(Sa_u(n)*Sa_u(n)+Sa_v(n)*Sa_v(n)) end if - !--- specific humidity at 2m --- - if (associated(Sa_t2m) .and. associated(Sa_pslv) .and. associated(Sa_q2m)) then - t2 = Sa_t2m(n) - pslv = Sa_pslv(n) - if (td2max < 50.0_r8) strm_tdew(n) = strm_tdew(n) + tkFrz - e = datm_eSat(strm_tdew(n), t2) - qsat = (0.622_r8 * e)/(pslv - 0.378_r8 * e) - Sa_q2m(n) = qsat + !--- calculate specific humidity from dew point temperature --- + if (associated(strm_tdew)) then + if (associated(Sa_t2m)) then + tbot = Sa_t2m(n) + else if (associated(Sa_tbot)) then + tbot = Sa_tbot(n) + end if + + if (associated(Sa_pslv)) then + pbot = Sa_pslv(n) + else if (associated(Sa_pbot)) then + pbot = Sa_pbot(n) + end if + + if (td2max < 50.0_r8) strm_tdew(n) = strm_tdew(n) + tkFrz + e = datm_eSat(strm_tdew(n), tbot) + qsat = (0.622_r8 * e)/(pbot - 0.378_r8 * e) + if (associated(Sa_q2m)) Sa_q2m(n) = qsat + if (associated(Sa_shum)) Sa_shum(n) = qsat end if end do @@ -293,23 +406,31 @@ subroutine datm_datamode_era5_advance(exportstate, mainproc, logunit, mpicom, ta !---------------------------------------------------------- ! convert J/m^2 to W/m^2 - if (associated(Faxa_lwdn)) Faxa_lwdn(:) = Faxa_lwdn(:)/3600.0_r8 - if (associated(Faxa_lwnet)) Faxa_lwnet(:) = Faxa_lwnet(:)/3600.0_r8 - if (associated(Faxa_swvdr)) Faxa_swvdr(:) = Faxa_swvdr(:)/3600.0_r8 - if (associated(Faxa_swndr)) Faxa_swndr(:) = Faxa_swndr(:)/3600.0_r8 - if (associated(Faxa_swvdf)) Faxa_swvdf(:) = Faxa_swvdf(:)/3600.0_r8 - if (associated(Faxa_swndf)) Faxa_swndf(:) = Faxa_swndf(:)/3600.0_r8 - if (associated(Faxa_swdn)) Faxa_swdn(:) = Faxa_swdn(:)/3600.0_r8 - if (associated(Faxa_swnet)) Faxa_swnet(:) = Faxa_swnet(:)/3600.0_r8 - if (associated(Faxa_sen)) Faxa_sen(:) = Faxa_sen(:)/3600.0_r8 - if (associated(Faxa_lat)) Faxa_lat(:) = Faxa_lat(:)/3600.0_r8 + if (lwmax < 1.0e4_r8) then + if (mainproc) write(logunit,*) trim(subname),' flux related variables are already in W/m^2 unit!' + else + if (associated(Faxa_lwdn)) Faxa_lwdn(:) = Faxa_lwdn(:)/3600.0_r8 + if (associated(Faxa_lwnet)) Faxa_lwnet(:) = Faxa_lwnet(:)/3600.0_r8 + if (associated(Faxa_swvdr)) Faxa_swvdr(:) = Faxa_swvdr(:)/3600.0_r8 + if (associated(Faxa_swndr)) Faxa_swndr(:) = Faxa_swndr(:)/3600.0_r8 + if (associated(Faxa_swvdf)) Faxa_swvdf(:) = Faxa_swvdf(:)/3600.0_r8 + if (associated(Faxa_swndf)) Faxa_swndf(:) = Faxa_swndf(:)/3600.0_r8 + if (associated(Faxa_swdn)) Faxa_swdn(:) = Faxa_swdn(:)/3600.0_r8 + if (associated(Faxa_swnet)) Faxa_swnet(:) = Faxa_swnet(:)/3600.0_r8 + if (associated(Faxa_sen)) Faxa_sen(:) = Faxa_sen(:)/3600.0_r8 + if (associated(Faxa_lat)) Faxa_lat(:) = Faxa_lat(:)/3600.0_r8 + end if ! convert m to kg/m^2/s - if (associated(Faxa_rain)) Faxa_rain(:) = Faxa_rain(:)/3600.0_r8*rhofw - if (associated(Faxa_rainc)) Faxa_rainc(:) = Faxa_rainc(:)/3600.0_r8*rhofw - if (associated(Faxa_rainl)) Faxa_rainl(:) = Faxa_rainl(:)/3600.0_r8*rhofw - if (associated(Faxa_snowc)) Faxa_snowc(:) = Faxa_snowc(:)/3600.0_r8*rhofw - if (associated(Faxa_snowl)) Faxa_snowl(:) = Faxa_snowl(:)/3600.0_r8*rhofw + if (precmax < 0.01_r8) then + if (mainproc) write(logunit,*) trim(subname),' precipitation related variables are already in kg/m^2/s unit!' + else + if (associated(Faxa_rain)) Faxa_rain(:) = Faxa_rain(:)/3600.0_r8*rhofw + if (associated(Faxa_rainc)) Faxa_rainc(:) = Faxa_rainc(:)/3600.0_r8*rhofw + if (associated(Faxa_rainl)) Faxa_rainl(:) = Faxa_rainl(:)/3600.0_r8*rhofw + if (associated(Faxa_snowc)) Faxa_snowc(:) = Faxa_snowc(:)/3600.0_r8*rhofw + if (associated(Faxa_snowl)) Faxa_snowl(:) = Faxa_snowl(:)/3600.0_r8*rhofw + end if ! convert N/m^2 s to N/m^2 if (associated(Faxa_taux)) Faxa_taux(:) = Faxa_taux(:)/3600.0_r8 diff --git a/datm/datm_datamode_simple_mod.F90 b/datm/datm_datamode_simple_mod.F90 new file mode 100644 index 000000000..ca978c153 --- /dev/null +++ b/datm/datm_datamode_simple_mod.F90 @@ -0,0 +1,379 @@ +module datm_datamode_simple_mod + + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldBundle + use ESMF , only : ESMF_DistGrid, ESMF_RouteHandle, ESMF_MeshCreate + use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MeshCreate + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_FILEFORMAT_ESMFMESH + use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND, operator(/=) + use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldCreate, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_FieldBundleAdd, ESMF_LOGMSG_INFO, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_RouteHandleDestroy, ESMF_EXTRAPMETHOD_NEAREST_STOD + use ESMF , only : ESMF_POLEMETHOD_ALLAVG, ESMF_REGRIDMETHOD_BILINEAR + use ESMF , only : ESMF_DistGridGet, ESMF_FieldRegridStore, ESMF_FieldRedistStore + use ESMF , only : ESMF_VM, ESMF_VMBroadcast + use pio , only : Var_Desc_t, file_desc_t, io_desc_t, pio_read_darray, pio_freedecomp + use pio , only : pio_openfile, PIO_NOWRITE, pio_seterrorhandling, PIO_BCAST_ERROR + use pio , only : pio_initdecomp, pio_inq_dimlen, pio_inq_varid + use pio , only : pio_inq_varndims, pio_inq_vardimid, pio_double + use pio , only : pio_closefile + use NUOPC , only : NUOPC_Advertise + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_cal_mod , only : shr_cal_date2julian + use shr_const_mod , only : shr_const_tkfrz, shr_const_pi + use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_type + use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, dshr_fldbun_regrid, chkerr + use dshr_mod , only : dshr_restart_read, dshr_restart_write + use dshr_strdata_mod , only : shr_strdata_type + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + + implicit none + private ! except + + public :: datm_datamode_simple_advertise + public :: datm_datamode_simple_init_pointers + public :: datm_datamode_simple_advance + public :: datm_datamode_simple_restart_write + public :: datm_datamode_simple_restart_read + + ! export state pointers + real(r8), pointer :: Sa_u(:) => null() + real(r8), pointer :: Sa_v(:) => null() + real(r8), pointer :: Sa_z(:) => null() + real(r8), pointer :: Sa_tbot(:) => null() + real(r8), pointer :: Sa_ptem(:) => null() + real(r8), pointer :: Sa_shum(:) => null() + real(r8), pointer :: Sa_pbot(:) => null() + real(r8), pointer :: Sa_dens(:) => null() + real(r8), pointer :: Sa_pslv(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() + real(r8), pointer :: Faxa_rainc(:) => null() + real(r8), pointer :: Faxa_rainl(:) => null() + real(r8), pointer :: Faxa_snowc(:) => null() + real(r8), pointer :: Faxa_snowl(:) => null() + real(r8), pointer :: Faxa_swndr(:) => null() + real(r8), pointer :: Faxa_swndf(:) => null() + real(r8), pointer :: Faxa_swvdr(:) => null() + real(r8), pointer :: Faxa_swvdf(:) => null() + real(r8), pointer :: Faxa_swnet(:) => null() + real(r8), pointer :: Faxa_ndep(:,:) => null() + + ! othe module arrays + real(R8), pointer :: yc(:) ! array of model latitudes + real(R8), pointer :: xc(:) ! array of model longitudes + + ! constant forcing values to be set via const_forcing_nml + real(R8) :: dn10 = 1.204_R8 + real(R8) :: slp = 101325.0_R8 + real(R8) :: q = 0.0_R8 + real(R8) :: t = 273.15_R8 + real(R8) :: u = 0.0_R8 + real(R8) :: v = 0.0_R8 + real(R8) :: peak_swdn = 330.0_R8 + real(R8) :: peak_lwdn = 450.0_R8 + + ! constants + real(R8) , parameter :: tKFrz = SHR_CONST_TKFRZ + real(R8) , parameter :: degtorad = SHR_CONST_PI/180.0_R8 + real(R8) , parameter :: phs_c0 = 0.298_R8 + real(R8) , parameter :: dLWarc = -5.000_R8 + + character(*), parameter :: nullstr = 'null' + character(*), parameter :: rpfile = 'rpointer.atm' + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine datm_datamode_simple_advertise(exportState, fldsexport, flds_scalar_name, & + nlfilename, my_task, vm, rc) + use shr_nl_mod, only: shr_nl_find_group_name + + ! input/output variables + type(esmf_State) , intent(inout) :: exportState + type(fldlist_type) , pointer :: fldsexport + character(len=*) , intent(in) :: flds_scalar_name + character(len=*) , intent(in) :: nlfilename + integer , intent(in) :: my_task + type(ESMF_VM) , intent(in) :: vm + integer , intent(out) :: rc + + ! local variables + type(fldlist_type), pointer :: fldList + integer , parameter :: main_task = 0 ! task number of main task + integer :: ierr ! error code + integer :: nu ! unit number + character(len=*) , parameter :: subname='(datm_datamode_simple_advertise): ' + real(R8) :: bcasttmp(8) + + !------------------------------------------------------------------------------- + + namelist / const_forcing_nml / dn10, slp, q, t, u, v, peak_swdn, peak_lwdn + + rc = ESMF_SUCCESS + + ! Read const_forcing_nml from nlfilename + if (my_task == main_task) then + open (newunit=nu,file=trim(nlfilename),status="old",action="read") + call shr_nl_find_group_name(nu, 'const_forcing_nml', status=ierr) + read (nu,nml=const_forcing_nml,iostat=ierr) + close(nu) + if (ierr > 0) then + call shr_sys_abort(subName//': namelist read error '//trim(nlfilename)) + end if + + bcasttmp = 0 + bcasttmp(1) = dn10 + bcasttmp(2) = slp + bcasttmp(3) = q + bcasttmp(4) = t + bcasttmp(5) = u + bcasttmp(6) = v + bcasttmp(7) = peak_swdn + bcasttmp(8) = peak_lwdn + end if + + call ESMF_VMBroadcast(vm, bcasttmp, 8, main_task, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + dn10 = bcasttmp(1) + slp = bcasttmp(2) + q = bcasttmp(3) + t = bcasttmp(4) + u = bcasttmp(5) + v = bcasttmp(6) + peak_swdn = bcasttmp(7) + peak_lwdn = bcasttmp(8) + + call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) + call dshr_fldList_add(fldsExport, 'Sa_z' ) + call dshr_fldList_add(fldsExport, 'Sa_u' ) + call dshr_fldList_add(fldsExport, 'Sa_v' ) + call dshr_fldList_add(fldsExport, 'Sa_ptem' ) + call dshr_fldList_add(fldsExport, 'Sa_dens' ) + call dshr_fldList_add(fldsExport, 'Sa_pslv' ) + call dshr_fldList_add(fldsExport, 'Sa_tbot' ) + call dshr_fldList_add(fldsExport, 'Sa_pbot' ) + call dshr_fldList_add(fldsExport, 'Sa_shum' ) + call dshr_fldList_add(fldsExport, 'Faxa_rainc' ) + call dshr_fldList_add(fldsExport, 'Faxa_rainl' ) + call dshr_fldList_add(fldsExport, 'Faxa_snowc' ) + call dshr_fldList_add(fldsExport, 'Faxa_snowl' ) + call dshr_fldList_add(fldsExport, 'Faxa_swndr' ) + call dshr_fldList_add(fldsExport, 'Faxa_swvdr' ) + call dshr_fldList_add(fldsExport, 'Faxa_swndf' ) + call dshr_fldList_add(fldsExport, 'Faxa_swvdf' ) + call dshr_fldList_add(fldsExport, 'Faxa_swnet' ) + call dshr_fldList_add(fldsExport, 'Faxa_lwdn' ) + call dshr_fldList_add(fldsExport, 'Faxa_swdn' ) + + fldlist => fldsExport ! the head of the linked list + do while (associated(fldlist)) + call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('(datm_comp_advertise): Fr_atm'//trim(fldList%stdname), ESMF_LOGMSG_INFO) + fldList => fldList%next + enddo + + end subroutine datm_datamode_simple_advertise + + !=============================================================================== + subroutine datm_datamode_simple_init_pointers(exportState, sdat, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: lsize + integer :: spatialDim ! number of dimension in mesh + integer :: numOwnedElements ! size of mesh + real(r8), pointer :: ownedElemCoords(:) ! mesh lat and lons + type(ESMF_StateItem_Flag) :: itemFlag + character(len=*), parameter :: subname='(datm_init_pointers): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lsize = sdat%model_lsize + + call ESMF_MeshGet(sdat%model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + allocate(yc(numOwnedElements)) + allocate(xc(numOwnedElements)) + call ESMF_MeshGet(sdat%model_mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,numOwnedElements + yc(n) = ownedElemCoords(2*n) + xc(n) = ownedElemCoords(2*n-1) + end do + + ! get export state pointers + call dshr_state_getfldptr(exportState, 'Sa_z' , fldptr1=Sa_z , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_v' , fldptr1=Sa_v , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_tbot' , fldptr1=Sa_tbot , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pbot' , fldptr1=Sa_pbot , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_dens' , fldptr1=Sa_dens , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pslv' , fldptr1=Sa_pslv , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_ptem' , fldptr1=Sa_ptem , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_shum' , fldptr1=Sa_shum , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_rainc' , fldptr1=Faxa_rainc , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_rainl' , fldptr1=Faxa_rainl , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_snowc' , fldptr1=Faxa_snowc , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_snowl' , fldptr1=Faxa_snowl , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swvdr' , fldptr1=Faxa_swvdr , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swvdf' , fldptr1=Faxa_swvdf , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swndr' , fldptr1=Faxa_swndr , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swndf' , fldptr1=Faxa_swndf , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swnet' , fldptr1=Faxa_swnet , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(exportstate, 'Faxa_ndep', itemFlag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + call dshr_state_getfldptr(exportState, 'Faxa_ndep', fldptr2=Faxa_ndep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine datm_datamode_simple_init_pointers + + !=============================================================================== + subroutine datm_datamode_simple_advance(target_ymd, target_tod, target_mon, & + model_calendar, rc) + + ! input/output variables + integer , intent(in) :: target_ymd + integer , intent(in) :: target_tod + integer , intent(in) :: target_mon + character(len=*) , intent(in) :: model_calendar + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: lsize + real(R8) :: rday ! elapsed day + character(len=*), parameter :: subname='(datm_datamode_simple): ' + real(R8), parameter :: epsilon_deg = 23.45 ! axial tilt of the Earth + real(R8) :: solar_decl ! solar declination angle (rad) to be used in idealized radiation calculations + real(R8) :: hour_angle ! hour angle (rad) to be used in idealized radiation calculations + real(R8) :: zenith_angle ! solar senith angle (rad) to be used in idealized radiation calculations + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lsize = size(Sa_z) + + call shr_cal_date2julian(target_ymd, target_tod, rday, model_calendar) + rday = mod((rday - 1.0_R8),365.0_R8) + + do n = 1,lsize + Sa_z(n) = 10.0_R8 + + !--- (i) Set forcing fields to constant values read from the namelist file --- + Sa_dens(n) = dn10 + Sa_pslv(n) = slp + Sa_pbot(n) = Sa_pslv(n) + Sa_shum(n) = q + Sa_tbot(n) = t + Sa_ptem(n) = Sa_tbot(n) + Sa_u(n) = u + Sa_v(n) = v + + !--- (ii) Set precipitation (currently all zeros) --- + + Faxa_rainc(n) = 0.0_R8 ! default zero + Faxa_snowc(n) = 0.0_R8 + if (Sa_tbot(n) < tKFrz ) then ! assign precip to rain/snow components + Faxa_rainl(n) = 0.0_R8 + Faxa_snowl(n) = 0.0_R8 ! todo + else + Faxa_rainl(n) = 0.0_R8 ! todo + Faxa_snowl(n) = 0.0_R8 + endif + + !--- (iii) RADIATION DATA --- + + ! long wave + solar_decl = (epsilon_deg * degtorad) * sin( 2.0_R8 * shr_const_pi * (int(rday) + 284.0_R8) / 365.0_R8) + zenith_angle = acos(sin(yc(n) * degtorad ) * sin(solar_decl) + cos(yc(n) * degtorad) * cos(solar_decl) ) + Faxa_lwdn(n) = max(0.0_R8, peak_lwdn * cos(zenith_angle)) + + ! short wave + hour_angle = (15.0_R8 * (target_tod/3600.0_R8 - 12.0_R8) + xc(n) ) * degtorad + zenith_angle = acos(sin(yc(n) * degtorad ) * sin(solar_decl) + cos(yc(n) * degtorad) * cos(solar_decl) * cos(hour_angle) ) + Faxa_swnet(n) = max(0.0_R8, peak_swdn * cos(zenith_angle)) + Faxa_swvdr(n) = Faxa_swnet(n)*(0.28_R8) + Faxa_swndr(n) = Faxa_swnet(n)*(0.31_R8) + Faxa_swvdf(n) = Faxa_swnet(n)*(0.24_R8) + Faxa_swndf(n) = Faxa_swnet(n)*(0.17_R8) + + enddo ! lsize + + if (associated(Faxa_ndep)) then + ! convert ndep flux to units of kgN/m2/s (input is in gN/m2/s) + Faxa_ndep(:,:) = Faxa_ndep(:,:) / 1000._r8 + end if + + end subroutine datm_datamode_simple_advance + + !=============================================================================== + subroutine datm_datamode_simple_restart_write(case_name, inst_suffix, ymd, tod, & + logunit, my_task, sdat) + + ! input/output variables + character(len=*) , intent(in) :: case_name + character(len=*) , intent(in) :: inst_suffix + integer , intent(in) :: ymd ! model date + integer , intent(in) :: tod ! model sec into model date + integer , intent(in) :: logunit + integer , intent(in) :: my_task + type(shr_strdata_type) , intent(inout) :: sdat + !------------------------------------------------------------------------------- + + call dshr_restart_write(rpfile, case_name, 'datm', inst_suffix, ymd, tod, & + logunit, my_task, sdat) + + end subroutine datm_datamode_simple_restart_write + + !=============================================================================== + subroutine datm_datamode_simple_restart_read(rest_filem, inst_suffix, logunit, my_task, mpicom, sdat) + + ! input/output arguments + character(len=*) , intent(inout) :: rest_filem + character(len=*) , intent(in) :: inst_suffix + integer , intent(in) :: logunit + integer , intent(in) :: my_task + integer , intent(in) :: mpicom + type(shr_strdata_type) , intent(inout) :: sdat + !------------------------------------------------------------------------------- + + call dshr_restart_read(rest_filem, rpfile, inst_suffix, nullstr, logunit, my_task, mpicom, sdat) + + end subroutine datm_datamode_simple_restart_read + +end module datm_datamode_simple_mod diff --git a/dice/CMakeLists.txt b/dice/CMakeLists.txt index 02b48d36c..acfc26d47 100644 --- a/dice/CMakeLists.txt +++ b/dice/CMakeLists.txt @@ -19,4 +19,17 @@ add_dependencies(dice dshr streams) target_include_directories (dice PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (dice PRIVATE "${CMAKE_SOURCE_DIR}") target_include_directories (dice PRIVATE "${PIO_Fortran_INCLUDE_DIR}") -target_include_directories (dice PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +if(NOT DISABLE_FoX) + target_include_directories (dice PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + +if(BLD_STANDALONE) + # ESMX requires mod files + foreach (SRC ${SRCFILES}) + string(REGEX REPLACE "[.]F90$" ".mod" MOD ${SRC}) + if (NOT DEFINED CIMEROOT AND MOD STREQUAL ice_comp_nuopc.mod) + set(MOD cdeps_dice_comp.mod) + endif() + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/${MOD}" DESTINATION include) + endforeach () +endif() diff --git a/dice/ice_comp_nuopc.F90 b/dice/ice_comp_nuopc.F90 index 266d86495..51ec80361 100644 --- a/dice/ice_comp_nuopc.F90 +++ b/dice/ice_comp_nuopc.F90 @@ -85,6 +85,7 @@ module cdeps_dice_comp character(CL) :: restfilm = nullstr ! model restart file namelist integer :: nx_global integer :: ny_global + logical :: export_all = .false. ! true => export all fields, do not check connected or not ! linked lists type(fldList_type) , pointer :: fldsImport => null() @@ -159,6 +160,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -183,7 +185,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) namelist / dice_nml / datamode, & model_meshfile, model_maskfile, & - restfilm, nx_global, ny_global, flux_swpf, flux_Qmin, flux_Qacc, flux_Qacc0 + restfilm, nx_global, ny_global, & + flux_swpf, flux_Qmin, flux_Qacc, flux_Qacc0, export_all rc = ESMF_SUCCESS @@ -204,6 +207,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (my_task == main_task) then nlfilename = "dice_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") + call shr_nl_find_group_name(nu, 'dice_nml', status=ierr) + read (nu,nml=dice_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -212,7 +217,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if ! write namelist input to standard out - write(logunit,F00)' datamode = ',trim(datamode) + write(logunit,F00)' datamode = ',trim(datamode) write(logunit,F00)' model_meshfile = ',trim(model_meshfile) write(logunit,F00)' model_maskfile = ',trim(model_maskfile) write(logunit,F01)' nx_global = ',nx_global @@ -222,13 +227,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logunit,F02)' flux_Qacc = ',flux_Qacc write(logunit,F03)' flux_Qacc0 = ',flux_Qacc0 write(logunit,F00)' restfilm = ',trim(restfilm) + write(logunit,F02)' export_all = ',export_all bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global if(flux_Qacc) bcasttmp(3) = 1 + if(export_all) bcasttmp(4) = 1 rbcasttmp(1) = flux_swpf rbcasttmp(2) = flux_Qmin rbcasttmp(3) = flux_Qacc0 + if(export_all) bcasttmp(4) = 1 endif ! broadcast namelist input @@ -243,7 +251,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, restfilm, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) + call ESMF_VMBroadcast(vm, bcasttmp, 4, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, rbcasttmp, 3, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -251,12 +259,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) nx_global = bcasttmp(1) ny_global = bcasttmp(2) flux_Qacc = (bcasttmp(3) == 1) + export_all= (bcasttmp(4) == 1) flux_swpf = rbcasttmp(1) flux_Qmin = rbcasttmp(2) flux_Qacc0 = rbcasttmp(3) - ! Validate datamode if ( trim(datamode) == 'ssmi' .or. trim(datamode) == 'ssmi_iaf') then if (my_task == main_task) write(logunit,*) ' dice datamode = ',trim(datamode) @@ -327,10 +335,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState ! by replacing the advertised fields with the newly created fields of the same name. call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':diceExport', rc=rc) + subname//':diceExport', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_fldlist_realize( importState, fldsImport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':diceImport', rc=rc) + subname//':diceImport', .false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! for single column, the target point might not be a point where the ice/ocn mask is > 0 diff --git a/dlnd/CMakeLists.txt b/dlnd/CMakeLists.txt index 38d6a416a..865f31e6b 100644 --- a/dlnd/CMakeLists.txt +++ b/dlnd/CMakeLists.txt @@ -17,4 +17,17 @@ add_dependencies(dlnd dshr streams) target_include_directories (dlnd PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (dlnd PRIVATE "${CMAKE_SOURCE_DIR}") target_include_directories (dlnd PRIVATE "${PIO_Fortran_INCLUDE_DIR}") -target_include_directories (dlnd PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +if(NOT DISABLE_FoX) + target_include_directories (dlnd PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + +if(BLD_STANDALONE) + # ESMX requires mod files + foreach (SRC ${SRCFILES}) + string(REGEX REPLACE "[.]F90$" ".mod" MOD ${SRC}) + if (NOT DEFINED CIMEROOT AND MOD STREQUAL lnd_comp_nuopc.mod) + set(MOD cdeps_dlnd_comp.mod) + endif() + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/${MOD}" DESTINATION include) + endforeach () +endif() diff --git a/dlnd/lnd_comp_nuopc.F90 b/dlnd/lnd_comp_nuopc.F90 index 320540581..5fe855ddf 100644 --- a/dlnd/lnd_comp_nuopc.F90 +++ b/dlnd/lnd_comp_nuopc.F90 @@ -25,7 +25,7 @@ module cdeps_dlnd_comp use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort use shr_cal_mod , only : shr_cal_ymd2date - use shr_log_mod , only : shr_log_setLogUnit + use shr_log_mod , only : shr_log_setLogUnit use dshr_methods_mod , only : dshr_state_getfldptr, dshr_state_diagnose, chkerr, memcheck use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_advance, shr_strdata_get_stream_domain use dshr_strdata_mod , only : shr_strdata_init_from_config @@ -81,6 +81,8 @@ module cdeps_dlnd_comp integer :: nx_global ! global nx dimension of model mesh integer :: ny_global ! global ny dimension of model mesh logical :: skip_restart_read = .false. ! true => skip restart read in continuation + logical :: export_all = .false. ! true => export all fields, do not check connected or not + ! linked lists type(fldList_type) , pointer :: fldsExport => null() type(dfield_type) , pointer :: dfields => null() @@ -155,6 +157,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -166,7 +169,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_VM) :: vm character(CL) :: cvalue integer :: nu ! unit number - integer :: bcasttmp(3) + integer :: bcasttmp(4) integer :: ierr ! error code character(len=*) , parameter :: subname=trim(modName)//':(InitializeAdvertise) ' character(*) , parameter :: F00 = "('(" // trim(modName) // ") ',8a)" @@ -175,7 +178,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- namelist / dlnd_nml / datamode, model_meshfile, model_maskfile, & - nx_global, ny_global, restfilm, skip_restart_read + nx_global, ny_global, restfilm, skip_restart_read, export_all rc = ESMF_SUCCESS @@ -196,6 +199,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (my_task == main_task) then nlfilename = "dlnd_in"//trim(inst_suffix) open (newunit=nu, file=trim(nlfilename), status="old", action="read") + call shr_nl_find_group_name(nu, 'dlnd_nml', status=ierr) + read (nu,nml=dlnd_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -206,7 +211,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) bcasttmp(1) = nx_global bcasttmp(2) = ny_global if(skip_restart_read) bcasttmp(3) = 1 + if(export_all) bcasttmp(4) = 1 end if + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -218,11 +225,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, restfilm, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) + call ESMF_VMBroadcast(vm, bcasttmp, 4, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) + export_all = (bcasttmp(4) == 1) ! write namelist input to standard out if (my_task == main_task) then @@ -233,6 +241,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logunit,F01)' ny_global = ',ny_global write(logunit,F00)' restfilm = ',trim(restfilm) write(logunit,F02)' skip_restart_read = ',skip_restart_read + write(logunit,F02)' export_all = ',export_all endif ! Validate sdat datamode @@ -289,7 +298,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Realize the actively coupled fields, now that a mesh is established and ! initialize dfields data type (to map streams to export state fields) - call dlnd_comp_realize(importState, exportState, rc=rc) + call dlnd_comp_realize(importState, exportState, export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Read restart if necessary @@ -459,11 +468,12 @@ subroutine dlnd_comp_advertise(importState, exportState, rc) end subroutine dlnd_comp_advertise !=============================================================================== - subroutine dlnd_comp_realize(importState, exportState, rc) + subroutine dlnd_comp_realize(importState, exportState, export_all, rc) ! input/output variables type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState + logical , intent(in) :: export_all integer , intent(out) :: rc ! local variables @@ -478,7 +488,7 @@ subroutine dlnd_comp_realize(importState, exportState, rc) ! ------------------------------------- call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':dlndExport', rc=rc) + subname//':dlndExport', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine dlnd_comp_realize diff --git a/docn/CMakeLists.txt b/docn/CMakeLists.txt index b8a2b44ee..007d595ca 100644 --- a/docn/CMakeLists.txt +++ b/docn/CMakeLists.txt @@ -23,4 +23,17 @@ add_dependencies(docn dshr streams) target_include_directories (docn PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (docn PRIVATE ${CMAKE_SOURCE_DIR}) target_include_directories (docn PRIVATE ${PIO_Fortran_INCLUDE_DIR}) -target_include_directories (docn PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +if(NOT DISABLE_FoX) + target_include_directories (docn PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + +if(BLD_STANDALONE) + # ESMX requires mod files + foreach (SRC ${SRCFILES}) + string(REGEX REPLACE "[.]F90$" ".mod" MOD ${SRC}) + if (NOT DEFINED CIMEROOT AND MOD STREQUAL ocn_comp_nuopc.mod) + set(MOD cdeps_docn_comp.mod) + endif() + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/${MOD}" DESTINATION include) + endforeach () +endif() diff --git a/docn/cime_config/config_component.xml b/docn/cime_config/config_component.xml index a06201aaa..0e03abf26 100644 --- a/docn/cime_config/config_component.xml +++ b/docn/cime_config/config_component.xml @@ -155,12 +155,12 @@ $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926.nc $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c110526.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2012_c130411.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2012_c130411.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2012_c130411.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2012_c130411.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2012_c130411.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2012_c130411.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2021_c120422.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2021_c120422.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2021_c120422.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2021_c120422.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2021_c120422.nc + $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2021_c120422.nc $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c101029.nc $DIN_LOC_ROOT/ocn/docn7/SSTDATA/sst_ice_CMIP6_DECK_E3SM_1x1_1850_clim_c20190125.nc $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c101028.nc @@ -240,7 +240,7 @@ 0 - 2012 + 2021 run_component_cam_sstice env_run.xml diff --git a/docn/ocn_comp_nuopc.F90 b/docn/ocn_comp_nuopc.F90 index d885b248b..a5e50ce50 100644 --- a/docn/ocn_comp_nuopc.F90 +++ b/docn/ocn_comp_nuopc.F90 @@ -103,6 +103,7 @@ module cdeps_docn_comp integer :: nx_global integer :: ny_global logical :: skip_restart_read = .false. ! true => skip restart read in continuation run + logical :: export_all = .false. ! true => export all fields, do not check connected or not ! linked lists type(fldList_type) , pointer :: fldsImport => null() @@ -177,7 +178,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -189,7 +190,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: nu ! unit number integer :: ierr ! error code character(len=CL) :: import_data_fields ! colon deliminted strings of input data fields - integer :: bcasttmp(3) + integer :: bcasttmp(4) real(r8) :: rtmp(1) type(ESMF_VM) :: vm character(len=*),parameter :: subname=trim(module_name)//':(InitializeAdvertise) ' @@ -202,7 +203,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) namelist / docn_nml / datamode, & model_meshfile, model_maskfile, & restfilm, nx_global, ny_global, sst_constant_value, skip_restart_read, & - import_data_fields + import_data_fields, export_all rc = ESMF_SUCCESS @@ -223,6 +224,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Read docn_nml from nlfilename nlfilename = "docn_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") + call shr_nl_find_group_name(nu, 'docn_nml', status=ierr) read (nu,nml=docn_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -241,12 +243,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logunit,F02)' skip_restart_read = ',skip_restart_read write(logunit,F00)' import_data_fields = ',trim(import_data_fields) write(logunit,*) ' sst_constant_value = ',sst_constant_value + write(logunit,F02)' export_all = ', export_all bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global if(skip_restart_read) bcasttmp(3) = 1 + if(export_all) bcasttmp(4) = 1 rtmp(1) = sst_constant_value + if(export_all) bcasttmp(4) = 1 endif ! Broadcast namelist input @@ -264,15 +269,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_VMBroadcast(vm, import_data_fields, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) + call ESMF_VMBroadcast(vm, bcasttmp, 4, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, rtmp, 1, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) + export_all = (bcasttmp(4) == 1) sst_constant_value = rtmp(1) ! Special logic for prescribed aquaplanet @@ -390,10 +395,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState ! by replacing the advertised fields with the newly created fields of the same name. call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//trim(modelname)//':Export', rc=rc) + subname//trim(modelname)//':Export', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call dshr_fldlist_realize( importState, fldsImport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//trim(modelname)//':Import', rc=rc) + subname//trim(modelname)//':Import', .false., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! for single column, the target point might not be a valid ocn point diff --git a/drof/CMakeLists.txt b/drof/CMakeLists.txt index 6cfc91167..444c855e6 100644 --- a/drof/CMakeLists.txt +++ b/drof/CMakeLists.txt @@ -17,4 +17,17 @@ add_dependencies(drof dshr streams) target_include_directories (drof PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (drof PRIVATE "${CMAKE_SOURCE_DIR}") target_include_directories (drof PRIVATE "${PIO_Fortran_INCLUDE_DIR}") +if(NOT DISABLE_FoX) target_include_directories (drof PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + +if(BLD_STANDALONE) + # ESMX requires mod files + foreach (SRC ${SRCFILES}) + string(REGEX REPLACE "[.]F90$" ".mod" MOD ${SRC}) + if (NOT DEFINED CIMEROOT AND MOD STREQUAL rof_comp_nuopc.mod) + set(MOD cdeps_drof_comp.mod) + endif() + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/${MOD}" DESTINATION include) + endforeach () +endif() diff --git a/drof/cime_config/config_component.xml b/drof/cime_config/config_component.xml index 8400ada9d..c87e1f1c6 100644 --- a/drof/cime_config/config_component.xml +++ b/drof/cime_config/config_component.xml @@ -13,7 +13,7 @@ --> - Data runoff model + Data runoff model NULL mode COREv2 normal year forcing: COREv2 interannual year forcing: diff --git a/drof/rof_comp_nuopc.F90 b/drof/rof_comp_nuopc.F90 index 2dbe97d3c..f6e9e7cd1 100644 --- a/drof/rof_comp_nuopc.F90 +++ b/drof/rof_comp_nuopc.F90 @@ -76,6 +76,8 @@ module cdeps_drof_comp integer :: nx_global integer :: ny_global logical :: skip_restart_read = .false. ! true => skip restart read + logical :: export_all = .false. ! true => export all fields, do not check connected or not + logical :: diagnose_data = .true. integer , parameter :: main_task=0 ! task number of main task character(*) , parameter :: rpfile = 'rpointer.rof' @@ -151,7 +153,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -164,7 +166,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: ierr ! error code type(fldlist_type), pointer :: fldList type(ESMF_VM) :: vm - integer :: bcasttmp(3) + integer :: bcasttmp(4) character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' character(*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" character(*) ,parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" @@ -172,7 +174,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- namelist / drof_nml / datamode, model_meshfile, model_maskfile, & - restfilm, nx_global, ny_global, skip_restart_read + restfilm, nx_global, ny_global, skip_restart_read, export_all rc = ESMF_SUCCESS @@ -193,6 +195,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (mainproc) then nlfilename = "drof_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") + call shr_nl_find_group_name(nu, 'drof_nml', status=ierr) read (nu,nml=drof_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -201,17 +204,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if ! write namelist input to standard out - write(logunit,F00)' datamode = ',trim(datamode) + write(logunit,F00)' datamode = ',trim(datamode) write(logunit,F00)' model_meshfile = ',trim(model_meshfile) write(logunit,F00)' model_maskfile = ',trim(model_maskfile) write(logunit,F01)' nx_global = ',nx_global write(logunit,F01)' ny_global = ',ny_global write(logunit,F00)' restfilm = ',trim(restfilm) write(logunit,F02)' skip_restart_read = ',skip_restart_read + write(logunit,F02)' export_all = ', export_all bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global if(skip_restart_read) bcasttmp(3) = 1 + if(export_all) bcasttmp(4) = 1 end if ! broadcast namelist input @@ -226,12 +231,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, restfilm, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) + call ESMF_VMBroadcast(vm, bcasttmp, 4, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) - + export_all = (bcasttmp(4) == 1) ! Validate datamode if (trim(datamode) == 'copyall') then @@ -294,7 +300,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState ! by replacing the advertised fields with the newly created fields of the same name. call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':drofExport', rc=rc) + subname//':drofExport', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get the time to interpolate the stream data to diff --git a/dshr/dshr_fldlist_mod.F90 b/dshr/dshr_fldlist_mod.F90 index 11b0ab5e3..398e1ce61 100644 --- a/dshr/dshr_fldlist_mod.F90 +++ b/dshr/dshr_fldlist_mod.F90 @@ -53,7 +53,7 @@ end subroutine dshr_fldlist_add !=============================================================================== - subroutine dshr_fldlist_realize(state, fldLists, flds_scalar_name, flds_scalar_num, mesh, tag, rc) + subroutine dshr_fldlist_realize(state, fldLists, flds_scalar_name, flds_scalar_num, mesh, tag, export_all, rc) ! input/output variables type(ESMF_State) , intent(inout) :: state @@ -62,6 +62,7 @@ subroutine dshr_fldlist_realize(state, fldLists, flds_scalar_name, flds_scalar_n integer , intent(in) :: flds_scalar_num type(ESMF_Mesh) , intent(in) :: mesh character(len=*) , intent(in) :: tag + logical , intent(in) :: export_all integer , intent(inout) :: rc ! local variables @@ -77,7 +78,13 @@ subroutine dshr_fldlist_realize(state, fldLists, flds_scalar_name, flds_scalar_n do while (associated(fldList)) stdname = fldList%stdname - if (NUOPC_IsConnected(state, fieldName=stdname)) then + if (NUOPC_IsConnected(state, fieldName=stdname) .or. export_all) then + ! Check field name since linked list might have empty string + if (trim(stdname) == '') then + fldList => fldList%next + cycle + end if + if (stdname == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & ESMF_LOGMSG_INFO) diff --git a/dshr/dshr_mod.F90 b/dshr/dshr_mod.F90 index 579296a9a..f253adc05 100644 --- a/dshr/dshr_mod.F90 +++ b/dshr/dshr_mod.F90 @@ -1346,7 +1346,7 @@ subroutine dshr_orbital_update(Time, logunit, maintask, eccen, obliqr, lambm0, integer :: orb_year ! orbital year for current orbital computation character(len=CL) :: msgstr ! temporary logical :: lprint - logical :: first_time = .true. + logical, save :: first_time = .true. character(len=*) , parameter :: subname = "(dshr_orbital_update)" !------------------------------------------- diff --git a/dwav/CMakeLists.txt b/dwav/CMakeLists.txt index 676b30040..2d96bf3a6 100644 --- a/dwav/CMakeLists.txt +++ b/dwav/CMakeLists.txt @@ -17,4 +17,17 @@ add_dependencies(dwav dshr streams) target_include_directories (dwav PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (dwav PRIVATE "${CMAKE_SOURCE_DIR}") target_include_directories (dwav PRIVATE "${PIO_Fortran_INCLUDE_DIR}") +if(NOT DISABLE_FoX) target_include_directories (dwav PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + +if(BLD_STANDALONE) + # ESMX requires mod files + foreach (SRC ${SRCFILES}) + string(REGEX REPLACE "[.]F90$" ".mod" MOD ${SRC}) + if (NOT DEFINED CIMEROOT AND MOD STREQUAL wav_comp_nuopc.mod) + set(MOD cdeps_dwav_comp.mod) + endif() + install(FILES "${CMAKE_CURRENT_BINARY_DIR}/${MOD}" DESTINATION include) + endforeach () +endif() diff --git a/dwav/wav_comp_nuopc.F90 b/dwav/wav_comp_nuopc.F90 index abf1a029f..351e7c82e 100644 --- a/dwav/wav_comp_nuopc.F90 +++ b/dwav/wav_comp_nuopc.F90 @@ -77,6 +77,8 @@ module cdeps_dwav_comp integer :: nx_global integer :: ny_global logical :: skip_restart_read = .false. ! true => skip restart read + logical :: export_all = .false. ! true => export all fields, do not check connected or not + ! constants logical :: diagnose_data = .true. integer , parameter :: main_task=0 ! task number of main task @@ -149,6 +151,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nl_mod, only: shr_nl_find_group_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -161,7 +164,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: nu ! unit number integer :: ierr ! error code type(ESMF_VM) :: vm - integer :: bcasttmp(3) + integer :: bcasttmp(4) character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' character(*) ,parameter :: F00 = "('(" // trim(modName) // ") ',8a)" character(*) ,parameter :: F01 = "('(" // trim(modName) // ") ',a,2x,i8)" @@ -169,7 +172,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- namelist / dwav_nml / datamode, model_meshfile, model_maskfile, & - restfilm, nx_global, ny_global, skip_restart_read + restfilm, nx_global, ny_global, skip_restart_read, export_all rc = ESMF_SUCCESS @@ -190,6 +193,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (my_task == main_task) then nlfilename = "dwav_in"//trim(inst_suffix) open (newunit=nu,file=trim(nlfilename),status="old",action="read") + call shr_nl_find_group_name(nu, 'dwav_nml', status=ierr) read (nu,nml=dwav_nml,iostat=ierr) close(nu) if (ierr > 0) then @@ -198,17 +202,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if ! write namelist input to standard out - write(logunit,F00)' datamode = ',trim(datamode) + write(logunit,F00)' datamode = ',trim(datamode) write(logunit,F00)' model_meshfile = ',trim(model_meshfile) write(logunit,F00)' model_maskfile = ',trim(model_maskfile) - write(logunit,F01)' nx_global = ',nx_global - write(logunit,F01)' ny_global = ',ny_global - write(logunit,F00)' restfilm = ',trim(restfilm) + write(logunit,F01)' nx_global = ',nx_global + write(logunit,F01)' ny_global = ',ny_global + write(logunit,F00)' restfilm = ',trim(restfilm) write(logunit,F02)' skip_restart_read = ',skip_restart_read + write(logunit,F02)' export_all = ', export_all bcasttmp = 0 bcasttmp(1) = nx_global bcasttmp(2) = ny_global if(skip_restart_read) bcasttmp(3) = 1 + if(export_all) bcasttmp(4) = 1 endif ! broadcast namelist input @@ -223,11 +229,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadcast(vm, restfilm, CL, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMBroadcast(vm, bcasttmp, 3, main_task, rc=rc) + call ESMF_VMBroadcast(vm, bcasttmp, 4, main_task, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nx_global = bcasttmp(1) ny_global = bcasttmp(2) skip_restart_read = (bcasttmp(3) == 1) + export_all = (bcasttmp(4) == 1) ! Call advertise phase if (trim(datamode) == 'copyall') then @@ -278,7 +286,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Realize the actively coupled fields, now that a mesh is established and ! initialize dfields data type (to map streams to export state fields) - call dwav_comp_realize(importState, exportState, rc=rc) + call dwav_comp_realize(importState, exportState, export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Read restart if necessary @@ -427,11 +435,12 @@ subroutine dwav_comp_advertise(importState, exportState, rc) end subroutine dwav_comp_advertise !=============================================================================== - subroutine dwav_comp_realize(importState, exportState, rc) + subroutine dwav_comp_realize(importState, exportState, export_all, rc) ! input/output variables type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState + logical , intent(in) :: export_all integer , intent(out) :: rc ! local variables @@ -446,7 +455,7 @@ subroutine dwav_comp_realize(importState, exportState, rc) ! ------------------------------------- call dshr_fldlist_realize( exportState, fldsExport, flds_scalar_name, flds_scalar_num, model_mesh, & - subname//':dwavExport', rc=rc) + subname//':dwavExport', export_all, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create stream-> export state mapping diff --git a/share/CMakeLists.txt b/share/CMakeLists.txt index 215847dae..6d1c3607d 100644 --- a/share/CMakeLists.txt +++ b/share/CMakeLists.txt @@ -5,10 +5,12 @@ set (GenF90_SRCS shr_infnan_mod.F90 shr_assert_mod.F90) add_library(cdeps_share ${GenF90_SRCS} + shr_nl_mod.F90 glc_elevclass_mod.F90 shr_timer_mod.F90 shr_cal_mod.F90 shr_kind_mod.F90 + shr_file_mod.F90 shr_sys_mod.F90 shr_abort_mod.F90 shr_const_mod.F90 diff --git a/share/shr_file_mod.F90 b/share/shr_file_mod.F90 new file mode 100644 index 000000000..c76bfca58 --- /dev/null +++ b/share/shr_file_mod.F90 @@ -0,0 +1,1048 @@ +! !MODULE: shr_file_mod.F90 --- Module to handle various file utilily functions. +! +! !DESCRIPTION: +! +! Miscilaneous methods to handle file and directory utilities as well as FORTRAN +! unit control. Also put/get local files into/from archival location +! +! File utilites used with CCSM Message passing: +! +! shr_file_stdio is the main example here, it changes the working directory, +! changes stdin and stdout to a given filename. +! +! This is needed because some implementations of MPI with MPMD so that +! each executable can run in a different working directory and redirect +! output to different files. +! +! File name archival convention, eg. +! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) +! is extensible -- the existence of the option file name prefix, eg. "mss:", +! and optional arguments, eg. rtpd-3650 can be used to access site-specific +! storage devices. Based on CCM (atmosphere) getfile & putfile routines, but +! intended to be a more extensible, shared code. +! +! !REVISION HISTORY: +! 2006-05-08 E. Kluzek, Add in shr_file_mod and getUnit, freeUnif methods. +! 2000-??-?? B. Kauffman, original version circa 2000 +! +! !INTERFACE: ------------------------------------------------------------------ + +MODULE shr_file_mod + + ! !USES: + + use shr_kind_mod ! defines kinds + use shr_sys_mod ! system calls + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + IMPLICIT none + + PRIVATE ! By default everything is private to this module + + ! !PUBLIC TYPES: + + ! no public types + + ! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_file_put ! Put a file to an archive location + public :: shr_file_get ! Get a file from an archive location + public :: shr_file_queryPrefix ! Get prefix type for a filename + public :: shr_file_getUnit ! Get a logical unit for reading or writing + public :: shr_file_freeUnit ! Free a logical unit + public :: shr_file_stdio ! change dir and stdin and stdout + public :: shr_file_chDir ! change current working directory + public :: shr_file_dirio ! change stdin and stdout + public :: shr_file_chStdIn ! change stdin (attach to a file) + public :: shr_file_chStdOut ! change stdout (attach to a file) + public :: shr_file_setIO ! open a log file from namelist + public :: shr_file_setLogUnit ! Reset the log unit number + public :: shr_file_setLogLevel ! Reset the logging debug level + public :: shr_file_getLogUnit ! Get the log unit number + public :: shr_file_getLogLevel ! Get the logging debug level + public :: shr_file_get_real_path ! Get a fully resolved path +#if defined NEMO_IN_CCSM + public :: shr_file_maxUnit ! Max unit number to give +#endif + + ! !PUBLIC DATA MEMBERS: + + ! Integer flags for recognized prefixes on file get/put operations + integer(SHR_KIND_IN), parameter, public :: shr_file_noPrefix = 0 ! no recognized prefix + integer(SHR_KIND_IN), parameter, public :: shr_file_nullPrefix = 1 ! null: + integer(SHR_KIND_IN), parameter, public :: shr_file_cpPrefix = 2 ! cp: + integer(SHR_KIND_IN), parameter, public :: shr_file_mssPrefix = 3 ! mss: + integer(SHR_KIND_IN), parameter, public :: shr_file_hpssPrefix = 4 ! hpss: + + !EOP + !--- unit numbers, users can ask for unit numbers from 0 to min, but getUnit + !--- won't give a unit below min, users cannot ask for unit number above max + !--- for backward compatability. + !--- eventually, recommend min as hard lower limit (tcraig, 9/2007) + integer(SHR_KIND_IN),parameter :: shr_file_minUnit = 10 ! Min unit number to give + integer(SHR_KIND_IN),parameter :: shr_file_maxUnit = 99 ! Max unit number to give + logical, save :: UnitTag(0:shr_file_maxUnit) = .false. ! Logical units in use + + !=============================================================================== +CONTAINS + !=============================================================================== + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_put -- Put a file to an archival location. + ! + ! !DESCRIPTION: + ! a generic, extensible put-local-file-into-archive routine + ! USAGE: + ! call shr_file_put(rcode,"foo","/home/user/foo") + ! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) + ! call shr_file_put(rcode,"foo","cp:/home/user/foo",remove=.true.) + ! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) + ! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) + ! if ( rcode /= 0 ) call shr_sys_abort( "error archiving foo to MSS" ) + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_put(rcode,loc_fn,rem_fn,passwd,rtpd,async,remove) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero -- error) + character(*), intent(in) :: loc_fn ! local filename + character(*), intent(in) :: rem_fn ! remote filename + character(*), intent(in),optional :: passwd ! password + integer(SHR_KIND_IN),intent(in),optional :: rtpd ! MSS retention period + logical, intent(in),optional :: async ! true <=> asynchronous put + logical, intent(in),optional :: remove ! true <=> rm after put + + !EOP + + !----- local ----- + integer(SHR_KIND_IN) :: rtpd2 ! MSS retention period + logical :: remove2 ! true <=> rm after put + logical :: async2 ! true <=> asynchronous put + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_put) ' + character(*),parameter :: F00 = "('(shr_file_put) ',4a)" + character(*),parameter :: F01 = "('(shr_file_put) ',a,i3,2a)" + character(*),parameter :: F02 = "(a,i4)" + + !------------------------------------------------------------------------------- + ! Notes: + ! - On some machines the system call will not return a valid error code + ! - when things are sent asynchronously, there probably won't be a error code + ! returned. + !------------------------------------------------------------------------------- + + remove2 =.false. ; if ( PRESENT(remove )) remove2 = remove + async2 =.true. ; if ( PRESENT(async )) async2 = async + passwd2 = " " ; if ( PRESENT(passwd )) passwd2 = passwd + rtpd2 = 365 ; if ( PRESENT(rtpd )) rtpd2 = rtpd + rcode = 0 + prefix = shr_file_queryPrefix( rem_fn ) + + if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file = '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! put via unix cp + !------------------------------------------------------ + rfn = rem_fn + if ( rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) + cmd = '/bin/cp -f '//trim(loc_fn)//' '//trim(rfn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! put onto NCAR's MSS + !------------------------------------------------------ + if (rtpd2 > 9999) rtpd2 = 9999 + write(cmd,F02) '/usr/local/bin/msrcp -period ',rtpd2 + if (async2 .and. (.not. remove2) ) cmd = trim(cmd)//' -async ' + if (len_trim(passwd2) > 0 ) cmd = trim(cmd)//' -wpwd '//trim(passwd) + cmd = trim(cmd)//' '//trim(loc_fn)//' '//trim(rem_fn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 .and. remove2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! put onto LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file archival, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + + END SUBROUTINE shr_file_put + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_get -- Get a file from archival location. + ! + ! !DESCRIPTION: + ! a generic, extensible get-local-file-from-archive routine + ! + ! USAGE: + ! call shr_file_get(rcode,"foo","/home/user/foo") + ! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) + ! call shr_file_get(rcode,"foo","cp:/home/user/foo",remove=.true.) + ! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) + ! call shr_file_get(rcode,"foo","mss:/USER/foo",clobber=.true.) + ! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo from MSS" ) + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_get(rcode,loc_fn,rem_fn,passwd,async,clobber) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero means error) + character(*) ,intent(in) :: loc_fn ! local filename + character(*) ,intent(in) :: rem_fn ! remote filename + character(*) ,intent(in),optional :: passwd ! password + logical ,intent(in),optional :: async ! true <=> asynchronous get + logical ,intent(in),optional :: clobber ! true <=> clobber existing file + + !EOP + + !----- local ----- + logical :: async2 ! true <=> asynchronous get + logical :: clobber2 ! true <=> clobber existing file + logical :: exists ! true <=> local file a ready exists + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_get) ' + character(*),parameter :: F00 = "('(shr_file_get) ',4a)" + character(*),parameter :: F01 = "('(shr_file_get) ',a,i3,2a)" + + !------------------------------------------------------------------------------- + ! Notes: + ! - On some machines the system call will not return a valid error code + ! - When things are sent asynchronously, there probably won't be a error code + ! returned. + !------------------------------------------------------------------------------- + + passwd2 = " " ; if (PRESENT(passwd )) passwd2 = passwd + async2 = .false. ; if (PRESENT(async )) async2 = async + clobber2 = .false. ; if (PRESENT(clobber)) clobber2 = clobber + rcode = 0 + + inquire(file=trim(loc_fn),exist=exists) + prefix = shr_file_queryPrefix( rem_fn ) + + if ( exists .and. .not. clobber2 ) then + !------------------------------------------------------ + ! (file exists) and (don't clobber) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: file exists & no-clobber for '//trim(loc_fn) + rcode = 0 + else if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file for '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! get via unix cp + !------------------------------------------------------ + rfn = rem_fn ! remove prefix from this temp file name + if (rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) + cmd = '/bin/cp -f '//trim(rfn)//' '//trim(loc_fn) + if (async2) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! get from NCAR's MSS + !------------------------------------------------------ + cmd = '/usr/local/bin/msrcp ' + if (async2) cmd = trim(cmd)//' -async ' + cmd = trim(cmd)//' '//trim(rem_fn)//' '//trim(loc_fn) + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! get from LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file retrieval, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + + END SUBROUTINE shr_file_get + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_queryPrefix -- Get the prefix type from a filepath. + ! + ! !DESCRIPTION: + ! + ! !INTERFACE: ------------------------------------------------------------------ + + integer(SHR_KIND_IN) FUNCTION shr_file_queryPrefix( filepath, prefix ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*), intent(in) :: filepath ! Input filepath + character(*), intent(out), optional :: prefix ! Output prefix description + + !EOP + + !----- local ----- + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + if ( filepath(1:5) == "null:" )then + shr_file_queryPrefix = shr_file_nullPrefix + if ( present(prefix) ) prefix = "null:" + else if( filepath(1:3) == "cp:" )then + shr_file_queryPrefix = shr_file_cpPrefix + if ( present(prefix) ) prefix = "cp:" + else if( filepath(1:4) == "mss:" )then + shr_file_queryPrefix = shr_file_mssPrefix + if ( present(prefix) ) prefix = "mss:" + else if( filepath(1:5) == "hpss:" )then + shr_file_queryPrefix = shr_file_hpssPrefix + if ( present(prefix) ) prefix = "hpss:" + else + shr_file_queryPrefix = shr_file_noPrefix + if ( present(prefix) ) prefix = "" + end if + + END FUNCTION shr_file_queryPrefix + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_getUnit -- Get a free FORTRAN unit number + ! + ! !DESCRIPTION: Get the next free FORTRAN unit number. + ! + ! !REVISION HISTORY: + ! 2005-Dec-14 - E. Kluzek - creation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + INTEGER FUNCTION shr_file_getUnit ( unit ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in),optional :: unit ! desired unit number + + !EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! loop index + logical :: opened ! If unit opened or not + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_getUnit) ' + character(*),parameter :: F00 = "('(shr_file_getUnit) ',A,I4,A)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + shr_file_getUnit = -1 + if (present (unit)) then + inquire( unit, opened=opened ) + if (unit < 0 .or. unit > shr_file_maxUnit) then + write(s_logunit,F00) 'invalid unit number request:', unit + call shr_sys_abort( 'ERROR: bad input unit number' ) + else if (opened .or. UnitTag(unit) .or. unit == 0 .or. unit == 5 & + .or. unit == 6) then + write(s_logunit,F00) 'unit number ', unit, ' is already in use' + call shr_sys_abort( 'ERROR: Input unit number already in use' ) + else + shr_file_getUnit = unit + UnitTag (unit) = .true. + return + end if + + else + ! --- Choose first available unit other than 0, 5, or 6 ------ + do n=shr_file_maxUnit, shr_file_minUnit, -1 + inquire( n, opened=opened ) + if (n == 5 .or. n == 6 .or. opened) then + cycle + end if + if ( .not. UnitTag(n) ) then + shr_file_getUnit = n + UnitTag(n) = .true. + return + end if + end do + end if + + call shr_sys_abort( subName//': Error: no available units found' ) + + END FUNCTION shr_file_getUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_freeUnit -- Free up a FORTRAN unit number + ! + ! !DESCRIPTION: Free up the given unit number + ! + ! !REVISION HISTORY: + ! 2005-Dec-14 - E. Kluzek - creation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_freeUnit ( unit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! unit number to be freed + + !EOP + + !----- local ----- + + !----- formats ----- + character(*), parameter :: subName = '(shr_file_freeUnit) ' + character(*), parameter :: F00 = "('(shr_file_freeUnit) ',A,I4,A)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + if (unit < 0 .or. unit > shr_file_maxUnit) then + if (s_loglev > 0) write(s_logunit,F00) 'invalid unit number request:', unit + else if (unit == 0 .or. unit == 5 .or. unit == 6) then + call shr_sys_abort( subName//': Error: units 0, 5, and 6 must not be freed' ) + else if (UnitTag(unit)) then + UnitTag (unit) = .false. + else + if (s_loglev > 0) write(s_logunit,F00) 'unit ', unit, ' was not in use' + end if + + return + + END SUBROUTINE shr_file_freeUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_stdio -- Change working directory, and redirect stdin/stdout + ! + ! !DESCRIPTION: + ! 1) change the cwd (current working directory) and + ! 2) redirect stdin & stdout (units 5 & 6) to named files, + ! where the desired cwd & files are specified by namelist file. + ! + ! Normally this is done to work around limitations in the execution syntax + ! of common MPI implementations. For example, SGI's mpirun syntax is not + ! flexible enough to allow MPMD models to select different execution + ! directories or to redirect stdin & stdout on the command line. + ! Such functionality is highly desireable for CCSM purposes. + ! ie. mpirun can't handle this: + ! unix> cd /usr/tmp/jdoe/csm/case01/atm ; atm < atm.parm > atm.log & + ! unix> cd /usr/tmp/jdoe/csm/case01/cpl ; cpl < cpl.parm > cpl.log & + ! etc. + ! + ! ASSUMPTIONS: + ! o if the cwd, stdin, or stdout are to be changed, there must be a namelist + ! file in the cwd named _stdio.nml where is provided via + ! subroutine dummy argument. + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_stdio(model) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdio) ' + character(*),parameter :: F00 = "('(shr_file_stdio) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_chdir (model) ! changes cwd + call shr_file_chStdOut(model) ! open units 5 & 6 to named files + call shr_file_chStdIn (model) ! open units 5 & 6 to named files + + END SUBROUTINE shr_file_stdio + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_chdir -- Change working directory. + ! + ! !DESCRIPTION: + ! change the cwd (current working directory), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_chdir(model, rcodeOut) + + ! !USES: + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code + + !EOP + + !--- local --- + character(SHR_KIND_CL) :: dir ! directory to cd to + integer (SHR_KIND_IN) :: rcode ! Return error code + character(SHR_KIND_CL) :: filename ! namelist file to read + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chdir) ' + character(*),parameter :: F00 = "('(shr_file_chdir) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, dirOut=dir, rcodeOut=rcode ) + if (dir /= "nochange") then + call shr_sys_chdir(dir ,rcode) + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", changed cwd to ",trim(dir) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", cwd has *not* been changed" + rcode = 1 + endif + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_chdir + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_dirio --- Change stdin and stdout. + ! + ! !DESCRIPTION: + ! change the stdin & stdout (units 5 & 6), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_dirio(model) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + + !EOP + + !--- local --- + + !--- formats --- + character(*),parameter :: subName = '(shr_file_dirio) ' + + !------------------------------------------------------------------------------- + ! Notes: + ! + !------------------------------------------------------------------------------- + + call shr_file_chStdIn (model) + call shr_file_chStdOut(model) + + END SUBROUTINE shr_file_dirio + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_chStdIn -- Change stdin + ! + ! !DESCRIPTION: + ! change the stdin (unit 5), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_chStdIn( model, NLFilename, rcodeOut ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env var name + character(SHR_KIND_CL),intent(out),optional :: NLFilename ! open unit 5 to this + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + + !EOP + + !--- local --- + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: nlfile ! Namelist filename for model to read from + character(SHR_KIND_CL) :: filename ! namelist file to read + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdIn) ' + character(*),parameter :: F00 = "('(shr_file_chStdIn) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdinOut=stdin, & + nlfileOut=nlfile, rcodeOut=rcode ) + if (stdin /= "nochange") then + open(unit=5,file=stdin ,status='UNKNOWN',iostat=rcode) + if ( rcode /= 0 )then + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': error opening file as unit 5:', & + trim(nlfile) + else + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': unit 5 connected to ', & + trim(stdin) + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 5 has *not* been redirected' + endif + if ( len_trim(nlfile) > 0) then + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': read namelist from file:',trim(nlfile) + if ( .not. present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename NOT present" + rcode = 7 + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", " + if ( present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename present, but null" + rcode = 8 + end if + endif + if ( present(NLFilename) ) NLFilename = nlfile + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_chStdIn + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_stdout -- Change stdout + ! + ! !DESCRIPTION: + ! change the stdout (unit 6), see shr_file_stdio for notes + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_chStdOut(model,rcodeOut) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + !--- arguments --- + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code + !EOP + + !--- local --- + character(SHR_KIND_CL) :: filename ! namelist file to read + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdOut) ' + character(*),parameter :: F00 = "('(shr_file_chStdOut) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdoutOut=stdout, & + rcodeOut=rcode ) + if (stdout /= "nochange") then + close(6) + open(unit=6,file=stdout,position='APPEND') + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 connected to ',trim(stdout) + call shr_sys_flush(s_logunit) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 has *not* been redirected' + rcode = 1 + endif + + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_chStdOut + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_stdioReadNL -- read in stdio namelist + ! + ! !DESCRIPTION: + ! Read in the stdio namelist for any given model type. Return any of the + ! needed input namelist variables as optional arguments. Return "nochange" in + ! dir, stdin, or stdout if shouldn't change. + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_stdioReadNL( model, filename, dirOut, stdinOut, stdoutOut, & + NLFileOut, rcodeOut ) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + character(SHR_KIND_CL),intent(out) :: filename ! nml file to read from unit 5 + character(SHR_KIND_CL),intent(out),optional :: NLFileOut ! open unit 6 to this file + character(SHR_KIND_CL),intent(out),optional :: dirOut ! directory to cd to + character(SHR_KIND_CL),intent(out),optional :: stdinOut ! open unit 5 to this file + character(SHR_KIND_CL),intent(out),optional :: stdoutOut ! open unit 6 to this file + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + + !EOP + + !--- local --- + logical :: exists ! true iff file exists + character(SHR_KIND_CL) :: dir ! directory to cd to + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + character(SHR_KIND_CL) :: NLFile ! namelist file to read seperately + integer (SHR_KIND_IN) :: rcode ! return code + integer (SHR_KIND_IN) :: unit ! Unit to read from + + namelist / stdio / dir,stdin,stdout,NLFile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdioReadNL) ' + character(*),parameter :: F00 = "('(shr_file_stdioReadNL) ',4a)" + character(*),parameter :: F01 = "('(shr_file_stdioReadNL) ',3a,i6)" + + !------------------------------------------------------------------------------- + ! Notes: + ! + !------------------------------------------------------------------------------- + + rcode = 0 + dir = "nochange" + stdin = "nochange" + stdout = "nochange" + NLFile = " " + + filename = trim(model)//"_stdio.nml" ! eg. file="cpl_stdio.nml" + inquire(file=filename,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(filename),& + & " doesn't exist, can not read stdio namelist from it" + rcode = 9 + else + unit = shr_file_getUnit() + open (unit,file=filename,action="READ") + read (unit,nml=stdio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(filename),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(filename) ) + end if + endif + if ( len_trim(NLFile) > 0 .and. trim(stdin) /= "nochange" )then + write(s_logunit,F00) "Error: input namelist:" + write(s_logunit,nml=stdio) + call shr_sys_abort(subName//" ERROR trying to both redirect AND "// & + "open namelist filename" ) + end if + if ( present(NLFileOut) ) NLFileOut = NLFile + if ( present(dirOut) ) dirOut = dir + if ( present(stdinOut) ) stdinOut = stdin + if ( present(stdoutOut) ) stdoutOut = stdout + if ( present(rcodeOut) ) rcodeOut = rcode + + END SUBROUTINE shr_file_stdioReadNL + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_setIO -- read in stdio namelist + ! + ! !DESCRIPTION: + ! This opens a namelist file specified as an argument and then opens + ! a log file associated with the unit argument. This may be extended + ! in the future. + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_setIO( nmlfile, funit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + character(len=*) ,intent(in) :: nmlfile ! namelist filename + integer(SHR_KIND_IN),intent(in) :: funit ! unit number for log file + + !EOP + + !--- local --- + logical :: exists ! true if file exists + character(SHR_KIND_CL) :: diri ! directory to cd to + character(SHR_KIND_CL) :: diro ! directory to cd to + character(SHR_KIND_CL) :: logfile ! open unit 6 to this file + integer(SHR_KIND_IN) :: unit ! unit number + integer(SHR_KIND_IN) :: rcode ! error code + + namelist / modelio / diri,diro,logfile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setIO) ' + character(*),parameter :: F00 = "('(shr_file_setIO) ',4a)" + character(*),parameter :: F01 = "('(shr_file_setIO) ',3a,i6)" + + !------------------------------------------------------------------------------- + ! Notes: + ! + !------------------------------------------------------------------------------- + + diri = "." + diro = "." + logfile = "" + + inquire(file=nmlfile,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(nmlfile)," nonexistent" + return + else + unit = shr_file_getUnit() + open (unit,file=nmlfile,action="READ") + read (unit,nml=modelio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(nmlfile),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(nmlfile) ) + end if + endif + + if (len_trim(logfile) > 0) then + open(funit,file=trim(diro)//"/"//trim(logfile)) + else + if (s_loglev > 0) write(s_logunit,F00) "logfile not opened" + endif + + END SUBROUTINE shr_file_setIO + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_setLogUnit -- Set the Log I/O Unit number + ! Depricated - use shr_log_setLogUnit + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_setLogUnit(unit) + use shr_log_mod, only: shr_log_setLogUnit + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! new unit number + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_setLogUnit) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: Caller must be sure it's a valid unit number + !------------------------------------------------------------------------------- +#if DEBUG + if (s_loglev > 2 .and. s_logunit-unit /= 0) then + write(s_logunit,*) subName,': reset log unit number from/to ',s_logunit, unit + write( unit,*) subName,': reset log unit number from/to ',s_logunit, unit + endif + if(unit /= 6) print *,__FILE__,__LINE__,'This routine is depricated - use shr_log_setLogUnit instead', unit +#endif + call shr_log_setLogUnit(unit) + + END SUBROUTINE shr_file_setLogUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_setLogLevel -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_setLogLevel(newlevel) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: newlevel ! new log level + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_setLogLevel) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + if (s_loglev+newlevel > 2 .and. s_loglev-newlevel /= 0) & + write(s_logunit,*) subName,': reset log level from/to ',s_loglev, newlevel + + s_loglev = newlevel + + END SUBROUTINE shr_file_setLogLevel + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_getLogUnit -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_getLogUnit(unit) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: unit ! new unit number + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_getLogUnit) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + unit = s_logunit + + END SUBROUTINE shr_file_getLogUnit + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: shr_file_getLogLevel -- Set the Log I/O Unit number + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE shr_file_getLogLevel(curlevel) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: curlevel ! new log level + + !EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_getLogLevel) ',4a)" + + !------------------------------------------------------------------------------- + ! Notes: + !------------------------------------------------------------------------------- + + curlevel = s_loglev + + END SUBROUTINE shr_file_getLogLevel + + !=============================================================================== + subroutine shr_file_get_real_path(path, resolved_path) + use, intrinsic :: iso_c_binding + character(len=*), intent(in) :: path + character(len=*), intent(out) :: resolved_path + + ! Define + integer :: n + character(len=1) :: a(SHR_KIND_CL) + type(c_ptr) :: ptr + + ! Fortran interface to C function, realpath() + interface + function realpath(path,resolved_path) bind(c,name="realpath") + use, intrinsic :: iso_c_binding + type(c_ptr) :: realpath + character(len=1,kind=c_char), intent(in) :: path(*) + character(len=1,kind=c_char), intent(out) :: resolved_path(*) + end function realpath + end interface + + ! Initialize + a="" + + ptr=realpath(trim(path)//C_NULL_CHAR,a) + + ! Transfer character array to character string + resolved_path = transfer(a,resolved_path) + + ! Determine the first null char + do n=1,SHR_KIND_CL + if(iachar(resolved_path(n:n)).eq.0) exit + end do + resolved_path=resolved_path(:n-1) + end subroutine shr_file_get_real_path + + + !=============================================================================== + +END MODULE shr_file_mod diff --git a/share/shr_nl_mod.F90 b/share/shr_nl_mod.F90 new file mode 100644 index 000000000..f06f2185c --- /dev/null +++ b/share/shr_nl_mod.F90 @@ -0,0 +1,88 @@ +module shr_nl_mod + +! Utilities for namelist reading +! Adapted Fall 2012 from CAM's namelist_utils. + +implicit none +private + +save + +public :: & + shr_nl_find_group_name ! seek through a file to find a specified namelist + +contains + +! This routine probably discards more error code information than it needs to. + +subroutine shr_nl_find_group_name(unit, group, status) + + use shr_string_mod, only: shr_string_toLower + +!--------------------------------------------------------------------------------------- +! Purpose: +! Search a file that contains namelist input for the specified namelist group name. +! Leave the file positioned so that the current record is the first record of the +! input for the specified group. +! +! Method: +! Read the file line by line. Each line is searched for an '&' which may only +! be preceded by blanks, immediately followed by the group name which is case +! insensitive. If found then backspace the file so the current record is the +! one containing the group name and return success. Otherwise return -1. +! +! Author: B. Eaton, August 2007 +!--------------------------------------------------------------------------------------- + + integer, intent(in) :: unit ! fortran unit attached to file + character(len=*), intent(in) :: group ! namelist group name + integer, intent(out) :: status ! 0 for success, -1 if group name not found + + ! Local variables + + integer :: len_grp + integer :: ios ! io status + character(len=80) :: inrec ! first 80 characters of input record + character(len=80) :: inrec2 ! left adjusted input record + character(len=len(group)) :: lc_group + + !--------------------------------------------------------------------------- + + len_grp = len_trim(group) + lc_group = shr_string_toLower(group) + + ios = 0 + do while (ios <= 0) + + read(unit, '(a)', iostat=ios, end=100) inrec + + if (ios <= 0) then ! ios < 0 indicates an end of record condition + + ! look for group name in this record + + ! remove leading blanks + inrec2 = adjustl(inrec) + + ! check for leading '&' + if (inrec2(1:1) == '&') then + + ! check for case insensitive group name + if (trim(lc_group) == shr_string_toLower(inrec2(2:len_grp+1))) then + + ! found group name. backspace to leave file position at this record + backspace(unit) + status = 0 + return + + end if + end if + end if + + end do + + 100 continue ! end of file processing + status = -1 + +end subroutine shr_nl_find_group_name + +end module shr_nl_mod diff --git a/streams/CMakeLists.txt b/streams/CMakeLists.txt index 99066e802..ab4b534ba 100644 --- a/streams/CMakeLists.txt +++ b/streams/CMakeLists.txt @@ -18,14 +18,16 @@ message("Stream srcfiles are ${SRCFILES}") add_library(streams ${SRCFILES}) -add_dependencies(streams FoX_dom) +if(NOT DISABLE_FoX) + add_dependencies(streams FoX_dom) + target_include_directories (streams PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) +endif() + if(BLD_STANDALONE) add_dependencies(streams cdeps_share) target_include_directories (streams PRIVATE ${CMAKE_BINARY_DIR}/share) endif() - -target_include_directories (streams PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/../fox/include) target_include_directories (streams PRIVATE ${ESMF_F90COMPILEPATHS}) target_include_directories (streams PRIVATE ${PIO_Fortran_INCLUDE_DIR}) diff --git a/streams/dshr_stream_mod.F90 b/streams/dshr_stream_mod.F90 index da206732a..298caaded 100644 --- a/streams/dshr_stream_mod.F90 +++ b/streams/dshr_stream_mod.F90 @@ -670,8 +670,6 @@ subroutine shr_stream_init_from_esmfconfig(streamfilename, streamdat, logunit, if( ESMF_ConfigGetLen(config=CF, label="stream_vectors"//mystrm//':', rc=rc) > 0 ) then call ESMF_ConfigGetAttribute(CF,value=streamdat(i)%stream_vectors,label="stream_vectors"//mystrm//':', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort("stream_vectors must be provided") endif if( ESMF_ConfigGetLen(config=CF, label="stream_lev_dimname"//mystrm//':', rc=rc) > 0 ) then @@ -1711,7 +1709,7 @@ end subroutine shr_stream_getNFiles !=============================================================================== subroutine shr_stream_restIO(pioid, streams, mode) - + use shr_file_mod, only : shr_file_get_real_path use pio, only : pio_def_dim, pio_def_var, pio_put_var, pio_get_var, file_desc_t, var_desc_t use pio, only : pio_int, pio_char @@ -1727,7 +1725,9 @@ subroutine shr_stream_restIO(pioid, streams, mode) integer :: n, k, maxnfiles=0 integer :: maxnt = 0 integer, allocatable :: tmp(:) - character(len=CL) :: fname + integer :: logunit + character(len=CL) :: fname, rfname, rsfname + !------------------------------------------------------------------------------- if (mode .eq. 'define') then @@ -1735,6 +1735,7 @@ subroutine shr_stream_restIO(pioid, streams, mode) rcode = pio_def_dim(pioid, 'strlen', CL, dimid_str) do k=1,size(streams) ! maxnfiles is the maximum number of files across all streams + logunit = streams(k)%logunit if (streams(k)%nfiles > maxnfiles) then maxnfiles = streams(k)%nfiles endif @@ -1923,16 +1924,28 @@ subroutine shr_stream_restIO(pioid, streams, mode) rcode = pio_inq_varid(pioid, 'timeofday', tvarid) rcode = pio_inq_varid(pioid, 'haveData' , hdvarid) do k=1,size(streams) + logunit = streams(k)%logunit do n=1,streams(k)%nfiles ! read in filename rcode = pio_get_var(pioid, varid, (/1,n,k/), fname) - if (trim(fname) /= trim(streams(k)%file(n)%name)) then - write(6,'(a)')' fname = '//trim(fname) - write(6,'(a,i8,2x,i8,2x,a)')' k,n,streams(k)%file(n)%name = ',k,n,trim(streams(k)%file(n)%name) - call shr_sys_abort('ERROR reading in filename') + + if(trim(fname) /= trim(streams(k)%file(n)%name)) then + write(logunit,*) 'Filename does not match restart record, checking realpath' + call shr_file_get_real_path(fname, rfname) + call shr_file_get_real_path(trim(streams(k)%file(n)%name), rsfname) + if (trim(rfname) /= trim(rsfname)) then + write(logunit,*) 'Filename path does not match restartfile, checking filename' + rfname = fname(index(fname,'/',.true.):) + rsfname = streams(k)%file(n)%name(index(streams(k)%file(n)%name, '/',.true.):) + if (trim(rfname) /= trim(rsfname)) then + write(logunit,*) trim(rfname), '<>', trim(rsfname) + write(logunit,'(a)')' fname = '//trim(fname) + write(logunit,'(a,i8,2x,i8,2x,a)')' k,n,streams(k)%file(n)%name = ',k,n,trim(streams(k)%file(n)%name) + call shr_sys_abort('ERROR reading in filename') + endif + endif endif - ! read in nt allocate(tmp(1)) rcode = pio_get_var(pioid, ntvarid, (/n,k/), tmp(1))